procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove old Gnus compat code from MH-E

Browse source 
* lisp/mh-e/mh-gnus.el (mh-mm-merge-handles)
(mh-mm-set-handle-multipart-parameter, mh-mm-inline-text-vcard)
(mh-mm-possibly-verify-or-decrypt)
(mh-mm-handle-multipart-ctl-parameter, mh-mm-readable-p)
(mh-mm-long-lines-p, mh-mm-keep-viewer-alive-p)
(mh-mm-destroy-parts, mh-mm-uu-dissect-text-parts)
(mh-mml-minibuffer-read-disposition): Make into obsolete aliases
for functions without the 'mh-' prefix.  Update callers.
(mh-gnus-local-map-property): Remove Emacs 20 compat code.
This commit is contained in:
Stefan Kangas 2021-10-09 03:00:00 +02:00
parent 3ae275eedc
commit 9a934c4c0f
2 changed files with 43 additions and 102 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

105
lisp/mh-e/mh-gnus.el
View file

@ -39,99 +39,40 @@
;; TODO This is not in Gnus 5.11.
(defun-mh mh-gnus-local-map-property gnus-local-map-property (map)
"Return a list suitable for a text property list specifying keymap MAP."
(cond ((>= emacs-major-version 21) (list 'keymap map))
(t (list 'local-map map))))
(list 'keymap map))
;; Copy of function from mm-decode.el.
(defun-mh mh-mm-merge-handles mm-merge-handles (handles1 handles2)
(append
(if (listp (car handles1))
handles1
(list handles1))
(if (listp (car handles2))
handles2
(list handles2))))
(define-obsolete-function-alias 'mh-mm-merge-handles
#'mm-merge-handles "29.1")
;; Copy of function from mm-decode.el.
(defun-mh mh-mm-set-handle-multipart-parameter
mm-set-handle-multipart-parameter (handle parameter value)
;; HANDLE could be a CTL.
(when handle
(put-text-property 0 (length (car handle)) parameter value
(car handle))))
(define-obsolete-function-alias 'mh-mm-set-handle-multipart-parameter
#'mm-set-handle-multipart-parameter "29.1")
;; Copy of function from mm-view.el.
(defun-mh mh-mm-inline-text-vcard mm-inline-text-vcard (handle)
(let ((inhibit-read-only t))
(mm-insert-inline
handle
(concat "\n-- \n"
(ignore-errors
(if (fboundp 'vcard-pretty-print)
(vcard-pretty-print (mm-get-part handle))
(vcard-format-string
(vcard-parse-string (mm-get-part handle)
'vcard-standard-filter))))))))
(define-obsolete-function-alias 'mh-mm-inline-text-vcard
#'mm-inline-text-vcard "29.1")
;; Function from mm-decode.el used in PGP messages. Just define it with older
;; Gnus to avoid compiler warning.
(defun-mh mh-mm-possibly-verify-or-decrypt
mm-possibly-verify-or-decrypt (_parts _ctl)
nil)
(define-obsolete-function-alias 'mh-mm-possibly-verify-or-decrypt
#'mm-possibly-verify-or-decrypt "29.1")
;; Copy of macro in mm-decode.el.
(defmacro-mh mh-mm-handle-multipart-ctl-parameter
mm-handle-multipart-ctl-parameter (handle parameter)
`(get-text-property 0 ,parameter (car ,handle)))
(define-obsolete-function-alias 'mh-mm-handle-multipart-ctl-parameter
#'mm-handle-multipart-ctl-parameter "29.1")
;; Copy of function in mm-decode.el.
(defun-mh 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 (mh-mm-long-lines-p 76))))))
(define-obsolete-function-alias 'mh-mm-readable-p
#'mm-readable-p "29.1")
;; Copy of function in mm-bodies.el.
(defun-mh 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))
(end-of-line)
(while (and (not (eobp))
(not (> (current-column) length)))
(forward-line 1)
(end-of-line))
(and (> (current-column) length)
(current-column))))
(define-obsolete-function-alias 'mh-mm-long-lines-p
#'mm-long-lines-p "29.1")
(defun-mh 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)
(define-obsolete-function-alias 'mh-mm-keep-viewer-alive-p
#'mm-keep-viewer-alive-p "29.1")
(defun-mh mh-mm-destroy-parts mm-destroy-parts (_list)
"Older versions of Emacs don't have this function."
nil)
(define-obsolete-function-alias 'mh-mm-destroy-parts
#'mm-destroy-parts "29.1")
(defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (_handles)
"Emacs 21 and XEmacs don't have this function."
nil)
(define-obsolete-function-alias 'mh-mm-uu-dissect-text-parts
#'mm-uu-dissect-text-parts "29.1")
;; Copy of function in mml.el.
(defun-mh mh-mml-minibuffer-read-disposition
mml-minibuffer-read-disposition (type &optional default filename)
(unless default
(setq default (mml-content-disposition type filename)))
(let ((disposition (completing-read
(format-prompt "Disposition" default)
'(("attachment") ("inline") (""))
nil t nil nil default)))
(if (not (equal disposition ""))
disposition
default)))
(define-obsolete-function-alias 'mh-mml-minibuffer-read-disposition
#'mml-minibuffer-read-disposition "29.1")
;; This is mm-save-part from Gnus 5.11 since that function in Emacs
;; 21.2 is buggy (the args to read-file-name are incorrect) and the

40
lisp/mh-e/mh-mime.el
View file

@ -141,7 +141,7 @@
mm-inline-text-html-renderer)
(and (boundp 'mm-text-html-renderer) mm-text-html-renderer))))
("text/x-vcard"
mh-mm-inline-text-vcard
mm-inline-text-vcard
(lambda (handle)
(or (featurep 'vcard)
(locate-library "vcard"))))
@ -171,7 +171,7 @@
("audio/.*" ignore ignore)
("image/.*" ignore ignore)
;; Default to displaying as text
(".*" mm-inline-text mh-mm-readable-p))
(".*" mm-inline-text mm-readable-p))
"Alist of media types/tests saying whether types can be displayed inline.")
(defvar mh-mime-save-parts-directory nil
@ -454,10 +454,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
(mh-mm-uu-dissect-text-parts handles)
(mm-uu-dissect-text-parts handles)
(setq handles (mm-uu-dissect)))
(setf (mh-mime-handles (mh-buffer-data))
(mh-mm-merge-handles
(mm-merge-handles
handles (mh-mime-handles (mh-buffer-data))))
handles))))
@ -528,10 +528,10 @@ parsed and then displayed."
(if pre-dissected-handles
(setq handles pre-dissected-handles)
(if (setq handles (mm-dissect-buffer nil))
(mh-mm-uu-dissect-text-parts handles)
(mm-uu-dissect-text-parts handles)
(setq handles (mm-uu-dissect)))
(setf (mh-mime-handles (mh-buffer-data))
(mh-mm-merge-handles handles
(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))
(mh-mm-set-handle-multipart-parameter
(mm-set-handle-multipart-parameter
handle 'mh-region (cons (point-min-marker) (point-max-marker)))))
(defun mh-mime-display-single (handle)
@ -868,7 +868,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 (mh-mm-handle-multipart-ctl-parameter handle 'protocol))
(let* ((protocol (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"))
@ -879,10 +879,10 @@ by commands like \"K v\" which operate on individual MIME parts."
(if (equal (car handle) "multipart/signed")
" Signed" " Encrypted")
" Part"))
(info (or (mh-mm-handle-multipart-ctl-parameter
(info (or (mm-handle-multipart-ctl-parameter
handle 'gnus-info)
"Undecided"))
(details (mh-mm-handle-multipart-ctl-parameter
(details (mm-handle-multipart-ctl-parameter
handle 'gnus-details))
pressed-details)
(setq details (if details (concat "\n" details) ""))
@ -1063,7 +1063,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 (mh-mm-keep-viewer-alive-p handle)
(if (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)
@ -1073,19 +1073,19 @@ HANDLE is associated with the undisplayer FUNCTION."
(defun mh-mime-security-press-button (handle)
"Callback from security button for part HANDLE."
(if (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info)
(if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
(mh-mime-security-show-details handle)
(let ((region (mh-mm-handle-multipart-ctl-parameter handle 'mh-region))
(let ((region (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 (mh-mm-handle-multipart-ctl-parameter handle 'buffer)
(with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer)
(let* ((mm-verify-option 'known)
(mm-decrypt-option 'known)
(new (mh-mm-possibly-verify-or-decrypt (cdr handle) handle)))
(new (mm-possibly-verify-or-decrypt (cdr handle) handle)))
(unless (eq new (cdr handle))
(mh-mm-destroy-parts (cdr handle))
(mm-destroy-parts (cdr handle))
(setcdr handle new))))
(mh-mime-display-security handle)
(goto-char point))))
@ -1095,7 +1095,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 (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details)))
(let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
(when details
(let ((mh-mime-security-button-pressed
(not (get-text-property (point) 'mh-button-pressed)))
@ -1285,7 +1285,7 @@ automatically."
(type (mh-minibuffer-read-type file))
(description (mml-minibuffer-read-description))
(dispos (or disposition
(mh-mml-minibuffer-read-disposition type))))
(mml-minibuffer-read-disposition type))))
(mml-insert-empty-tag 'part 'type type 'filename file
'disposition dispos 'description description)))
@ -1799,7 +1799,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
(mh-mm-destroy-parts (mh-mime-handles mime-data))
(mm-destroy-parts (mh-mime-handles mime-data))
(remhash (current-buffer) mh-globals-hash))))
;;;###mh-autoload
@ -1807,7 +1807,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
(mh-mm-destroy-parts (mh-mime-handles mime-data)))
(mm-destroy-parts (mh-mime-handles mime-data)))
(remhash (current-buffer) mh-globals-hash)))
(provide 'mh-mime)