aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBill Wohler2006-01-31 20:46:15 +0000
committerBill Wohler2006-01-31 20:46:15 +0000
commit06e7028b76c83c5fba3b1e581ae5b68cd7bcc177 (patch)
tree85d2c8a2da0f47a4b45456cfc87467f0aaae1c7d
parent08166ee946ae1c8c6c86b003c464857d507a42da (diff)
downloademacs-06e7028b76c83c5fba3b1e581ae5b68cd7bcc177.tar.gz
emacs-06e7028b76c83c5fba3b1e581ae5b68cd7bcc177.zip
* 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.
-rw-r--r--lisp/mh-e/ChangeLog76
-rw-r--r--lisp/mh-e/mh-acros.el30
-rw-r--r--lisp/mh-e/mh-alias.el16
-rw-r--r--lisp/mh-e/mh-compat.el86
-rw-r--r--lisp/mh-e/mh-folder.el13
-rw-r--r--lisp/mh-e/mh-gnus.el30
-rw-r--r--lisp/mh-e/mh-identity.el2
-rw-r--r--lisp/mh-e/mh-mime.el46
-rw-r--r--lisp/mh-e/mh-utils.el9
-rw-r--r--lisp/mh-e/mh-xface.el64
10 files changed, 223 insertions, 149 deletions
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index a018b66347e..dc465888f44 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,79 @@
12006-01-31 Bill Wohler <wohler@newt.com>
2
3 * mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name
4 argument since compatibility functions should have our package
5 prefix (mh-) by Emacs convention and to avoid messing up checks
6 for the same functions in other packages. Use explicit argument
7 instead of forming name by adding mh-e prefix so that one can grep
8 and find the definition.
9
10 * mh-alias.el (mh-alias-local-users, mh-alias-reload)
11 (mh-alias-expand, mh-alias-minibuffer-confirm-address): Use
12 mh-assoc-string instead of assoc-string.
13
14 * mh-compat.el (assoc-string): Rename to mh-assoc-string.
15 (mh-mail-abbrev-make-syntax-table, mh-url-hexify-string): Move
16 here from mh-utils.el.
17 (mh-display-completion-list): Move here from mh-comp.el.
18 (mh-face-foreground, mh-face-background): Move here from
19 mh-xface.el.
20 (mh-write-file-functions): Move here from mh-folder.el
21
22 * mh-folder.el (mh-write-file-functions-compat): Move to
23 mh-compat.el and rename to mh-write-file-functions.
24 (mh-folder-mode): Use the new name.
25
26 * mh-gnus.el (gnus-local-map-property): Rename to
27 mh-gnus-local-map-property.
28 (mm-merge-handles): Rename to mh-mm-merge-handles.
29 (mm-set-handle-multipart-parameter): Rename to
30 mh-mm-set-handle-multipart-parameter.
31 (mm-inline-text-vcard): Rename to mh-mm-inline-text-vcard.
32 (mm-possibly-verify-or-decrypt): Rename to
33 mh-mm-possibly-verify-or-decrypt.
34 (mm-handle-multipart-ctl-parameter): Rename to
35 mh-mm-handle-multipart-ctl-parameter.
36 (mm-readable-p): Rename to mh-mm-readable-p.
37 (mm-long-lines-p): Rename to mh-mm-long-lines-p.
38 (mm-keep-viewer-alive-p): Rename to mh-mm-keep-viewer-alive-p.
39 (mm-destroy-parts): Rename to mh-mm-destroy-parts.
40 (mm-uu-dissect-text-parts): Rename to mh-mm-uu-dissect-text-parts.
41 (mml-minibuffer-read-disposition): Rename to
42 mh-mml-minibuffer-read-disposition.
43
44 * mh-identity.el (mh-identity-field-handler): Use mh-assoc-string
45 instead of assoc-string.
46
47 * mh-mime.el (mh-mm-inline-media-tests, mh-mm-inline-message)
48 (mh-mime-display, mh-mime-display-security)
49 (mh-insert-mime-button, mh-insert-mime-security-button)
50 (mh-handle-set-external-undisplayer)
51 (mh-mime-security-press-button, mh-mime-security-show-details)
52 (mh-mml-attach-file, mh-mime-cleanup)
53 (mh-destroy-postponed-handles): Use new mh-* names for
54 compatibility functions.
55
56 * mh-utils.el (mail-abbrev-make-syntax-table): Move to
57 mh-compat.el and rename to mh-mail-abbrev-make-syntax-table.
58 (mh-beginning-of-word): Use the new name.
59 (mh-get-field): Delete ancient alias.
60
61 * mh-xface.el (mh-face-foreground-compat): Move to mh-compat.el
62 and rename to mh-face-foreground
63 (mh-face-background-compat): Move to mh-compat.el
64 and rename to mh-face-background.
65 (mh-face-display-function): Use the new names.
66 (mh-x-image-url-cache-canonicalize): Use mh-url-hexify-string
67 instead of url-hexify-string.
68 (url-unreserved-chars): Move to mh-compat.el and rename to
69 mh-url-unreserved-chars.
70 (url-hexify-string): Move to mh-compat.el and rename to
71 mh-url-hexify-string.
72
73 * mh-letter.el (mh-complete-word): Fix bug in call to
74 mh-display-completion-list. Wrong argument was passed, so
75 completions wouldn't show highlighted prefix.
76
12006-01-29 Bill Wohler <wohler@newt.com> 772006-01-29 Bill Wohler <wohler@newt.com>
2 78
3 * mh-e.el (mh-scan-format-file-check): Allow any non-nil for 79 * mh-e.el (mh-scan-format-file-check): Allow any non-nil for
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index 313d3f19a2d..8f38abc56ee 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -82,25 +82,25 @@ loads \"cl\" appropriately."
82 (funcall ',function ,@args)))) 82 (funcall ',function ,@args))))
83 83
84;;;###mh-autoload 84;;;###mh-autoload
85(defmacro mh-defun-compat (function arg-list &rest body) 85(defmacro mh-defun-compat (name function arg-list &rest body)
86 "This is a macro to define functions which are not defined. 86 "Create function NAME.
87It is used for functions which were added to Emacs recently. 87If FUNCTION exists, then NAME becomes an alias for FUNCTION.
88If FUNCTION is not defined then it is defined to have argument 88Otherwise, create function NAME with ARG-LIST and BODY."
89list, ARG-LIST and body, BODY."
90 (let ((defined-p (fboundp function))) 89 (let ((defined-p (fboundp function)))
91 (unless defined-p 90 (if defined-p
92 `(defun ,function ,arg-list ,@body)))) 91 `(defalias ',name ',function)
92 `(defun ,name ,arg-list ,@body))))
93(put 'mh-defun-compat 'lisp-indent-function 'defun) 93(put 'mh-defun-compat 'lisp-indent-function 'defun)
94 94
95;;;###mh-autoload 95;;;###mh-autoload
96(defmacro mh-defmacro-compat (function arg-list &rest body) 96(defmacro mh-defmacro-compat (name macro arg-list &rest body)
97 "This is a macro to define functions which are not defined. 97 "Create macro NAME.
98It is used for macros which were added to Emacs recently. 98If MACRO exists, then NAME becomes an alias for MACRO.
99If FUNCTION is not defined then it is defined to have argument 99Otherwise, create macro NAME with ARG-LIST and BODY."
100list, ARG-LIST and body, BODY." 100 (let ((defined-p (fboundp macro)))
101 (let ((defined-p (fboundp function))) 101 (if defined-p
102 (unless defined-p 102 `(defalias ',name ',macro)
103 `(defmacro ,function ,arg-list ,@body)))) 103 `(defmacro ,name ,arg-list ,@body))))
104(put 'mh-defmacro-compat 'lisp-indent-function 'defun) 104(put 'mh-defmacro-compat 'lisp-indent-function 'defun)
105 105
106 106
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index 98c14d63302..23af886c320 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -169,7 +169,7 @@ Exclude all aliases already in `mh-alias-alist' from \"ali\""
169 (if (string-equal username realname) 169 (if (string-equal username realname)
170 (concat "<" username ">") 170 (concat "<" username ">")
171 (concat realname " <" username ">")))) 171 (concat realname " <" username ">"))))
172 (when (not (assoc-string alias-name mh-alias-alist t)) 172 (when (not (mh-assoc-string alias-name mh-alias-alist t))
173 (setq passwd-alist (cons (list alias-name alias-translation) 173 (setq passwd-alist (cons (list alias-name alias-translation)
174 passwd-alist))))))) 174 passwd-alist)))))))
175 (forward-line 1))) 175 (forward-line 1)))
@@ -198,12 +198,12 @@ been loaded."
198 (cond 198 (cond
199 ((looking-at "^[ \t]")) ;Continuation line 199 ((looking-at "^[ \t]")) ;Continuation line
200 ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias 200 ((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
201 (when (not (assoc-string (match-string 1) mh-alias-blind-alist t)) 201 (when (not (mh-assoc-string (match-string 1) mh-alias-blind-alist t))
202 (setq mh-alias-blind-alist 202 (setq mh-alias-blind-alist
203 (cons (list (match-string 1)) mh-alias-blind-alist)) 203 (cons (list (match-string 1)) mh-alias-blind-alist))
204 (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist)))) 204 (setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
205 ((looking-at "\\(.+\\): .*$") ; A new MH alias 205 ((looking-at "\\(.+\\): .*$") ; A new MH alias
206 (when (not (assoc-string (match-string 1) mh-alias-alist t)) 206 (when (not (mh-assoc-string (match-string 1) mh-alias-alist t))
207 (setq mh-alias-alist 207 (setq mh-alias-alist
208 (cons (list (match-string 1)) mh-alias-alist))))) 208 (cons (list (match-string 1)) mh-alias-alist)))))
209 (forward-line 1))) 209 (forward-line 1)))
@@ -214,7 +214,7 @@ been loaded."
214 user) 214 user)
215 (while local-users 215 (while local-users
216 (setq user (car local-users)) 216 (setq user (car local-users))
217 (if (not (assoc-string (car user) mh-alias-alist t)) 217 (if (not (mh-assoc-string (car user) mh-alias-alist t))
218 (setq mh-alias-alist (append mh-alias-alist (list user)))) 218 (setq mh-alias-alist (append mh-alias-alist (list user))))
219 (setq local-users (cdr local-users))))) 219 (setq local-users (cdr local-users)))))
220 (run-hooks 'mh-alias-reloaded-hook) 220 (run-hooks 'mh-alias-reloaded-hook)
@@ -251,10 +251,10 @@ returns the string unchanged if not defined. The same is done here."
251 "Return expansion for ALIAS. 251 "Return expansion for ALIAS.
252Blind aliases or users from /etc/passwd are not expanded." 252Blind aliases or users from /etc/passwd are not expanded."
253 (cond 253 (cond
254 ((assoc-string alias mh-alias-blind-alist t) 254 ((mh-assoc-string alias mh-alias-blind-alist t)
255 alias) ; Don't expand a blind alias 255 alias) ; Don't expand a blind alias
256 ((assoc-string alias mh-alias-passwd-alist t) 256 ((mh-assoc-string alias mh-alias-passwd-alist t)
257 (cadr (assoc-string alias mh-alias-passwd-alist t))) 257 (cadr (mh-assoc-string alias mh-alias-passwd-alist t)))
258 (t 258 (t
259 (mh-alias-ali alias)))) 259 (mh-alias-ali alias))))
260 260
@@ -292,7 +292,7 @@ Blind aliases or users from /etc/passwd are not expanded."
292 (let* ((case-fold-search t) 292 (let* ((case-fold-search t)
293 (beg (mh-beginning-of-word)) 293 (beg (mh-beginning-of-word))
294 (the-name (buffer-substring-no-properties beg (point)))) 294 (the-name (buffer-substring-no-properties beg (point))))
295 (if (assoc-string the-name mh-alias-alist t) 295 (if (mh-assoc-string the-name mh-alias-alist t)
296 (message "%s -> %s" the-name (mh-alias-expand the-name)) 296 (message "%s -> %s" the-name (mh-alias-expand the-name))
297 ;; Check if if was a single word likely to be an alias 297 ;; Check if if was a single word likely to be an alias
298 (if (and (equal mh-alias-flash-on-comma 1) 298 (if (and (equal mh-alias-flash-on-comma 1)
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 452d0a3c089..c60ae20d811 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -36,31 +36,91 @@
36;; way, it's easy to occasionally go through this file and see which 36;; way, it's easy to occasionally go through this file and see which
37;; macros we can retire. 37;; macros we can retire.
38 38
39;; See also mh-gnus.el for compatibility macros used to span different 39;; Please use mh-gnus.el when providing compatibility with different
40;; versions of Gnus. 40;; versions of Gnus and mh-xemacs.el for compatibility with XEmacs.
41 41
42;; Macros are listed alphabetically. 42;; Items are listed alphabetically.
43 43
44(unless (fboundp 'assoc-string) 44(mh-defun-compat mh-assoc-string assoc-string (key list case-fold)
45 (defsubst assoc-string (key list case-fold) 45 "Like `assoc' but specifically for strings.
46 "Like `assoc' but specifically for strings.
47Case is ignored if CASE-FOLD is non-nil. 46Case is ignored if CASE-FOLD is non-nil.
48This function added by MH-E for Emacs versions that lack 47This function added by MH-E for Emacs versions that lack
49`assoc-string', introduced in Emacs 22." 48`assoc-string', introduced in Emacs 22."
50 (if case-fold 49 (if case-fold
51 (assoc-ignore-case key list) 50 (assoc-ignore-case key list)
52 (assoc key list)))) 51 (assoc key list)))
52
53(require 'mailabbrev nil t)
54(mh-defun-compat mh-mail-abbrev-make-syntax-table
55 mail-abbrev-make-syntax-table ()
56 "Emacs 21 and XEmacs don't have this function."
57 nil)
53 58
54(defmacro mh-display-completion-list (completions &optional common-substring) 59(defmacro mh-display-completion-list (completions &optional common-substring)
55 "Display the list of COMPLETIONS. 60 "Display the list of COMPLETIONS.
56Calls `display-completion-list' correctly in older environments. 61See documentation for `display-completion-list' for a description of the
57Versions of Emacs prior to version 22 lacked a COMMON-SUBSTRING 62arguments COMPLETIONS and perhaps COMMON-SUBSTRING.
58argument which is used to highlight the next possible character you 63This macro added by MH-E for Emacs versions that lack a
59can enter in the current list of completions." 64COMMON-SUBSTRING argument, introduced in Emacs 22."
60 (if (< emacs-major-version 22) 65 (if (< emacs-major-version 22)
61 `(display-completion-list ,completions) 66 `(display-completion-list ,completions)
62 `(display-completion-list ,completions ,common-substring))) 67 `(display-completion-list ,completions ,common-substring)))
63 68
69(defmacro mh-face-foreground (face &optional frame inherit)
70 "Return the foreground color name of FACE, or nil if unspecified.
71See documentation for `face-foreground' for a description of the
72arguments FACE, FRAME, and perhaps INHERIT.
73This macro added by MH-E for Emacs versions that lack an INHERIT
74argument, introduced in Emacs 22."
75 (if (< emacs-major-version 22)
76 `(face-foreground ,face ,frame)
77 `(face-foreground ,face ,frame ,inherit)))
78
79(defmacro mh-face-background (face &optional frame inherit)
80 "Return the background color name of face, or nil if unspecified.
81See documentation for `back-foreground' for a description of the
82arguments FACE, FRAME, and INHERIT.
83This macro added by MH-E for Emacs versions that lack an INHERIT
84argument, introduced in Emacs 22."
85 (if (< emacs-major-version 22)
86 `(face-background ,face ,frame)
87 `(face-background ,face ,frame ,inherit)))
88
89;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21.
90(if (not (boundp 'url-unreserved-chars))
91 (defconst mh-url-unresrved-chars
92 '(
93 ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
94 ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
95 ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
96 ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
97 "A list of characters that are _NOT_ reserved in the URL spec.
98This is taken from RFC 2396."))
99
100(mh-defun-compat mh-url-hexify-string url-hexify-string (str)
101 "Escape characters in a string.
102This is a copy of `url-hexify-string' from url-util.el in Emacs
10322; needed by Emacs 21."
104 (mapconcat
105 (lambda (char)
106 ;; Fixme: use a char table instead.
107 (if (not (memq char mh-url-unreserved-chars))
108 (if (> char 255)
109 (error "Hexifying multibyte character %s" str)
110 (format "%%%02X" char))
111 (char-to-string char)))
112 str ""))
113
114(defmacro mh-write-file-functions ()
115 "Return `write-file-functions' if it exists.
116Otherwise return `local-write-file-hooks'.
117This macro exists purely for compatibility. The former symbol is used
118in Emacs 22 onward while the latter is used in previous versions and
119XEmacs."
120 (if (boundp 'write-file-functions)
121 ''write-file-functions ;Emacs 22 on
122 ''local-write-file-hooks)) ;XEmacs
123
64(provide 'mh-compat) 124(provide 'mh-compat)
65 125
66;; Local Variables: 126;; Local Variables:
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 98ecc06d7c2..5339363df19 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -515,15 +515,6 @@ font-lock is done highlighting.")
515 (set-specifier horizontal-scrollbar-visible-p nil 515 (set-specifier horizontal-scrollbar-visible-p nil
516 (cons (current-buffer) nil))))) 516 (cons (current-buffer) nil)))))
517 517
518(defmacro mh-write-file-functions-compat ()
519 "Return `write-file-functions' if it exists.
520Otherwise return `local-write-file-hooks'. This macro exists
521purely for compatibility. The former symbol is used in Emacs 21.4
522onward while the latter is used in previous versions and XEmacs."
523 (if (boundp 'write-file-functions)
524 ''write-file-functions ;Emacs 21.4
525 ''local-write-file-hooks)) ;XEmacs
526
527;; Register mh-folder-mode as supporting which-function-mode... 518;; Register mh-folder-mode as supporting which-function-mode...
528(require 'which-func nil t) 519(require 'which-func nil t)
529(when (boundp 'which-func-modes) 520(when (boundp 'which-func-modes)
@@ -650,8 +641,8 @@ perform the operation on all messages in that region.
650 (setq truncate-lines t) 641 (setq truncate-lines t)
651 (auto-save-mode -1) 642 (auto-save-mode -1)
652 (setq buffer-offer-save t) 643 (setq buffer-offer-save t)
653 (mh-make-local-hook (mh-write-file-functions-compat)) 644 (mh-make-local-hook (mh-write-file-functions))
654 (add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t) 645 (add-hook (mh-write-file-functions) 'mh-execute-commands nil t)
655 (make-local-variable 'revert-buffer-function) 646 (make-local-variable 'revert-buffer-function)
656 (make-local-variable 'hl-line-mode) ; avoid pollution 647 (make-local-variable 'hl-line-mode) ; avoid pollution
657 (mh-funcall-if-exists hl-line-mode 1) 648 (mh-funcall-if-exists hl-line-mode 1)
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index dd2a888f12f..8944db89f70 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -39,26 +39,27 @@
39(require 'mml nil t) 39(require 'mml nil t)
40 40
41;; Copy of function from gnus-util.el. 41;; Copy of function from gnus-util.el.
42(mh-defun-compat gnus-local-map-property (map) 42(mh-defun-compat mh-gnus-local-map-property gnus-local-map-property (map)
43 "Return a list suitable for a text property list specifying keymap MAP." 43 "Return a list suitable for a text property list specifying keymap MAP."
44 (cond (mh-xemacs-flag (list 'keymap map)) 44 (cond (mh-xemacs-flag (list 'keymap map))
45 ((>= emacs-major-version 21) (list 'keymap map)) 45 ((>= emacs-major-version 21) (list 'keymap map))
46 (t (list 'local-map map)))) 46 (t (list 'local-map map))))
47 47
48;; Copy of function from mm-decode.el. 48;; Copy of function from mm-decode.el.
49(mh-defun-compat mm-merge-handles (handles1 handles2) 49(mh-defun-compat mh-mm-merge-handles mm-merge-handles (handles1 handles2)
50 (append (if (listp (car handles1)) handles1 (list handles1)) 50 (append (if (listp (car handles1)) handles1 (list handles1))
51 (if (listp (car handles2)) handles2 (list handles2)))) 51 (if (listp (car handles2)) handles2 (list handles2))))
52 52
53;; Copy of function from mm-decode.el. 53;; Copy of function from mm-decode.el.
54(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value) 54(mh-defun-compat mh-mm-set-handle-multipart-parameter
55 mm-set-handle-multipart-parameter (handle parameter value)
55 ;; HANDLE could be a CTL. 56 ;; HANDLE could be a CTL.
56 (if handle 57 (if handle
57 (put-text-property 0 (length (car handle)) parameter value 58 (put-text-property 0 (length (car handle)) parameter value
58 (car handle)))) 59 (car handle))))
59 60
60;; Copy of function from mm-view.el. 61;; Copy of function from mm-view.el.
61(mh-defun-compat mm-inline-text-vcard (handle) 62(mh-defun-compat mh-mm-inline-text-vcard mm-inline-text-vcard (handle)
62 (let (buffer-read-only) 63 (let (buffer-read-only)
63 (mm-insert-inline 64 (mm-insert-inline
64 handle 65 handle
@@ -72,25 +73,27 @@
72 73
73;; Function from mm-decode.el used in PGP messages. Just define it with older 74;; Function from mm-decode.el used in PGP messages. Just define it with older
74;; Gnus to avoid compiler warning. 75;; Gnus to avoid compiler warning.
75(mh-defun-compat mm-possibly-verify-or-decrypt (parts ctl) 76(mh-defun-compat mh-mm-possibly-verify-or-decrypt
77 mm-possibly-verify-or-decrypt (parts ctl)
76 nil) 78 nil)
77 79
78;; Copy of macro in mm-decode.el. 80;; Copy of macro in mm-decode.el.
79(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter) 81(mh-defmacro-compat mh-mm-handle-multipart-ctl-parameter
82 mm-handle-multipart-ctl-parameter (handle parameter)
80 `(get-text-property 0 ,parameter (car ,handle))) 83 `(get-text-property 0 ,parameter (car ,handle)))
81 84
82;; Copy of function in mm-decode.el. 85;; Copy of function in mm-decode.el.
83(mh-defun-compat mm-readable-p (handle) 86(mh-defun-compat mh-mm-readable-p mm-readable-p (handle)
84 "Say whether the content of HANDLE is readable." 87 "Say whether the content of HANDLE is readable."
85 (and (< (with-current-buffer (mm-handle-buffer handle) 88 (and (< (with-current-buffer (mm-handle-buffer handle)
86 (buffer-size)) 10000) 89 (buffer-size)) 10000)
87 (mm-with-unibyte-buffer 90 (mm-with-unibyte-buffer
88 (mm-insert-part handle) 91 (mm-insert-part handle)
89 (and (eq (mm-body-7-or-8) '7bit) 92 (and (eq (mm-body-7-or-8) '7bit)
90 (not (mm-long-lines-p 76)))))) 93 (not (mh-mm-long-lines-p 76))))))
91 94
92;; Copy of function in mm-bodies.el. 95;; Copy of function in mm-bodies.el.
93(mh-defun-compat mm-long-lines-p (length) 96(mh-defun-compat mh-mm-long-lines-p mm-long-lines-p (length)
94 "Say whether any of the lines in the buffer is longer than LENGTH." 97 "Say whether any of the lines in the buffer is longer than LENGTH."
95 (save-excursion 98 (save-excursion
96 (goto-char (point-min)) 99 (goto-char (point-min))
@@ -102,21 +105,22 @@
102 (and (> (current-column) length) 105 (and (> (current-column) length)
103 (current-column)))) 106 (current-column))))
104 107
105(mh-defun-compat mm-keep-viewer-alive-p (handle) 108(mh-defun-compat mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle)
106 ;; Released Gnus doesn't keep handles associated with externally displayed 109 ;; Released Gnus doesn't keep handles associated with externally displayed
107 ;; MIME parts. So this will always return nil. 110 ;; MIME parts. So this will always return nil.
108 nil) 111 nil)
109 112
110(mh-defun-compat mm-destroy-parts (list) 113(mh-defun-compat mh-mm-destroy-parts mm-destroy-parts (list)
111 "Older versions of Emacs don't have this function." 114 "Older versions of Emacs don't have this function."
112 nil) 115 nil)
113 116
114(mh-defun-compat mm-uu-dissect-text-parts (handles) 117(mh-defun-compat mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles)
115 "Emacs 21 and XEmacs don't have this function." 118 "Emacs 21 and XEmacs don't have this function."
116 nil) 119 nil)
117 120
118;; Copy of function in mml.el. 121;; Copy of function in mml.el.
119(mh-defun-compat mml-minibuffer-read-disposition (type &optional default) 122(mh-defun-compat mh-mml-minibuffer-read-disposition
123 mml-minibuffer-read-disposition (type &optional default)
120 (unless default (setq default 124 (unless default (setq default
121 (if (and (string-match "\\`text/" type) 125 (if (and (string-match "\\`text/" type)
122 (not (string-match "\\`text/rtf\\'" type))) 126 (not (string-match "\\`text/rtf\\'" type)))
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index faafea71f3f..4d401bbea55 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -127,7 +127,7 @@ The field name is downcased. If the FIELD begins with the
127character \":\", then it must have a special handler defined in 127character \":\", then it must have a special handler defined in
128`mh-identity-handlers', else return an error since it is not a 128`mh-identity-handlers', else return an error since it is not a
129valid header field." 129valid header field."
130 (or (cdr (assoc-string field mh-identity-handlers t)) 130 (or (cdr (mh-assoc-string field mh-identity-handlers t))
131 (and (eq (aref field 0) ?:) 131 (and (eq (aref field 0) ?:)
132 (error "Field %s not found in `mh-identity-handlers'" field)) 132 (error "Field %s not found in `mh-identity-handlers'" field))
133 (cdr (assoc ":default" mh-identity-handlers)) 133 (cdr (assoc ":default" mh-identity-handlers))
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index de4c01a9604..776f0c067a8 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -144,7 +144,7 @@
144 mm-inline-text-html-renderer) 144 mm-inline-text-html-renderer)
145 (and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))) 145 (and (boundp 'mm-text-html-renderer) mm-text-html-renderer))))
146 ("text/x-vcard" 146 ("text/x-vcard"
147 mm-inline-text-vcard 147 mh-mm-inline-text-vcard
148 (lambda (handle) 148 (lambda (handle)
149 (or (featurep 'vcard) 149 (or (featurep 'vcard)
150 (locate-library "vcard")))) 150 (locate-library "vcard"))))
@@ -174,7 +174,7 @@
174 ("audio/.*" ignore ignore) 174 ("audio/.*" ignore ignore)
175 ("image/.*" ignore ignore) 175 ("image/.*" ignore ignore)
176 ;; Default to displaying as text 176 ;; Default to displaying as text
177 (".*" mm-inline-text mm-readable-p)) 177 (".*" mm-inline-text mh-mm-readable-p))
178 "Alist of media types/tests saying whether types can be displayed inline.") 178 "Alist of media types/tests saying whether types can be displayed inline.")
179 179
180(defvar mh-mime-save-parts-directory nil 180(defvar mh-mime-save-parts-directory nil
@@ -460,10 +460,10 @@ decoding the same message multiple times."
460 (setf (gethash handle (mh-mime-handles-cache (mh-buffer-data))) 460 (setf (gethash handle (mh-mime-handles-cache (mh-buffer-data)))
461 (let ((handles (mm-dissect-buffer nil))) 461 (let ((handles (mm-dissect-buffer nil)))
462 (if handles 462 (if handles
463 (mm-uu-dissect-text-parts handles) 463 (mh-mm-uu-dissect-text-parts handles)
464 (setq handles (mm-uu-dissect))) 464 (setq handles (mm-uu-dissect)))
465 (setf (mh-mime-handles (mh-buffer-data)) 465 (setf (mh-mime-handles (mh-buffer-data))
466 (mm-merge-handles 466 (mh-mm-merge-handles
467 handles (mh-mime-handles (mh-buffer-data)))) 467 handles (mh-mime-handles (mh-buffer-data))))
468 handles)))) 468 handles))))
469 469
@@ -527,11 +527,11 @@ parsed and then displayed."
527 (if pre-dissected-handles 527 (if pre-dissected-handles
528 (setq handles pre-dissected-handles) 528 (setq handles pre-dissected-handles)
529 (if (setq handles (mm-dissect-buffer nil)) 529 (if (setq handles (mm-dissect-buffer nil))
530 (mm-uu-dissect-text-parts handles) 530 (mh-mm-uu-dissect-text-parts handles)
531 (setq handles (mm-uu-dissect))) 531 (setq handles (mm-uu-dissect)))
532 (setf (mh-mime-handles (mh-buffer-data)) 532 (setf (mh-mime-handles (mh-buffer-data))
533 (mm-merge-handles handles 533 (mh-mm-merge-handles handles
534 (mh-mime-handles (mh-buffer-data)))) 534 (mh-mime-handles (mh-buffer-data))))
535 (unless handles 535 (unless handles
536 (mh-decode-message-body))) 536 (mh-decode-message-body)))
537 537
@@ -637,7 +637,7 @@ buttons for alternative parts that are usually suppressed."
637 (let ((mh-mime-security-button-line-format 637 (let ((mh-mime-security-button-line-format
638 mh-mime-security-button-end-line-format)) 638 mh-mime-security-button-end-line-format))
639 (mh-insert-mime-security-button handle)) 639 (mh-insert-mime-security-button handle))
640 (mm-set-handle-multipart-parameter 640 (mh-mm-set-handle-multipart-parameter
641 handle 'mh-region (cons (point-min-marker) (point-max-marker))))) 641 handle 'mh-region (cons (point-min-marker) (point-max-marker)))))
642 642
643(defun mh-mime-display-single (handle) 643(defun mh-mime-display-single (handle)
@@ -853,7 +853,7 @@ by commands like \"K v\" which operate on individual MIME parts."
853 (setq begin (point)) 853 (setq begin (point))
854 (gnus-eval-format 854 (gnus-eval-format
855 mh-mime-button-line-format mh-mime-button-line-format-alist 855 mh-mime-button-line-format mh-mime-button-line-format-alist
856 `(,@(gnus-local-map-property mh-mime-button-map) 856 `(,@(mh-gnus-local-map-property mh-mime-button-map)
857 mh-callback mh-mm-display-part 857 mh-callback mh-mm-display-part
858 mh-part ,index 858 mh-part ,index
859 mh-data ,handle)) 859 mh-data ,handle))
@@ -878,7 +878,7 @@ by commands like \"K v\" which operate on individual MIME parts."
878 878
879(defun mh-insert-mime-security-button (handle) 879(defun mh-insert-mime-security-button (handle)
880 "Display buttons for PGP message, HANDLE." 880 "Display buttons for PGP message, HANDLE."
881 (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) 881 (let* ((protocol (mh-mm-handle-multipart-ctl-parameter handle 'protocol))
882 (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist)) 882 (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist))
883 (nth 2 (assoc protocol mm-decrypt-function-alist)) 883 (nth 2 (assoc protocol mm-decrypt-function-alist))
884 "Unknown")) 884 "Unknown"))
@@ -886,9 +886,9 @@ by commands like \"K v\" which operate on individual MIME parts."
886 (if (equal (car handle) "multipart/signed") 886 (if (equal (car handle) "multipart/signed")
887 " Signed" " Encrypted") 887 " Signed" " Encrypted")
888 " Part")) 888 " Part"))
889 (info (or (mm-handle-multipart-ctl-parameter handle 'gnus-info) 889 (info (or (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info)
890 "Undecided")) 890 "Undecided"))
891 (details (mm-handle-multipart-ctl-parameter handle 'gnus-details)) 891 (details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details))
892 pressed-details begin end face) 892 pressed-details begin end face)
893 (setq details (if details (concat "\n" details) "")) 893 (setq details (if details (concat "\n" details) ""))
894 (setq pressed-details (if mh-mime-security-button-pressed details "")) 894 (setq pressed-details (if mh-mime-security-button-pressed details ""))
@@ -898,7 +898,7 @@ by commands like \"K v\" which operate on individual MIME parts."
898 (gnus-eval-format 898 (gnus-eval-format
899 mh-mime-security-button-line-format 899 mh-mime-security-button-line-format
900 mh-mime-security-button-line-format-alist 900 mh-mime-security-button-line-format-alist
901 `(,@(gnus-local-map-property mh-mime-security-button-map) 901 `(,@(mh-gnus-local-map-property mh-mime-security-button-map)
902 mh-button-pressed ,mh-mime-security-button-pressed 902 mh-button-pressed ,mh-mime-security-button-pressed
903 mh-callback mh-mime-security-press-button 903 mh-callback mh-mime-security-press-button
904 mh-line-format ,mh-mime-security-button-line-format 904 mh-line-format ,mh-mime-security-button-line-format
@@ -1065,7 +1065,7 @@ This is only called in recent versions of Gnus. The MIME handles
1065are stored in data structures corresponding to MH-E folder buffer 1065are stored in data structures corresponding to MH-E folder buffer
1066FOLDER instead of in Gnus (as in the original). The MIME part, 1066FOLDER instead of in Gnus (as in the original). The MIME part,
1067HANDLE is associated with the undisplayer FUNCTION." 1067HANDLE is associated with the undisplayer FUNCTION."
1068 (if (mm-keep-viewer-alive-p handle) 1068 (if (mh-mm-keep-viewer-alive-p handle)
1069 (let ((new-handle (copy-sequence handle))) 1069 (let ((new-handle (copy-sequence handle)))
1070 (mm-handle-set-undisplayer new-handle function) 1070 (mm-handle-set-undisplayer new-handle function)
1071 (mm-handle-set-undisplayer handle nil) 1071 (mm-handle-set-undisplayer handle nil)
@@ -1076,19 +1076,19 @@ HANDLE is associated with the undisplayer FUNCTION."
1076 1076
1077(defun mh-mime-security-press-button (handle) 1077(defun mh-mime-security-press-button (handle)
1078 "Callback from security button for part HANDLE." 1078 "Callback from security button for part HANDLE."
1079 (if (mm-handle-multipart-ctl-parameter handle 'gnus-info) 1079 (if (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info)
1080 (mh-mime-security-show-details handle) 1080 (mh-mime-security-show-details handle)
1081 (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region)) 1081 (let ((region (mh-mm-handle-multipart-ctl-parameter handle 'mh-region))
1082 point) 1082 point)
1083 (setq point (point)) 1083 (setq point (point))
1084 (goto-char (car region)) 1084 (goto-char (car region))
1085 (delete-region (car region) (cdr region)) 1085 (delete-region (car region) (cdr region))
1086 (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer) 1086 (with-current-buffer (mh-mm-handle-multipart-ctl-parameter handle 'buffer)
1087 (let* ((mm-verify-option 'known) 1087 (let* ((mm-verify-option 'known)
1088 (mm-decrypt-option 'known) 1088 (mm-decrypt-option 'known)
1089 (new (mm-possibly-verify-or-decrypt (cdr handle) handle))) 1089 (new (mh-mm-possibly-verify-or-decrypt (cdr handle) handle)))
1090 (unless (eq new (cdr handle)) 1090 (unless (eq new (cdr handle))
1091 (mm-destroy-parts (cdr handle)) 1091 (mh-mm-destroy-parts (cdr handle))
1092 (setcdr handle new)))) 1092 (setcdr handle new))))
1093 (mh-mime-display-security handle) 1093 (mh-mime-display-security handle)
1094 (goto-char point)))) 1094 (goto-char point))))
@@ -1098,7 +1098,7 @@ HANDLE is associated with the undisplayer FUNCTION."
1098;; to be no way of getting rid of the inserted text. 1098;; to be no way of getting rid of the inserted text.
1099(defun mh-mime-security-show-details (handle) 1099(defun mh-mime-security-show-details (handle)
1100 "Toggle display of detailed security info for HANDLE." 1100 "Toggle display of detailed security info for HANDLE."
1101 (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) 1101 (let ((details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details)))
1102 (when details 1102 (when details
1103 (let ((mh-mime-security-button-pressed 1103 (let ((mh-mime-security-button-pressed
1104 (not (get-text-property (point) 'mh-button-pressed))) 1104 (not (get-text-property (point) 'mh-button-pressed)))
@@ -1296,7 +1296,7 @@ automatically."
1296 (type (mh-minibuffer-read-type file)) 1296 (type (mh-minibuffer-read-type file))
1297 (description (mml-minibuffer-read-description)) 1297 (description (mml-minibuffer-read-description))
1298 (dispos (or disposition 1298 (dispos (or disposition
1299 (mml-minibuffer-read-disposition type)))) 1299 (mh-mml-minibuffer-read-disposition type))))
1300 (mml-insert-empty-tag 'part 'type type 'filename file 1300 (mml-insert-empty-tag 'part 'type type 'filename file
1301 'disposition dispos 'description description))) 1301 'disposition dispos 'description description)))
1302 1302
@@ -1784,7 +1784,7 @@ initialized. Always use the command `mh-have-file-command'.")
1784 ;; This is for Emacs, what about XEmacs? 1784 ;; This is for Emacs, what about XEmacs?
1785 (mh-funcall-if-exists remove-images (point-min) (point-max)) 1785 (mh-funcall-if-exists remove-images (point-min) (point-max))
1786 (when mime-data 1786 (when mime-data
1787 (mm-destroy-parts (mh-mime-handles mime-data)) 1787 (mh-mm-destroy-parts (mh-mime-handles mime-data))
1788 (remhash (current-buffer) mh-globals-hash)))) 1788 (remhash (current-buffer) mh-globals-hash))))
1789 1789
1790;;;###mh-autoload 1790;;;###mh-autoload
@@ -1792,7 +1792,7 @@ initialized. Always use the command `mh-have-file-command'.")
1792 "Free MIME data for externally displayed MIME parts." 1792 "Free MIME data for externally displayed MIME parts."
1793 (let ((mime-data (mh-buffer-data))) 1793 (let ((mime-data (mh-buffer-data)))
1794 (when mime-data 1794 (when mime-data
1795 (mm-destroy-parts (mh-mime-handles mime-data))) 1795 (mh-mm-destroy-parts (mh-mime-handles mime-data)))
1796 (remhash (current-buffer) mh-globals-hash))) 1796 (remhash (current-buffer) mh-globals-hash)))
1797 1797
1798(provide 'mh-mime) 1798(provide 'mh-mime)
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index ec26a6a140c..b34ff8ee5b6 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -51,11 +51,6 @@ used in lieu of `search' in the CL package."
51 51
52;;; General Utilities 52;;; General Utilities
53 53
54(require 'mailabbrev nil t)
55(mh-defun-compat mail-abbrev-make-syntax-table ()
56 "Emacs 21 and XEmacs don't have this function."
57 nil)
58
59;;;###mh-autoload 54;;;###mh-autoload
60(defun mh-beginning-of-word (&optional n) 55(defun mh-beginning-of-word (&optional n)
61 "Return position of the N th word backwards." 56 "Return position of the N th word backwards."
@@ -63,7 +58,7 @@ used in lieu of `search' in the CL package."
63 (let ((syntax-table (syntax-table))) 58 (let ((syntax-table (syntax-table)))
64 (unwind-protect 59 (unwind-protect
65 (save-excursion 60 (save-excursion
66 (mail-abbrev-make-syntax-table) 61 (mh-mail-abbrev-make-syntax-table)
67 (set-syntax-table mail-abbrev-syntax-table) 62 (set-syntax-table mail-abbrev-syntax-table)
68 (backward-word n) 63 (backward-word n)
69 (point)) 64 (point))
@@ -817,8 +812,6 @@ current buffer."
817 (buffer-substring-no-properties start (point)))) 812 (buffer-substring-no-properties start (point))))
818 "")) 813 ""))
819 814
820(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
821
822;;;###mh-autoload 815;;;###mh-autoload
823(defun mh-goto-header-field (field) 816(defun mh-goto-header-field (field)
824 "Move to FIELD in the message header. 817 "Move to FIELD in the message header.
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index 45431bef5d2..58d175f5470 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -59,32 +59,6 @@
59 mh-clean-message-header-flag)) 59 mh-clean-message-header-flag))
60 (funcall mh-show-xface-function))) 60 (funcall mh-show-xface-function)))
61 61
62(defmacro mh-face-foreground-compat (face &optional frame inherit)
63 "Return the foreground color name of FACE, or nil if unspecified.
64See documentation for `face-foreground' for a description of the
65arguments FACE, FRAME, and INHERIT.
66
67Calls `face-foreground' correctly in older environments. Versions
68of Emacs prior to version 22 lacked an INHERIT argument which
69when t tells `face-foreground' to consider an inherited value for
70the foreground if the face does not define one itself."
71 (if (>= emacs-major-version 22)
72 `(face-foreground ,face ,frame ,inherit)
73 `(face-foreground ,face ,frame)))
74
75(defmacro mh-face-background-compat(face &optional frame inherit)
76 "Return the background color name of face, or nil if unspecified.
77See documentation for `back-foreground' for a description of the
78arguments FACE, FRAME, and INHERIT.
79
80Calls `face-background' correctly in older environments. Versions
81of Emacs prior to version 22 lacked an INHERIT argument which
82when t tells `face-background' to consider an inherited value for
83the background if the face does not define one itself."
84 (if (>= emacs-major-version 22)
85 `(face-background ,face ,frame ,inherit)
86 `(face-background ,face ,frame)))
87
88;; Shush compiler. 62;; Shush compiler.
89(eval-when-compile 63(eval-when-compile
90 (mh-do-in-xemacs (defvar default-enable-multibyte-characters))) 64 (mh-do-in-xemacs (defvar default-enable-multibyte-characters)))
@@ -120,9 +94,9 @@ in this order is used."
120 insert-image (create-image 94 insert-image (create-image
121 raw type t 95 raw type t
122 :foreground 96 :foreground
123 (mh-face-foreground-compat 'mh-show-xface nil t) 97 (mh-face-foreground 'mh-show-xface nil t)
124 :background 98 :background
125 (mh-face-background-compat 'mh-show-xface nil t)) 99 (mh-face-background 'mh-show-xface nil t))
126 " "))) 100 " ")))
127 ;; XEmacs 101 ;; XEmacs
128 (mh-do-in-xemacs 102 (mh-do-in-xemacs
@@ -386,41 +360,17 @@ This is only done if `mh-x-image-cache-directory' is nil."
386(defun mh-x-image-url-cache-canonicalize (url) 360(defun mh-x-image-url-cache-canonicalize (url)
387 "Canonicalize URL. 361 "Canonicalize URL.
388Replace the ?/ character with a ?! character and append .png. 362Replace the ?/ character with a ?! character and append .png.
389Also replaces special characters with `url-hexify-string' since 363Also replaces special characters with `mh-url-hexify-string'
390not all characters, such as :, are legal within Windows 364since not all characters, such as :, are legal within Windows
391filenames. See URL `http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp'." 365filenames. See URL
366`http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp'."
392 (format "%s/%s.png" mh-x-image-cache-directory 367 (format "%s/%s.png" mh-x-image-cache-directory
393 (url-hexify-string 368 (mh-url-hexify-string
394 (with-temp-buffer 369 (with-temp-buffer
395 (insert url) 370 (insert url)
396 (mh-replace-string "/" "!") 371 (mh-replace-string "/" "!")
397 (buffer-string))))) 372 (buffer-string)))))
398 373
399;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21.
400(if (not (boundp 'url-unreserved-chars))
401 (defconst url-unreserved-chars
402 '(
403 ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
404 ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
405 ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
406 ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
407 "A list of characters that are _NOT_ reserved in the URL spec.
408This is taken from RFC 2396."))
409
410(mh-defun-compat url-hexify-string (str)
411 "Escape characters in a string.
412This is a copy of the function of the same name from url-util.el
413in Emacs 22; needed by Emacs 21."
414 (mapconcat
415 (lambda (char)
416 ;; Fixme: use a char table instead.
417 (if (not (memq char url-unreserved-chars))
418 (if (> char 255)
419 (error "Hexifying multibyte character %s" str)
420 (format "%%%02X" char))
421 (char-to-string char)))
422 str ""))
423
424(defun mh-x-image-get-download-state (file) 374(defun mh-x-image-get-download-state (file)
425 "Check the state of FILE by following any symbolic links." 375 "Check the state of FILE by following any symbolic links."
426 (unless (file-exists-p mh-x-image-cache-directory) 376 (unless (file-exists-p mh-x-image-cache-directory)