summaryrefslogtreecommitdiff
path: root/lisp/mh-e/mh-folder.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/mh-e/mh-folder.el')
-rw-r--r--lisp/mh-e/mh-folder.el450
1 files changed, 211 insertions, 239 deletions
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 35277ae46a1..132ac33d269 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -72,10 +72,8 @@ the MH mail system."
;;; Desktop Integration
-;; desktop-buffer-mode-handlers appeared in Emacs 22.
-(if (boundp 'desktop-buffer-mode-handlers)
- (add-to-list 'desktop-buffer-mode-handlers
- '(mh-folder-mode . mh-restore-desktop-buffer)))
+(add-to-list 'desktop-buffer-mode-handlers
+ '(mh-folder-mode . mh-restore-desktop-buffer))
(defun mh-restore-desktop-buffer (_file-name name _misc)
"Restore an MH folder buffer specified in a desktop file.
@@ -213,141 +211,137 @@ annotation.")
(defalias 'mh-alt-visit-folder #'mh-visit-folder)
;; Save the "b" binding for a future `back'. Maybe?
-(gnus-define-keys mh-folder-mode-map
- " " mh-page-msg
- "!" mh-refile-or-write-again
- "'" mh-toggle-tick
- "," mh-header-display
- "." mh-alt-show
- ":" mh-show-preferred-alternative
- ";" mh-toggle-mh-decode-mime-flag
- ">" mh-write-msg-to-file
- "?" mh-help
- "E" mh-extract-rejected-mail
- "M" mh-modify
- "\177" mh-previous-page
- "\C-d" mh-delete-msg-no-motion
- "\t" mh-index-next-folder
- [backtab] mh-index-previous-folder
- "\M-\t" mh-index-previous-folder
- "\e<" mh-first-msg
- "\e>" mh-last-msg
- "\ed" mh-redistribute
- "\r" mh-show
- "^" mh-alt-refile-msg
- "c" mh-copy-msg
- "d" mh-delete-msg
- "e" mh-edit-again
- "f" mh-forward
- "g" mh-goto-msg
- "i" mh-inc-folder
- "k" mh-delete-subject-or-thread
- "m" mh-alt-send
- "n" mh-next-undeleted-msg
- "\M-n" mh-next-unread-msg
- "o" mh-refile-msg
- "p" mh-previous-undeleted-msg
- "\M-p" mh-previous-unread-msg
- "q" mh-quit
- "r" mh-reply
- "s" mh-send
- "t" mh-toggle-showing
- "u" mh-undo
- "v" mh-index-visit-folder
- "x" mh-execute-commands
- "|" mh-pipe-msg)
-
-(gnus-define-keys (mh-folder-map "F" mh-folder-mode-map)
- "?" mh-prefix-help
- "'" mh-index-ticked-messages
- "S" mh-sort-folder
- "c" mh-catchup
- "f" mh-alt-visit-folder
- "k" mh-kill-folder
- "l" mh-list-folders
- "n" mh-index-new-messages
- "o" mh-alt-visit-folder
- "p" mh-pack-folder
- "q" mh-index-sequenced-messages
- "r" mh-rescan-folder
- "s" mh-search
- "u" mh-undo-folder
- "v" mh-visit-folder)
-
-(define-key mh-folder-mode-map "I" mh-inc-spool-map)
-
-(gnus-define-keys (mh-junk-map "J" mh-folder-mode-map)
- "?" mh-prefix-help
- "a" mh-junk-allowlist
- "b" mh-junk-blocklist
- "w" mh-junk-whitelist)
-
-(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map)
- "?" mh-prefix-help
- "C" mh-ps-print-toggle-color
- "F" mh-ps-print-toggle-faces
- "f" mh-ps-print-msg-file
- "l" mh-print-msg
- "p" mh-ps-print-msg)
-
-(gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map)
- "'" mh-narrow-to-tick
- "?" mh-prefix-help
- "d" mh-delete-msg-from-seq
- "k" mh-delete-seq
- "l" mh-list-sequences
- "n" mh-narrow-to-seq
- "p" mh-put-msg-in-seq
- "s" mh-msg-is-in-seq
- "w" mh-widen)
-
-(gnus-define-keys (mh-thread-map "T" mh-folder-mode-map)
- "?" mh-prefix-help
- "u" mh-thread-ancestor
- "p" mh-thread-previous-sibling
- "n" mh-thread-next-sibling
- "t" mh-toggle-threads
- "d" mh-thread-delete
- "o" mh-thread-refile)
-
-(gnus-define-keys (mh-limit-map "/" mh-folder-mode-map)
- "'" mh-narrow-to-tick
- "?" mh-prefix-help
- "c" mh-narrow-to-cc
- "g" mh-narrow-to-range
- "m" mh-narrow-to-from
- "s" mh-narrow-to-subject
- "t" mh-narrow-to-to
- "w" mh-widen)
-
-(gnus-define-keys (mh-extract-map "X" mh-folder-mode-map)
- "?" mh-prefix-help
- "s" mh-store-msg ;shar
- "u" mh-store-msg) ;uuencode
-
-(gnus-define-keys (mh-digest-map "D" mh-folder-mode-map)
- " " mh-page-digest
- "?" mh-prefix-help
- "\177" mh-page-digest-backwards
- "b" mh-burst-digest)
-
-(gnus-define-keys (mh-mime-map "K" mh-folder-mode-map)
- "?" mh-prefix-help
- "a" mh-mime-save-parts
- "e" mh-display-with-external-viewer
- "i" mh-folder-inline-mime-part
- "o" mh-folder-save-mime-part
- "t" mh-toggle-mime-buttons
- "v" mh-folder-toggle-mime-part
- "\t" mh-next-button
- [backtab] mh-prev-button
- "\M-\t" mh-prev-button)
-
-(cond
- ((featurep 'xemacs)
- (define-key mh-folder-mode-map [button2] 'mh-show-mouse))
- (t
- (define-key mh-folder-mode-map [mouse-2] 'mh-show-mouse)))
+(define-keymap :keymap mh-folder-mode-map
+ "SPC" #'mh-page-msg
+ "!" #'mh-refile-or-write-again
+ "'" #'mh-toggle-tick
+ "," #'mh-header-display
+ "." #'mh-alt-show
+ ":" #'mh-show-preferred-alternative
+ ";" #'mh-toggle-mh-decode-mime-flag
+ ">" #'mh-write-msg-to-file
+ "?" #'mh-help
+ "E" #'mh-extract-rejected-mail
+ "M" #'mh-modify
+ "DEL" #'mh-previous-page
+ "C-d" #'mh-delete-msg-no-motion
+ "TAB" #'mh-index-next-folder
+ "<backtab>" #'mh-index-previous-folder
+ "C-M-i" #'mh-index-previous-folder
+ "ESC <" #'mh-first-msg
+ "ESC >" #'mh-last-msg
+ "ESC d" #'mh-redistribute
+ "RET" #'mh-show
+ "^" #'mh-alt-refile-msg
+ "c" #'mh-copy-msg
+ "d" #'mh-delete-msg
+ "e" #'mh-edit-again
+ "f" #'mh-forward
+ "g" #'mh-goto-msg
+ "i" #'mh-inc-folder
+ "k" #'mh-delete-subject-or-thread
+ "m" #'mh-alt-send
+ "n" #'mh-next-undeleted-msg
+ "M-n" #'mh-next-unread-msg
+ "o" #'mh-refile-msg
+ "p" #'mh-previous-undeleted-msg
+ "M-p" #'mh-previous-unread-msg
+ "q" #'mh-quit
+ "r" #'mh-reply
+ "s" #'mh-send
+ "t" #'mh-toggle-showing
+ "u" #'mh-undo
+ "v" #'mh-index-visit-folder
+ "x" #'mh-execute-commands
+ "|" #'mh-pipe-msg
+
+ "F" (define-keymap :prefix 'mh-folder-map
+ "?" #'mh-prefix-help
+ "'" #'mh-index-ticked-messages
+ "S" #'mh-sort-folder
+ "c" #'mh-catchup
+ "f" #'mh-alt-visit-folder
+ "k" #'mh-kill-folder
+ "l" #'mh-list-folders
+ "n" #'mh-index-new-messages
+ "o" #'mh-alt-visit-folder
+ "p" #'mh-pack-folder
+ "q" #'mh-index-sequenced-messages
+ "r" #'mh-rescan-folder
+ "s" #'mh-search
+ "u" #'mh-undo-folder
+ "v" #'mh-visit-folder)
+
+ "I" mh-inc-spool-map
+
+ "J" (define-keymap :prefix 'mh-junk-map
+ "?" #'mh-prefix-help
+ "a" #'mh-junk-allowlist
+ "b" #'mh-junk-blocklist
+ "w" #'mh-junk-whitelist)
+
+ "P" (define-keymap :prefix 'mh-ps-print-map
+ "?" #'mh-prefix-help
+ "C" #'mh-ps-print-toggle-color
+ "F" #'mh-ps-print-toggle-faces
+ "f" #'mh-ps-print-msg-file
+ "l" #'mh-print-msg
+ "p" #'mh-ps-print-msg)
+
+ "S" (define-keymap :prefix 'mh-sequence-map
+ "'" #'mh-narrow-to-tick
+ "?" #'mh-prefix-help
+ "d" #'mh-delete-msg-from-seq
+ "k" #'mh-delete-seq
+ "l" #'mh-list-sequences
+ "n" #'mh-narrow-to-seq
+ "p" #'mh-put-msg-in-seq
+ "s" #'mh-msg-is-in-seq
+ "w" #'mh-widen)
+
+ "T" (define-keymap :prefix 'mh-thread-map
+ "?" #'mh-prefix-help
+ "u" #'mh-thread-ancestor
+ "p" #'mh-thread-previous-sibling
+ "n" #'mh-thread-next-sibling
+ "t" #'mh-toggle-threads
+ "d" #'mh-thread-delete
+ "o" #'mh-thread-refile)
+
+ "/" (define-keymap :prefix 'mh-limit-map
+ "'" #'mh-narrow-to-tick
+ "?" #'mh-prefix-help
+ "c" #'mh-narrow-to-cc
+ "g" #'mh-narrow-to-range
+ "m" #'mh-narrow-to-from
+ "s" #'mh-narrow-to-subject
+ "t" #'mh-narrow-to-to
+ "w" #'mh-widen)
+
+ "X" (define-keymap :prefix 'mh-extract-map
+ "?" #'mh-prefix-help
+ "s" #'mh-store-msg ;shar
+ "u" #'mh-store-msg) ;uuencode
+
+ "D" (define-keymap :prefix 'mh-digest-map
+ "SPC" #'mh-page-digest
+ "?" #'mh-prefix-help
+ "DEL" #'mh-page-digest-backwards
+ "b" #'mh-burst-digest)
+
+ "K" (define-keymap :prefix 'mh-mime-map
+ "?" #'mh-prefix-help
+ "a" #'mh-mime-save-parts
+ "e" #'mh-display-with-external-viewer
+ "i" #'mh-folder-inline-mime-part
+ "o" #'mh-folder-save-mime-part
+ "t" #'mh-toggle-mime-buttons
+ "v" #'mh-folder-toggle-mime-part
+ "TAB" #'mh-next-button
+ "<backtab>" #'mh-prev-button
+ "C-M-i" #'mh-prev-button)
+
+ "<mouse-2>" #'mh-show-mouse)
;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
@@ -512,24 +506,14 @@ font-lock is done highlighting.")
;;; MH-Folder Mode
(defmacro mh-remove-xemacs-horizontal-scrollbar ()
- "Get rid of the horizontal scrollbar that XEmacs insists on putting in."
- (when (featurep 'xemacs)
- '(if (and (featurep 'scrollbar)
- (fboundp 'set-specifier))
- (set-specifier horizontal-scrollbar-visible-p nil
- (cons (current-buffer) nil)))))
+ (declare (obsolete nil "29.1"))
+ nil)
;; Register mh-folder-mode as supporting which-function-mode...
-(eval-and-compile (mh-require 'which-func nil t))
+(eval-and-compile (require 'which-func nil t))
(when (and (boundp 'which-func-modes) (listp which-func-modes))
(add-to-list 'which-func-modes 'mh-folder-mode))
-;; Shush compiler.
-(defvar desktop-save-buffer)
-(defvar font-lock-auto-fontify)
-(mh-do-in-xemacs
- (defvar font-lock-defaults))
-
;; Ensure new buffers won't get this mode if default major-mode is nil.
(put 'mh-folder-mode 'mode-class 'special)
@@ -590,80 +574,68 @@ region in the MH-Folder buffer, then the MH-E command will
perform the operation on all messages in that region.
\\{mh-folder-mode-map}"
- (mh-do-in-gnu-emacs
- (unless mh-folder-tool-bar-map
- (mh-tool-bar-folder-buttons-init))
- (if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) mh-folder-tool-bar-map)))
- (mh-do-in-xemacs
- (mh-tool-bar-init :folder))
+ (unless mh-folder-tool-bar-map
+ (mh-tool-bar-folder-buttons-init))
+ (if (boundp 'tool-bar-map)
+ (setq-local tool-bar-map mh-folder-tool-bar-map))
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(mh-folder-font-lock-keywords t))
(make-local-variable 'desktop-save-buffer)
(setq desktop-save-buffer t)
- (mh-make-local-vars
- 'mh-colors-available-flag (mh-colors-available-p)
+ (setq-local
+ mh-colors-available-flag (mh-colors-available-p)
; Do we have colors available
- 'mh-current-folder (buffer-name) ; Name of folder, a string
- 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
- 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
+ mh-current-folder (buffer-name) ; Name of folder, a string
+ mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
+ mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/"
(file-name-as-directory (mh-expand-file-name (buffer-name)))
- 'mh-display-buttons-for-inline-parts-flag
+ mh-display-buttons-for-inline-parts-flag
mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to
; be toggled.
- 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed
- 'overlay-arrow-position nil ; Allow for simultaneous display in
- 'overlay-arrow-string ">" ; different MH-E buffers.
- 'mh-showing-mode nil ; Show message also?
- 'mh-refile-list nil ; List of folder names in mh-seq-list
- 'mh-delete-list nil ; List of msgs nums to delete
- 'mh-blocklist nil ; List of messages to process as spam
- 'mh-allowlist nil ; List of messages to process as ham
- 'mh-seq-list nil ; Alist of (seq . msgs) nums
- 'mh-seen-list nil ; List of displayed messages
- 'mh-next-direction 'forward ; Direction to move to next message
- 'mh-view-ops () ; Stack that keeps track of the order
+ mh-arrow-marker (make-marker) ; Marker where arrow is displayed
+ overlay-arrow-position nil ; Allow for simultaneous display in
+ overlay-arrow-string ">" ; different MH-E buffers.
+ mh-showing-mode nil ; Show message also?
+ mh-refile-list nil ; List of folder names in mh-seq-list
+ mh-delete-list nil ; List of msgs nums to delete
+ mh-blocklist nil ; List of messages to process as spam
+ mh-allowlist nil ; List of messages to process as ham
+ mh-seq-list nil ; Alist of (seq . msgs) nums
+ mh-seen-list nil ; List of displayed messages
+ mh-next-direction 'forward ; Direction to move to next message
+ mh-view-ops () ; Stack that keeps track of the order
; in which narrowing/threading has been
; carried out.
- 'mh-folder-view-stack () ; Stack of previous views of the
+ mh-folder-view-stack () ; Stack of previous views of the
; folder.
- 'mh-index-data nil ; If the folder was created by a call
+ mh-index-data nil ; If the folder was created by a call
; to mh-search, this contains info
; about the search results.
- 'mh-index-previous-search nil ; folder, indexer, search-regexp
- 'mh-index-msg-checksum-map nil ; msg -> checksum map
- 'mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
- 'mh-index-sequence-search-flag nil ; folder resulted from sequence search
- 'mh-first-msg-num nil ; Number of first msg in buffer
- 'mh-last-msg-num nil ; Number of last msg in buffer
- 'mh-msg-count nil ; Number of msgs in buffer
- 'mh-mode-line-annotation nil ; Indicates message range
- 'mh-sequence-notation-history (make-hash-table)
+ mh-index-previous-search nil ; folder, indexer, search-regexp
+ mh-index-msg-checksum-map nil ; msg -> checksum map
+ mh-index-checksum-origin-map nil ; checksum -> ( orig-folder, orig-msg )
+ mh-index-sequence-search-flag nil ; folder resulted from sequence search
+ mh-first-msg-num nil ; Number of first msg in buffer
+ mh-last-msg-num nil ; Number of last msg in buffer
+ mh-msg-count nil ; Number of msgs in buffer
+ mh-mode-line-annotation nil ; Indicates message range
+ mh-sequence-notation-history (make-hash-table)
; Remember what is overwritten by
; mh-note-seq.
- 'imenu-create-index-function 'mh-index-create-imenu-index
+ imenu-create-index-function 'mh-index-create-imenu-index
; Setup imenu support
- 'mh-previous-window-config nil) ; Previous window configuration
- (mh-remove-xemacs-horizontal-scrollbar)
+ mh-previous-window-config nil) ; Previous window configuration
(setq truncate-lines t)
(auto-save-mode -1)
(setq buffer-offer-save t)
- (mh-make-local-hook (mh-write-file-functions))
- (add-hook (mh-write-file-functions) #'mh-execute-commands nil t)
+ (add-hook 'write-file-functions #'mh-execute-commands nil t)
(make-local-variable 'revert-buffer-function)
(make-local-variable 'hl-line-mode) ; avoid pollution
- (mh-funcall-if-exists hl-line-mode 1)
+ (hl-line-mode 1)
(setq revert-buffer-function #'mh-undo-folder)
(add-to-list 'minor-mode-alist '(mh-showing-mode " Show"))
- (mh-do-in-xemacs
- (easy-menu-add mh-folder-sequence-menu)
- (easy-menu-add mh-folder-message-menu)
- (easy-menu-add mh-folder-folder-menu))
(mh-inc-spool-make)
- (mh-set-help mh-folder-mode-help-messages)
- (if (and (featurep 'xemacs)
- font-lock-auto-fontify)
- (turn-on-font-lock))) ; Force font-lock in XEmacs.
+ (mh-set-help mh-folder-mode-help-messages))
@@ -1571,35 +1543,35 @@ after the commands are processed."
(append folders-changed (mh-index-execute-commands))))
;; Then refile messages
- (mh-mapc #'(lambda (folder-msg-list)
- (let* ((dest-folder (symbol-name (car folder-msg-list)))
- (last (car (mh-translate-range dest-folder "last")))
- (msgs (cdr folder-msg-list)))
- (push dest-folder folders-changed)
- (setq redraw-needed-flag t)
- (apply #'mh-exec-cmd
- "refile" "-src" folder dest-folder
- (mh-coalesce-msg-list msgs))
- (mh-delete-scan-msgs msgs)
- ;; Preserve sequences in destination folder...
- (when mh-refile-preserves-sequences-flag
- (clrhash dest-map)
- (cl-loop
- for i from (1+ (or last 0))
- for msg in (sort (copy-sequence msgs) #'<)
- do (cl-loop for seq-name in (gethash msg seq-map)
- do (push i (gethash seq-name dest-map))))
- (maphash
- #'(lambda (seq msgs)
- ;; Can't be run in the background, since the
- ;; current folder is changed by mark this could
- ;; lead to a race condition with the next refile.
- (apply #'mh-exec-cmd "mark"
- "-sequence" (symbol-name seq) dest-folder
- "-add" (mapcar #'(lambda (x) (format "%s" x))
- (mh-coalesce-msg-list msgs))))
- dest-map))))
- mh-refile-list)
+ (mapc (lambda (folder-msg-list)
+ (let* ((dest-folder (symbol-name (car folder-msg-list)))
+ (last (car (mh-translate-range dest-folder "last")))
+ (msgs (cdr folder-msg-list)))
+ (push dest-folder folders-changed)
+ (setq redraw-needed-flag t)
+ (apply #'mh-exec-cmd
+ "refile" "-src" folder dest-folder
+ (mh-coalesce-msg-list msgs))
+ (mh-delete-scan-msgs msgs)
+ ;; Preserve sequences in destination folder...
+ (when mh-refile-preserves-sequences-flag
+ (clrhash dest-map)
+ (cl-loop
+ for i from (1+ (or last 0))
+ for msg in (sort (copy-sequence msgs) #'<)
+ do (cl-loop for seq-name in (gethash msg seq-map)
+ do (push i (gethash seq-name dest-map))))
+ (maphash
+ #'(lambda (seq msgs)
+ ;; Can't be run in the background, since the
+ ;; current folder is changed by mark this could
+ ;; lead to a race condition with the next refile.
+ (apply #'mh-exec-cmd "mark"
+ "-sequence" (symbol-name seq) dest-folder
+ "-add" (mapcar #'(lambda (x) (format "%s" x))
+ (mh-coalesce-msg-list msgs))))
+ dest-map))))
+ mh-refile-list)
(setq mh-refile-list ())
;; Now delete messages
@@ -1642,14 +1614,14 @@ after the commands are processed."
do (cl-loop for seq-name in (gethash msg seq-map)
do (push i (gethash seq-name allow-map))))
(maphash
- #'(lambda (seq msgs)
- ;; Can't be run in background, since the current
- ;; folder is changed by mark this could lead to a
- ;; race condition with the next refile/allowlist.
- (apply #'mh-exec-cmd "mark"
- "-sequence" (symbol-name seq) mh-inbox
- "-add" (mapcar #'(lambda(x) (format "%s" x))
- (mh-coalesce-msg-list msgs))))
+ (lambda (seq msgs)
+ ;; Can't be run in background, since the current
+ ;; folder is changed by mark this could lead to a
+ ;; race condition with the next refile/allowlist.
+ (apply #'mh-exec-cmd "mark"
+ "-sequence" (symbol-name seq) mh-inbox
+ "-add" (mapcar #'(lambda(x) (format "%s" x))
+ (mh-coalesce-msg-list msgs))))
allow-map))
(setq mh-allowlist nil)))
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-01 06:41:53 +0000