From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.bugs Subject: bug#53981: 28.0.91; shortdoc: Add support for outline-minor-mode Date: Wed, 09 Nov 2022 19:17:31 +0200 Organization: LINKOV.NET Message-ID: <86sfisujx0.fsf@mail.linkov.net> References: <86k045b70e.fsf@mail.linkov.net> <83a651xmx8.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="5077"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (x86_64-pc-linux-gnu) Cc: mail@daniel-mendler.de, 53981@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Nov 09 18:28:13 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1osorz-00016g-Qw for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 09 Nov 2022 18:28:11 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1osorw-0007z5-1B; Wed, 09 Nov 2022 12:28:08 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1osorq-0007wI-6Y for bug-gnu-emacs@gnu.org; Wed, 09 Nov 2022 12:28:02 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1osorp-00067b-TX for bug-gnu-emacs@gnu.org; Wed, 09 Nov 2022 12:28:01 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1osorp-00037w-Jq for bug-gnu-emacs@gnu.org; Wed, 09 Nov 2022 12:28:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 09 Nov 2022 17:28:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 53981 X-GNU-PR-Package: emacs Original-Received: via spool by 53981-submit@debbugs.gnu.org id=B53981.166801485911968 (code B ref 53981); Wed, 09 Nov 2022 17:28:01 +0000 Original-Received: (at 53981) by debbugs.gnu.org; 9 Nov 2022 17:27:39 +0000 Original-Received: from localhost ([127.0.0.1]:40794 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1osorS-00036y-M7 for submit@debbugs.gnu.org; Wed, 09 Nov 2022 12:27:39 -0500 Original-Received: from relay3-d.mail.gandi.net ([217.70.183.195]:52833) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1osorQ-00036X-Lk for 53981@debbugs.gnu.org; Wed, 09 Nov 2022 12:27:37 -0500 Original-Received: (Authenticated sender: juri@linkov.net) by mail.gandi.net (Postfix) with ESMTPSA id 75CD96000C; Wed, 9 Nov 2022 17:27:28 +0000 (UTC) In-Reply-To: <83a651xmx8.fsf@gnu.org> (Eli Zaretskii's message of "Tue, 08 Nov 2022 21:32:03 +0200") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:247452 Archived-At: --=-=-= Content-Type: text/plain >> + (while (if outline-search-function >> + (funcall outline-search-function) >> + (re-search-forward outline-regexp nil t)) > > This changes the effect of the code because the new code searches for > a different regexp. Sorry, this was an attempt to unify code branches, but this change remained untested. Now fixed below. >> + (if outline-search-function >> + (funcall outline-search-function) >> + (re-search-forward >> + (concat "^\\(?:" outline-regexp "\\)") >> + nil 'move))) > > These two loops cons a new string each iteration. (So did the > original code, but if we are touching this, might as well fix that.) This is optimized as well: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=outline-search-level.patch diff --git a/lisp/apropos.el b/lisp/apropos.el index 624c29cb410..02a32a2e7ce 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -493,7 +493,7 @@ apropos-mode \\{apropos-mode-map}" (make-local-variable 'apropos--current) (setq-local revert-buffer-function #'apropos--revert-buffer) - (setq-local outline-regexp "^[^ \n]+" + (setq-local outline-search-function #'outline-search-level outline-level (lambda () 1) outline-minor-mode-cycle t outline-minor-mode-highlight t @@ -1188,7 +1188,8 @@ apropos-print (insert-text-button (symbol-name symbol) 'type 'apropos-symbol 'skip apropos-multi-type - 'face 'apropos-symbol) + 'face 'apropos-symbol + 'outline-level 1) (setq button-end (point)) (if (and (eq apropos-sort-by-scores 'verbose) (cadr apropos-item)) diff --git a/lisp/outline.el b/lisp/outline.el index a646f71db8b..fcac9d1950b 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -59,6 +59,14 @@ outline-heading-end-regexp in the file it applies to.") ;;;###autoload(put 'outline-heading-end-regexp 'safe-local-variable 'stringp) +(defvar outline-search-function nil + "Function to search the next outline heading. +The function is called with two arguments: the limit of the search +and the optional argument for the backward search; it should return +non-nil, move point (to the end of the buffer when search fails), +and set match-data appropriately if it succeeds; +like re-search-forward with `outline-regexp' would.") + (defvar outline-mode-prefix-map (let ((map (make-sparse-keymap))) (define-key map "@" 'outline-mark-subtree) @@ -233,7 +241,8 @@ outline-mode-map (defvar outline-font-lock-keywords '( ;; Highlight headings according to the level. - (eval . (list (concat "^\\(?:" outline-regexp "\\).*") + (eval . (list (or outline-search-function + (concat "^\\(?:" outline-regexp "\\).*")) 0 '(if outline-minor-mode (if outline-minor-mode-highlight (list 'face (outline-font-lock-face))) @@ -366,7 +375,9 @@ outline-font-lock-face "Return one of `outline-font-lock-faces' for current level." (save-excursion (goto-char (match-beginning 0)) - (looking-at outline-regexp) + (if outline-search-function + (funcall outline-search-function nil nil t) + (looking-at outline-regexp)) (aref outline-font-lock-faces (% (1- (funcall outline-level)) (length outline-font-lock-faces))))) @@ -474,8 +485,11 @@ outline-minor-mode-highlight-buffer ;; Fallback to overlays when font-lock is unsupported. (save-excursion (goto-char (point-min)) - (let ((regexp (concat "^\\(?:" outline-regexp "\\).*$"))) - (while (re-search-forward regexp nil t) + (let ((regexp (unless outline-search-function + (concat "^\\(?:" outline-regexp "\\).*$")))) + (while (if outline-search-function + (funcall outline-search-function) + (re-search-forward regexp nil t)) (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) (overlay-put overlay 'outline-highlight t) ;; FIXME: Is it possible to override all underlying face attributes? @@ -592,26 +606,32 @@ outline-next-preface "Skip forward to just before the next heading line. If there's no following heading line, stop before the newline at the end of the buffer." - (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") - nil 'move) - (goto-char (match-beginning 0))) - (if (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) - (forward-char -1))) + (when (if outline-search-function + (funcall outline-search-function) + (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") + nil 'move)) + (goto-char (match-beginning 0))) + (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) + (forward-char -1))) (defun outline-next-heading () "Move to the next (possibly invisible) heading line." (interactive) ;; Make sure we don't match the heading we're at. - (if (and (bolp) (not (eobp))) (forward-char 1)) - (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)") - nil 'move) - (goto-char (match-beginning 0)))) + (when (and (bolp) (not (eobp))) (forward-char 1)) + (when (if outline-search-function + (funcall outline-search-function) + (re-search-forward (concat "^\\(?:" outline-regexp "\\)") + nil 'move)) + (goto-char (match-beginning 0)))) (defun outline-previous-heading () "Move to the previous (possibly invisible) heading line." (interactive) - (re-search-backward (concat "^\\(?:" outline-regexp "\\)") - nil 'move)) + (if outline-search-function + (funcall outline-search-function nil t) + (re-search-backward (concat "^\\(?:" outline-regexp "\\)") + nil 'move))) (defsubst outline-invisible-p (&optional pos) "Non-nil if the character after POS has outline invisible property. @@ -628,8 +648,10 @@ outline-back-to-heading (let (found) (save-excursion (while (not found) - (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") - nil t) + (or (if outline-search-function + (funcall outline-search-function nil t) + (re-search-backward (concat "^\\(?:" outline-regexp "\\)") + nil t)) (signal 'outline-before-first-heading nil)) (setq found (and (or invisible-ok (not (outline-invisible-p))) (point))))) @@ -642,7 +664,9 @@ outline-on-heading-p (save-excursion (beginning-of-line) (and (bolp) (or invisible-ok (not (outline-invisible-p))) - (looking-at outline-regexp)))) + (if outline-search-function + (funcall outline-search-function nil nil t) + (looking-at outline-regexp))))) (defun outline-insert-heading () "Insert a new heading at same depth at point." @@ -754,7 +778,9 @@ outline-demote (while (and (progn (outline-next-heading) (not (eobp))) (<= (funcall outline-level) level)))) (unless (eobp) - (looking-at outline-regexp) + (if outline-search-function + (funcall outline-search-function nil nil t) + (looking-at outline-regexp)) (match-string-no-properties 0)))) ;; Bummer!! There is no higher-level heading in the buffer. (outline-invent-heading head nil)))) @@ -805,7 +831,9 @@ outline-map-region (save-excursion (setq end (copy-marker end)) (goto-char beg) - (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t) + (when (if outline-search-function + (funcall outline-search-function) + (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t)) (goto-char (match-beginning 0)) (funcall fun) (while (and (progn @@ -873,21 +901,23 @@ outline-next-visible-heading (if (< arg 0) (beginning-of-line) (end-of-line)) - (let (found-heading-p) + (let ((regexp (unless outline-search-function + (concat "^\\(?:" outline-regexp "\\)"))) + found-heading-p) (while (and (not (bobp)) (< arg 0)) (while (and (not (bobp)) (setq found-heading-p - (re-search-backward - (concat "^\\(?:" outline-regexp "\\)") - nil 'move)) + (if outline-search-function + (funcall outline-search-function nil t) + (re-search-backward regexp nil 'move))) (outline-invisible-p))) (setq arg (1+ arg))) (while (and (not (eobp)) (> arg 0)) (while (and (not (eobp)) (setq found-heading-p - (re-search-forward - (concat "^\\(?:" outline-regexp "\\)") - nil 'move)) + (if outline-search-function + (funcall outline-search-function) + (re-search-forward regexp nil 'move))) (outline-invisible-p (match-beginning 0)))) (setq arg (1- arg))) (if found-heading-p (beginning-of-line)))) @@ -1108,7 +1138,9 @@ outline-hide-sublevels (cond (current-prefix-arg (prefix-numeric-value current-prefix-arg)) ((save-excursion (beginning-of-line) - (looking-at outline-regexp)) + (if outline-search-function + (funcall outline-search-function nil nil t) + (looking-at outline-regexp))) (funcall outline-level)) (t 1)))) (if (< levels 1) @@ -1255,7 +1287,9 @@ outline-up-heading (setq level (funcall outline-level))) (setq start-level level)) (setq arg (- arg 1)))) - (looking-at outline-regexp)) + (if outline-search-function + (funcall outline-search-function nil nil t) + (looking-at outline-regexp))) (defun outline-forward-same-level (arg) "Move forward to the ARG'th subheading at same level as this one. @@ -1346,6 +1380,38 @@ outline-headers-as-kill (insert "\n\n")))))) (kill-new (buffer-string))))))) + +;;; Search text-property for outline headings + +;;;###autoload +(defun outline-search-level (&optional limit backward looking-at) + (outline-search-text-property 'outline-level limit backward looking-at)) + +(defun outline-search-text-property (prop &optional limit backward looking-at) + (let* ((prop-at + (if looking-at + (get-text-property (point) prop) + (when (get-text-property (point) prop) + ;; Go to the end of the current heading + (if backward + (text-property-search-backward prop) + (text-property-search-forward prop))) + t)) + (prop-match + (when prop-at + (if backward + (text-property-search-backward prop) + (text-property-search-forward prop))))) + (if prop-match + (let ((beg (prop-match-beginning prop-match)) + (end (prop-match-end prop-match))) + (if (or (null limit) (< end limit)) + (set-match-data (list beg end)) + (goto-char (or limit (point-max)))) + t) + (goto-char (point-max)) + nil))) + ;;; Initial visibility diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index dbac03432c1..18b758a9ca3 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -1374,7 +1374,12 @@ shortdoc-display-group (unless (bobp) (insert "\n")) (insert (propertize - (concat (substitute-command-keys data) "\n\n") + (substitute-command-keys data) + 'face 'shortdoc-heading + 'shortdoc-section t + 'outline-level 1)) + (insert (propertize + "\n\n" 'face 'shortdoc-heading 'shortdoc-section t))) ;; There may be functions not yet defined in the data. @@ -1397,7 +1402,7 @@ shortdoc--display-function (start-section (point)) arglist-start) ;; Function calling convention. - (insert (propertize "(" 'shortdoc-function function)) + (insert (propertize "(" 'shortdoc-function function 'outline-level 2)) (if (plist-get data :no-manual) (insert-text-button (symbol-name function) @@ -1531,7 +1536,9 @@ shortdoc-mode-map (define-derived-mode shortdoc-mode special-mode "shortdoc" "Mode for shortdoc." - :interactive nil) + :interactive nil + (setq-local outline-search-function #'outline-search-level) + (setq-local outline-level (lambda () (get-text-property (point) 'outline-level)))) (defun shortdoc--goto-section (arg sym &optional reverse) (unless (natnump arg) --=-=-=--