org-compat: Use `define-advice' instead of `defadvice'

* lisp/org-compat.el (outline-flag-region):
(outline-next-visible-heading):
(outline-back-to-heading):
(outline-on-heading-p):
(outline-hide-sublevels):
(outline-toggle-children): Use `define-advice', remove redundant
interactive specs, and use `derived-mode-p' instead of `eq'
`major-mode'.

Suggested by Stefan Monnier.
This commit is contained in:
Ihor Radchenko 2022-09-03 16:05:42 +08:00
parent 710b6ca70e
commit ea665792b2
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 41 additions and 52 deletions

View File

@ -1456,69 +1456,58 @@ key."
;; Folding in outline-mode is not compatible with org-mode folding
;; anymore. Working around to avoid breakage of external packages
;; assuming the compatibility.
(defadvice outline-flag-region (around outline-flag-region@fix-for-org-fold (from to flag) activate)
(define-advice outline-flag-region (:around (oldfun from to flag) fix-for-org-fold)
"Run `org-fold-region' when in org-mode."
(if (eq major-mode 'org-mode)
(setq ad-return-value (org-fold-region (max from (point-min)) (min to (point-max)) flag 'headline))
ad-do-it))
(if (derived-mode-p 'org-mode)
(org-fold-region (max from (point-min)) (min to (point-max)) flag 'headline)
(apply oldfun from to flag)))
(defadvice outline-next-visible-heading (around outline-next-visible-heading@fix-for-org-fold (arg) activate)
(define-advice outline-next-visible-heading (:around (oldfun arg) fix-for-org-fold)
"Run `org-next-visible-heading' when in org-mode."
(interactive "p")
(if (eq major-mode 'org-mode)
(setq ad-return-value (org-next-visible-heading arg))
ad-do-it))
(if (derived-mode-p 'org-mode)
(org-next-visible-heading arg)
(apply oldfun arg)))
(defadvice outline-back-to-heading (around outline-back-to-heading@fix-for-org-fold (&optional invisible-ok) activate)
(define-advice outline-back-to-heading (:around (oldfun &optional invisible-ok) fix-for-org-fold)
"Run `org-back-to-heading' when in org-mode."
(if (eq major-mode 'org-mode)
(setq ad-return-value
(progn
(beginning-of-line)
(or (org-at-heading-p (not invisible-ok))
(let (found)
(save-excursion
(while (not found)
(or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
nil t)
(signal 'outline-before-first-heading nil))
(setq found (and (or invisible-ok (not (org-fold-folded-p)))
(point)))))
(goto-char found)
found))))
ad-do-it))
(if (derived-mode-p 'org-mode)
(progn
(beginning-of-line)
(or (org-at-heading-p (not invisible-ok))
(let (found)
(save-excursion
(while (not found)
(or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
nil t)
(signal 'outline-before-first-heading nil))
(setq found (and (or invisible-ok (not (org-fold-folded-p)))
(point)))))
(goto-char found)
found)))
(apply oldfun invisible-ok)))
(defadvice outline-on-heading-p (around outline-on-heading-p@fix-for-org-fold (&optional invisible-ok) activate)
(define-advice outline-on-heading-p (:around (oldfun &optional invisible-ok) fix-for-org-fold)
"Run `org-at-heading-p' when in org-mode."
(if (eq major-mode 'org-mode)
(setq ad-return-value (org-at-heading-p (not invisible-ok)))
ad-do-it))
(if (derived-mode-p 'org-mode)
(org-at-heading-p (not invisible-ok))
(apply oldfun invisible-ok)))
(defadvice outline-hide-sublevels (around outline-hide-sublevels@fix-for-org-fold (levels) activate)
(define-advice outline-hide-sublevels (:around (oldfun levels) fix-for-org-fold)
"Run `org-fold-hide-sublevels' when in org-mode."
(interactive (list
(cond
(current-prefix-arg (prefix-numeric-value current-prefix-arg))
((save-excursion (beginning-of-line)
(looking-at outline-regexp))
(funcall outline-level))
(t 1))))
(if (eq major-mode 'org-mode)
(setq ad-return-value (org-fold-hide-sublevels levels))
ad-do-it))
(if (derived-mode-p 'org-mode)
(org-fold-hide-sublevels levels)
(apply oldfun levels)))
(defadvice outline-toggle-children (around outline-toggle-children@fix-for-org-fold () activate)
(define-advice outline-toggle-children (:around (oldfun) fix-for-org-fold)
"Run `org-fold-hide-sublevels' when in org-mode."
(interactive)
(if (eq major-mode 'org-mode)
(setq ad-return-value
(save-excursion
(org-back-to-heading)
(if (not (org-fold-folded-p (line-end-position)))
(org-fold-hide-subtree)
(org-fold-show-children)
(org-fold-show-entry 'hide-drawers))))
ad-do-it))
(if (derived-mode-p 'org-mode)
(save-excursion
(org-back-to-heading)
(if (not (org-fold-folded-p (line-end-position)))
(org-fold-hide-subtree)
(org-fold-show-children)
(org-fold-show-entry 'hide-drawers)))
(apply oldfun)))
;; TODO: outline-headers-as-kill