* 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.
This commit is contained in:
Bill Wohler
parent
08166ee946
commit
06e7028b76
10 changed files with 223 additions and 149 deletions
|
|
@ -1,3 +1,79 @@
|
|||
2006-01-31 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* 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.
|
||||
|
||||
* mh-letter.el (mh-complete-word): Fix bug in call to
|
||||
mh-display-completion-list. Wrong argument was passed, so
|
||||
completions wouldn't show highlighted prefix.
|
||||
|
||||
2006-01-29 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* mh-e.el (mh-scan-format-file-check): Allow any non-nil for
|
||||
|
|
|
|||
|
|
@ -82,25 +82,25 @@ loads \"cl\" appropriately."
|
|||
(funcall ',function ,@args))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-defun-compat (function arg-list &rest body)
|
||||
"This is a macro to define functions which are not defined.
|
||||
It is used for functions which were added to Emacs recently.
|
||||
If FUNCTION is not defined then it is defined to have argument
|
||||
list, ARG-LIST and body, BODY."
|
||||
(defmacro mh-defun-compat (name function arg-list &rest body)
|
||||
"Create function NAME.
|
||||
If FUNCTION exists, then NAME becomes an alias for FUNCTION.
|
||||
Otherwise, create function NAME with ARG-LIST and BODY."
|
||||
(let ((defined-p (fboundp function)))
|
||||
(unless defined-p
|
||||
`(defun ,function ,arg-list ,@body))))
|
||||
(if defined-p
|
||||
`(defalias ',name ',function)
|
||||
`(defun ,name ,arg-list ,@body))))
|
||||
(put 'mh-defun-compat 'lisp-indent-function 'defun)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-defmacro-compat (function arg-list &rest body)
|
||||
"This is a macro to define functions which are not defined.
|
||||
It is used for macros which were added to Emacs recently.
|
||||
If FUNCTION is not defined then it is defined to have argument
|
||||
list, ARG-LIST and body, BODY."
|
||||
(let ((defined-p (fboundp function)))
|
||||
(unless defined-p
|
||||
`(defmacro ,function ,arg-list ,@body))))
|
||||
(defmacro mh-defmacro-compat (name macro arg-list &rest body)
|
||||
"Create macro NAME.
|
||||
If MACRO exists, then NAME becomes an alias for MACRO.
|
||||
Otherwise, create macro NAME with ARG-LIST and BODY."
|
||||
(let ((defined-p (fboundp macro)))
|
||||
(if defined-p
|
||||
`(defalias ',name ',macro)
|
||||
`(defmacro ,name ,arg-list ,@body))))
|
||||
(put 'mh-defmacro-compat 'lisp-indent-function 'defun)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -169,7 +169,7 @@ Exclude all aliases already in `mh-alias-alist' from \"ali\""
|
|||
(if (string-equal username realname)
|
||||
(concat "<" username ">")
|
||||
(concat realname " <" username ">"))))
|
||||
(when (not (assoc-string alias-name mh-alias-alist t))
|
||||
(when (not (mh-assoc-string alias-name mh-alias-alist t))
|
||||
(setq passwd-alist (cons (list alias-name alias-translation)
|
||||
passwd-alist)))))))
|
||||
(forward-line 1)))
|
||||
|
|
@ -198,12 +198,12 @@ been loaded."
|
|||
(cond
|
||||
((looking-at "^[ \t]")) ;Continuation line
|
||||
((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
|
||||
(when (not (assoc-string (match-string 1) mh-alias-blind-alist t))
|
||||
(when (not (mh-assoc-string (match-string 1) mh-alias-blind-alist t))
|
||||
(setq mh-alias-blind-alist
|
||||
(cons (list (match-string 1)) mh-alias-blind-alist))
|
||||
(setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
|
||||
((looking-at "\\(.+\\): .*$") ; A new MH alias
|
||||
(when (not (assoc-string (match-string 1) mh-alias-alist t))
|
||||
(when (not (mh-assoc-string (match-string 1) mh-alias-alist t))
|
||||
(setq mh-alias-alist
|
||||
(cons (list (match-string 1)) mh-alias-alist)))))
|
||||
(forward-line 1)))
|
||||
|
|
@ -214,7 +214,7 @@ been loaded."
|
|||
user)
|
||||
(while local-users
|
||||
(setq user (car local-users))
|
||||
(if (not (assoc-string (car user) mh-alias-alist t))
|
||||
(if (not (mh-assoc-string (car user) mh-alias-alist t))
|
||||
(setq mh-alias-alist (append mh-alias-alist (list user))))
|
||||
(setq local-users (cdr local-users)))))
|
||||
(run-hooks 'mh-alias-reloaded-hook)
|
||||
|
|
@ -251,10 +251,10 @@ returns the string unchanged if not defined. The same is done here."
|
|||
"Return expansion for ALIAS.
|
||||
Blind aliases or users from /etc/passwd are not expanded."
|
||||
(cond
|
||||
((assoc-string alias mh-alias-blind-alist t)
|
||||
((mh-assoc-string alias mh-alias-blind-alist t)
|
||||
alias) ; Don't expand a blind alias
|
||||
((assoc-string alias mh-alias-passwd-alist t)
|
||||
(cadr (assoc-string alias mh-alias-passwd-alist t)))
|
||||
((mh-assoc-string alias mh-alias-passwd-alist t)
|
||||
(cadr (mh-assoc-string alias mh-alias-passwd-alist t)))
|
||||
(t
|
||||
(mh-alias-ali alias))))
|
||||
|
||||
|
|
@ -292,7 +292,7 @@ Blind aliases or users from /etc/passwd are not expanded."
|
|||
(let* ((case-fold-search t)
|
||||
(beg (mh-beginning-of-word))
|
||||
(the-name (buffer-substring-no-properties beg (point))))
|
||||
(if (assoc-string the-name mh-alias-alist t)
|
||||
(if (mh-assoc-string the-name mh-alias-alist t)
|
||||
(message "%s -> %s" the-name (mh-alias-expand the-name))
|
||||
;; Check if if was a single word likely to be an alias
|
||||
(if (and (equal mh-alias-flash-on-comma 1)
|
||||
|
|
|
|||
|
|
@ -36,31 +36,91 @@
|
|||
;; way, it's easy to occasionally go through this file and see which
|
||||
;; macros we can retire.
|
||||
|
||||
;; See also mh-gnus.el for compatibility macros used to span different
|
||||
;; versions of Gnus.
|
||||
;; Please use mh-gnus.el when providing compatibility with different
|
||||
;; versions of Gnus and mh-xemacs.el for compatibility with XEmacs.
|
||||
|
||||
;; Macros are listed alphabetically.
|
||||
;; Items are listed alphabetically.
|
||||
|
||||
(unless (fboundp 'assoc-string)
|
||||
(defsubst assoc-string (key list case-fold)
|
||||
"Like `assoc' but specifically for strings.
|
||||
(mh-defun-compat mh-assoc-string assoc-string (key list case-fold)
|
||||
"Like `assoc' but specifically for strings.
|
||||
Case is ignored if CASE-FOLD is non-nil.
|
||||
This function added by MH-E for Emacs versions that lack
|
||||
`assoc-string', introduced in Emacs 22."
|
||||
(if case-fold
|
||||
(assoc-ignore-case key list)
|
||||
(assoc key list))))
|
||||
(if case-fold
|
||||
(assoc-ignore-case key list)
|
||||
(assoc key list)))
|
||||
|
||||
(require 'mailabbrev nil t)
|
||||
(mh-defun-compat mh-mail-abbrev-make-syntax-table
|
||||
mail-abbrev-make-syntax-table ()
|
||||
"Emacs 21 and XEmacs don't have this function."
|
||||
nil)
|
||||
|
||||
(defmacro mh-display-completion-list (completions &optional common-substring)
|
||||
"Display the list of COMPLETIONS.
|
||||
Calls `display-completion-list' correctly in older environments.
|
||||
Versions of Emacs prior to version 22 lacked a COMMON-SUBSTRING
|
||||
argument which is used to highlight the next possible character you
|
||||
can enter in the current list of completions."
|
||||
See documentation for `display-completion-list' for a description of the
|
||||
arguments COMPLETIONS and perhaps COMMON-SUBSTRING.
|
||||
This macro added by MH-E for Emacs versions that lack a
|
||||
COMMON-SUBSTRING argument, introduced in Emacs 22."
|
||||
(if (< emacs-major-version 22)
|
||||
`(display-completion-list ,completions)
|
||||
`(display-completion-list ,completions ,common-substring)))
|
||||
|
||||
(defmacro mh-face-foreground (face &optional frame inherit)
|
||||
"Return the foreground color name of FACE, or nil if unspecified.
|
||||
See documentation for `face-foreground' for a description of the
|
||||
arguments FACE, FRAME, and perhaps INHERIT.
|
||||
This macro added by MH-E for Emacs versions that lack an INHERIT
|
||||
argument, introduced in Emacs 22."
|
||||
(if (< emacs-major-version 22)
|
||||
`(face-foreground ,face ,frame)
|
||||
`(face-foreground ,face ,frame ,inherit)))
|
||||
|
||||
(defmacro mh-face-background (face &optional frame inherit)
|
||||
"Return the background color name of face, or nil if unspecified.
|
||||
See documentation for `back-foreground' for a description of the
|
||||
arguments FACE, FRAME, and INHERIT.
|
||||
This macro added by MH-E for Emacs versions that lack an INHERIT
|
||||
argument, introduced in Emacs 22."
|
||||
(if (< emacs-major-version 22)
|
||||
`(face-background ,face ,frame)
|
||||
`(face-background ,face ,frame ,inherit)))
|
||||
|
||||
;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21.
|
||||
(if (not (boundp 'url-unreserved-chars))
|
||||
(defconst mh-url-unresrved-chars
|
||||
'(
|
||||
?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
|
||||
?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
|
||||
?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
|
||||
?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
|
||||
"A list of characters that are _NOT_ reserved in the URL spec.
|
||||
This is taken from RFC 2396."))
|
||||
|
||||
(mh-defun-compat mh-url-hexify-string url-hexify-string (str)
|
||||
"Escape characters in a string.
|
||||
This is a copy of `url-hexify-string' from url-util.el in Emacs
|
||||
22; needed by Emacs 21."
|
||||
(mapconcat
|
||||
(lambda (char)
|
||||
;; Fixme: use a char table instead.
|
||||
(if (not (memq char mh-url-unreserved-chars))
|
||||
(if (> char 255)
|
||||
(error "Hexifying multibyte character %s" str)
|
||||
(format "%%%02X" char))
|
||||
(char-to-string char)))
|
||||
str ""))
|
||||
|
||||
(defmacro mh-write-file-functions ()
|
||||
"Return `write-file-functions' if it exists.
|
||||
Otherwise return `local-write-file-hooks'.
|
||||
This macro exists purely for compatibility. The former symbol is used
|
||||
in Emacs 22 onward while the latter is used in previous versions and
|
||||
XEmacs."
|
||||
(if (boundp 'write-file-functions)
|
||||
''write-file-functions ;Emacs 22 on
|
||||
''local-write-file-hooks)) ;XEmacs
|
||||
|
||||
(provide 'mh-compat)
|
||||
|
||||
;; Local Variables:
|
||||
|
|
|
|||
|
|
@ -515,15 +515,6 @@ font-lock is done highlighting.")
|
|||
(set-specifier horizontal-scrollbar-visible-p nil
|
||||
(cons (current-buffer) nil)))))
|
||||
|
||||
(defmacro mh-write-file-functions-compat ()
|
||||
"Return `write-file-functions' if it exists.
|
||||
Otherwise return `local-write-file-hooks'. This macro exists
|
||||
purely for compatibility. The former symbol is used in Emacs 21.4
|
||||
onward while the latter is used in previous versions and XEmacs."
|
||||
(if (boundp 'write-file-functions)
|
||||
''write-file-functions ;Emacs 21.4
|
||||
''local-write-file-hooks)) ;XEmacs
|
||||
|
||||
;; Register mh-folder-mode as supporting which-function-mode...
|
||||
(require 'which-func nil t)
|
||||
(when (boundp 'which-func-modes)
|
||||
|
|
@ -650,8 +641,8 @@ perform the operation on all messages in that region.
|
|||
(setq truncate-lines t)
|
||||
(auto-save-mode -1)
|
||||
(setq buffer-offer-save t)
|
||||
(mh-make-local-hook (mh-write-file-functions-compat))
|
||||
(add-hook (mh-write-file-functions-compat) 'mh-execute-commands nil t)
|
||||
(mh-make-local-hook (mh-write-file-functions))
|
||||
(add-hook (mh-write-file-functions) 'mh-execute-commands nil t)
|
||||
(make-local-variable 'revert-buffer-function)
|
||||
(make-local-variable 'hl-line-mode) ; avoid pollution
|
||||
(mh-funcall-if-exists hl-line-mode 1)
|
||||
|
|
|
|||
|
|
@ -39,26 +39,27 @@
|
|||
(require 'mml nil t)
|
||||
|
||||
;; Copy of function from gnus-util.el.
|
||||
(mh-defun-compat gnus-local-map-property (map)
|
||||
(mh-defun-compat mh-gnus-local-map-property gnus-local-map-property (map)
|
||||
"Return a list suitable for a text property list specifying keymap MAP."
|
||||
(cond (mh-xemacs-flag (list 'keymap map))
|
||||
((>= emacs-major-version 21) (list 'keymap map))
|
||||
(t (list 'local-map map))))
|
||||
|
||||
;; Copy of function from mm-decode.el.
|
||||
(mh-defun-compat mm-merge-handles (handles1 handles2)
|
||||
(mh-defun-compat mh-mm-merge-handles mm-merge-handles (handles1 handles2)
|
||||
(append (if (listp (car handles1)) handles1 (list handles1))
|
||||
(if (listp (car handles2)) handles2 (list handles2))))
|
||||
|
||||
;; Copy of function from mm-decode.el.
|
||||
(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value)
|
||||
(mh-defun-compat mh-mm-set-handle-multipart-parameter
|
||||
mm-set-handle-multipart-parameter (handle parameter value)
|
||||
;; HANDLE could be a CTL.
|
||||
(if handle
|
||||
(put-text-property 0 (length (car handle)) parameter value
|
||||
(car handle))))
|
||||
|
||||
;; Copy of function from mm-view.el.
|
||||
(mh-defun-compat mm-inline-text-vcard (handle)
|
||||
(mh-defun-compat mh-mm-inline-text-vcard mm-inline-text-vcard (handle)
|
||||
(let (buffer-read-only)
|
||||
(mm-insert-inline
|
||||
handle
|
||||
|
|
@ -72,25 +73,27 @@
|
|||
|
||||
;; Function from mm-decode.el used in PGP messages. Just define it with older
|
||||
;; Gnus to avoid compiler warning.
|
||||
(mh-defun-compat mm-possibly-verify-or-decrypt (parts ctl)
|
||||
(mh-defun-compat mh-mm-possibly-verify-or-decrypt
|
||||
mm-possibly-verify-or-decrypt (parts ctl)
|
||||
nil)
|
||||
|
||||
;; Copy of macro in mm-decode.el.
|
||||
(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter)
|
||||
(mh-defmacro-compat mh-mm-handle-multipart-ctl-parameter
|
||||
mm-handle-multipart-ctl-parameter (handle parameter)
|
||||
`(get-text-property 0 ,parameter (car ,handle)))
|
||||
|
||||
;; Copy of function in mm-decode.el.
|
||||
(mh-defun-compat mm-readable-p (handle)
|
||||
(mh-defun-compat mh-mm-readable-p mm-readable-p (handle)
|
||||
"Say whether the content of HANDLE is readable."
|
||||
(and (< (with-current-buffer (mm-handle-buffer handle)
|
||||
(buffer-size)) 10000)
|
||||
(mm-with-unibyte-buffer
|
||||
(mm-insert-part handle)
|
||||
(and (eq (mm-body-7-or-8) '7bit)
|
||||
(not (mm-long-lines-p 76))))))
|
||||
(not (mh-mm-long-lines-p 76))))))
|
||||
|
||||
;; Copy of function in mm-bodies.el.
|
||||
(mh-defun-compat mm-long-lines-p (length)
|
||||
(mh-defun-compat mh-mm-long-lines-p mm-long-lines-p (length)
|
||||
"Say whether any of the lines in the buffer is longer than LENGTH."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
|
|
@ -102,21 +105,22 @@
|
|||
(and (> (current-column) length)
|
||||
(current-column))))
|
||||
|
||||
(mh-defun-compat mm-keep-viewer-alive-p (handle)
|
||||
(mh-defun-compat mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle)
|
||||
;; Released Gnus doesn't keep handles associated with externally displayed
|
||||
;; MIME parts. So this will always return nil.
|
||||
nil)
|
||||
|
||||
(mh-defun-compat mm-destroy-parts (list)
|
||||
(mh-defun-compat mh-mm-destroy-parts mm-destroy-parts (list)
|
||||
"Older versions of Emacs don't have this function."
|
||||
nil)
|
||||
|
||||
(mh-defun-compat mm-uu-dissect-text-parts (handles)
|
||||
(mh-defun-compat mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles)
|
||||
"Emacs 21 and XEmacs don't have this function."
|
||||
nil)
|
||||
|
||||
;; Copy of function in mml.el.
|
||||
(mh-defun-compat mml-minibuffer-read-disposition (type &optional default)
|
||||
(mh-defun-compat mh-mml-minibuffer-read-disposition
|
||||
mml-minibuffer-read-disposition (type &optional default)
|
||||
(unless default (setq default
|
||||
(if (and (string-match "\\`text/" type)
|
||||
(not (string-match "\\`text/rtf\\'" type)))
|
||||
|
|
|
|||
|
|
@ -127,7 +127,7 @@ The field name is downcased. If the FIELD begins with the
|
|||
character \":\", then it must have a special handler defined in
|
||||
`mh-identity-handlers', else return an error since it is not a
|
||||
valid header field."
|
||||
(or (cdr (assoc-string field mh-identity-handlers t))
|
||||
(or (cdr (mh-assoc-string field mh-identity-handlers t))
|
||||
(and (eq (aref field 0) ?:)
|
||||
(error "Field %s not found in `mh-identity-handlers'" field))
|
||||
(cdr (assoc ":default" mh-identity-handlers))
|
||||
|
|
|
|||
|
|
@ -144,7 +144,7 @@
|
|||
mm-inline-text-html-renderer)
|
||||
(and (boundp 'mm-text-html-renderer) mm-text-html-renderer))))
|
||||
("text/x-vcard"
|
||||
mm-inline-text-vcard
|
||||
mh-mm-inline-text-vcard
|
||||
(lambda (handle)
|
||||
(or (featurep 'vcard)
|
||||
(locate-library "vcard"))))
|
||||
|
|
@ -174,7 +174,7 @@
|
|||
("audio/.*" ignore ignore)
|
||||
("image/.*" ignore ignore)
|
||||
;; Default to displaying as text
|
||||
(".*" mm-inline-text mm-readable-p))
|
||||
(".*" mm-inline-text mh-mm-readable-p))
|
||||
"Alist of media types/tests saying whether types can be displayed inline.")
|
||||
|
||||
(defvar mh-mime-save-parts-directory nil
|
||||
|
|
@ -460,10 +460,10 @@ decoding the same message multiple times."
|
|||
(setf (gethash handle (mh-mime-handles-cache (mh-buffer-data)))
|
||||
(let ((handles (mm-dissect-buffer nil)))
|
||||
(if handles
|
||||
(mm-uu-dissect-text-parts handles)
|
||||
(mh-mm-uu-dissect-text-parts handles)
|
||||
(setq handles (mm-uu-dissect)))
|
||||
(setf (mh-mime-handles (mh-buffer-data))
|
||||
(mm-merge-handles
|
||||
(mh-mm-merge-handles
|
||||
handles (mh-mime-handles (mh-buffer-data))))
|
||||
handles))))
|
||||
|
||||
|
|
@ -527,11 +527,11 @@ parsed and then displayed."
|
|||
(if pre-dissected-handles
|
||||
(setq handles pre-dissected-handles)
|
||||
(if (setq handles (mm-dissect-buffer nil))
|
||||
(mm-uu-dissect-text-parts handles)
|
||||
(mh-mm-uu-dissect-text-parts handles)
|
||||
(setq handles (mm-uu-dissect)))
|
||||
(setf (mh-mime-handles (mh-buffer-data))
|
||||
(mm-merge-handles handles
|
||||
(mh-mime-handles (mh-buffer-data))))
|
||||
(mh-mm-merge-handles handles
|
||||
(mh-mime-handles (mh-buffer-data))))
|
||||
(unless handles
|
||||
(mh-decode-message-body)))
|
||||
|
||||
|
|
@ -637,7 +637,7 @@ buttons for alternative parts that are usually suppressed."
|
|||
(let ((mh-mime-security-button-line-format
|
||||
mh-mime-security-button-end-line-format))
|
||||
(mh-insert-mime-security-button handle))
|
||||
(mm-set-handle-multipart-parameter
|
||||
(mh-mm-set-handle-multipart-parameter
|
||||
handle 'mh-region (cons (point-min-marker) (point-max-marker)))))
|
||||
|
||||
(defun mh-mime-display-single (handle)
|
||||
|
|
@ -853,7 +853,7 @@ by commands like \"K v\" which operate on individual MIME parts."
|
|||
(setq begin (point))
|
||||
(gnus-eval-format
|
||||
mh-mime-button-line-format mh-mime-button-line-format-alist
|
||||
`(,@(gnus-local-map-property mh-mime-button-map)
|
||||
`(,@(mh-gnus-local-map-property mh-mime-button-map)
|
||||
mh-callback mh-mm-display-part
|
||||
mh-part ,index
|
||||
mh-data ,handle))
|
||||
|
|
@ -878,7 +878,7 @@ by commands like \"K v\" which operate on individual MIME parts."
|
|||
|
||||
(defun mh-insert-mime-security-button (handle)
|
||||
"Display buttons for PGP message, HANDLE."
|
||||
(let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
|
||||
(let* ((protocol (mh-mm-handle-multipart-ctl-parameter handle 'protocol))
|
||||
(crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist))
|
||||
(nth 2 (assoc protocol mm-decrypt-function-alist))
|
||||
"Unknown"))
|
||||
|
|
@ -886,9 +886,9 @@ by commands like \"K v\" which operate on individual MIME parts."
|
|||
(if (equal (car handle) "multipart/signed")
|
||||
" Signed" " Encrypted")
|
||||
" Part"))
|
||||
(info (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
|
||||
(info (or (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info)
|
||||
"Undecided"))
|
||||
(details (mm-handle-multipart-ctl-parameter handle 'gnus-details))
|
||||
(details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details))
|
||||
pressed-details begin end face)
|
||||
(setq details (if details (concat "\n" details) ""))
|
||||
(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."
|
|||
(gnus-eval-format
|
||||
mh-mime-security-button-line-format
|
||||
mh-mime-security-button-line-format-alist
|
||||
`(,@(gnus-local-map-property mh-mime-security-button-map)
|
||||
`(,@(mh-gnus-local-map-property mh-mime-security-button-map)
|
||||
mh-button-pressed ,mh-mime-security-button-pressed
|
||||
mh-callback mh-mime-security-press-button
|
||||
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
|
|||
are stored in data structures corresponding to MH-E folder buffer
|
||||
FOLDER instead of in Gnus (as in the original). The MIME part,
|
||||
HANDLE is associated with the undisplayer FUNCTION."
|
||||
(if (mm-keep-viewer-alive-p handle)
|
||||
(if (mh-mm-keep-viewer-alive-p handle)
|
||||
(let ((new-handle (copy-sequence handle)))
|
||||
(mm-handle-set-undisplayer new-handle function)
|
||||
(mm-handle-set-undisplayer handle nil)
|
||||
|
|
@ -1076,19 +1076,19 @@ HANDLE is associated with the undisplayer FUNCTION."
|
|||
|
||||
(defun mh-mime-security-press-button (handle)
|
||||
"Callback from security button for part HANDLE."
|
||||
(if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
|
||||
(if (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info)
|
||||
(mh-mime-security-show-details handle)
|
||||
(let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region))
|
||||
(let ((region (mh-mm-handle-multipart-ctl-parameter handle 'mh-region))
|
||||
point)
|
||||
(setq point (point))
|
||||
(goto-char (car region))
|
||||
(delete-region (car region) (cdr region))
|
||||
(with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer)
|
||||
(with-current-buffer (mh-mm-handle-multipart-ctl-parameter handle 'buffer)
|
||||
(let* ((mm-verify-option 'known)
|
||||
(mm-decrypt-option 'known)
|
||||
(new (mm-possibly-verify-or-decrypt (cdr handle) handle)))
|
||||
(new (mh-mm-possibly-verify-or-decrypt (cdr handle) handle)))
|
||||
(unless (eq new (cdr handle))
|
||||
(mm-destroy-parts (cdr handle))
|
||||
(mh-mm-destroy-parts (cdr handle))
|
||||
(setcdr handle new))))
|
||||
(mh-mime-display-security handle)
|
||||
(goto-char point))))
|
||||
|
|
@ -1098,7 +1098,7 @@ HANDLE is associated with the undisplayer FUNCTION."
|
|||
;; to be no way of getting rid of the inserted text.
|
||||
(defun mh-mime-security-show-details (handle)
|
||||
"Toggle display of detailed security info for HANDLE."
|
||||
(let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
|
||||
(let ((details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details)))
|
||||
(when details
|
||||
(let ((mh-mime-security-button-pressed
|
||||
(not (get-text-property (point) 'mh-button-pressed)))
|
||||
|
|
@ -1296,7 +1296,7 @@ automatically."
|
|||
(type (mh-minibuffer-read-type file))
|
||||
(description (mml-minibuffer-read-description))
|
||||
(dispos (or disposition
|
||||
(mml-minibuffer-read-disposition type))))
|
||||
(mh-mml-minibuffer-read-disposition type))))
|
||||
(mml-insert-empty-tag 'part 'type type 'filename file
|
||||
'disposition dispos 'description description)))
|
||||
|
||||
|
|
@ -1784,7 +1784,7 @@ initialized. Always use the command `mh-have-file-command'.")
|
|||
;; This is for Emacs, what about XEmacs?
|
||||
(mh-funcall-if-exists remove-images (point-min) (point-max))
|
||||
(when mime-data
|
||||
(mm-destroy-parts (mh-mime-handles mime-data))
|
||||
(mh-mm-destroy-parts (mh-mime-handles mime-data))
|
||||
(remhash (current-buffer) mh-globals-hash))))
|
||||
|
||||
;;;###mh-autoload
|
||||
|
|
@ -1792,7 +1792,7 @@ initialized. Always use the command `mh-have-file-command'.")
|
|||
"Free MIME data for externally displayed MIME parts."
|
||||
(let ((mime-data (mh-buffer-data)))
|
||||
(when mime-data
|
||||
(mm-destroy-parts (mh-mime-handles mime-data)))
|
||||
(mh-mm-destroy-parts (mh-mime-handles mime-data)))
|
||||
(remhash (current-buffer) mh-globals-hash)))
|
||||
|
||||
(provide 'mh-mime)
|
||||
|
|
|
|||
|
|
@ -51,11 +51,6 @@ used in lieu of `search' in the CL package."
|
|||
|
||||
;;; General Utilities
|
||||
|
||||
(require 'mailabbrev nil t)
|
||||
(mh-defun-compat mail-abbrev-make-syntax-table ()
|
||||
"Emacs 21 and XEmacs don't have this function."
|
||||
nil)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-beginning-of-word (&optional n)
|
||||
"Return position of the N th word backwards."
|
||||
|
|
@ -63,7 +58,7 @@ used in lieu of `search' in the CL package."
|
|||
(let ((syntax-table (syntax-table)))
|
||||
(unwind-protect
|
||||
(save-excursion
|
||||
(mail-abbrev-make-syntax-table)
|
||||
(mh-mail-abbrev-make-syntax-table)
|
||||
(set-syntax-table mail-abbrev-syntax-table)
|
||||
(backward-word n)
|
||||
(point))
|
||||
|
|
@ -817,8 +812,6 @@ current buffer."
|
|||
(buffer-substring-no-properties start (point))))
|
||||
""))
|
||||
|
||||
(fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-goto-header-field (field)
|
||||
"Move to FIELD in the message header.
|
||||
|
|
|
|||
|
|
@ -59,32 +59,6 @@
|
|||
mh-clean-message-header-flag))
|
||||
(funcall mh-show-xface-function)))
|
||||
|
||||
(defmacro mh-face-foreground-compat (face &optional frame inherit)
|
||||
"Return the foreground color name of FACE, or nil if unspecified.
|
||||
See documentation for `face-foreground' for a description of the
|
||||
arguments FACE, FRAME, and INHERIT.
|
||||
|
||||
Calls `face-foreground' correctly in older environments. Versions
|
||||
of Emacs prior to version 22 lacked an INHERIT argument which
|
||||
when t tells `face-foreground' to consider an inherited value for
|
||||
the foreground if the face does not define one itself."
|
||||
(if (>= emacs-major-version 22)
|
||||
`(face-foreground ,face ,frame ,inherit)
|
||||
`(face-foreground ,face ,frame)))
|
||||
|
||||
(defmacro mh-face-background-compat(face &optional frame inherit)
|
||||
"Return the background color name of face, or nil if unspecified.
|
||||
See documentation for `back-foreground' for a description of the
|
||||
arguments FACE, FRAME, and INHERIT.
|
||||
|
||||
Calls `face-background' correctly in older environments. Versions
|
||||
of Emacs prior to version 22 lacked an INHERIT argument which
|
||||
when t tells `face-background' to consider an inherited value for
|
||||
the background if the face does not define one itself."
|
||||
(if (>= emacs-major-version 22)
|
||||
`(face-background ,face ,frame ,inherit)
|
||||
`(face-background ,face ,frame)))
|
||||
|
||||
;; Shush compiler.
|
||||
(eval-when-compile
|
||||
(mh-do-in-xemacs (defvar default-enable-multibyte-characters)))
|
||||
|
|
@ -120,9 +94,9 @@ in this order is used."
|
|||
insert-image (create-image
|
||||
raw type t
|
||||
:foreground
|
||||
(mh-face-foreground-compat 'mh-show-xface nil t)
|
||||
(mh-face-foreground 'mh-show-xface nil t)
|
||||
:background
|
||||
(mh-face-background-compat 'mh-show-xface nil t))
|
||||
(mh-face-background 'mh-show-xface nil t))
|
||||
" ")))
|
||||
;; XEmacs
|
||||
(mh-do-in-xemacs
|
||||
|
|
@ -386,41 +360,17 @@ This is only done if `mh-x-image-cache-directory' is nil."
|
|||
(defun mh-x-image-url-cache-canonicalize (url)
|
||||
"Canonicalize URL.
|
||||
Replace the ?/ character with a ?! character and append .png.
|
||||
Also replaces special characters with `url-hexify-string' since
|
||||
not all characters, such as :, are legal within Windows
|
||||
filenames. See URL `http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp'."
|
||||
Also replaces special characters with `mh-url-hexify-string'
|
||||
since not all characters, such as :, are legal within Windows
|
||||
filenames. See URL
|
||||
`http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp'."
|
||||
(format "%s/%s.png" mh-x-image-cache-directory
|
||||
(url-hexify-string
|
||||
(mh-url-hexify-string
|
||||
(with-temp-buffer
|
||||
(insert url)
|
||||
(mh-replace-string "/" "!")
|
||||
(buffer-string)))))
|
||||
|
||||
;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21.
|
||||
(if (not (boundp 'url-unreserved-chars))
|
||||
(defconst url-unreserved-chars
|
||||
'(
|
||||
?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
|
||||
?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
|
||||
?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
|
||||
?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
|
||||
"A list of characters that are _NOT_ reserved in the URL spec.
|
||||
This is taken from RFC 2396."))
|
||||
|
||||
(mh-defun-compat url-hexify-string (str)
|
||||
"Escape characters in a string.
|
||||
This is a copy of the function of the same name from url-util.el
|
||||
in Emacs 22; needed by Emacs 21."
|
||||
(mapconcat
|
||||
(lambda (char)
|
||||
;; Fixme: use a char table instead.
|
||||
(if (not (memq char url-unreserved-chars))
|
||||
(if (> char 255)
|
||||
(error "Hexifying multibyte character %s" str)
|
||||
(format "%%%02X" char))
|
||||
(char-to-string char)))
|
||||
str ""))
|
||||
|
||||
(defun mh-x-image-get-download-state (file)
|
||||
"Check the state of FILE by following any symbolic links."
|
||||
(unless (file-exists-p mh-x-image-cache-directory)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue