[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/vm 9aa3a94cd3 3/3: Merge branch 'advice-add' into 'main'
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/vm 9aa3a94cd3 3/3: Merge branch 'advice-add' into 'main' |
|
Date: |
Wed, 17 Jul 2024 01:01:02 -0400 (EDT) |
branch: elpa/vm
commit 9aa3a94cd33aeb97a980d67554599a8b7aa30111
Merge: b6eb1886b8 7cefb73851
Author: Mark Diekhans <markd@ucsc.edu>
Commit: Mark Diekhans <markd@ucsc.edu>
Merge branch 'advice-add' into 'main'
Use `advice-add`
See merge request emacs-vm/vm!9
---
contrib/vm-mime-display-internal-application.el | 33 +++++++++--------
contrib/vm-sumurg.el | 13 +++----
lisp/vm-pcrisis.el | 49 ++++++++++++++-----------
lisp/vm-pgg.el | 29 ++++++++++-----
lisp/vm-ps-print.el | 4 +-
lisp/vm-rfaddons.el | 47 ++++++++++++------------
lisp/vm-serial.el | 3 +-
lisp/vm-smime.el | 3 +-
lisp/vm-w3.el | 7 ++--
lisp/vm.el | 2 +-
10 files changed, 106 insertions(+), 84 deletions(-)
diff --git a/contrib/vm-mime-display-internal-application.el
b/contrib/vm-mime-display-internal-application.el
index 2584b26971..69e8b2f9af 100644
--- a/contrib/vm-mime-display-internal-application.el
+++ b/contrib/vm-mime-display-internal-application.el
@@ -75,23 +75,24 @@ attachments.")
"*If non-nil, display application/x-SUBTYPE attachments the same as
application/SUBTYPE attachments.
See `vm-mime-internal-application-subtypes'.")
-(defadvice vm-mime-can-display-internal (after application/xxxx activate
- compile)
+(advice-add 'vm-mime-can-display-internal :around
+ #'vm-mime--respect-internal-application-subtype)
+(defun vm-mime--respect-internal-application-subtype
+ (orig-fun &optional layout &rest args)
"Respect `vm-mime-internal-application-subtypes'."
- (or ad-return-value
- (setq ad-return-value
- (let* ((layout (ad-get-arg 0))
- (type (car (vm-mm-layout-type layout)))
- (subtype (if (vm-mime-types-match "application" type)
- (substring type (1+ (match-end 0)))))
- (mode (if subtype
- (vm-mime-can-display-internal-application
- subtype))))
- (if mode
- (let ((charset (or (vm-mime-get-parameter layout "charset")
- "us-ascii")))
- (or (vm-mime-charset-internally-displayable-p charset)
- (vm-mime-can-convert-charset charset))))))))
+ (or (apply orig-fun layout args)
+ (let* ((layout layout)
+ (type (car (vm-mm-layout-type layout)))
+ (subtype (if (vm-mime-types-match "application" type)
+ (substring type (1+ (match-end 0)))))
+ (mode (if subtype
+ (vm-mime-can-display-internal-application
+ subtype))))
+ (if mode
+ (let ((charset (or (vm-mime-get-parameter layout "charset")
+ "us-ascii")))
+ (or (vm-mime-charset-internally-displayable-p charset)
+ (vm-mime-can-convert-charset charset)))))))
(defun vm-mime-can-display-internal-application (subtype)
"Return the Emacs mode for displaying \"application/SUBTYPE\" MIME objects."
diff --git a/contrib/vm-sumurg.el b/contrib/vm-sumurg.el
index ca9358ecbf..6fd4875683 100644
--- a/contrib/vm-sumurg.el
+++ b/contrib/vm-sumurg.el
@@ -106,14 +106,13 @@
; assuming that m is a message, highlight it in yellow, orange or red
; according as it has a *, **, or *** label.
-(defun vm-sumurg-highlight-message ()
+(defun vm-sumurg-highlight-message (&rest _)
(vm-sumurg-add-highlights (string-to-number (vm-number-of m))
(vm-su-start-of m) (vm-su-end-of m)
(vm-sumurg-level-of m)
))
-(defadvice vm-summary-highlight-region (after vm-sumurg-vshr activate compile)
- (vm-sumurg-highlight-message))
+(advice-add 'vm-summary-highlight-region :after #'vm-sumurg-highlight-message)
(defvar vm-sumurg-counter [0 0 0 0 0])
@@ -486,11 +485,11 @@
(add-hook 'vm-mode-hook ' vm-sumurg-vm-mode-hook-fn)
(add-hook 'vm-presentation-mode-hook ' vm-sumurg-vm-mode-hook-fn)
-(defadvice vm-do-needed-mode-line-update
- (before vm-sumurg-dnmlu activate compile)
+(advice-add 'vm-do-needed-mode-line-update :before #'vm-smurg--dnmlu)
+(defun vm-smurg--dnmlu (&rest _)
(when (and vm-message-pointer vm-ml-sumurg-extent)
- (set-extent-face vm-ml-sumurg-extent
- (aref vm-sumurg-facearray
+ (set-extent-face vm-ml-sumurg-extent
+ (aref vm-sumurg-facearray
(vm-sumurg-level-of (car vm-message-pointer))))
(if vm-presentation-buffer
(save-excursion
diff --git a/lisp/vm-pcrisis.el b/lisp/vm-pcrisis.el
index 3071c9a5f8..e3141defc4 100644
--- a/lisp/vm-pcrisis.el
+++ b/lisp/vm-pcrisis.el
@@ -1529,54 +1529,59 @@ recursion nor concurrent calls."
(vmpc-init-vars)
(setq vmpc-current-buffer nil)))
-(defadvice vm-do-reply (around vmpc-reply activate)
- "*Reply to a message with pcrisis voodoo."
+(advice-add 'vm-do-reply :around #'vmpc--reply)
+(defun vmpc--reply (orig-fun &rest args)
+ "Reply to a message with pcrisis voodoo."
(vmpc-init-vars 'reply)
(vmpc-build-true-conditions-list)
(vmpc-build-actions-to-run-list)
(vmpc-run-actions)
- ad-do-it
+ (apply orig-fun args)
(vmpc-create-sig-and-pre-sig-exerlays)
(vmpc-make-vars-local)
(vmpc-run-actions))
-(defadvice vm-mail-from-folder (around vmpc-mail activate)
- "*Start a new message with pcrisis voodoo."
+(advice-add 'vm-mail-from-folder :around #'vmpc--mail)
+(defun vmpc--mail (orig-fun &rest args)
+ "Start a new message with pcrisis voodoo."
(vm-follow-summary-cursor)
(vm-select-folder-buffer-and-validate 1 (interactive-p))
(vmpc-init-vars 'mail)
(vmpc-build-true-conditions-list)
(vmpc-build-actions-to-run-list)
(vmpc-run-actions)
- ad-do-it
+ (apply orig-fun args)
(vmpc-create-sig-and-pre-sig-exerlays)
(vmpc-make-vars-local)
(vmpc-run-actions))
-(defadvice vm-mail (around vmpc-newmail activate)
- "*Start a new message with pcrisis voodoo."
+(advice-add 'vm-mail :around #'vmpc--newmail)
+(defun vmpc--newmail (orig-fun &rest args)
+ "Start a new message with pcrisis voodoo."
(vmpc-init-vars 'newmail)
(vmpc-build-true-conditions-list)
(vmpc-build-actions-to-run-list)
(vmpc-run-actions)
- ad-do-it
+ (apply orig-fun args)
(vmpc-create-sig-and-pre-sig-exerlays)
(vmpc-make-vars-local)
(vmpc-run-actions))
-(defadvice vm-compose-mail (around vmpc-compose-newmail activate)
- "*Start a new message with pcrisis voodoo."
+(advice-add 'vm-compose-mail :around #'vmpc--compose-newmail)
+(defun vmpc--compose-newmail (orig-fun &rest args)
+ "Start a new message with pcrisis voodoo."
(vmpc-init-vars 'newmail)
(vmpc-build-true-conditions-list)
(vmpc-build-actions-to-run-list)
(vmpc-run-actions)
- ad-do-it
+ (apply orig-fun args)
(vmpc-create-sig-and-pre-sig-exerlays)
(vmpc-make-vars-local)
(vmpc-run-actions))
-(defadvice vm-forward-message (around vmpc-forward activate)
- "*Forward a message with pcrisis voodoo."
+(advice-add 'vm-forward-message :around #'vmpc--forward)
+(defun vmpc--forward (orig-fun &rest args)
+ "Forward a message with pcrisis voodoo."
;; this stuff is already done when replying, but not here:
(vm-follow-summary-cursor)
(vm-select-folder-buffer-and-validate 1 (interactive-p))
@@ -1585,13 +1590,14 @@ recursion nor concurrent calls."
(vmpc-build-true-conditions-list)
(vmpc-build-actions-to-run-list)
(vmpc-run-actions)
- ad-do-it
+ (apply orig-fun args)
(vmpc-create-sig-and-pre-sig-exerlays)
(vmpc-make-vars-local)
(vmpc-run-actions))
-(defadvice vm-forward-message-plain (around vmpc-forward activate)
- "*Forward a message in plain text with pcrisis voodoo."
+(advice-add 'vm-forward-message-plain :around #'vmpc--forward-plain)
+(defun vmpc--forward-plain (orig-fun &rest args)
+ "Forward a message in plain text with pcrisis voodoo."
;; this stuff is already done when replying, but not here:
(vm-follow-summary-cursor)
(vm-select-folder-buffer-and-validate 1 (interactive-p))
@@ -1600,13 +1606,14 @@ recursion nor concurrent calls."
(vmpc-build-true-conditions-list)
(vmpc-build-actions-to-run-list)
(vmpc-run-actions)
- ad-do-it
+ (apply orig-fun args)
(vmpc-create-sig-and-pre-sig-exerlays)
(vmpc-make-vars-local)
(vmpc-run-actions))
-(defadvice vm-resend-message (around vmpc-resend activate)
- "*Resent a message with pcrisis voodoo."
+(advice-add 'vm-resend-message :around #'vmpc--resend)
+(defun vmpc--resend (orig-fun &rest args)
+ "Resent a message with pcrisis voodoo."
;; this stuff is already done when replying, but not here:
(vm-follow-summary-cursor)
(vm-select-folder-buffer-and-validate 1 (interactive-p))
@@ -1615,7 +1622,7 @@ recursion nor concurrent calls."
(vmpc-build-true-conditions-list)
(vmpc-build-actions-to-run-list)
(vmpc-run-actions)
- ad-do-it
+ (apply orig-fun args)
(vmpc-create-sig-and-pre-sig-exerlays)
(vmpc-make-vars-local)
(vmpc-run-actions))
diff --git a/lisp/vm-pgg.el b/lisp/vm-pgg.el
index b6159d605c..5cd6c48144 100644
--- a/lisp/vm-pgg.el
+++ b/lisp/vm-pgg.el
@@ -606,7 +606,9 @@ When the button is pressed ACTION is called."
(t
(error "This should never happen!")))))))
-(defadvice vm-present-current-message (after vm-pgg-cleartext-automode
activate)
+(advice-add 'vm-present-current-message
+ :after #'vm-pgg--present-cleartext-automode)
+(defun vm-pgg--present-cleartext-automode (&rest _)
"Decode or check signature on clear text messages."
(vm-pgg-state-set)
(when (and vm-pgg-cleartext-decoded
@@ -616,13 +618,14 @@ When the button is pressed ACTION is called."
(not vm-mime-decoded))
(vm-pgg-cleartext-automode)))
-(defadvice vm-scroll-forward (around vm-pgg-cleartext-automode activate)
+(advice-add 'vm-scroll-forward :around #'vm-pgg--scroll-cleartext-automode)
+(defun vm-pgg--scroll-cleartext-automode (orig-fun &rest args)
"Decode or check signature on clear text messages."
(let ((vm-system-state-was
(save-excursion
(vm-select-folder-buffer-if-possible)
vm-system-state)))
- ad-do-it
+ (apply orig-fun args)
(vm-pgg-state-set)
(when (and (eq vm-system-state-was 'previewing)
(not vm-mime-decoded))
@@ -667,12 +670,15 @@ When the button is pressed ACTION is called."
'vm-pgg-bad-signature
'vm-pgg-good-signature)))))
-(defadvice vm-mime-transfer-decode-region (around vm-pgg-cleartext-automode
activate)
+(advice-add 'vm-mime-transfer-decode-region
+ :around #'vm-pgg--transfer-cleartext-automode)
+(defun vm-pgg--transfer-cleartext-automode (orig-fun &optional layout
+ &rest args)
"Decode or check signature on clear text messages parts."
(let ((vm-pgg-part-start (point)))
- ad-do-it
+ (apply orig-fun layout args)
;; BUGME should we use marks here?
- (when (and (vm-mime-text-type-layout-p (ad-get-arg 0))
+ (when (and (vm-mime-text-type-layout-p layout)
(< vm-pgg-part-start (point)))
(save-excursion
(save-restriction
@@ -683,7 +689,9 @@ When the button is pressed ACTION is called."
;(scroll-down 1000)
)))))
-(defadvice vm-mime-display-internal-text/plain (around
vm-pgg-cleartext-automode activate)
+(advice-add 'vm-mime-display-internal-text/plain
+ :around #'vm-pgg--display-cleartext-automode)
+(defun vm-pgg--display-cleartext-automode (orig-fun &rest args)
"Decode or check signature on clear text messages parts.
We use the advice here in order to avoid overwriting VMs internal text display
function. Faces will get lost if a charset conversion happens thus we do the
@@ -691,7 +699,7 @@ cleanup here after verification and decoding took place."
(let ((vm-pgg-cleartext-state nil)
(start (point))
end)
- ad-do-it
+ (apply orig-fun args)
(when vm-pgg-cleartext-state
(setq end (point))
(save-restriction
@@ -797,7 +805,8 @@ cleanup here after verification and decoding took place."
(defvar vm-pgg-recursion nil
"Detect recursive calles.")
-(defadvice vm-decode-mime-message (around vm-pgg-clear-state activate)
+(advice-add 'vm-decode-mime-message :around #'vm-pgg--clear-state)
+(defun vm-pgg--clear-state (orig-fun &rest args)
"Clear the modeline state before decoding."
(vm-select-folder-buffer)
(when (not vm-pgg-recursion)
@@ -808,7 +817,7 @@ cleanup here after verification and decoding took place."
(if vm-pgg-cleartext-decoded
(vm-present-current-message))
(let ((vm-pgg-recursion t))
- ad-do-it)))
+ (apply orig-fun args))))
(defun vm-pgg-mime-decrypt (button)
"Replace the BUTTON with the output from `pgg-snarf-keys'."
diff --git a/lisp/vm-ps-print.el b/lisp/vm-ps-print.el
index 77d437b11e..e636c65e34 100644
--- a/lisp/vm-ps-print.el
+++ b/lisp/vm-ps-print.el
@@ -60,6 +60,8 @@
(provide 'vm-ps-print)
+(require 'cl-lib)
+
(eval-when-compile
(require 'ps-print)
@@ -430,7 +432,7 @@ pages per sheet to queried FILENAME. No prefix prints 1
page per sheet
to printer while prefix without numerical argument simply queries for
filename and formats 1 page per sheet. (JJK)"
(interactive
- (if (and (integerp current-prefix-arg) (plusp current-prefix-arg))
+ (if (and (integerp current-prefix-arg) (cl-plusp current-prefix-arg))
nil
(list (ps-print-preprint current-prefix-arg))))
(let ((last-command)
diff --git a/lisp/vm-rfaddons.el b/lisp/vm-rfaddons.el
index e5e6618a31..360c96b447 100644
--- a/lisp/vm-rfaddons.el
+++ b/lisp/vm-rfaddons.el
@@ -128,6 +128,21 @@ nil. (Rob F)"
option)
body)))))
+(defun vm-rfaddons--fake-date (orig-fun &rest args)
+ "Do not change an existing date if `vm-mail-mode-fake-date-p' is t. (Rob F)"
+ (if (not (and vm-mail-mode-fake-date-p
+ (vm-mail-mode-get-header-contents "Date:")))
+ (apply orig-fun args)))
+
+(defun vm-rfaddons--do-preview-again (&rest _)
+ (if vm-mime-delete-after-saving
+ (vm-present-current-message)))
+
+(defun vm-rfaddons--mime-auto-save-all-attachments (&optional m flag)
+ (if (and (eq flag 'expunged)
+ (not (vm-filed-flag m)))
+ (vm-mime-auto-save-all-attachments-delete-external m)))
+
;;;###autoload
(defun vm-rfaddons-infect-vm (&optional sit-for
option-list exclude-option-list)
@@ -244,11 +259,8 @@ or do the binding and advising on your own. (Rob F)"
;; This allows us to fake a date by advising vm-mail-mode-insert-date-maybe
(vm-rfaddons-check-option
'fake-date option-list
- (defadvice vm-mail-mode-insert-date-maybe (around vm-fake-date activate)
- "Do not change an existing date if `vm-mail-mode-fake-date-p' is t. (Rob
F)"
- (if (not (and vm-mail-mode-fake-date-p
- (vm-mail-mode-get-header-contents "Date:")))
- ad-do-it)))
+ (advice-add 'vm-mail-mode-insert-date-maybe
+ :around #'vm-rfaddons--fake-date))
(vm-rfaddons-check-option
'open-line option-list
@@ -270,14 +282,8 @@ or do the binding and advising on your own. (Rob F)"
;; that a presentation buffer is used. The visibility-widget
;; would cause "*"s to be inserted into the folder buffer.
(setq vm-always-use-presentation t)
- (defadvice vm-present-current-message
- (after vm-shrunken-headers-pcm activate)
- "Shrink headers when previewing a message."
- (vm-shrunken-headers))
- (defadvice vm-expose-hidden-headers
- (after vm-shrunken-headers-ehh activate)
- "Shrink headers when viewing hidden headers."
- (vm-shrunken-headers))
+ (advice-add 'vm-present-current-message :after #'vm-shrunken-headers)
+ (advice-add 'vm-expose-hidden-headers :after #'vm-shrunken-headers)
;; this overrides the VM binding of "T" to `vm-toggle-thread'
(define-key vm-mode-map "T" 'vm-shrunken-headers-toggle)))
@@ -301,10 +307,8 @@ or do the binding and advising on your own. (Rob F)"
'auto-save-all-attachments option-list
;; In order to reflect MIME type changes when `vm-mime-delete-after-saving'
;; is t we preview the message again.
- (defadvice vm-mime-send-body-to-file
- (after vm-do-preview-again activate)
- (if vm-mime-delete-after-saving
- (vm-present-current-message)))
+ (advice-add 'vm-mime-send-body-to-file
+ :after #'vm-rfaddons--do-preview-again)
(add-hook 'vm-select-new-message-hook 'vm-mime-auto-save-all-attachments))
(vm-rfaddons-check-option
@@ -312,11 +316,8 @@ or do the binding and advising on your own. (Rob F)"
;; and their deletion when deleting a unfiled message,
;; this is probably a problem, since actually we should delete it
;; only if there remains no reference to it!!!!
- (defadvice vm-set-deleted-flag-of
- (before vm-mime-auto-save-all-attachments activate)
- (if (and (eq (ad-get-arg 1) 'expunged)
- (not (vm-filed-flag (ad-get-arg 0))))
- (vm-mime-auto-save-all-attachments-delete-external (ad-get-arg 0)))))
+ (advice-add 'vm-set-deleted-flag-of
+ :before #'vm-rfaddons--mime-auto-save-all-attachments))
(vm-rfaddons-check-option
'return-receipt-to option-list
@@ -1420,7 +1421,7 @@ text/alternative message depending on the value of the
variable
;; empty lines
(cons "\n\n\n+"
"\n\n")
- ;; signature & -----Urspr�ngliche Nachricht-----
+ ;; signature & -----Ursprüngliche Nachricht-----
(cons (concat "^" vm-included-text-prefix "--[^\n]*\n"
"\\(" vm-included-text-prefix "[^\n]*\n\\)+")
"\n")
diff --git a/lisp/vm-serial.el b/lisp/vm-serial.el
index be5fb683f5..44686f9d3e 100644
--- a/lisp/vm-serial.el
+++ b/lisp/vm-serial.el
@@ -912,7 +912,8 @@ questions will bother you!"
(if vm-serial-send-mail-exit
(kill-this-buffer))))))))
-(defadvice vm-mail-send-and-exit (after vm-serial-send-mail activate)
+(advice-add 'vm-mail-send-and-exit :after #'vm-serial--send-mail)
+(defun vm-serial--send-mail (&rest _)
(if vm-serial-source-buffer
(kill-this-buffer)))
diff --git a/lisp/vm-smime.el b/lisp/vm-smime.el
index f47f5d63e5..37c43497d2 100644
--- a/lisp/vm-smime.el
+++ b/lisp/vm-smime.el
@@ -27,6 +27,7 @@
(require 'vm-misc))
(eval-when-compile
+ (require 'cl-lib)
(require 'vm-minibuf)
(require 'vm-toolbar)
(require 'vm-mouse)
@@ -259,7 +260,7 @@ obtain the certificate files. Returns a list of paths to
these
certificate files."
(let ((certfiles '())
(default-directory smime-certificate-directory))
- (case vm-smime-get-recipient-certificate-method
+ (cl-case vm-smime-get-recipient-certificate-method
(ask
;; this method just always asks for all certificates
(setq certfiles
diff --git a/lisp/vm-w3.el b/lisp/vm-w3.el
index a6e81497bc..65fdbc7b9d 100644
--- a/lisp/vm-w3.el
+++ b/lisp/vm-w3.el
@@ -59,10 +59,11 @@
url-current-mime-headers (list (cons "content-type" type)
(cons "content-encoding" encoding)))))
-(defadvice url-cid (around vm-w3 activate)
+(advice-add 'url-cid :around #'vm--usr-cid)
+(defun vm--usr-cid (orig-fun url &rest args)
(if nil;(not vm-w3-text/html-message)
- ad-do-it
- (vm-w3-cid-retrieve (ad-get-arg 0))))
+ (apply orig-fun url args)
+ (vm-w3-cid-retrieve url)))
;;;###autoload
(defun vm-mime-display-internal-emacs-w3-text/html (start end layout)
diff --git a/lisp/vm.el b/lisp/vm.el
index 0a5543c530..8d6a5226a7 100644
--- a/lisp/vm.el
+++ b/lisp/vm.el
@@ -8,7 +8,7 @@
;; Version: 8.3.0snapshot
;; Maintainer: viewmail-info@nongnu.org
;; URL: https://gitlab.com/emacs-vm/vm
-;; Package-Requires: ((cl-lib "0.5"))
+;; Package-Requires: ((cl-lib "0.5") (nadvice "0.3"))
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by