Mercurial > emacs
annotate lisp/mh-e/mh-utils.el @ 68520:6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
since compatibility functions should have our package prefix (mh-) by
Emacs convention and to avoid messing up checks for the same functions
in other packages. Use explicit argument instead of forming name by
adding mh-e prefix so that one can grep and find the definition.
* mh-alias.el (mh-alias-local-users, mh-alias-reload)
(mh-alias-expand, mh-alias-minibuffer-confirm-address): Use
mh-assoc-string instead of assoc-string.
* mh-compat.el (assoc-string): Rename to mh-assoc-string.
(mh-mail-abbrev-make-syntax-table, mh-url-hexify-string): Move here
from mh-utils.el.
(mh-display-completion-list): Move here from mh-comp.el.
(mh-face-foreground, mh-face-background): Move here from mh-xface.el.
(mh-write-file-functions): Move here from mh-folder.el
* mh-folder.el (mh-write-file-functions-compat): Move to mh-compat.el
and rename to mh-write-file-functions.
(mh-folder-mode): Use the new name.
* mh-gnus.el (gnus-local-map-property): Rename to
mh-gnus-local-map-property.
(mm-merge-handles): Rename to mh-mm-merge-handles.
(mm-set-handle-multipart-parameter): Rename to
mh-mm-set-handle-multipart-parameter.
(mm-inline-text-vcard): Rename to mh-mm-inline-text-vcard.
(mm-possibly-verify-or-decrypt): Rename to
mh-mm-possibly-verify-or-decrypt.
(mm-handle-multipart-ctl-parameter): Rename to
mh-mm-handle-multipart-ctl-parameter.
(mm-readable-p): Rename to mh-mm-readable-p.
(mm-long-lines-p): Rename to mh-mm-long-lines-p.
(mm-keep-viewer-alive-p): Rename to mh-mm-keep-viewer-alive-p.
(mm-destroy-parts): Rename to mh-mm-destroy-parts.
(mm-uu-dissect-text-parts): Rename to mh-mm-uu-dissect-text-parts.
(mml-minibuffer-read-disposition): Rename to
mh-mml-minibuffer-read-disposition.
* mh-identity.el (mh-identity-field-handler): Use mh-assoc-string
instead of assoc-string.
* mh-mime.el (mh-mm-inline-media-tests, mh-mm-inline-message)
(mh-mime-display, mh-mime-display-security) (mh-insert-mime-button,
mh-insert-mime-security-button) (mh-handle-set-external-undisplayer)
(mh-mime-security-press-button, mh-mime-security-show-details)
(mh-mml-attach-file, mh-mime-cleanup)
(mh-destroy-postponed-handles): Use new mh-* names for compatibility
functions.
* mh-utils.el (mail-abbrev-make-syntax-table): Move to mh-compat.el
and rename to mh-mail-abbrev-make-syntax-table.
(mh-beginning-of-word): Use the new name.
(mh-get-field): Delete ancient alias.
* mh-xface.el (mh-face-foreground-compat): Move to mh-compat.el and
rename to mh-face-foreground
(mh-face-background-compat): Move to mh-compat.el and rename to
mh-face-background.
(mh-face-display-function): Use the new names.
(mh-x-image-url-cache-canonicalize): Use mh-url-hexify-string instead
of url-hexify-string.
(url-unreserved-chars): Move to mh-compat.el and rename to
mh-url-unreserved-chars.
(url-hexify-string): Move to mh-compat.el and rename to
mh-url-hexify-string.
author | Bill Wohler <wohler@newt.com> |
---|---|
date | Tue, 31 Jan 2006 20:46:15 +0000 |
parents | 0f44616074ba |
children | 7daec5f4a289 7432ca837c8d |
rev | line source |
---|---|
68465 | 1 ;;; mh-utils.el --- MH-E general utilities |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
2 |
62847
aa8c2e12ee24
Upgraded to MH-E version 7.84.
Bill Wohler <wohler@newt.com>
parents:
62767
diff
changeset
|
3 ;; Copyright (C) 1993, 1995, 1997, |
67988
7882fc7df359
* mh-alias.el (mh-alias-grab-from-field): Remove leading * from
Bill Wohler <wohler@newt.com>
parents:
67969
diff
changeset
|
4 ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
5 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
6 ;; Author: Bill Wohler <wohler@newt.com> |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
7 ;; Maintainer: Bill Wohler <wohler@newt.com> |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
8 ;; Keywords: mail |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
9 ;; See: mh-e.el |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
10 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
11 ;; This file is part of GNU Emacs. |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
12 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
13 ;; GNU Emacs is free software; you can redistribute it and/or modify |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
14 ;; it under the terms of the GNU General Public License as published by |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
15 ;; the Free Software Foundation; either version 2, or (at your option) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
16 ;; any later version. |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
17 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
18 ;; GNU Emacs is distributed in the hope that it will be useful, |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
21 ;; GNU General Public License for more details. |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
22 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
23 ;; You should have received a copy of the GNU General Public License |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
64085 | 25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
26 ;; Boston, MA 02110-1301, USA. | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
27 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
28 ;;; Commentary: |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
29 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
30 ;;; Change Log: |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
31 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
32 ;;; Code: |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
33 |
68465 | 34 (require 'mh-e) |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
35 (mh-require-cl) |
68096
57c4e7929f99
* mh-alias.el (mh-alias-gecos-name): Use replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68013
diff
changeset
|
36 |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
37 (require 'font-lock) |
67681 | 38 |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
39 ;;; CL Replacements |
67681 | 40 |
68465 | 41 ;;;###mh-autoload |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
42 (defun mh-search-from-end (char string) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
43 "Return the position of last occurrence of CHAR in STRING. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
44 If CHAR is not present in STRING then return nil. The function is |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
45 used in lieu of `search' in the CL package." |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
46 (loop for index from (1- (length string)) downto 0 |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
47 when (equal (aref string index) char) return index |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
48 finally return nil)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
49 |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
50 |
67681 | 51 |
68465 | 52 ;;; General Utilities |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
53 |
68465 | 54 ;;;###mh-autoload |
55 (defun mh-beginning-of-word (&optional n) | |
56 "Return position of the N th word backwards." | |
57 (unless n (setq n 1)) | |
58 (let ((syntax-table (syntax-table))) | |
59 (unwind-protect | |
60 (save-excursion | |
68520
6a7173abcf59
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name argument
Bill Wohler <wohler@newt.com>
parents:
68477
diff
changeset
|
61 (mh-mail-abbrev-make-syntax-table) |
68465 | 62 (set-syntax-table mail-abbrev-syntax-table) |
63 (backward-word n) | |
64 (point)) | |
65 (set-syntax-table syntax-table)))) | |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
66 |
68465 | 67 ;;;###mh-autoload |
68 (defun mh-colors-available-p () | |
69 "Check if colors are available in the Emacs being used." | |
70 (or mh-xemacs-flag | |
71 (let ((color-cells (display-color-cells))) | |
72 (and (numberp color-cells) (>= color-cells 8))))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
73 |
68465 | 74 ;;;###mh-autoload |
75 (defun mh-colors-in-use-p () | |
76 "Check if colors are being used in the folder buffer." | |
77 (and mh-colors-available-flag font-lock-mode)) | |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
78 |
68465 | 79 ;;;###mh-autoload |
80 (defun mh-delete-line (lines) | |
81 "Delete the next LINES lines." | |
82 (delete-region (point) (progn (forward-line lines) (point)))) | |
83 | |
84 (defvar mh-image-load-path-called-flag nil) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
85 |
68465 | 86 ;;;###mh-autoload |
87 (defun mh-image-load-path () | |
88 "Ensure that the MH-E images are accessible by `find-image'. | |
89 Images for MH-E are found in ../../etc/images relative to the | |
90 files in \"lisp/mh-e\". If `image-load-path' exists (since Emacs | |
91 22), then the images directory is added to it if isn't already | |
92 there. Otherwise, the images directory is added to the | |
93 `load-path' if it isn't already there." | |
94 (unless mh-image-load-path-called-flag | |
95 (let (mh-library-name mh-image-load-path) | |
96 ;; First, find mh-e in the load-path. | |
97 (setq mh-library-name (locate-library "mh-e")) | |
98 (if (not mh-library-name) | |
99 (error "Can not find MH-E in load-path")) | |
100 (setq mh-image-load-path | |
101 (expand-file-name (concat (file-name-directory mh-library-name) | |
102 "../../etc/images"))) | |
103 (if (not (file-exists-p mh-image-load-path)) | |
104 (error "Can not find image directory %s" mh-image-load-path)) | |
105 (if (boundp 'image-load-path) | |
106 (add-to-list 'image-load-path mh-image-load-path) | |
107 (add-to-list 'load-path mh-image-load-path))) | |
108 (setq mh-image-load-path-called-flag t))) | |
66477
117f8e71b37a
* mh-customize.el (mh-adaptive-cmd-note-flag)
Bill Wohler <wohler@newt.com>
parents:
66354
diff
changeset
|
109 |
68465 | 110 ;;;###mh-autoload |
111 (defun mh-make-local-vars (&rest pairs) | |
112 "Initialize local variables according to the variable-value PAIRS." | |
113 (while pairs | |
114 (set (make-local-variable (car pairs)) (car (cdr pairs))) | |
115 (setq pairs (cdr (cdr pairs))))) | |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
116 |
68465 | 117 ;;;###mh-autoload |
118 (defun mh-mapc (function list) | |
119 "Apply FUNCTION to each element of LIST for side effects only." | |
120 (while list | |
121 (funcall function (car list)) | |
122 (setq list (cdr list)))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
123 |
68465 | 124 ;;;###mh-autoload |
125 (defun mh-replace-string (old new) | |
126 "Replace all occurrences of OLD with NEW in the current buffer. | |
127 Ignores case when searching for OLD." | |
128 (goto-char (point-min)) | |
129 (let ((case-fold-search t)) | |
130 (while (search-forward old nil t) | |
131 (replace-match new t t)))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
132 |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
133 |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
134 |
68465 | 135 ;;; Logo Display |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
136 |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
137 (defvar mh-logo-cache nil) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
138 |
68465 | 139 ;;;###mh-autoload |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
140 (defun mh-logo-display () |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
141 "Modify mode line to display MH-E logo." |
68465 | 142 (mh-image-load-path) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
143 (mh-do-in-gnu-emacs |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
144 (add-text-properties |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
145 0 2 |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
146 `(display ,(or mh-logo-cache |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
147 (setq mh-logo-cache |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
148 (mh-funcall-if-exists |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
149 find-image '((:type xpm :ascent center |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
150 :file "mh-logo.xpm")))))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
151 (car mode-line-buffer-identification))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
152 (mh-do-in-xemacs |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
153 (setq modeline-buffer-identification |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
154 (list |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
155 (if mh-modeline-glyph |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
156 (cons modeline-buffer-id-left-extent mh-modeline-glyph) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
157 (cons modeline-buffer-id-left-extent "XEmacs%N:")) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
158 (cons modeline-buffer-id-right-extent " %17b"))))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
159 |
68465 | 160 |
161 | |
162 ;;; Read MH Profile | |
163 | |
164 (defvar mh-find-path-run nil | |
165 "Non-nil if `mh-find-path' has been run already. | |
166 Do not access this variable; `mh-find-path' already uses it to | |
167 avoid running more than once.") | |
67756
7ff92ad99326
* mh-alias.el (mh-alias-reload): Sync docstrings with manual.
Bill Wohler <wohler@newt.com>
parents:
67681
diff
changeset
|
168 |
68465 | 169 ;;;###mh-autoload |
170 (defun mh-find-path () | |
171 "Set variables from user's MH profile. | |
172 | |
173 This function sets `mh-user-path' from your \"Path:\" MH profile | |
174 component (but defaults to \"Mail\" if one isn't present), | |
175 `mh-draft-folder' from \"Draft-Folder:\", `mh-unseen-seq' from | |
176 \"Unseen-Sequence:\", `mh-previous-seq' from | |
177 \"Previous-Sequence:\", and `mh-inbox' from \"Inbox:\" (defaults | |
178 to \"+inbox\"). | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
179 |
68465 | 180 The hook `mh-find-path-hook' is run after these variables have |
181 been set. This hook can be used the change the value of these | |
182 variables if you need to run with different values between MH and | |
183 MH-E." | |
184 (unless mh-find-path-run | |
185 ;; Sanity checks. | |
186 (if (and (getenv "MH") | |
187 (not (file-readable-p (getenv "MH")))) | |
188 (error "MH environment variable contains unreadable file %s" | |
189 (getenv "MH"))) | |
190 (if (null (mh-variants)) | |
191 (error "Install MH and run install-mh before running MH-E")) | |
192 (let ((profile "~/.mh_profile")) | |
193 (if (not (file-readable-p profile)) | |
194 (error "Run install-mh before running MH-E"))) | |
195 ;; Read MH profile. | |
196 (setq mh-user-path (mh-profile-component "Path")) | |
197 (if (not mh-user-path) | |
198 (setq mh-user-path "Mail")) | |
199 (setq mh-user-path | |
200 (file-name-as-directory | |
201 (expand-file-name mh-user-path (expand-file-name "~")))) | |
202 (mh-set-x-image-cache-directory (expand-file-name ".mhe-x-image-cache" | |
203 mh-user-path)) | |
204 (setq mh-draft-folder (mh-profile-component "Draft-Folder")) | |
205 (if mh-draft-folder | |
206 (progn | |
207 (if (not (mh-folder-name-p mh-draft-folder)) | |
208 (setq mh-draft-folder (format "+%s" mh-draft-folder))) | |
209 (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) | |
210 (error | |
211 "Draft folder \"%s\" not found; create it and try again" | |
212 (mh-expand-file-name mh-draft-folder))))) | |
213 (setq mh-inbox (mh-profile-component "Inbox")) | |
214 (cond ((not mh-inbox) | |
215 (setq mh-inbox "+inbox")) | |
216 ((not (mh-folder-name-p mh-inbox)) | |
217 (setq mh-inbox (format "+%s" mh-inbox)))) | |
218 (setq mh-unseen-seq (mh-profile-component "Unseen-Sequence")) | |
219 (if mh-unseen-seq | |
220 (setq mh-unseen-seq (intern mh-unseen-seq)) | |
221 (setq mh-unseen-seq 'unseen)) ;old MH default? | |
222 (setq mh-previous-seq (mh-profile-component "Previous-Sequence")) | |
223 (if mh-previous-seq | |
224 (setq mh-previous-seq (intern mh-previous-seq))) | |
225 (run-hooks 'mh-find-path-hook) | |
226 (mh-collect-folder-names) | |
227 (setq mh-find-path-run t))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
228 |
67681 | 229 |
230 | |
68465 | 231 ;;; Help Functions |
232 | |
233 ;;;###mh-autoload | |
234 (defun mh-ephem-message (string) | |
235 "Display STRING in the minibuffer momentarily." | |
236 (message "%s" string) | |
237 (sit-for 5) | |
238 (message "")) | |
239 | |
240 (defvar mh-help-default nil | |
241 "Mode to use if messages are not present for the current mode.") | |
242 | |
243 (defvar mh-help-messages nil | |
244 "Help messages for all modes. | |
245 This is an alist of alists. The primary key is a symbol | |
246 representing the mode; the value is described in `mh-set-help'.") | |
247 | |
248 ;;;###mh-autoload | |
249 (defun mh-set-help (messages &optional default) | |
250 "Set help messages. | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
251 |
68465 | 252 The MESSAGES are assumed to be an associative array. It is used |
253 to show help for the most common commands in the current mode. | |
254 The key is a prefix char. The value is one or more strings which | |
255 are concatenated together and displayed in a help buffer if ? is | |
256 pressed after the prefix character. The special key nil is used | |
257 to display the non-prefixed commands. | |
258 | |
259 The substitutions described in `substitute-command-keys' are performed as | |
260 well. | |
261 | |
262 If optional argument DEFAULT is non-nil, then these messages will | |
263 be used if help is asked for an unknown mode." | |
264 (add-to-list 'mh-help-messages (cons major-mode messages)) | |
265 (if default | |
266 (setq mh-help-default major-mode))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
267 |
68465 | 268 ;;;###mh-autoload |
269 (defun mh-help (&optional help-messages) | |
270 "Display cheat sheet for the MH-E commands. | |
271 See `mh-set-help' for setting the help messages. | |
272 HELP-MESSAGES are used instead if given. | |
273 This is a list of one or more strings which are concatenated together | |
274 and displayed in a help buffer." | |
275 (interactive) | |
276 (let* ((help (or help-messages | |
277 (cdr (assoc nil (assoc major-mode mh-help-messages))))) | |
278 (text (substitute-command-keys (mapconcat 'identity help "")))) | |
279 (with-electric-help | |
280 (function | |
281 (lambda () | |
282 (insert text))) | |
283 mh-help-buffer))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
284 |
68465 | 285 ;;;###mh-autoload |
286 (defun mh-prefix-help () | |
287 "Display cheat sheet for the commands of the current prefix in minibuffer." | |
288 (interactive) | |
289 ;; We got here because the user pressed a "?", but he pressed a prefix key | |
290 ;; before that. Since the the key vector starts at index 0, the index of the | |
291 ;; last keystroke is length-1 and thus the second to last keystroke is at | |
292 ;; length-2. We use that information to obtain a suitable prefix character | |
293 ;; from the recent keys. | |
294 (let* ((keys (recent-keys)) | |
295 (prefix-char (elt keys (- (length keys) 2))) | |
296 (help (cdr (assoc prefix-char (assoc major-mode mh-help-messages))))) | |
297 (mh-help help))) | |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
298 |
68465 | 299 |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
300 |
68465 | 301 ;;; Message Number Utilities |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
302 |
68465 | 303 ;;;###mh-autoload |
304 (defun mh-coalesce-msg-list (messages) | |
305 "Given a list of MESSAGES, return a list of message number ranges. | |
306 This is the inverse of `mh-read-msg-list', which expands ranges. | |
307 Message lists passed to MH programs should be processed by this | |
308 function to avoid exceeding system command line argument limits." | |
309 (let ((msgs (sort (copy-sequence messages) 'mh-greaterp)) | |
310 (range-high nil) | |
311 (prev -1) | |
312 (ranges nil)) | |
313 (while prev | |
314 (if range-high | |
315 (if (or (not (numberp prev)) | |
316 (not (equal (car msgs) (1- prev)))) | |
317 (progn ;non-sequential, flush old range | |
318 (if (eq prev range-high) | |
319 (setq ranges (cons range-high ranges)) | |
320 (setq ranges (cons (format "%s-%s" prev range-high) ranges))) | |
321 (setq range-high nil)))) | |
322 (or range-high | |
323 (setq range-high (car msgs))) ;start new or first range | |
324 (setq prev (car msgs)) | |
325 (setq msgs (cdr msgs))) | |
326 ranges)) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
327 |
68465 | 328 (defun mh-greaterp (msg1 msg2) |
329 "Return the greater of two message indicators MSG1 and MSG2. | |
330 Strings are \"smaller\" than numbers. | |
331 Valid values are things like \"cur\", \"last\", 1, and 1820." | |
332 (if (numberp msg1) | |
333 (if (numberp msg2) | |
334 (> msg1 msg2) | |
335 t) | |
336 (if (numberp msg2) | |
337 nil | |
338 (string-lessp msg2 msg1)))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
339 |
68465 | 340 ;;;###mh-autoload |
341 (defun mh-lessp (msg1 msg2) | |
342 "Return the lesser of two message indicators MSG1 and MSG2. | |
343 Strings are \"smaller\" than numbers. | |
344 Valid values are things like \"cur\", \"last\", 1, and 1820." | |
345 (not (mh-greaterp msg1 msg2))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
346 |
68465 | 347 ;;;###mh-autoload |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
348 (defun mh-get-msg-num (error-if-no-message) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
349 "Return the message number of the displayed message. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
350 If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
351 the cursor is not pointing to a message." |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
352 (save-excursion |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
353 (beginning-of-line) |
68465 | 354 (cond ((looking-at (mh-scan-msg-number-regexp)) |
62847
aa8c2e12ee24
Upgraded to MH-E version 7.84.
Bill Wohler <wohler@newt.com>
parents:
62767
diff
changeset
|
355 (string-to-number (buffer-substring (match-beginning 1) |
aa8c2e12ee24
Upgraded to MH-E version 7.84.
Bill Wohler <wohler@newt.com>
parents:
62767
diff
changeset
|
356 (match-end 1)))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
357 (error-if-no-message |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
358 (error "Cursor not pointing to message")) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
359 (t nil)))) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
360 |
68465 | 361 (add-to-list 'debug-ignored-errors "^Cursor not pointing to message$") |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
362 |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
363 |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
364 |
68465 | 365 ;;; Folder Cache and Access |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
366 |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
367 (defvar mh-sub-folders-cache (make-hash-table :test #'equal)) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
368 (defvar mh-current-folder-name nil) |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
369 (defvar mh-flists-partial-line "") |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
370 (defvar mh-flists-process nil) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
371 |
68465 | 372 ;;;###mh-autoload |
373 (defun mh-clear-sub-folders-cache () | |
374 "Clear `mh-sub-folders-cache'." | |
375 (clrhash mh-sub-folders-cache)) | |
376 | |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
377 ;; Initialize mh-sub-folders-cache... |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
378 (defun mh-collect-folder-names () |
68188
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
379 "Collect folder names by running \"folders\"." |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
380 (unless mh-flists-process |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
381 (setq mh-flists-process |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
382 (mh-exec-cmd-daemon "folders" 'mh-collect-folder-names-filter |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
383 "-recurse" "-fast")))) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
384 |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
385 (defun mh-collect-folder-names-filter (process output) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
386 "Read folder names. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
387 PROCESS is the flists process that was run to collect folder |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
388 names and the function is called when OUTPUT is available." |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
389 (let ((position 0) |
68465 | 390 (prevailing-match-data (match-data)) |
391 line-end folder) | |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
392 (unwind-protect |
68465 | 393 (while (setq line-end (string-match "\n" output position)) |
394 (setq folder (format "+%s%s" | |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
395 mh-flists-partial-line |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
396 (substring output position line-end))) |
68465 | 397 (setq mh-flists-partial-line "") |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
398 (unless (equal (aref folder 1) ?.) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
399 (mh-populate-sub-folders-cache folder)) |
68465 | 400 (setq position (1+ line-end))) |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
401 (set-match-data prevailing-match-data)) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
402 (setq mh-flists-partial-line (substring output position)))) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
403 |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
404 (defun mh-populate-sub-folders-cache (folder) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
405 "Tell `mh-sub-folders-cache' about FOLDER." |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
406 (let* ((last-slash (mh-search-from-end ?/ folder)) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
407 (child1 (substring folder (1+ (or last-slash 0)))) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
408 (parent (and last-slash (substring folder 0 last-slash))) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
409 (parent-slash (and parent (mh-search-from-end ?/ parent))) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
410 (child2 (and parent (substring parent (1+ (or parent-slash 0))))) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
411 (grand-parent (and parent-slash (substring parent 0 parent-slash))) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
412 (cache-entry (gethash parent mh-sub-folders-cache))) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
413 (unless (loop for x in cache-entry when (equal (car x) child1) return t |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
414 finally return nil) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
415 (push (list child1) cache-entry) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
416 (setf (gethash parent mh-sub-folders-cache) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
417 (sort cache-entry (lambda (x y) (string< (car x) (car y))))) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
418 (when parent |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
419 (loop for x in (gethash grand-parent mh-sub-folders-cache) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
420 when (equal (car x) child2) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
421 do (progn (setf (cdr x) t) (return))))))) |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
422 |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
423 (defun mh-normalize-folder-name (folder &optional empty-string-okay |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
424 dont-remove-trailing-slash) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
425 "Normalizes FOLDER name. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
426 |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
427 Makes sure that two '/' characters never occur next to each |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
428 other. Also all occurrences of \"..\" and \".\" are suitably |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
429 processed. So \"+inbox/../news\" will be normalized to \"+news\". |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
430 |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
431 If optional argument EMPTY-STRING-OKAY is nil then a '+' is added |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
432 at the front if FOLDER lacks one. If non-nil and FOLDER is the |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
433 empty string then nothing is added. |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
434 |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
435 If optional argument DONT-REMOVE-TRAILING-SLASH is non-nil then a |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
436 trailing '/' if present is retained (if present), otherwise it is |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
437 removed." |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
438 (when (stringp folder) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
439 ;; Replace two or more consecutive '/' characters with a single '/' |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
440 (while (string-match "//" folder) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
441 (setq folder (replace-match "/" nil t folder))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
442 (let* ((length (length folder)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
443 (trailing-slash-present (and (> length 0) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
444 (equal (aref folder (1- length)) ?/))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
445 (leading-slash-present (and (> length 0) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
446 (equal (aref folder 0) ?/)))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
447 (when (and (> length 0) (equal (aref folder 0) ?@) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
448 (stringp mh-current-folder-name)) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
449 (setq folder (format "%s/%s/" mh-current-folder-name |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
450 (substring folder 1)))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
451 ;; XXX: Purge empty strings from the list that split-string returns. In |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
452 ;; XEmacs, (split-string "+foo/" "/") returns ("+foo" "") while in GNU |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
453 ;; Emacs it returns ("+foo"). In the code it is assumed that the |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
454 ;; components list has no empty strings. |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
455 (let ((components (delete "" (split-string folder "/"))) |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
456 (result ())) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
457 ;; Remove .. and . from the pathname. |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
458 (dolist (component components) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
459 (cond ((and (equal component "..") result) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
460 (pop result)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
461 ((equal component "..")) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
462 ((equal component ".")) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
463 (t (push component result)))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
464 (setq folder "") |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
465 (dolist (component result) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
466 (setq folder (concat component "/" folder))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
467 ;; Remove trailing '/' if needed. |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
468 (unless (and trailing-slash-present dont-remove-trailing-slash) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
469 (when (not (equal folder "")) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
470 (setq folder (substring folder 0 (1- (length folder)))))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
471 (when leading-slash-present |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
472 (setq folder (concat "/" folder))))) |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
473 (cond ((and empty-string-okay (equal folder ""))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
474 ((equal folder "") (setq folder "+")) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
475 ((not (equal (aref folder 0) ?+)) (setq folder (concat "+" folder))))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
476 folder) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
477 |
68188
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
478 (defmacro mh-children-p (folder) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
479 "Return t if FOLDER from sub-folders cache has children. |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
480 The car of folder is the name, and the cdr is either t or some |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
481 sort of count that I do not understand. It's too small to be the |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
482 number of messages in the sub-folders and too large to be the |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
483 number of sub-folders. XXX" |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
484 `(if (cdr ,folder) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
485 t |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
486 nil)) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
487 |
68465 | 488 ;;;###mh-autoload |
68188
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
489 (defun mh-folder-list (folder) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
490 "Return FOLDER and its descendents. |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
491 Returns a list of strings. For example, |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
492 |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
493 '(\"inbox\" \"lists\" \"lists/mh-e\"). |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
494 |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
495 If folder is nil, then all folders are considered. Respects the |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
496 value of `mh-recursive-folders-flag'. If this flag is nil, and |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
497 the sub-folders have not been explicitly viewed, then they will |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
498 not be returned." |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
499 (let ((folder-list)) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
500 ;; Normalize folder. Strip leading +. Add trailing slash. If no |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
501 ;; folder is specified, ensure it is nil to ensure we get the |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
502 ;; top-level folders; otherwise mh-sub-folders returns all the |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
503 ;; files in / if given an empty string or +. |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
504 (when folder |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
505 (setq folder (replace-regexp-in-string "^\+" "" folder)) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
506 (setq folder (replace-regexp-in-string "/*$" "/" folder)) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
507 (if (equal folder "") |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
508 (setq folder nil))) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
509 (loop for f in (mh-sub-folders folder) do |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
510 (setq folder-list (append folder-list (list (concat folder (car f))))) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
511 (if (mh-children-p f) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
512 (setq folder-list |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
513 (append folder-list |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
514 (mh-folder-list (concat folder (car f))))))) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
515 folder-list)) |
dcf226991252
* mh-search.el (mh-index-next-result-function): Add format to
Bill Wohler <wohler@newt.com>
parents:
68163
diff
changeset
|
516 |
68465 | 517 ;;;###mh-autoload |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
518 (defun mh-sub-folders (folder &optional add-trailing-slash-flag) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
519 "Find the subfolders of FOLDER. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
520 The function avoids running folders unnecessarily by caching the |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
521 results of the actual folders call. |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
522 |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
523 If optional argument ADD-TRAILING-SLASH-FLAG is non-nil then a |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
524 slash is added to each of the sub-folder names that may have |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
525 nested folders within them." |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
526 (let* ((folder (mh-normalize-folder-name folder)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
527 (match (gethash folder mh-sub-folders-cache 'no-result)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
528 (sub-folders (cond ((eq match 'no-result) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
529 (setf (gethash folder mh-sub-folders-cache) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
530 (mh-sub-folders-actual folder))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
531 (t match)))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
532 (if add-trailing-slash-flag |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
533 (mapcar #'(lambda (x) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
534 (if (cdr x) (cons (concat (car x) "/") (cdr x)) x)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
535 sub-folders) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
536 sub-folders))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
537 |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
538 (defun mh-sub-folders-actual (folder) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
539 "Execute the command folders to return the sub-folders of FOLDER. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
540 Filters out the folder names that start with \".\" so that |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
541 directories that aren't usually mail folders are hidden." |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
542 (let ((arg-list `(,(expand-file-name "folders" mh-progs) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
543 nil (t nil) nil "-noheader" "-norecurse" "-nototal" |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
544 ,@(if (stringp folder) (list folder) ()))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
545 (results ()) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
546 (current-folder (concat |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
547 (with-temp-buffer |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
548 (call-process (expand-file-name "folder" mh-progs) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
549 nil '(t nil) nil "-fast") |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
550 (buffer-substring (point-min) (1- (point-max)))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
551 "+"))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
552 (with-temp-buffer |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
553 (apply #'call-process arg-list) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
554 (goto-char (point-min)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
555 (while (not (and (eolp) (bolp))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
556 (goto-char (line-end-position)) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
557 (let ((start-pos (line-beginning-position)) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
558 (has-pos (search-backward " has " (line-beginning-position) t))) |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
559 (when (integerp has-pos) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
560 (while (equal (char-after has-pos) ? ) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
561 (decf has-pos)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
562 (incf has-pos) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
563 (while (equal (char-after start-pos) ? ) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
564 (incf start-pos)) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
565 (let* ((name (buffer-substring start-pos has-pos)) |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
566 (first-char (aref name 0)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
567 (last-char (aref name (1- (length name))))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
568 (unless (member first-char '(?. ?# ?,)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
569 (when (and (equal last-char ?+) (equal name current-folder)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
570 (setq name (substring name 0 (1- (length name))))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
571 (push |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
572 (cons name |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
573 (search-forward "(others)" (line-end-position) t)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
574 results)))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
575 (forward-line 1)))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
576 (setq results (nreverse results)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
577 (when (stringp folder) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
578 (setq results (cdr results)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
579 (let ((folder-name-len (length (format "%s/" (substring folder 1))))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
580 (setq results (mapcar (lambda (f) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
581 (cons (substring (car f) folder-name-len) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
582 (cdr f))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
583 results)))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
584 results)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
585 |
68465 | 586 ;;;###mh-autoload |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
587 (defun mh-remove-from-sub-folders-cache (folder) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
588 "Remove FOLDER and its parent from `mh-sub-folders-cache'. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
589 FOLDER should be unconditionally removed from the cache. Also the |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
590 last ancestor of FOLDER present in the cache must be removed as |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
591 well. |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
592 |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
593 To see why this is needed assume we have a folder +foo which has |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
594 a single sub-folder qux. Now we create the folder +foo/bar/baz. |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
595 Here we will need to invalidate the cached sub-folders of +foo, |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
596 otherwise completion on +foo won't tell us about the option |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
597 +foo/bar!" |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
598 (remhash folder mh-sub-folders-cache) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
599 (block ancestor-found |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
600 (let ((parent folder) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
601 (one-ancestor-found nil) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
602 last-slash) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
603 (while (setq last-slash (mh-search-from-end ?/ parent)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
604 (setq parent (substring parent 0 last-slash)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
605 (unless (eq (gethash parent mh-sub-folders-cache 'none) 'none) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
606 (remhash parent mh-sub-folders-cache) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
607 (if one-ancestor-found |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
608 (return-from ancestor-found) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
609 (setq one-ancestor-found t)))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
610 (remhash nil mh-sub-folders-cache)))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
611 |
68465 | 612 |
613 | |
614 ;;; Folder Utilities | |
615 | |
616 ;;;###mh-autoload | |
617 (defun mh-folder-name-p (name) | |
618 "Return non-nil if NAME is the name of a folder. | |
619 A name (a string or symbol) can be a folder name if it begins | |
620 with \"+\"." | |
621 (if (symbolp name) | |
622 (eq (aref (symbol-name name) 0) ?+) | |
623 (and (> (length name) 0) | |
624 (eq (aref name 0) ?+)))) | |
625 | |
626 ;;;###mh-autoload | |
627 (defun mh-expand-file-name (filename &optional default) | |
628 "Expand FILENAME like `expand-file-name', but also handle MH folder names. | |
629 Any filename that starts with '+' is treated as a folder name. | |
630 See `expand-file-name' for description of DEFAULT." | |
631 (if (mh-folder-name-p filename) | |
632 (expand-file-name (substring filename 1) mh-user-path) | |
633 (expand-file-name filename default))) | |
634 | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
635 (defvar mh-folder-hist nil) |
68096
57c4e7929f99
* mh-alias.el (mh-alias-gecos-name): Use replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68013
diff
changeset
|
636 |
57c4e7929f99
* mh-alias.el (mh-alias-gecos-name): Use replace-regexp-in-string
Bill Wohler <wohler@newt.com>
parents:
68013
diff
changeset
|
637 ;; Shush compiler. |
68465 | 638 (eval-when-compile (defvar mh-speed-flists-cache)) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
639 |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
640 (defvar mh-allow-root-folder-flag nil |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
641 "Non-nil means \"+\" is an acceptable folder name. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
642 This variable is used to communicate with |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
643 `mh-folder-completion-function'. That function can have exactly |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
644 three arguments so we bind this variable to t or nil. |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
645 |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
646 This variable should never be set.") |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
647 |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
648 (defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map)) |
67852
5b7ceef33307
(mh-process-daemon): Don't change buffer in proc-filter.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
67760
diff
changeset
|
649 (define-key mh-folder-completion-map " " 'minibuffer-complete) ;Why??? |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
650 |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
651 (defvar mh-speed-flists-inhibit-flag nil) |
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
652 |
68465 | 653 ;;;###mh-autoload |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
654 (defun mh-speed-flists-active-p () |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
655 "Check if speedbar is running with message counts enabled." |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
656 (and (featurep 'mh-speed) |
56406
d36b00b98db0
Upgraded to MH-E version 7.4.4.
Bill Wohler <wohler@newt.com>
parents:
52401
diff
changeset
|
657 (not mh-speed-flists-inhibit-flag) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
658 (> (hash-table-count mh-speed-flists-cache) 0))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
659 |
68465 | 660 ;;;###mh-autoload |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
661 (defun mh-folder-completion-function (name predicate flag) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
662 "Programmable completion for folder names. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
663 NAME is the partial folder name that has been input. PREDICATE if |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
664 non-nil is a function that is used to filter the possible choices |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
665 and FLAG determines whether the completion is over." |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
666 (let* ((orig-name name) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
667 (name (mh-normalize-folder-name name nil t)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
668 (last-slash (mh-search-from-end ?/ name)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
669 (last-complete (if last-slash (substring name 0 last-slash) nil)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
670 (remainder (cond (last-complete (substring name (1+ last-slash))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
671 ((and (> (length name) 0) (equal (aref name 0) ?+)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
672 (substring name 1)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
673 (t "")))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
674 (cond ((eq flag nil) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
675 (let ((try-res (try-completion |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
676 name |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
677 (mapcar (lambda (x) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
678 (cons (if (not last-complete) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
679 (concat "+" (car x)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
680 (concat last-complete "/" (car x))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
681 (cdr x))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
682 (mh-sub-folders last-complete t)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
683 predicate))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
684 (cond ((eq try-res nil) nil) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
685 ((and (eq try-res t) (equal name orig-name)) t) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
686 ((eq try-res t) name) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
687 (t try-res)))) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
688 ((eq flag t) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
689 (all-completions |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
690 remainder (mh-sub-folders last-complete t) predicate)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
691 ((eq flag 'lambda) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
692 (let ((path (concat mh-user-path |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
693 (substring (mh-normalize-folder-name name) 1)))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
694 (cond (mh-allow-root-folder-flag (file-exists-p path)) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
695 ((equal path mh-user-path) nil) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
696 (t (file-exists-p path)))))))) |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
697 |
68465 | 698 ;; Shush compiler. |
699 (eval-when-compile | |
700 (mh-do-in-xemacs | |
701 (defvar completion-root-regexp) | |
702 (defvar minibuffer-completing-file-name))) | |
703 | |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
704 (defun mh-folder-completing-read (prompt default allow-root-folder-flag) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
705 "Read folder name with PROMPT and default result DEFAULT. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
706 If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
707 a folder name corresponding to `mh-user-path'." |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
708 (mh-normalize-folder-name |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
709 (let ((minibuffer-completing-file-name t) |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
710 (completion-root-regexp "^[+/]") |
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
711 (minibuffer-local-completion-map mh-folder-completion-map) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
712 (mh-allow-root-folder-flag allow-root-folder-flag)) |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
713 (completing-read prompt 'mh-folder-completion-function nil nil nil |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
714 'mh-folder-hist default)) |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
715 t)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
716 |
68465 | 717 ;;;###mh-autoload |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
718 (defun mh-prompt-for-folder (prompt default can-create |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
719 &optional default-string allow-root-folder-flag) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
720 "Prompt for a folder name with PROMPT. |
67758
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
721 Returns the folder's name as a string. DEFAULT is used if the |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
722 folder exists and the user types return. If the CAN-CREATE flag |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
723 is t, then a folder is created if it doesn't already exist. If |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
724 optional argument DEFAULT-STRING is non-nil, use it in the prompt |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
725 instead of DEFAULT. If ALLOW-ROOT-FOLDER-FLAG is non-nil then the |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
726 function will accept the folder +, which means all folders when |
6b063593fdad
Follow Emacs coding conventions. Use default setting of
Bill Wohler <wohler@newt.com>
parents:
67756
diff
changeset
|
727 used in searching." |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
728 (if (null default) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
729 (setq default "")) |
65681
4312387e37c8
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
Romain Francoise <romain@orebokech.com>
parents:
64085
diff
changeset
|
730 (let* ((default-string (cond (default-string (format " (default %s)" default-string)) |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
731 ((equal "" default) "") |
65681
4312387e37c8
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
Romain Francoise <romain@orebokech.com>
parents:
64085
diff
changeset
|
732 (t (format " (default %s)" default)))) |
4312387e37c8
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
Romain Francoise <romain@orebokech.com>
parents:
64085
diff
changeset
|
733 (prompt (format "%s folder%s: " prompt default-string)) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
734 (mh-current-folder-name mh-current-folder) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
735 read-name folder-name) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
736 (while (and (setq read-name (mh-folder-completing-read |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
737 prompt default allow-root-folder-flag)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
738 (equal read-name "") |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
739 (equal default ""))) |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
740 (cond ((or (equal read-name "") |
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
741 (and (equal read-name "+") (not allow-root-folder-flag))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
742 (setq read-name default)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
743 ((not (mh-folder-name-p read-name)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
744 (setq read-name (format "+%s" read-name)))) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
745 (if (or (not read-name) (equal "" read-name)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
746 (error "No folder specified")) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
747 (setq folder-name read-name) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
748 (cond ((and (> (length folder-name) 0) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
749 (eq (aref folder-name (1- (length folder-name))) ?/)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
750 (setq folder-name (substring folder-name 0 -1)))) |
50702
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
751 (let* ((last-slash (mh-search-from-end ?/ folder-name)) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
752 (parent (and last-slash (substring folder-name 0 last-slash))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
753 (child (if last-slash |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
754 (substring folder-name (1+ last-slash)) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
755 (substring folder-name 1)))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
756 (unless (member child |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
757 (mapcar #'car (gethash parent mh-sub-folders-cache))) |
7dd3d5eae9c7
Upgraded to MH-E version 7.3.
Bill Wohler <wohler@newt.com>
parents:
49598
diff
changeset
|
758 (mh-remove-from-sub-folders-cache folder-name))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
759 (let ((new-file-flag |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
760 (not (file-exists-p (mh-expand-file-name folder-name))))) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
761 (cond ((and new-file-flag |
67857
226904e7d40b
(mh-prompt-for-folder): Use can-create argument to suppress creation
Bill Wohler <wohler@newt.com>
parents:
67852
diff
changeset
|
762 can-create |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
763 (y-or-n-p |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
764 (format "Folder %s does not exist. Create it? " |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
765 folder-name))) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
766 (message "Creating %s" folder-name) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
767 (mh-exec-cmd-error nil "folder" folder-name) |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
768 (mh-remove-from-sub-folders-cache folder-name) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
769 (when (boundp 'mh-speed-folder-map) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
770 (mh-speed-add-folder folder-name)) |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
771 (message "Creating %s...done" folder-name)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
772 (new-file-flag |
67857
226904e7d40b
(mh-prompt-for-folder): Use can-create argument to suppress creation
Bill Wohler <wohler@newt.com>
parents:
67852
diff
changeset
|
773 (error "Folder %s does not exist" folder-name)) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
774 ((not (file-directory-p (mh-expand-file-name folder-name))) |
68013
bbc0e52abce5
* mh-alias.el (mh-alias-add-alias): Grand message and error string
Bill Wohler <wohler@newt.com>
parents:
67988
diff
changeset
|
775 (error "%s is not a directory" |
49578
b35587af8747
Upgraded to MH-E version 7.2.
Bill Wohler <wohler@newt.com>
parents:
49459
diff
changeset
|
776 (mh-expand-file-name folder-name))))) |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
777 folder-name)) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
778 |
67681 | 779 |
780 | |
68465 | 781 ;;; Message Utilities |
782 | |
783 ;; Functions that would ordinarily be in mh-letter.el that are needed | |
784 ;; by mh-show.el are found here in order to prevent the loading of | |
785 ;; mh-letter.el until a message is actually composed. | |
786 | |
787 ;;;###mh-autoload | |
788 (defun mh-in-header-p () | |
789 "Return non-nil if the point is in the header of a draft message." | |
790 (< (point) (mh-mail-header-end))) | |
68163
3b7532a82079
* mh-search.el: New file containing contents of mh-index.el and
Bill Wohler <wohler@newt.com>
parents:
68137
diff
changeset
|
791 |
68465 | 792 ;;;###mh-autoload |
793 (defun mh-extract-from-header-value () | |
794 "Extract From: string from header." | |
795 (save-excursion | |
796 (if (not (mh-goto-header-field "From:")) | |
797 nil | |
798 (skip-chars-forward " \t") | |
799 (buffer-substring-no-properties | |
800 (point) (progn (mh-header-field-end)(point)))))) | |
801 | |
802 ;;;###mh-autoload | |
68477
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
803 (defun mh-get-header-field (field) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
804 "Find and return the body of FIELD in the mail header. |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
805 Returns the empty string if the field is not in the header of the |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
806 current buffer." |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
807 (if (mh-goto-header-field field) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
808 (progn |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
809 (skip-chars-forward " \t") ;strip leading white space in body |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
810 (let ((start (point))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
811 (mh-header-field-end) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
812 (buffer-substring-no-properties start (point)))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
813 "")) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
814 |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
815 ;;;###mh-autoload |
68465 | 816 (defun mh-goto-header-field (field) |
817 "Move to FIELD in the message header. | |
818 Move to the end of the FIELD name, which should end in a colon. | |
819 Returns t if found, nil if not." | |
820 (goto-char (point-min)) | |
821 (let ((case-fold-search t) | |
822 (headers-end (save-excursion | |
823 (mh-goto-header-end 0) | |
824 (point)))) | |
825 (re-search-forward (format "^%s" field) headers-end t))) | |
826 | |
827 ;;;###mh-autoload | |
828 (defun mh-goto-header-end (arg) | |
829 "Move the cursor ARG lines after the header." | |
830 (if (re-search-forward "^-*$" nil nil) | |
831 (forward-line arg))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
832 |
68465 | 833 ;;;###mh-autoload |
834 (defun mh-mail-header-end () | |
835 "Substitute for `mail-header-end' that doesn't widen the buffer. | |
836 | |
837 In MH-E we frequently need to find the end of headers in nested | |
838 messages, where the buffer has been narrowed. This function works | |
839 in this situation." | |
840 (save-excursion | |
841 ;; XXX: The following replaces a call to rfc822-goto-eoh. Occasionally, | |
842 ;; mail headers that MH-E has to read contains lines of the form: | |
843 ;; From xxx@yyy Mon May 10 11:48:07 2004 | |
844 ;; In this situation, rfc822-goto-eoh doesn't go to the end of the | |
845 ;; header. The replacement allows From_ lines in the mail header. | |
846 (goto-char (point-min)) | |
847 (loop for p = (re-search-forward | |
848 "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move) | |
849 do (cond ((null p) (return)) | |
850 (t (goto-char (match-beginning 0)) | |
851 (unless (looking-at "From ") (return)) | |
852 (goto-char p)))) | |
853 (point))) | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
854 |
68465 | 855 ;;;###mh-autoload |
856 (defun mh-header-field-beginning () | |
857 "Move to the beginning of the current header field. | |
858 Handles RFC 822 continuation lines." | |
859 (beginning-of-line) | |
860 (while (looking-at "^[ \t]") | |
861 (forward-line -1))) | |
862 | |
863 ;;;###mh-autoload | |
864 (defun mh-header-field-end () | |
865 "Move to the end of the current header field. | |
866 Handles RFC 822 continuation lines." | |
867 (forward-line 1) | |
868 (while (looking-at "^[ \t]") | |
869 (forward-line 1)) | |
870 (backward-char 1)) ;to end of previous line | |
871 | |
872 ;;;###mh-autoload | |
68477
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
873 (defun mh-letter-hide-all-skipped-fields () |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
874 "Hide all skipped fields." |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
875 (save-excursion |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
876 (goto-char (point-min)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
877 (save-restriction |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
878 (narrow-to-region (point) (mh-mail-header-end)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
879 (while (re-search-forward mh-letter-header-field-regexp nil t) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
880 (if (mh-letter-skipped-header-field-p (match-string 1)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
881 (mh-letter-toggle-header-field-display -1) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
882 (mh-letter-toggle-header-field-display 'long)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
883 (beginning-of-line 2))))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
884 |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
885 ;;;###mh-autoload |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
886 (defun mh-letter-skipped-header-field-p (field) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
887 "Check if FIELD is to be skipped." |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
888 (let ((field (downcase field))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
889 (loop for x in mh-compose-skipped-header-fields |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
890 when (equal (downcase x) field) return t |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
891 finally return nil))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
892 |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
893 (defvar mh-hidden-header-keymap |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
894 (let ((map (make-sparse-keymap))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
895 (mh-do-in-gnu-emacs |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
896 (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
897 (mh-do-in-xemacs |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
898 (define-key map '(button2) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
899 'mh-letter-toggle-header-field-display-button)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
900 map)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
901 |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
902 ;;;###mh-autoload |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
903 (defun mh-letter-toggle-header-field-display (arg) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
904 "Toggle display of header field at point. |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
905 |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
906 Use this command to display truncated header fields. This command |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
907 is a toggle so entering it again will hide the field. This |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
908 command takes a prefix argument ARG: if negative then the field |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
909 is hidden, if positive then the field is displayed." |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
910 (interactive (list nil)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
911 (when (and (mh-in-header-p) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
912 (progn |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
913 (end-of-line) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
914 (re-search-backward mh-letter-header-field-regexp nil t))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
915 (let ((buffer-read-only nil) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
916 (modified-flag (buffer-modified-p)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
917 (begin (point)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
918 end) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
919 (end-of-line) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
920 (setq end (1- (if (re-search-forward "^[^ \t]" nil t) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
921 (match-beginning 0) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
922 (point-max)))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
923 (goto-char begin) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
924 ;; Make it clickable... |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
925 (add-text-properties begin end `(keymap ,mh-hidden-header-keymap |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
926 mouse-face highlight)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
927 (unwind-protect |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
928 (cond ((or (and (not arg) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
929 (text-property-any begin end 'invisible 'vanish)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
930 (and (numberp arg) (>= arg 0)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
931 (and (eq arg 'long) (> (line-beginning-position 5) end))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
932 (remove-text-properties begin end '(invisible nil)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
933 (search-forward ":" (line-end-position) t) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
934 (mh-letter-skip-leading-whitespace-in-header-field)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
935 ;; XXX Redesign to make usable by user. Perhaps use a positive |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
936 ;; numeric prefix to make that many lines visible. |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
937 ((eq arg 'long) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
938 (end-of-line 4) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
939 (mh-letter-truncate-header-field end) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
940 (beginning-of-line)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
941 (t (end-of-line) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
942 (mh-letter-truncate-header-field end) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
943 (beginning-of-line))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
944 (set-buffer-modified-p modified-flag))))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
945 |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
946 ;;;###mh-autoload |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
947 (defun mh-letter-skip-leading-whitespace-in-header-field () |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
948 "Skip leading whitespace in a header field. |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
949 If the header field doesn't have at least one space after the |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
950 colon then a space character is added." |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
951 (let ((need-space t)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
952 (while (memq (char-after) '(?\t ?\ )) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
953 (forward-char) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
954 (setq need-space nil)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
955 (when need-space (insert " ")))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
956 |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
957 (defun mh-letter-truncate-header-field (end) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
958 "Replace text from current line till END with an ellipsis. |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
959 If the current line is too long truncate a part of it as well." |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
960 (let ((max-len (min (window-width) 62))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
961 (when (> (+ (current-column) 4) max-len) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
962 (backward-char (- (+ (current-column) 5) max-len))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
963 (when (> end (point)) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
964 (add-text-properties (point) end '(invisible vanish))))) |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
965 |
0f44616074ba
* mh-comp.el (mh-letter-hide-all-skipped-fields)
Bill Wohler <wohler@newt.com>
parents:
68465
diff
changeset
|
966 ;;;###mh-autoload |
68465 | 967 (defun mh-signature-separator-p () |
968 "Return non-nil if buffer includes \"^-- $\"." | |
969 (save-excursion | |
970 (goto-char (point-min)) | |
971 (re-search-forward mh-signature-separator-regexp nil t))) | |
56673
e9a6cbc8ca5e
Upgraded to MH-E version 7.4.80.
Bill Wohler <wohler@newt.com>
parents:
56406
diff
changeset
|
972 |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
973 (provide 'mh-utils) |
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
974 |
67681 | 975 ;; Local Variables: |
976 ;; indent-tabs-mode: nil | |
977 ;; sentence-end-double-space: nil | |
978 ;; End: | |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
979 |
67681 | 980 ;; arch-tag: 1af39fdf-f66f-4b06-9b48-18a7656c8e36 |
49459
06b77df47802
* mh-e: Created directory. ChangeLog will appear in a week when we
Bill Wohler <wohler@newt.com>
parents:
diff
changeset
|
981 ;;; mh-utils.el ends here |