X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b038485e9a815712dd80038565ce391a7128701e..9c0c2af5a157eca18c86f644121f7eac5488dbda:/lisp/info.el diff --git a/lisp/info.el b/lisp/info.el index f3dd9a859a..47af5bb815 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -139,7 +139,7 @@ These directories are searched after those in `Info-directory-list'." :type '(repeat directory) :group 'info) -(defcustom Info-scroll-prefer-subnodes t +(defcustom Info-scroll-prefer-subnodes nil "*If non-nil, \\\\[Info-scroll-up] in a menu visits subnodes. If this is non-nil, and you scroll far enough in a node that its menu appears on the screen, the next \\\\[Info-scroll-up] @@ -149,6 +149,7 @@ that you visit a subnode before getting to the end of the menu. Setting this option to nil results in behavior similar to the stand-alone Info reader program, which visits the first subnode from the menu only when you hit the end of the current node." + :version "21.4" :type 'boolean :group 'info) @@ -162,6 +163,14 @@ If value is non-nil but not t, the reference section is still shown." (other :tag "Replace only tag" tag)) :group 'info) +(defcustom Info-refill-paragraphs nil + "*If non-nil, attempt to refill paragraphs with hidden references. +This refilling may accidentally remove explicit line breaks in the info +file, so be prepared for a few surprises if you enable this feature." + :version "21.4" + :type 'boolean + :group 'info) + (defcustom Info-mode-hook ;; Try to obey obsolete Info-fontify settings. (unless (and (boundp 'Info-fontify) (null Info-fontify)) @@ -902,7 +911,9 @@ a case-insensitive match is tried." nodename end) (re-search-backward "^\^_") (search-forward "Node: ") - (setq nodename (Info-following-node-name)) + (setq nodename + (and (looking-at (Info-following-node-name-re)) + (match-string 1))) (search-forward "\n\^_" nil 'move) (beginning-of-line) (setq end (point)) @@ -1201,8 +1212,8 @@ If FORK is a string, it is the name to use for the new buffer." nodename) (setq filename (if (= (match-beginning 1) (match-end 1)) "" - (substring nodename (match-beginning 2) (match-end 2))) - nodename (substring nodename (match-beginning 3) (match-end 3))) + (match-string 2 nodename)) + nodename (match-string 3 nodename)) (let ((trim (string-match "\\s *\\'" filename))) (if trim (setq filename (substring filename 0 trim)))) (let ((trim (string-match "\\s *\\'" nodename))) @@ -1317,7 +1328,7 @@ If FORK is a string, it is the name to use for the new buffer." (when (equal regexp "") (setq regexp (car Info-search-history))) (when regexp - (let ((found ()) + (let (found beg-found give-up (onode Info-current-node) (ofile Info-current-file) (opoint (point)) @@ -1326,53 +1337,70 @@ If FORK is a string, it is the name to use for the new buffer." (save-excursion (save-restriction (widen) + (while (and (not give-up) + (or (null found) + (isearch-range-invisible beg-found found))) + (if (re-search-forward regexp nil t) + (setq found (point) beg-found (match-beginning 0)) + (setq give-up t))))) + ;; If no subfiles, give error now. + (if give-up (if (null Info-current-subfile) - (progn (re-search-forward regexp) (setq found (point))) - (condition-case err - (progn (re-search-forward regexp) (setq found (point))) - (search-failed nil))))) - (if (not found) ;can only happen in subfile case -- else would have erred - (unwind-protect - (let ((list ())) - (save-excursion - (set-buffer (marker-buffer Info-tag-table-marker)) + (re-search-forward regexp) + (setq found nil))) + + (unless found + (unwind-protect + ;; Try other subfiles. + (let ((list ())) + (save-excursion + (set-buffer (marker-buffer Info-tag-table-marker)) + (goto-char (point-min)) + (search-forward "\n\^_\nIndirect:") + (save-restriction + (narrow-to-region (point) + (progn (search-forward "\n\^_") + (1- (point)))) (goto-char (point-min)) - (search-forward "\n\^_\nIndirect:") - (save-restriction - (narrow-to-region (point) - (progn (search-forward "\n\^_") - (1- (point)))) - (goto-char (point-min)) - ;; Find the subfile we just searched. - (search-forward (concat "\n" osubfile ": ")) - ;; Skip that one. - (forward-line 1) - ;; Make a list of all following subfiles. - ;; Each elt has the form (VIRT-POSITION . SUBFILENAME). - (while (not (eobp)) - (re-search-forward "\\(^.*\\): [0-9]+$") - (goto-char (+ (match-end 1) 2)) - (setq list (cons (cons (+ (point-min) - (read (current-buffer))) - (match-string-no-properties 1)) - list)) - (goto-char (1+ (match-end 0)))) - ;; Put in forward order - (setq list (nreverse list)))) - (while list - (message "Searching subfile %s..." (cdr (car list))) - (Info-read-subfile (car (car list))) - (setq list (cdr list)) + ;; Find the subfile we just searched. + (search-forward (concat "\n" osubfile ": ")) + ;; Skip that one. + (forward-line 1) + ;; Make a list of all following subfiles. + ;; Each elt has the form (VIRT-POSITION . SUBFILENAME). + (while (not (eobp)) + (re-search-forward "\\(^.*\\): [0-9]+$") + (goto-char (+ (match-end 1) 2)) + (setq list (cons (cons (+ (point-min) + (read (current-buffer))) + (match-string-no-properties 1)) + list)) + (goto-char (1+ (match-end 0)))) + ;; Put in forward order + (setq list (nreverse list)))) + (while list + (message "Searching subfile %s..." (cdr (car list))) + (Info-read-subfile (car (car list))) + (setq list (cdr list)) + (setq give-up nil found nil) + (while (and (not give-up) + (or (null found) + (isearch-range-invisible beg-found found))) (if (re-search-forward regexp nil t) - (setq found (point) list ()))) + (setq found (point) beg-found (match-beginning 0)) + (setq give-up t))) + (if give-up + (setq found nil)) (if found - (message "") - (signal 'search-failed (list regexp)))) - (if (not found) - (progn (Info-read-subfile osubfile) - (goto-char opoint) - (Info-select-node) - (set-window-start (selected-window) ostart))))) + (setq list nil))) + (if found + (message "") + (signal 'search-failed (list regexp)))) + (if (not found) + (progn (Info-read-subfile osubfile) + (goto-char opoint) + (Info-select-node) + (set-window-start (selected-window) ostart))))) (widen) (goto-char found) (Info-select-node) @@ -1385,35 +1413,38 @@ If FORK is a string, it is the name to use for the new buffer." (defun Info-extract-pointer (name &optional errorname) "Extract the value of the node-pointer named NAME. If there is none, use ERRORNAME in the error message; -if ERRORNAME is nil, just return nil. -Bind this in case the user sets it to nil." +if ERRORNAME is nil, just return nil." + ;; Bind this in case the user sets it to nil. (let ((case-fold-search t)) (save-excursion - (save-restriction - (goto-char (point-min)) - (let ((bound (point))) - (forward-line 1) - (cond ((re-search-backward (concat name ":") bound t) - (goto-char (match-end 0)) - (Info-following-node-name)) - ((not (eq errorname t)) - (error "Node has no %s" - (capitalize (or errorname name)))))))))) - -(defun Info-following-node-name (&optional allowedchars) - "Return the node name in the buffer following point. + (goto-char (point-min)) + (let ((bound (point))) + (forward-line 1) + (cond ((re-search-backward + (concat name ":" (Info-following-node-name-re)) bound t) + (match-string 1)) + ((not (eq errorname t)) + (error "Node has no %s" + (capitalize (or errorname name))))))))) + +(defun Info-following-node-name-re (&optional allowedchars) + "Return a regexp matching a node name. ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp -saying which chars may appear in the node name." - (skip-chars-forward " \t") - (buffer-substring-no-properties - (point) - (progn - (while (looking-at (concat "[" (or allowedchars "^,\t\n") "]")) - (skip-chars-forward (concat (or allowedchars "^,\t\n") "(")) - (if (looking-at "(") - (skip-chars-forward "^)"))) - (skip-chars-backward " ") - (point)))) +saying which chars may appear in the node name. +Submatch 1 is the complete node name. +Submatch 2 if non-nil is the parenthesized file name part of the node name. +Submatch 3 is the local part of the node name. +End of submatch 0, 1, and 3 are the same, so you can safely concat." + (concat "[ \t]*" ;Skip leading space. + "\\(\\(([^)]+)\\)?" ;Node name can start with a file name. + "\\([" (or allowedchars "^,\t\n") "]*" ;Any number of allowed chars. + "[" (or allowedchars "^,\t\n") " ]" ;The last char can't be a space. + "\\|\\)\\)")) ;Allow empty node names. + +;;; For compatibility; other files have used this name. +(defun Info-following-node-name () + (and (looking-at (Info-following-node-name-re)) + (match-string 1))) (defun Info-next () "Go to the next node of this node." @@ -1472,9 +1503,7 @@ FOOTNOTENAME may be an abbreviation of the reference name." (goto-char (point-min)) (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t) - (setq str (buffer-substring-no-properties - (match-beginning 1) - (1- (point)))) + (setq str (match-string-no-properties 1)) ;; See if this one should be the default. (and (null default) (<= (match-beginning 0) start-point) @@ -1494,23 +1523,14 @@ FOOTNOTENAME may be an abbreviation of the reference name." (if (eq default t) (setq default str)) (if (eq alt-default t) (setq alt-default str)) ;; Don't add this string if it's a duplicate. - ;; We use a loop instead of "(assoc str completions)" because - ;; we want to do a case-insensitive compare. - (let ((tail completions) - (tem (downcase str))) - (while (and tail - (not (string-equal tem (downcase (car (car tail)))))) - (setq tail (cdr tail))) - (or tail - (setq completions - (cons (cons str nil) - completions)))))) + (or (assoc-string str completions t) + (push str completions)))) ;; If no good default was found, try an alternate. (or default (setq default alt-default)) ;; If only one cross-reference found, then make it default. (if (eq (length completions) 1) - (setq default (car (car completions)))) + (setq default (car completions))) (if completions (let ((input (completing-read (if default (concat @@ -1543,19 +1563,23 @@ FOOTNOTENAME may be an abbreviation of the reference name." (setq i (+ i 1))) (Info-goto-node target))) +(defconst Info-menu-entry-name-re "\\(?:[^:]\\|:[^:,.;() \t\n]\\)*" + ;; We allow newline because this is also used in Info-follow-reference, + ;; where the xref name might be wrapped over two lines. + "Regexp that matches a menu entry name upto but not including the colon. +Because of ambiguities, this should be concatenated with something like +`:' and `Info-following-node-name-re'.") + (defun Info-extract-menu-node-name (&optional multi-line) (skip-chars-forward " \t\n") - (let ((beg (point)) - str) - (while (not (looking-at ":*[,.;() \t\n]")) - (skip-chars-forward "^:") - (forward-char 1)) - (setq str - (if (looking-at ":") - (buffer-substring-no-properties beg (1- (point))) - (skip-chars-forward " \t\n") - (Info-following-node-name (if multi-line "^.,\t" "^.,\t\n")))) - (replace-regexp-in-string "[ \n]+" " " str))) + (when (looking-at (concat Info-menu-entry-name-re ":\\(:\\|" + (Info-following-node-name-re + (if multi-line "^.,\t" "^.,\t\n")) "\\)")) + (replace-regexp-in-string + "[ \n]+" " " + (or (match-string 2) + ;; If the node name is the menu entry name (using `entry::'). + (buffer-substring (match-beginning 0) (1- (match-beginning 1))))))) ;; No one calls this. ;;(defun Info-menu-item-sequence (list) @@ -1567,7 +1591,8 @@ FOOTNOTENAME may be an abbreviation of the reference name." (defvar Info-complete-next-re nil) (defvar Info-complete-cache nil) -(defconst Info-node-spec-re "[^.,:(]*\\(([^)]*)[^.,:]*\\)?[,:.]" +(defconst Info-node-spec-re + (concat (Info-following-node-name-re "^.,:") "[,:.]") "Regexp to match the text after a : until the terminating `.'.") (defun Info-complete-menu-item (string predicate action) @@ -1578,7 +1603,11 @@ FOOTNOTENAME may be an abbreviation of the reference name." ;; also look for menu items in subsequent nodes as long as those ;; nodes' names match `Info-complete-next-re'. This feature is currently ;; only used for completion in Info-index. - (with-current-buffer Info-complete-menu-buffer + + ;; Note that `Info-complete-menu-buffer' could be current already, + ;; so we want to save point. + (save-excursion + (set-buffer Info-complete-menu-buffer) (let ((completion-ignore-case t) (case-fold-search t) (orignode Info-current-node) @@ -1590,7 +1619,7 @@ FOOTNOTENAME may be an abbreviation of the reference name." (concat "\n\\* +" (regexp-quote string) ":") nil t) (let ((pattern (concat "\n\\* +\\(" (regexp-quote string) - "[^\t\n]*?\\):" Info-node-spec-re)) + Info-menu-entry-name-re "\\):" Info-node-spec-re)) completions) ;; Check the cache. (if (and (equal (nth 0 Info-complete-cache) Info-current-file) @@ -1648,7 +1677,9 @@ new buffer." (save-excursion (goto-char p) (end-of-line) - (if (re-search-backward "\n\\* +\\([^\t\n]*\\):" beg t) + (if (re-search-backward (concat "\n\\* +\\(" + Info-menu-entry-name-re + "\\):") beg t) (setq default (match-string-no-properties 1)))))) (let ((item nil)) (while (null item) @@ -2086,8 +2117,11 @@ Give a blank topic name to go to the Index node itself." (search-forward (format "`%s'" (substring name 0 (match-beginning 1))) nil t)) - (search-forward name nil t)) - (beginning-of-line) + (search-forward name nil t) + ;; Try again without the " <1>" makeinfo can append + (and (string-match "\\`\\(.*\\) <[0-9]+>\\'" name) + (Info-find-index-name (match-string 1 name)))) + (progn (beginning-of-line) t) ;; non-nil for recursive call (goto-char (point-min))))) (defun Info-undefined () @@ -2230,7 +2264,8 @@ if point is in a menu item description, follow that menu item." (define-key Info-mode-map " " 'Info-scroll-up) (define-key Info-mode-map "\C-m" 'Info-follow-nearest-node) (define-key Info-mode-map "\t" 'Info-next-reference) - (define-key Info-mode-map "\e\t" 'Info-prev-reference) + (define-key Info-mode-map [(shift tab)] 'Info-prev-reference) + (define-key Info-mode-map [backtab] 'Info-prev-reference) (define-key Info-mode-map "1" 'Info-nth-menu-item) (define-key Info-mode-map "2" 'Info-nth-menu-item) (define-key Info-mode-map "3" 'Info-nth-menu-item) @@ -2369,9 +2404,7 @@ if point is in a menu item description, follow that menu item." (save-excursion (goto-char (point-min)) (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t) - (setq str (buffer-substring - (match-beginning 1) - (1- (point)))) + (setq str (match-string 1)) (setq i 0) (while (setq i (string-match "[ \n\t]+" str i)) (setq str (concat (substring str 0 i) " " @@ -2739,11 +2772,32 @@ the variable `Info-file-list-for-emacs'." "Face for headers in Info menus." :group 'info) +(defun Info-escape-percent (string) + "Double all occurrences of `%' in STRING. + +Return a new string with all `%' characters replaced by `%%'. +Preserve text properties." + (let ((start 0) + (end (length string)) + mb me m matches) + (save-match-data + (while (and (< start end) (string-match "%" string start)) + (setq mb (match-beginning 0) + me (1+ mb) + m (substring string mb me) + matches (cons m + (cons m + (cons (substring string start mb) + matches))) + start me)) + (push (substring string start end) matches) + (apply #'concat (nreverse matches))))) + (defun Info-fontify-menu-headers () "Add the face `info-menu-header' to any header before a menu entry." (save-excursion (goto-char (point-min)) - (when (re-search-forward "\\* Menu:" nil t) + (when (re-search-forward "^\\* Menu:" nil t) (put-text-property (match-beginning 0) (match-end 0) 'font-lock-face 'info-menu-header) (while (re-search-forward "\n\n\\([^*\n ].*\\)\n\n?[*]" nil t) @@ -2794,7 +2848,7 @@ the variable `Info-file-list-for-emacs'." (let* ((nbeg (match-beginning 2)) (nend (match-end 2)) (tbeg (match-beginning 1)) - (tag (buffer-substring tbeg (match-end 1)))) + (tag (match-string 1))) (if (string-equal tag "Node") (put-text-property nbeg nend 'font-lock-face 'info-header-node) (put-text-property nbeg nend 'font-lock-face 'info-header-xref) @@ -2813,7 +2867,7 @@ the variable `Info-file-list-for-emacs'." ((equal tag "Up") Info-up-link-keymap)))))) (when Info-use-header-line (goto-char (point-min)) - (let ((header-end (save-excursion (end-of-line) (point))) + (let ((header-end (line-end-position)) header) ;; If we find neither Next: nor Prev: link, show the entire ;; node header. Otherwise, don't show the File: and Node: @@ -2825,14 +2879,14 @@ the variable `Info-file-list-for-emacs'." (progn (goto-char (match-beginning 1)) (setq header (buffer-substring (point) header-end))) - (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" nil t) + (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" header-end t) (setq header (concat "No next, prev or up links -- " (buffer-substring (point) header-end))) (setq header (buffer-substring (point) header-end)))) (put-text-property (point-min) (1+ (point-min)) - 'header-line header) + 'header-line (Info-escape-percent header)) ;; Hide the part of the first line ;; that is in the header, if it is just part. (unless (bobp) @@ -2855,7 +2909,7 @@ the variable `Info-file-list-for-emacs'." ;; on frames that can display the font above. (when (memq (framep (selected-frame)) '(x pc w32 mac)) (add-text-properties (1- (match-beginning 2)) (match-end 2) - '(invisible t)))) + '(invisible t front-sticky nil rear-nonsticky t)))) (goto-char (point-min)) (while (re-search-forward "\\(\\*Note[ \t]*\\)\n?[ \t]*\\([^:]*\\)\\(:[^.,:(]*\\(([^)]*)[^.,:]*\\)?[,:]?\n?\\)" nil t) (unless (= (char-after (1- (match-beginning 0))) ?\") ; hack @@ -2868,17 +2922,23 @@ the variable `Info-file-list-for-emacs'." (goto-char start) (skip-syntax-backward " ") (setq other-tag - (cond - ((<= (point) (point-min)) - "See ") - ((memq (char-before) '(nil ?\. ?! )) - "See ") - ((memq (char-before) '( ?\( ?\[ ?\{ ?\, ?\; ?\: )) - "see "))) + (cond ((memq (char-before) '(nil ?\. ?! ??)) + "See ") + ((memq (char-before) '(?\, ?\; ?\: ?-)) + "see ") + ((memq (char-before) '(?\( ?\[ ?\{)) + ;; Check whether the paren is preceded by + ;; an end of sentence + (skip-syntax-backward " (") + (if (memq (char-before) '(nil ?\. ?! ??)) + "See " + "see ")) + ((save-match-data (looking-at "\n\n")) + "See "))) (goto-char next)) (if hide-tag (add-text-properties (match-beginning 1) (match-end 1) - '(invisible t))) + '(invisible t front-sticky nil rear-nonsticky t))) (add-text-properties (match-beginning 2) (match-end 2) (cons 'help-echo @@ -2889,33 +2949,35 @@ the variable `Info-file-list-for-emacs'." mouse-face highlight)))) (when (eq Info-hide-note-references t) (add-text-properties (match-beginning 3) (match-end 3) - '(invisible t))) + '(invisible t front-sticky nil rear-nonsticky t))) (when other-tag (save-excursion (goto-char (match-beginning 1)) (insert other-tag))) - (when (or hide-tag (eq Info-hide-note-references t)) + (when (and Info-refill-paragraphs + (or hide-tag (eq Info-hide-note-references t))) (push (set-marker (make-marker) start) paragraph-markers))))) - (let ((fill-nobreak-invisible t) - (fill-individual-varying-indent nil) - (paragraph-start "\f\\|[ \t]*[-*]\\|[ \t]*$") - (paragraph-separate ".*\\.[ \t]*\n[ \t]\\|[ \t]*[-*]\\|[ \t\f]*$") - (adaptive-fill-mode nil)) - (goto-char (point-max)) - (while paragraph-markers - (let ((m (car paragraph-markers))) - (setq paragraph-markers (cdr paragraph-markers)) - (when (< m (point)) - (goto-char m) - (move-to-left-margin) - (when (zerop (forward-paragraph)) - (let ((end (point)) - (beg (progn (backward-paragraph) (point)))) - (fill-individual-paragraphs beg end nil nil) - (goto-char beg)))) - (set-marker m nil)))) + (when (and Info-refill-paragraphs + paragraph-markers) + (let ((fill-nobreak-invisible t) + (fill-individual-varying-indent nil) + (paragraph-start "\f\\|[ \t]*[-*]\\|[ \t]*$") + (paragraph-separate ".*\\.[ \t]*\n[ \t]\\|[ \t]*[-*]\\|[ \t\f]*$") + (adaptive-fill-mode nil)) + (goto-char (point-max)) + (while paragraph-markers + (let ((m (car paragraph-markers))) + (setq paragraph-markers (cdr paragraph-markers)) + (when (< m (point)) + (goto-char m) + (beginning-of-line) + (let ((beg (point))) + (when (zerop (forward-paragraph)) + (fill-individual-paragraphs beg (point) nil nil) + (goto-char beg)))) + (set-marker m nil))))) (goto-char (point-min)) (when (and (search-forward "\n* Menu:" nil t) @@ -2924,10 +2986,10 @@ the variable `Info-file-list-for-emacs'." (< (- (point-max) (point)) Info-fontify-maximum-menu-size)) (let ((n 0) cont) - (while (re-search-forward (concat "^\\* +\\([^:\t\n]*\\)\\(:" - Info-node-spec-re - "\\([ \t]*\\)\\)") - nil t) + (while (re-search-forward + (concat "^\\* +\\(" Info-menu-entry-name-re "\\)\\(:" + Info-node-spec-re "\\([ \t]*\\)\\)") + nil t) (setq n (1+ n)) (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys (put-text-property (match-beginning 0) @@ -2943,11 +3005,11 @@ the variable `Info-file-list-for-emacs'." '(font-lock-face info-xref mouse-face highlight)))) (when (eq Info-hide-note-references t) - (put-text-property (match-beginning 2) (match-beginning 4) + (put-text-property (match-beginning 2) (1- (match-end 6)) 'invisible t) ;; We need a stretchable space like :align-to but with ;; a minimum value. - (put-text-property (match-beginning 4) (match-end 4) 'display + (put-text-property (1- (match-end 6)) (match-end 6) 'display (if (>= 22 (- (match-end 1) (match-beginning 0))) '(space :align-to 24) @@ -2955,7 +3017,10 @@ the variable `Info-file-list-for-emacs'." (setq cont (looking-at ".")) (while (and (= (forward-line 1) 0) (looking-at "\\([ \t]+\\)[^*\n]")) - (put-text-property (match-beginning 1) (match-end 1) 'display + (put-text-property (match-beginning 1) (1- (match-end 1)) + 'invisible t) + (put-text-property (1- (match-end 1)) (match-end 1) + 'display (if cont '(space :align-to 26) '(space :align-to 24))) @@ -3166,4 +3231,5 @@ BUFFER is the buffer speedbar is requesting buttons for." (provide 'info) +;;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac ;;; info.el ends here