1 |
;;; mh-utils.el --- MH-E code needed for both sending and reading |
;;; mh-utils.el --- MH-E code needed for both sending and reading |
2 |
|
|
3 |
;; Copyright (C) 1993, 95, 1997, |
;; Copyright (C) 1993, 95, 1997, |
4 |
;; 2000, 01, 02, 2003 Free Software Foundation, Inc. |
;; 2000, 01, 02, 03, 2004 Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Bill Wohler <wohler@newt.com> |
;; Author: Bill Wohler <wohler@newt.com> |
7 |
;; Maintainer: Bill Wohler <wohler@newt.com> |
;; Maintainer: Bill Wohler <wohler@newt.com> |
37 |
(defvar mh-xemacs-flag (featurep 'xemacs) |
(defvar mh-xemacs-flag (featurep 'xemacs) |
38 |
"Non-nil means the current Emacs is XEmacs.") |
"Non-nil means the current Emacs is XEmacs.") |
39 |
|
|
40 |
(require 'cl) |
;; The Emacs coding conventions require that the cl package not be required at |
41 |
|
;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl |
42 |
|
;; routines in their macro expansions. Use mh-require-cl to provide the cl |
43 |
|
;; routines in the best way possible. |
44 |
|
(eval-when-compile (require 'cl)) |
45 |
|
(defmacro mh-require-cl () |
46 |
|
(if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash) |
47 |
|
`(require 'cl) |
48 |
|
`(eval-when-compile (require 'cl)))) |
49 |
|
|
50 |
|
(mh-require-cl) |
51 |
(require 'gnus-util) |
(require 'gnus-util) |
52 |
(require 'font-lock) |
(require 'font-lock) |
53 |
|
(require 'mouse) |
54 |
|
(load "tool-bar" t t) |
55 |
(require 'mh-loaddefs) |
(require 'mh-loaddefs) |
56 |
(require 'mh-customize) |
(require 'mh-customize) |
57 |
|
(require 'mh-inc) |
58 |
|
|
59 |
(load "mm-decode" t t) ; Non-fatal dependency |
(load "mm-decode" t t) ; Non-fatal dependency |
60 |
(load "mm-view" t t) ; Non-fatal dependency |
(load "mm-view" t t) ; Non-fatal dependency |
61 |
|
(load "hl-line" t t) ; Non-fatal dependency |
62 |
(load "executable" t t) ; Non-fatal dependency on |
(load "executable" t t) ; Non-fatal dependency on |
63 |
; executable-find |
; executable-find |
64 |
|
|
66 |
(defvar font-lock-auto-fontify) |
(defvar font-lock-auto-fontify) |
67 |
(defvar font-lock-defaults) |
(defvar font-lock-defaults) |
68 |
(defvar mark-active) |
(defvar mark-active) |
|
(defvar tool-bar-mode) |
|
69 |
|
|
70 |
;;; Autoloads |
;;; Autoloads |
71 |
(autoload 'gnus-article-highlight-citation "gnus-cite") |
(autoload 'gnus-article-highlight-citation "gnus-cite") |
94 |
(defvar mh-nmh-flag nil |
(defvar mh-nmh-flag nil |
95 |
"Non-nil means nmh is installed on this system instead of MH.") |
"Non-nil means nmh is installed on this system instead of MH.") |
96 |
|
|
97 |
|
(defvar mh-flists-present-flag nil |
98 |
|
"Non-nil means that we have `flists'.") |
99 |
|
|
100 |
;;;###autoload |
;;;###autoload |
101 |
(put 'mh-progs 'risky-local-variable t) |
(put 'mh-progs 'risky-local-variable t) |
102 |
;;;###autoload |
;;;###autoload |
327 |
|
|
328 |
;; Copy of `goto-address-mail-regexp' |
;; Copy of `goto-address-mail-regexp' |
329 |
(defvar mh-address-mail-regexp |
(defvar mh-address-mail-regexp |
330 |
"[-a-zA-Z0-9._]+@[-a-zA-z0-9_]+\\.+[a-zA-Z0-9]+" |
"[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" |
331 |
"A regular expression probably matching an e-mail address.") |
"A regular expression probably matching an e-mail address.") |
332 |
|
|
333 |
;; From goto-addr.el, which we don't want to force-load on users. |
;; From goto-addr.el, which we don't want to force-load on users. |
451 |
(4 font-lock-comment-face nil t))))))) |
(4 font-lock-comment-face nil t))))))) |
452 |
"Additional expressions to highlight in MH-show mode.") |
"Additional expressions to highlight in MH-show mode.") |
453 |
|
|
454 |
|
(defvar mh-letter-font-lock-keywords |
455 |
|
`(,@mh-show-font-lock-keywords-with-cite |
456 |
|
(mh-font-lock-field-data (1 'mh-letter-header-field-face prepend t)))) |
457 |
|
|
458 |
(defun mh-show-font-lock-fontify-region (beg end loudly) |
(defun mh-show-font-lock-fontify-region (beg end loudly) |
459 |
"Limit font-lock in `mh-show-mode' to the header. |
"Limit font-lock in `mh-show-mode' to the header. |
460 |
Used when `mh-highlight-citation-p' is set to gnus, leaving the body to be |
Used when `mh-highlight-citation-p' is set to gnus, leaving the body to be |
652 |
|
|
653 |
(put 'mh-in-show-buffer 'lisp-indent-hook 'defun) |
(put 'mh-in-show-buffer 'lisp-indent-hook 'defun) |
654 |
|
|
655 |
|
(defmacro mh-do-at-event-location (event &rest body) |
656 |
|
"Switch to the location of EVENT and execute BODY. |
657 |
|
After BODY has been executed return to original window. The modification flag |
658 |
|
of the buffer in the event window is preserved." |
659 |
|
(let ((event-window (make-symbol "event-window")) |
660 |
|
(event-position (make-symbol "event-position")) |
661 |
|
(original-window (make-symbol "original-window")) |
662 |
|
(original-position (make-symbol "original-position")) |
663 |
|
(modified-flag (make-symbol "modified-flag"))) |
664 |
|
`(save-excursion |
665 |
|
(let* ((,event-window |
666 |
|
(or (mh-funcall-if-exists posn-window (event-start ,event)) |
667 |
|
(mh-funcall-if-exists event-window ,event))) |
668 |
|
(,event-position |
669 |
|
(or (mh-funcall-if-exists posn-point (event-start ,event)) |
670 |
|
(mh-funcall-if-exists event-closest-point ,event))) |
671 |
|
(,original-window (selected-window)) |
672 |
|
(,original-position (progn |
673 |
|
(set-buffer (window-buffer ,event-window)) |
674 |
|
(set-marker (make-marker) (point)))) |
675 |
|
(,modified-flag (buffer-modified-p)) |
676 |
|
(buffer-read-only nil)) |
677 |
|
(unwind-protect (progn |
678 |
|
(select-window ,event-window) |
679 |
|
(goto-char ,event-position) |
680 |
|
,@body) |
681 |
|
(set-buffer-modified-p ,modified-flag) |
682 |
|
(goto-char ,original-position) |
683 |
|
(set-marker ,original-position nil) |
684 |
|
(select-window ,original-window)))))) |
685 |
|
|
686 |
|
(put 'mh-do-at-event-location 'lisp-indent-hook 'defun) |
687 |
|
|
688 |
(defmacro mh-make-seq (name msgs) |
(defmacro mh-make-seq (name msgs) |
689 |
"Create sequence NAME with the given MSGS." |
"Create sequence NAME with the given MSGS." |
690 |
(list 'cons name msgs)) |
(list 'cons name msgs)) |
814 |
(prog1 (call-interactively (function ,original-function)) |
(prog1 (call-interactively (function ,original-function)) |
815 |
(setq normal-exit t)) |
(setq normal-exit t)) |
816 |
(mh-funcall-if-exists deactivate-mark) |
(mh-funcall-if-exists deactivate-mark) |
817 |
|
(when (eq major-mode 'mh-folder-mode) |
818 |
|
(mh-funcall-if-exists hl-line-highlight)) |
819 |
(cond ((not normal-exit) |
(cond ((not normal-exit) |
820 |
(set-window-configuration config)) |
(set-window-configuration config)) |
821 |
,(if dont-return |
,(if dont-return |
878 |
(mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq) |
(mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq) |
879 |
(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq) |
(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq) |
880 |
(mh-defun-show-buffer mh-show-widen mh-widen) |
(mh-defun-show-buffer mh-show-widen mh-widen) |
881 |
(mh-defun-show-buffer mh-show-narrow-to-subject |
(mh-defun-show-buffer mh-show-narrow-to-subject mh-narrow-to-subject) |
882 |
mh-narrow-to-subject) |
(mh-defun-show-buffer mh-show-narrow-to-from mh-narrow-to-from) |
883 |
|
(mh-defun-show-buffer mh-show-narrow-to-cc mh-narrow-to-cc) |
884 |
|
(mh-defun-show-buffer mh-show-narrow-to-range mh-narrow-to-range) |
885 |
|
(mh-defun-show-buffer mh-show-narrow-to-to mh-narrow-to-to) |
886 |
(mh-defun-show-buffer mh-show-store-msg mh-store-msg) |
(mh-defun-show-buffer mh-show-store-msg mh-store-msg) |
887 |
(mh-defun-show-buffer mh-show-page-digest mh-page-digest) |
(mh-defun-show-buffer mh-show-page-digest mh-page-digest) |
888 |
(mh-defun-show-buffer mh-show-page-digest-backwards |
(mh-defun-show-buffer mh-show-page-digest-backwards |
912 |
(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist) |
(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist) |
913 |
(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist) |
(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist) |
914 |
(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages) |
(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages) |
915 |
|
(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages) |
916 |
|
(mh-defun-show-buffer mh-show-index-sequenced-messages |
917 |
|
mh-index-sequenced-messages) |
918 |
|
|
919 |
;;; Populate mh-show-mode-map |
;;; Populate mh-show-mode-map |
920 |
(gnus-define-keys mh-show-mode-map |
(gnus-define-keys mh-show-mode-map |
959 |
|
|
960 |
(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map) |
(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map) |
961 |
"?" mh-prefix-help |
"?" mh-prefix-help |
962 |
|
"'" mh-index-ticked-messages |
963 |
"S" mh-show-sort-folder |
"S" mh-show-sort-folder |
964 |
"f" mh-show-visit-folder |
"f" mh-show-visit-folder |
965 |
"i" mh-index-search |
"i" mh-index-search |
967 |
"l" mh-show-list-folders |
"l" mh-show-list-folders |
968 |
"n" mh-index-new-messages |
"n" mh-index-new-messages |
969 |
"o" mh-show-visit-folder |
"o" mh-show-visit-folder |
970 |
|
"q" mh-show-index-sequenced-messages |
971 |
"r" mh-show-rescan-folder |
"r" mh-show-rescan-folder |
972 |
"s" mh-show-search-folder |
"s" mh-show-search-folder |
973 |
"t" mh-show-toggle-threads |
"t" mh-show-toggle-threads |
975 |
"v" mh-show-visit-folder) |
"v" mh-show-visit-folder) |
976 |
|
|
977 |
(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map) |
(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map) |
978 |
|
"'" mh-show-narrow-to-tick |
979 |
"?" mh-prefix-help |
"?" mh-prefix-help |
980 |
"d" mh-show-delete-msg-from-seq |
"d" mh-show-delete-msg-from-seq |
981 |
"k" mh-show-delete-seq |
"k" mh-show-delete-seq |
1004 |
(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map) |
(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map) |
1005 |
"'" mh-show-narrow-to-tick |
"'" mh-show-narrow-to-tick |
1006 |
"?" mh-prefix-help |
"?" mh-prefix-help |
1007 |
|
"c" mh-show-narrow-to-cc |
1008 |
|
"f" mh-show-narrow-to-from |
1009 |
|
"r" mh-show-narrow-to-range |
1010 |
"s" mh-show-narrow-to-subject |
"s" mh-show-narrow-to-subject |
1011 |
|
"t" mh-show-narrow-to-to |
1012 |
"w" mh-show-widen) |
"w" mh-show-widen) |
1013 |
|
|
1014 |
(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map) |
(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map) |
1107 |
;;; Ensure new buffers won't get this mode if default-major-mode is nil. |
;;; Ensure new buffers won't get this mode if default-major-mode is nil. |
1108 |
(put 'mh-show-mode 'mode-class 'special) |
(put 'mh-show-mode 'mode-class 'special) |
1109 |
|
|
1110 |
;; Avoid compiler warning |
;; Avoid compiler warnings in XEmacs and Emacs 20 |
1111 |
(defvar tool-bar-map) |
(eval-when-compile |
1112 |
|
(defvar tool-bar-mode) |
1113 |
|
(defvar tool-bar-map)) |
1114 |
|
|
1115 |
(define-derived-mode mh-show-mode text-mode "MH-Show" |
(define-derived-mode mh-show-mode text-mode "MH-Show" |
1116 |
"Major mode for showing messages in MH-E.\\<mh-show-mode-map> |
"Major mode for showing messages in MH-E.\\<mh-show-mode-map> |
1121 |
(mh-show-unquote-From) |
(mh-show-unquote-From) |
1122 |
(mh-show-xface) |
(mh-show-xface) |
1123 |
(mh-show-addr) |
(mh-show-addr) |
1124 |
|
(setq buffer-invisibility-spec '((vanish . t) t)) |
1125 |
|
(set (make-local-variable 'line-move-ignore-invisible) t) |
1126 |
(make-local-variable 'font-lock-defaults) |
(make-local-variable 'font-lock-defaults) |
1127 |
;;(set (make-local-variable 'font-lock-support-mode) nil) |
;;(set (make-local-variable 'font-lock-support-mode) nil) |
1128 |
(cond |
(cond |
1139 |
(if (and mh-xemacs-flag |
(if (and mh-xemacs-flag |
1140 |
font-lock-auto-fontify) |
font-lock-auto-fontify) |
1141 |
(turn-on-font-lock)) |
(turn-on-font-lock)) |
1142 |
(if (and (boundp 'tool-bar-mode) tool-bar-mode) |
(set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map) |
|
(set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)) |
|
1143 |
(mh-funcall-if-exists mh-toolbar-init :show) |
(mh-funcall-if-exists mh-toolbar-init :show) |
1144 |
(when mh-decode-mime-flag |
(when mh-decode-mime-flag |
1145 |
(mh-make-local-hook 'kill-buffer-hook) |
(mh-make-local-hook 'kill-buffer-hook) |
1389 |
(defun mh-show (&optional message) |
(defun mh-show (&optional message) |
1390 |
"Show message at cursor. |
"Show message at cursor. |
1391 |
If optional argument MESSAGE is non-nil, display that message instead. |
If optional argument MESSAGE is non-nil, display that message instead. |
1392 |
Force a two-window display with the folder window on top (size |
Force a two-window display with the folder window on top (size given by the |
1393 |
`mh-summary-height') and the show buffer below it. |
variable `mh-summary-height') and the show buffer below it. |
1394 |
If the message is already visible, display the start of the message. |
If the message is already visible, display the start of the message. |
1395 |
|
|
1396 |
Display of the message is controlled by setting the variables |
Display of the message is controlled by setting the variables |
1409 |
(mouse-set-point EVENT) |
(mouse-set-point EVENT) |
1410 |
(mh-show)) |
(mh-show)) |
1411 |
|
|
1412 |
|
(defun mh-summary-height () |
1413 |
|
"Return ideal value for the variable `mh-summary-height'. |
1414 |
|
The current frame height is taken into consideration." |
1415 |
|
(or (and (fboundp 'frame-height) |
1416 |
|
(> (frame-height) 24) |
1417 |
|
(min 10 (/ (frame-height) 6))) |
1418 |
|
4)) |
1419 |
|
|
1420 |
(defun mh-show-msg (msg) |
(defun mh-show-msg (msg) |
1421 |
"Show MSG. |
"Show MSG. |
1422 |
The value of `mh-show-hook' is a list of functions to be called, with no |
The value of `mh-show-hook' is a list of functions to be called, with no |
1426 |
(mh-showing-mode t) |
(mh-showing-mode t) |
1427 |
(setq mh-page-to-next-msg-flag nil) |
(setq mh-page-to-next-msg-flag nil) |
1428 |
(let ((folder mh-current-folder) |
(let ((folder mh-current-folder) |
1429 |
|
(folders (list mh-current-folder)) |
1430 |
(clean-message-header mh-clean-message-header-flag) |
(clean-message-header mh-clean-message-header-flag) |
1431 |
(show-window (get-buffer-window mh-show-buffer))) |
(show-window (get-buffer-window mh-show-buffer))) |
1432 |
(if (not (eq (next-window (minibuffer-window)) (selected-window))) |
(if (not (eq (next-window (minibuffer-window)) (selected-window))) |
1438 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1439 |
(if (not clean-message-header) |
(if (not clean-message-header) |
1440 |
(mh-start-of-uncleaned-message))) |
(mh-start-of-uncleaned-message))) |
1441 |
(mh-display-msg msg folder)))) |
(mh-display-msg msg folder))) |
1442 |
(if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split |
(if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split |
1443 |
(shrink-window (- (window-height) mh-summary-height))) |
(shrink-window (- (window-height) (or mh-summary-height |
1444 |
(mh-recenter nil) |
(mh-summary-height))))) |
1445 |
(if (not (memq msg mh-seen-list)) |
(mh-recenter nil) |
1446 |
(setq mh-seen-list (cons msg mh-seen-list))) |
(if (not (memq msg mh-seen-list)) |
1447 |
(when mh-update-sequences-after-mh-show-flag |
(setq mh-seen-list (cons msg mh-seen-list))) |
1448 |
(if mh-index-data (mh-index-update-unseen msg)) |
(when mh-update-sequences-after-mh-show-flag |
1449 |
(mh-update-sequences)) |
(mh-update-sequences) |
1450 |
(run-hooks 'mh-show-hook)) |
(when mh-index-data |
1451 |
|
(setq folders |
1452 |
|
(append (mh-index-delete-from-sequence mh-unseen-seq (list msg)) |
1453 |
|
folders))) |
1454 |
|
(when (mh-speed-flists-active-p) |
1455 |
|
(apply #'mh-speed-flists t folders))) |
1456 |
|
(run-hooks 'mh-show-hook))) |
1457 |
|
|
1458 |
(defun mh-modify (&optional message) |
(defun mh-modify (&optional message) |
1459 |
"Edit message at cursor. |
"Edit message at cursor. |
1460 |
If optional argument MESSAGE is non-nil, edit that message instead. |
If optional argument MESSAGE is non-nil, edit that message instead. |
1461 |
Force a two-window display with the folder window on top (size |
Force a two-window display with the folder window on top (size given by the |
1462 |
`mh-summary-height') and the message editing buffer below it. |
value of the variable `mh-summary-height') and the message editing buffer below |
1463 |
|
it. |
1464 |
|
|
1465 |
The message is displayed in raw form." |
The message is displayed in raw form." |
1466 |
(interactive) |
(interactive) |
1620 |
(beginning-of-line) |
(beginning-of-line) |
1621 |
(mh-delete-line 1) |
(mh-delete-line 1) |
1622 |
(while (looking-at "[ \t]") |
(while (looking-at "[ \t]") |
1623 |
(mh-delete-line 1)))) |
(mh-delete-line 1))))) |
1624 |
(unlock-buffer)))) |
(let ((mh-compose-skipped-header-fields ())) |
1625 |
|
(mh-letter-hide-all-skipped-fields)) |
1626 |
|
(unlock-buffer))) |
1627 |
|
|
1628 |
(defun mh-delete-line (lines) |
(defun mh-delete-line (lines) |
1629 |
"Delete the next LINES lines." |
"Delete the next LINES lines." |
1639 |
(with-mh-folder-updating (t) |
(with-mh-folder-updating (t) |
1640 |
(beginning-of-line) |
(beginning-of-line) |
1641 |
(forward-char offset) |
(forward-char offset) |
1642 |
(let ((notation (or notation (char-after)))) |
(let* ((change-stack-flag (and (stringp notation) |
1643 |
(delete-char 1) |
(equal offset (1+ mh-cmd-note)) |
1644 |
(insert notation)))))) |
(not (eq notation mh-note-seq)))) |
1645 |
|
(msg (and change-stack-flag (or msg (mh-get-msg-num nil)))) |
1646 |
|
(stack (and msg (gethash msg mh-sequence-notation-history))) |
1647 |
|
(notation (or notation (char-after)))) |
1648 |
|
(if stack |
1649 |
|
;; The presence of the stack tells us that we don't need to |
1650 |
|
;; notate the message, since the notation would be replaced |
1651 |
|
;; by a sequence notation. So we will just put the notation |
1652 |
|
;; at the bottom of the stack. If the sequence is deleted, |
1653 |
|
;; the correct notation will be shown. |
1654 |
|
(setf (gethash msg mh-sequence-notation-history) |
1655 |
|
(reverse (cons (aref notation 0) (cdr (reverse stack))))) |
1656 |
|
;; Since we don't have any sequence notations in the way, just |
1657 |
|
;; notate the scan line. |
1658 |
|
(delete-char 1) |
1659 |
|
(insert notation)) |
1660 |
|
(when change-stack-flag |
1661 |
|
(mh-thread-update-scan-line-map msg notation offset))))))) |
1662 |
|
|
1663 |
(defun mh-find-msg-get-num (step) |
(defun mh-find-msg-get-num (step) |
1664 |
"Return the message number of the message nearest the cursor. |
"Return the message number of the message nearest the cursor. |
1772 |
(setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) |
(setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) |
1773 |
(if mh-previous-seq |
(if mh-previous-seq |
1774 |
(setq mh-previous-seq (intern mh-previous-seq))) |
(setq mh-previous-seq (intern mh-previous-seq))) |
1775 |
(run-hooks 'mh-find-path-hook)))) |
(run-hooks 'mh-find-path-hook) |
1776 |
|
(mh-collect-folder-names)))) |
1777 |
|
|
1778 |
(defun mh-file-command-p (file) |
(defun mh-file-command-p (file) |
1779 |
"Return t if file FILE is the name of a executable regular file." |
"Return t if file FILE is the name of a executable regular file." |
1817 |
mh-nmh-flag t))) |
mh-nmh-flag t))) |
1818 |
(kill-buffer tmp-buffer)))) |
(kill-buffer tmp-buffer)))) |
1819 |
(unless (and mh-progs mh-lib mh-lib-progs) |
(unless (and mh-progs mh-lib mh-lib-progs) |
1820 |
(error "Unable to determine paths from `mhparam' command"))))) |
(error "Unable to determine paths from `mhparam' command")) |
1821 |
|
(setq mh-flists-present-flag |
1822 |
|
(file-exists-p (expand-file-name "flists" mh-progs)))))) |
1823 |
|
|
1824 |
(defun mh-path-search (path file) |
(defun mh-path-search (path file) |
1825 |
"Search PATH, a list of directory names, for FILE. |
"Search PATH, a list of directory names, for FILE. |
1908 |
|
|
1909 |
If DONT-ANNOTATE-FLAG is non-nil then the annotations in the folder buffer are |
If DONT-ANNOTATE-FLAG is non-nil then the annotations in the folder buffer are |
1910 |
not updated." |
not updated." |
1911 |
(let ((entry (mh-find-seq seq))) |
(let ((entry (mh-find-seq seq)) |
1912 |
|
(internal-seq-flag (mh-internal-seq seq))) |
1913 |
(if (and msgs (atom msgs)) (setq msgs (list msgs))) |
(if (and msgs (atom msgs)) (setq msgs (list msgs))) |
1914 |
|
(unless internal-flag |
1915 |
|
(mh-add-to-sequence seq msgs) |
1916 |
|
(when (not dont-annotate-flag) |
1917 |
|
(mh-iterate-on-range msg msgs |
1918 |
|
(unless (memq msg (cdr entry)) |
1919 |
|
(mh-add-sequence-notation msg internal-seq-flag))))) |
1920 |
(if (null entry) |
(if (null entry) |
1921 |
(setq mh-seq-list |
(setq mh-seq-list |
1922 |
(cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) |
(cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) |
1923 |
mh-seq-list)) |
mh-seq-list)) |
1924 |
(if msgs (setcdr entry (mh-canonicalize-sequence |
(if msgs (setcdr entry (mh-canonicalize-sequence |
1925 |
(append msgs (mh-seq-msgs entry)))))) |
(append msgs (mh-seq-msgs entry)))))))) |
|
(cond ((not internal-flag) |
|
|
(mh-add-to-sequence seq msgs) |
|
|
(unless dont-annotate-flag |
|
|
(mh-notate-seq seq mh-note-seq (1+ mh-cmd-note))))))) |
|
1926 |
|
|
1927 |
(defun mh-canonicalize-sequence (msgs) |
(defun mh-canonicalize-sequence (msgs) |
1928 |
"Sort MSGS in decreasing order and remove duplicates." |
"Sort MSGS in decreasing order and remove duplicates." |
1936 |
|
|
1937 |
(defvar mh-sub-folders-cache (make-hash-table :test #'equal)) |
(defvar mh-sub-folders-cache (make-hash-table :test #'equal)) |
1938 |
(defvar mh-current-folder-name nil) |
(defvar mh-current-folder-name nil) |
1939 |
|
(defvar mh-flists-partial-line "") |
1940 |
|
(defvar mh-flists-process nil) |
1941 |
|
|
1942 |
|
;; Initialize mh-sub-folders-cache... |
1943 |
|
(defun mh-collect-folder-names () |
1944 |
|
"Collect folder names by running `flists'." |
1945 |
|
(unless mh-flists-process |
1946 |
|
(setq mh-flists-process |
1947 |
|
(mh-exec-cmd-daemon "folders" 'mh-collect-folder-names-filter |
1948 |
|
"-recurse" "-fast")))) |
1949 |
|
|
1950 |
|
(defun mh-collect-folder-names-filter (process output) |
1951 |
|
"Read folder names. |
1952 |
|
PROCESS is the flists process that was run to collect folder names and the |
1953 |
|
function is called when OUTPUT is available." |
1954 |
|
(let ((position 0) |
1955 |
|
(prevailing-match-data (match-data)) |
1956 |
|
line-end folder) |
1957 |
|
(unwind-protect |
1958 |
|
(while (setq line-end (string-match "\n" output position)) |
1959 |
|
(setq folder (format "+%s%s" |
1960 |
|
mh-flists-partial-line |
1961 |
|
(substring output position line-end))) |
1962 |
|
(setq mh-flists-partial-line "") |
1963 |
|
(unless (equal (aref folder 1) ?.) |
1964 |
|
(mh-populate-sub-folders-cache folder)) |
1965 |
|
(setq position (1+ line-end))) |
1966 |
|
(set-match-data prevailing-match-data)) |
1967 |
|
(setq mh-flists-partial-line (substring output position)))) |
1968 |
|
|
1969 |
|
(defun mh-populate-sub-folders-cache (folder) |
1970 |
|
"Tell `mh-sub-folders-cache' about FOLDER." |
1971 |
|
(let* ((last-slash (mh-search-from-end ?/ folder)) |
1972 |
|
(child1 (substring folder (1+ (or last-slash 0)))) |
1973 |
|
(parent (and last-slash (substring folder 0 last-slash))) |
1974 |
|
(parent-slash (and parent (mh-search-from-end ?/ parent))) |
1975 |
|
(child2 (and parent (substring parent (1+ (or parent-slash 0))))) |
1976 |
|
(grand-parent (and parent-slash (substring parent 0 parent-slash))) |
1977 |
|
(cache-entry (gethash parent mh-sub-folders-cache))) |
1978 |
|
(unless (loop for x in cache-entry when (equal (car x) child1) return t |
1979 |
|
finally return nil) |
1980 |
|
(push (list child1) cache-entry) |
1981 |
|
(setf (gethash parent mh-sub-folders-cache) |
1982 |
|
(sort cache-entry (lambda (x y) (string< (car x) (car y))))) |
1983 |
|
(when parent |
1984 |
|
(loop for x in (gethash grand-parent mh-sub-folders-cache) |
1985 |
|
when (equal (car x) child2) |
1986 |
|
do (progn (setf (cdr x) t) (return))))))) |
1987 |
|
|
1988 |
(defun mh-normalize-folder-name (folder &optional empty-string-okay |
(defun mh-normalize-folder-name (folder &optional empty-string-okay |
1989 |
dont-remove-trailing-slash) |
dont-remove-trailing-slash) |
2139 |
(defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map)) |
(defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map)) |
2140 |
(define-key mh-folder-completion-map " " 'minibuffer-complete) |
(define-key mh-folder-completion-map " " 'minibuffer-complete) |
2141 |
|
|
2142 |
|
(defvar mh-speed-flists-inhibit-flag nil) |
2143 |
|
|
2144 |
(defun mh-speed-flists-active-p () |
(defun mh-speed-flists-active-p () |
2145 |
"Check if speedbar is running with message counts enabled." |
"Check if speedbar is running with message counts enabled." |
2146 |
(and (featurep 'mh-speed) |
(and (featurep 'mh-speed) |
2147 |
|
(not mh-speed-flists-inhibit-flag) |
2148 |
(> (hash-table-count mh-speed-flists-cache) 0))) |
(> (hash-table-count mh-speed-flists-cache) 0))) |
2149 |
|
|
2150 |
(defun mh-folder-completion-function (name predicate flag) |
(defun mh-folder-completion-function (name predicate flag) |
2282 |
The output is not read or parsed by MH-E." |
The output is not read or parsed by MH-E." |
2283 |
(save-excursion |
(save-excursion |
2284 |
(set-buffer (get-buffer-create mh-log-buffer)) |
(set-buffer (get-buffer-create mh-log-buffer)) |
2285 |
(let ((initial-size (mh-truncate-log-buffer))) |
(let* ((initial-size (mh-truncate-log-buffer)) |
2286 |
(apply 'call-process |
(start (point)) |
2287 |
(expand-file-name command mh-progs) nil t nil |
(args (mh-list-to-string args))) |
2288 |
(mh-list-to-string args)) |
(apply 'call-process (expand-file-name command mh-progs) nil t nil args) |
2289 |
(if (> (buffer-size) initial-size) |
(when (> (buffer-size) initial-size) |
2290 |
(save-window-excursion |
(save-excursion |
2291 |
(switch-to-buffer-other-window mh-log-buffer) |
(goto-char start) |
2292 |
(sit-for 5)))))) |
(insert "Errors when executing: " command) |
2293 |
|
(loop for arg in args do (insert " " arg)) |
2294 |
|
(insert "\n")) |
2295 |
|
(save-window-excursion |
2296 |
|
(switch-to-buffer-other-window mh-log-buffer) |
2297 |
|
(sit-for 5)))))) |
2298 |
|
|
2299 |
(defun mh-exec-cmd-error (env command &rest args) |
(defun mh-exec-cmd-error (env command &rest args) |
2300 |
"In environment ENV, execute mh-command COMMAND with ARGS. |
"In environment ENV, execute mh-command COMMAND with ARGS. |
2329 |
command nil |
command nil |
2330 |
(expand-file-name command mh-progs) |
(expand-file-name command mh-progs) |
2331 |
(mh-list-to-string args)))) |
(mh-list-to-string args)))) |
2332 |
(set-process-filter process (or filter 'mh-process-daemon)))) |
(set-process-filter process (or filter 'mh-process-daemon)) |
2333 |
|
process)) |
2334 |
|
|
2335 |
(defun mh-exec-cmd-env-daemon (env command filter &rest args) |
(defun mh-exec-cmd-env-daemon (env command filter &rest args) |
2336 |
"In ennvironment ENV, execute mh-command COMMAND in the background. |
"In ennvironment ENV, execute mh-command COMMAND in the background. |
2452 |
(setq l (cdr l))) |
(setq l (cdr l))) |
2453 |
new-list)) |
new-list)) |
2454 |
|
|
2455 |
|
(defun mh-replace-in-string (regexp newtext string) |
2456 |
|
"Replace REGEXP with NEWTEXT everywhere in STRING and return result. |
2457 |
|
NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. |
2458 |
|
|
2459 |
|
The function body was copied from `dired-replace-in-string' in dired.el. |
2460 |
|
Emacs21 has `replace-regexp-in-string' while XEmacs has `replace-in-string'. |
2461 |
|
Neither is present in Emacs20. The file gnus-util.el in Gnus 5.10.1 and above |
2462 |
|
has `gnus-replace-in-string'. We should use that when we decide to not support |
2463 |
|
older versions of Gnus." |
2464 |
|
(let ((result "") (start 0) mb me) |
2465 |
|
(while (string-match regexp string start) |
2466 |
|
(setq mb (match-beginning 0) |
2467 |
|
me (match-end 0) |
2468 |
|
result (concat result (substring string start mb) newtext) |
2469 |
|
start me)) |
2470 |
|
(concat result (substring string start)))) |
2471 |
|
|
2472 |
(provide 'mh-utils) |
(provide 'mh-utils) |
2473 |
|
|
2474 |
;;; Local Variables: |
;;; Local Variables: |