Rewrite defadvice to define-advice

ccc.el

@@ -38,7 +38,7 @@
 (require 'faces)                        ; read-color, color-values
 
 (eval-when-compile
-  (require 'advice))
+  (require 'nadvice))
 
 ;; Internal variables.
 (defvar ccc-buffer-local-cursor-color nil)
@@ -270,33 +270,34 @@ This function is the same as `facemenu-color-equal'"
   (ccc-set-frame-background-color (selected-frame) (ccc-current-background-color)))
 
 ;; Advices.
-(defadvice modify-frame-parameters (after ccc-ad activate)
-  (when (and (assq 'cursor-color (ad-get-arg 1))
+(define-advice modify-frame-parameters (:after (frame alist) ccc-ad)
+  (when (and (assq 'cursor-color alist)
              (null ccc-buffer-local-cursor-color))
-    (ccc-set-frame-cursor-color (ad-get-arg 0)
-                                (cdr (assq 'cursor-color (ad-get-arg 1)))))
-  (when (and (assq 'foreground-color (ad-get-arg 1))
+    (ccc-set-frame-cursor-color frame
+                                (cdr (assq 'cursor-color alist))))
+  (when (and (assq 'foreground-color alist)
              (null ccc-buffer-local-foreground-color))
-    (ccc-set-frame-foreground-color (ad-get-arg 0)
-                                    (cdr (assq 'foreground-color (ad-get-arg 1)))))
-  (when (and (assq 'background-color (ad-get-arg 1))
+    (ccc-set-frame-foreground-color frame
+                                    (cdr (assq 'foreground-color alist))))
+  (when (and (assq 'background-color alist)
              (null ccc-buffer-local-background-color))
-    (ccc-set-frame-background-color (ad-get-arg 0)
+    (ccc-set-frame-background-color frame
                                     (cdr (assq 'background-color
-                                               (ad-get-arg 1))))))
+                                               alist)))))
 
-(defadvice custom-theme-checkbox-toggle (after ccc-ad activate)
+(define-advice custom-theme-checkbox-toggle
+    (:after (widget &optional event) ccc-ad)
   (setq ccc-default-cursor-color (ccc-current-cursor-color)
         ccc-default-foreground-color (ccc-current-foreground-color)
         ccc-default-background-color (ccc-current-background-color))
   (ccc-set-frame-cursor-color (selected-frame) (ccc-current-cursor-color))
   (ccc-set-frame-foreground-color (selected-frame) (ccc-current-foreground-color))
   (ccc-set-frame-background-color (selected-frame) (ccc-current-background-color)))
 
-(defadvice enable-theme (after ccc-ad activate)
+(define-advice enable-theme (:after (theme) ccc-ad)
   (ccc-setup-current-colors))
 
-(defadvice disable-theme (after ccc-ad activate)
+(define-advice disable-theme (:after (theme) ccc-ad)
   (ccc-setup-current-colors))
 
 (provide 'ccc)

context-skk.el

@@ -199,14 +199,17 @@
 ;; Advices
 ;;
 (defmacro define-context-skk-advice (target)
-  `(defadvice ,target (around ,(intern (concat (symbol-name target) "-ctx-switch")) activate)
+  `(define-advice ,target
+       (:around
+        (oldfun &rest args)
+        ,(intern (concat (symbol-name target) "-ctx-switch")))
      "$BJ8L.$K1~$8$F<+F0E*$K(B skk $B$NF~NO%b!<%I$r(B latin $B$K$9$k!#(B"
      (if context-skk-mode
          (if (context-skk-context-check)
              (context-skk-insert)
            (eval `(let ,(context-skk-customize)
-                    ad-do-it)))
-       ad-do-it)))
+                    (apply oldfun args))))
+       (apply oldfun args))))
 
 (define-context-skk-advice skk-insert)
 (define-context-skk-advice skk-jisx0208-latin-insert)

etc/dot.skk

@@ -372,14 +372,15 @@
 
   ;; tooltip 表示の際のマウスポインタを変更して遊んでみる
   ;; 注) この設定は X Window System 上の GNU Emacs でないと利用できません。
-  (defadvice skk-tooltip-show-at-point (around set-pointer activate)
+  (define-advice skk-tooltip-show-at-point
+      (:around (oldfun text &optional situation) set-pointer)
     (let ((shape x-pointer-shape))
       (require 'avoid)
-      (mouse-avoidance-set-pointer-shape (if (ad-get-arg 1)
+      (mouse-avoidance-set-pointer-shape (if text
 					     x-pointer-pencil
 					   x-pointer-hand1))
       (unwind-protect
-	  ad-do-it
+	  (funcall oldfun text situation)
 	(mouse-avoidance-set-pointer-shape shape))))
   )
 
@@ -744,7 +745,8 @@
 ;; Tips といえるものではないが、`lisp-interaction-mode' において "C-j"
 ;; (`eval-print-last-sexp') を利用する人にとっては、英数モードにおいて
 ;; "C-j" によって かなモードに入る仕様は使いづらい。
-;; (defadvice skk-latin-mode (after no-latin-mode-in-lisp-interaction activate)
+;; (define-advice skk-latin-mode
+;;     (:after (arg) no-latin-mode-in-lisp-interaction)
 ;;   "`lisp-interaction-mode' において英数モードを回避する。"
 ;;   (when (eq major-mode 'lisp-interaction-mode)
 ;;     (skk-mode-off)))
@@ -777,8 +779,8 @@
 ;;; orgtbl-mode
 ;;; http://mail.ring.gr.jp/skk/201807/msg00001.html
 (skk-wrap-newline-command orgtbl-ret)
-(defadvice org-delete-backward-char (around skk-ad activate)
+(define-advice org-delete-backward-char (:around (oldfun N) skk-ad)
   (skk-delete-backward-char N)
-  ad-do-it)
+  (funcall oldfun N))
 
 ;;; dot.skk ends here

maint/checkdoc-batch.el

@@ -64,9 +64,9 @@
 
 ;;; Code:
 
-;; for `ad-find-advice' macro when running uncompiled
-;; (don't unload 'advice before our -unload-function)
-(require 'advice)
+;; for `advice-remove' when running uncompiled
+;; (don't unload 'nadvice before our -unload-function)
+(require 'nadvice)
 
 (require 'checkdoc)
 
@@ -269,58 +269,81 @@ Output a `checkdoc-batch' error about buffer position POS."
 
 ;;-----------------------------------------------------------------------------
 
-(defadvice checkdoc-autofix-ask-replace (around checkdoc-batch)
+(define-advice checkdoc-autofix-ask-replace
+    (:around
+     (oldfun start end question replacewith &optional complex)
+     checkdoc-batch)
   "Temporary hack to capture message and say yes to change."
   (checkdoc-batch-error start (concat question " " replacewith))
   (delete-region start end)
   (save-excursion
     (goto-char start)
     (insert replacewith)
     (set-buffer-modified-p nil))
-  (setq ad-return-value t))
+  t)
 
-(defadvice checkdoc-y-or-n-p (around checkdoc-batch)
+(define-advice checkdoc-y-or-n-p (:around (oldfun question) checkdoc-batch)
   "Temporary hack to capture message and say yes to change."
-  (checkdoc-batch-error (point)
-                        (ad-get-arg 0)) ;; QUESTION
-  (setq ad-return-value t))
+  (checkdoc-batch-error (point) question)
+  t)
 
-(defadvice checkdoc-recursive-edit (around checkdoc-batch)
+(define-advice checkdoc-recursive-edit (:around (oldfun msg) checkdoc-batch)
   "Temporary hack to capture message and suppress edit."
-  (checkdoc-batch-error (point)
-                        (ad-get-arg 0)) ;; MSG
-  (setq ad-return-value t))
+  (checkdoc-batch-error (point) msg)
+  t)
 
-(defadvice checkdoc-create-error (around checkdoc-batch)
+(define-advice checkdoc-create-error
+    (:around (oldfun text start end &optional unfixable) checkdoc-batch)
   "Temporary hack to capture checkdoc error messages."
   ;; START is nil for a whole-buffer thing like missing ";;; Commentary"
   ;; section
   (checkdoc-batch-error (or start (point-min))
                         text)
-  (setq ad-return-value nil))
+  nil)
 
-(defadvice message (around checkdoc-batch)
+(define-advice message
+    (:around (oldfun format-string &rest args) checkdoc-batch)
   "Temporary hack to capture checkdoc messages."
-  (let ((format (ad-get-arg 0)))
+  (let ((format format-string))
     (if (null format)
-        (setq ad-return-value nil)
-      (let ((str (apply 'format (ad-get-args 0))))
-        (setq ad-return-value str)
+        nil
+      (let ((str (apply 'format (cons format-string args))))
         (unless (string-match "\\(\\`Searching for \\|Done\\|Starting new Ispell\\|Ispell process killed\\)" format)
-          (checkdoc-batch-message "%s\n" str))))))
-
-(defadvice read-string (around checkdoc-batch)
+          (checkdoc-batch-message "%s\n" str))
+        str))))
+
+(define-advice read-string
+    (:around
+     (oldfun
+      prompt
+      &optional
+      initial-input
+      history
+      default-value
+      inherit-input-method)
+     checkdoc-batch)
   "Temporary hack to just return an empty string."
-  (setq ad-return-value ""))
-
-(defadvice completing-read (around checkdoc-batch)
+  "")
+
+(define-advice completing-read
+    (:around
+     (oldfun
+      prompt
+      collection
+      &optional
+      predicate
+      require-match
+      initial-input
+      hist
+      def
+      inherit-input-method)
+     checkdoc-batch)
   "Temporary hack to just return first completion candidate."
-  (setq ad-return-value
-        (or (checkdoc-batch-completion-first-candidate
-             (ad-get-arg 1)) ;; COLLECTION or TABLE
-            "")))
+  (or (checkdoc-batch-completion-first-candidate collection)
+      ""))
 
-(defadvice ispell-command-loop (around checkdoc-batch)
+(define-advice ispell-command-loop
+    (:around (oldfun miss guess word start end) checkdoc-batch)
   "Temporary hack to capture spelling error reports."
   (let ((maybe (delq nil (list miss guess))))
     (setq maybe
@@ -348,10 +371,14 @@ List of functions (symbols) with `checkdoc-batch' advice.")
 (defun checkdoc-batch-advice (action)
   "An internal part of checkdoc-batch.el.
 Call ACTION on `checkdoc-batch-advised-functions'.
-ACTION can be symbol `ad-enable-advice' or `ad-disable-advice'."
+ACTION can be symbol `enable-advice' or `disable-advice'."
   (dolist (func checkdoc-batch-advised-functions)
-    (funcall action func 'around 'checkdoc-batch)
-    (ad-activate    func)))
+    (let ((advice (make-symbol (concat (symbol-name func) "@checkdoc-batch"))))
+      (cond
+       ((eq action 'enable-advice)
+        (advice-add func 'around advice))
+       ((eq action 'disable-advice)
+        (advice-remove func advice))))))
 
 ;; this cleans up in emacs22 up, but since the advice is only enabled while
 ;; checkdoc-batch executes it doesn't matter if it's left behind in
@@ -361,10 +388,7 @@ ACTION can be symbol `ad-enable-advice' or `ad-disable-advice'."
   "An internal part of checkdoc-batch.el.
 Remove advice from `checkdoc-batch-advised-functions'.
 This is called by `unload-feature'."
-  (dolist (func checkdoc-batch-advised-functions)
-    (when (ad-find-advice func 'around 'checkdoc-batch)
-      (ad-remove-advice   func 'around 'checkdoc-batch)
-      (ad-activate        func)))
+  (checkdoc-batch-advice 'disable-advice)
   nil) ;; and do normal unload-feature actions too
 
 
@@ -455,9 +479,9 @@ Generate a report for the current temp buffer contents."
      (let ((checkdoc-autofix-flag 'automatic))
        (unwind-protect
            (progn
-             (checkdoc-batch-advice 'ad-enable-advice)
+             (checkdoc-batch-advice 'enable-advice)
              (checkdoc))
-         (checkdoc-batch-advice 'ad-disable-advice))))))
+         (checkdoc-batch-advice 'disable-advice))))))
 
 ;;;###autoload
 (defun checkdoc-batch ()

nicola/NICOLA-DDSKK-MK

@@ -3,7 +3,7 @@
 ;;; Code:
 
 (require 'cl-lib)
-(require 'advice)
+(require 'nadvice)
 
 (defun config-nicola-ddskk ()
   (let (prefix lisp-dir version-specific-lisp-dir)

nicola/skk-kanagaki-util.el

@@ -204,13 +204,14 @@
                           "$B!,(B"
                         "$B!+(B"))))))
 
-(defadvice isearch-repeat (around skk-kanagaki-workaround activate)
+(define-advice isearch-repeat
+    (:around (oldfun direction &optional count) skk-kanagaki-workaround)
   (cond ((get 'isearch-barrier 'skk-kanagaki)
          (goto-char isearch-barrier)
-         ad-do-it
+         (funcall oldfun direction count)
          (put 'isearch-barrier 'skk-kanagaki nil))
         (t
-         ad-do-it)))
+         (funcall oldfun direction count))))
 
 ;;;###autoload
 (defun skk-kanagaki-handakuten (&optional arg)

nicola/skk-kanagaki.el

@@ -435,7 +435,7 @@ XFree86 $B>e$G;HMQ$9$k>l9g!"(B $BNc$($P$3$NCM$r(B [henkan]
 
 ;; Pieces of advice.
 
-(defadvice skk-setup-keymap (after skk-kanagaki-keys activate preactivate)
+(define-advice skk-setup-keymap (:after () skk-kanagaki-keys)
   ;; $B%-!<%P%$%s%I!#$?$@$7$3$l$O!"$h$jE,@Z$J%-!<Dj5A$r8+$D$1$k$^$G$N;CDjE*=hCV!#(B
   ;; $B$3$3$G8@$&!V$h$jE,@Z$J%-!<Dj5A!W$H$O!"F~NOJ}<0$K0MB8$9$k$?$a!"(BSKK $B$N=EMW(B
   ;; $B$J%-!<Dj5A$r%U%!%s%/%7%g%s%-!<$K;D$7$F$*$/$3$H$O!"<BMQ$N$?$a$h$j$b$`$7$m(B
@@ -469,7 +469,8 @@ XFree86 $B>e$G;HMQ$9$k>l9g!"(B $BNc$($P$3$NCM$r(B [henkan]
       (define-key skk-j-mode-map (symbol-value (car cell)) (cdr cell))))
   (define-key help-map skk-kanagaki-help-key 'skk-kanagaki-help))
 
-(defadvice skk-insert (around skk-kanagaki-workaround activate compile)
+(define-advice skk-insert
+    (:around (oldfun &optional arg prog-list-number) skk-kanagaki-workaround)
   "$B2>L>F~NOMQ$N(B work around $B!#(B"
   ;;
   (when (and skk-process-okuri-early
@@ -485,31 +486,27 @@ XFree86 $B>e$G;HMQ$9$k>l9g!"(B $BNc$($P$3$NCM$r(B [henkan]
            nil)
           (t
            skk-set-henkan-point-key))))
-    ad-do-it))
+    (funcall oldfun arg prog-list-number)))
 
-(defadvice skk-compute-henkan-lists-sub-adjust-okuri (around
-                                                      skk-kanagaki-adjust-okuri
-                                                      activate compile)
+(define-advice skk-compute-henkan-lists-sub-adjust-okuri
+    (:around (oldfun item &optional okuri-key) skk-kanagaki-adjust-okuri)
   (cond
    (skk-use-kana-keyboard
     ;; $B2>L>F~NOMQ$NFC<l=hM}(B
-    (let ((item (ad-get-arg 0))
-          (okuri-key (ad-get-arg 1)))
-      (setq ad-return-value
-            (cond
-             ((or (and (eq skk-kanagaki-state 'kana)
-                       ;; okuri-key $B$,(B "$B$C(B" $B$G(B item $B$,(B "$B$C$F(B" $B$J$I$@$C$?>l9g!#(B
-                       (string-match (concat "^" (regexp-quote okuri-key))
-                                     item))
-                  (and (eq skk-kanagaki-state 'rom)
-                       ;; okuri-key $B$,(B "$B$C$F(B" $B$G(B item $B$,(B "$B$C(B" $B$J$I$@$C$?>l9g!#(B
-                       (string-match (concat "^" (regexp-quote item))
-                                     okuri-key)))
-              okuri-key)
-             (t
-              item)))))
+    (cond
+     ((or (and (eq skk-kanagaki-state 'kana)
+               ;; okuri-key $B$,(B "$B$C(B" $B$G(B item $B$,(B "$B$C$F(B" $B$J$I$@$C$?>l9g!#(B
+               (string-match (concat "^" (regexp-quote okuri-key))
+                             item))
+          (and (eq skk-kanagaki-state 'rom)
+               ;; okuri-key $B$,(B "$B$C$F(B" $B$G(B item $B$,(B "$B$C(B" $B$J$I$@$C$?>l9g!#(B
+               (string-match (concat "^" (regexp-quote item))
+                             okuri-key)))
+      okuri-key)
+     (t
+      item)))
    (t
-    ad-do-it)))
+    (funcall oldfun item okuri-key))))
 
 (provide 'skk-kanagaki)