comparison lisp/info.el @ 51735:204ae43066d1

(Info-following-node-name-re): New fun. (Info-following-node-name): Remove. (Info-insert-dir): Use the new fun. (Info-extract-pointer): Don't save restriction; use new fun. (Info-menu-entry-name-re): New const. (Info-menu-entry-name-re): Use it along with new fun. (Info-node-spec-re): Use new fun. (Info-complete-menu-item, Info-fontify-node): Use new const. (Info-goto-node, Info-follow-reference, Info-menu-update): Use match-string. (Info-follow-reference): Use assoc-string. Use a list of strings for the completion table. (Info-fontify-node): Use match-string, line-end-position. Limit the search for `node:' to the first line.

51734:400a9c7868fd

	      (while (and (zerop (forward-line 1)) (eolp)))
	      (let ((beg (point))
		    nodename end)
		(re-search-backward "^\^_")
		(search-forward "Node: ")
		(setq nodename (Info-following-node-name))
		(search-forward "\n\^_" nil 'move)
		(beginning-of-line)
		(setq end (point))
		(push (list nodename other beg end) this-buffer-nodes)))
	    (if (assoc-ignore-case "top" this-buffer-nodes)

  (let (filename)
    (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)"
		  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)))
    (let ((trim (string-match "\\s *\\'" filename)))
      (if trim (setq filename (substring filename 0 trim))))
    (let ((trim (string-match "\\s *\\'" nodename)))
      (if trim (setq nodename (substring nodename 0 trim))))
    (if transient-mark-mode (deactivate-mark))

				   Info-history))))))

(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."
  (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.
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))))

(defun Info-next ()
  "Go to the next node of this node."
  (interactive)
  (Info-goto-node (Info-extract-pointer "next")))

       (beginning-of-line)
       (setq bol (point))

       (goto-char (point-min))
       (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
	 (setq str (buffer-substring-no-properties
		    (match-beginning 1)
		    (1- (point))))
	 ;; See if this one should be the default.
	 (and (null default)
	      (<= (match-beginning 0) start-point)
	      (<= start-point (point))
	      (setq default t))

	   (setq i (1+ i)))
	 ;; Record as a completion and perhaps as default.
	 (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))))))
     ;; 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))))
     (if completions
	 (let ((input (completing-read (if default
					   (concat
					    "Follow reference named: (default "
					    default ") ")

      (setq target (concat (substring target 0 i) " "
			   (substring target (match-end 0))))
      (setq i (+ i 1)))
    (Info-goto-node target)))

(defun Info-extract-menu-node-name (&optional multi-line)
  (skip-chars-forward " \t\n")
  (let ((beg (point))
	str)
    (while (progn
	     (skip-chars-forward "^:")
	     (forward-char 1)
	     (not (looking-at ":*[,.;() \t\n]"))))
    (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)))

;; No one calls this.
;;(defun Info-menu-item-sequence (list)
;;  (while list
;;    (Info-menu (car list))

(defvar Info-complete-menu-buffer)
(defvar Info-complete-next-re nil)
(defvar Info-complete-cache nil)

(defconst Info-node-spec-re "[^.,:(]*\\(([^)]*)[^.,:]*\\)?[,:.]"
  "Regexp to match the text after a : until the terminating `.'.")

(defun Info-complete-menu-item (string predicate action)
  ;; This uses two dynamically bound variables:
  ;; - `Info-complete-menu-buffer' which contains the buffer in which

      (if (not (memq action '(nil t)))
	  (re-search-forward
	   (concat "\n\\* +" (regexp-quote string) ":") nil t)
	(let ((pattern (concat "\n\\* +\\("
			       (regexp-quote string)
			       "[^\t\n]*?\\):" Info-node-spec-re))
	      completions)
	  ;; Check the cache.
	  (if (and (equal (nth 0 Info-complete-cache) Info-current-file)
		   (equal (nth 1 Info-complete-cache) Info-current-node)
		   (equal (nth 2 Info-complete-cache) Info-complete-next-re)

	      (number 0)
	      (case-fold-search t))
	  (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 i 0)
	      (while (setq i (string-match "[ \n\t]+" str i))
		(setq str (concat (substring str 0 i) " "
				  (substring str (match-end 0))))
		(setq i (1+ i)))

	  (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
	    (goto-char (match-end 0))
	    (let* ((nbeg (match-beginning 2))
		   (nend (match-end 2))
		   (tbeg (match-beginning 1))
		   (tag (buffer-substring tbeg (match-end 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)
		(put-text-property tbeg nend 'mouse-face 'highlight)
		(put-text-property tbeg nend

				    ((equal tag "Prev") Info-prev-link-keymap)
				    ((equal tag "Next") Info-next-link-keymap)
				    ((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)))
		  header)
	      ;; If we find neither Next: nor Prev: link, show the entire
	      ;; node header.  Otherwise, don't show the File: and Node:
	      ;; parts, to avoid wasting precious space on information that
	      ;; is available in the mode line.

		   "\\(next\\|up\\|prev[ious]*\\): "
		   header-end t)
		  (progn
		    (goto-char (match-beginning 1))
		    (setq header (buffer-substring (point) header-end)))
		(if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" nil t)
		    (setq header
			  (concat "No next, prev or up links  --  "
				  (buffer-substring (point) header-end)))
		  (setq header (buffer-substring (point) header-end))))

		   (not (string-match "\\<Index\\>" Info-current-node))
		   ;; Don't take time to annotate huge menus
		   (< (- (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)
	      (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)
				     (1+ (match-beginning 0))
				     'font-lock-face 'info-menu-5))

			  (concat "mouse-2: go to " (match-string 3))
			"mouse-2: go to this node")
		      '(font-lock-face info-xref
			mouse-face highlight))))
	      (when (eq Info-hide-note-references t)
		(put-text-property (match-beginning 2) (1- (match-end 4))
				   'invisible t)
		;; We need a stretchable space like :align-to but with
		;; a minimum value.
		(put-text-property (1- (match-end 4)) (match-end 4) 'display
				   (if (>= 22 (- (match-end 1)
						 (match-beginning 0)))
				       '(space :align-to 24)
				     '(space :width 2)))
		(setq cont (looking-at "."))

51735:204ae43066d1

	      (while (and (zerop (forward-line 1)) (eolp)))
	      (let ((beg (point))
		    nodename end)
		(re-search-backward "^\^_")
		(search-forward "Node: ")
		(setq nodename
		      (and (looking-at (Info-following-node-name-re))
			   (match-string 1)))
		(search-forward "\n\^_" nil 'move)
		(beginning-of-line)
		(setq end (point))
		(push (list nodename other beg end) this-buffer-nodes)))
	    (if (assoc-ignore-case "top" this-buffer-nodes)

  (let (filename)
    (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)"
		  nodename)
    (setq filename (if (= (match-beginning 1) (match-end 1))
		       ""
		     (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)))
      (if trim (setq nodename (substring nodename 0 trim))))
    (if transient-mark-mode (deactivate-mark))

				   Info-history))))))

(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.
  (let ((case-fold-search t))
    (save-excursion
      (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.
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.

(defun Info-next ()
  "Go to the next node of this node."
  (interactive)
  (Info-goto-node (Info-extract-pointer "next")))

       (beginning-of-line)
       (setq bol (point))

       (goto-char (point-min))
       (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
	 (setq str (match-string-no-properties 1))
	 ;; See if this one should be the default.
	 (and (null default)
	      (<= (match-beginning 0) start-point)
	      (<= start-point (point))
	      (setq default t))

	   (setq i (1+ i)))
	 ;; Record as a completion and perhaps as default.
	 (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.
	 (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 completions)))
     (if completions
	 (let ((input (completing-read (if default
					   (concat
					    "Follow reference named: (default "
					    default ") ")

      (setq target (concat (substring target 0 i) " "
			   (substring target (match-end 0))))
      (setq i (+ i 1)))
    (Info-goto-node target)))

(defconst Info-menu-entry-name-re "\\(?:[^:\n]+\\|:[^,.;() \t\n]\\)*"
  "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")
  (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)
;;  (while list
;;    (Info-menu (car list))

(defvar Info-complete-menu-buffer)
(defvar Info-complete-next-re nil)
(defvar Info-complete-cache nil)

(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)
  ;; This uses two dynamically bound variables:
  ;; - `Info-complete-menu-buffer' which contains the buffer in which

      (if (not (memq action '(nil t)))
	  (re-search-forward
	   (concat "\n\\* +" (regexp-quote string) ":") nil t)
	(let ((pattern (concat "\n\\* +\\("
			       (regexp-quote string)
			       Info-menu-entry-name-re "\\):" Info-node-spec-re))
	      completions)
	  ;; Check the cache.
	  (if (and (equal (nth 0 Info-complete-cache) Info-current-file)
		   (equal (nth 1 Info-complete-cache) Info-current-node)
		   (equal (nth 2 Info-complete-cache) Info-complete-next-re)

	      (number 0)
	      (case-fold-search t))
	  (save-excursion
	    (goto-char (point-min))
	    (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
	      (setq str (match-string 1))
	      (setq i 0)
	      (while (setq i (string-match "[ \n\t]+" str i))
		(setq str (concat (substring str 0 i) " "
				  (substring str (match-end 0))))
		(setq i (1+ i)))

	  (while (looking-at "[ \t]*\\([^:, \t\n]+\\):[ \t]+\\([^:,\t\n]+\\),?")
	    (goto-char (match-end 0))
	    (let* ((nbeg (match-beginning 2))
		   (nend (match-end 2))
		   (tbeg (match-beginning 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)
		(put-text-property tbeg nend 'mouse-face 'highlight)
		(put-text-property tbeg nend

				    ((equal tag "Prev") Info-prev-link-keymap)
				    ((equal tag "Next") Info-next-link-keymap)
				    ((equal tag "Up") Info-up-link-keymap))))))
	  (when Info-use-header-line
	    (goto-char (point-min))
	    (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:
	      ;; parts, to avoid wasting precious space on information that
	      ;; is available in the mode line.

		   "\\(next\\|up\\|prev[ious]*\\): "
		   header-end t)
		  (progn
		    (goto-char (match-beginning 1))
		    (setq header (buffer-substring (point) header-end)))
		(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))))

		   (not (string-match "\\<Index\\>" Info-current-node))
		   ;; Don't take time to annotate huge menus
		   (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
	  (let ((n 0)
		cont)
	    (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)
				     (1+ (match-beginning 0))
				     'font-lock-face 'info-menu-5))

			  (concat "mouse-2: go to " (match-string 3))
			"mouse-2: go to this node")
		      '(font-lock-face info-xref
			mouse-face highlight))))
	      (when (eq Info-hide-note-references t)
		(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 (1- (match-end 6)) (match-end 6) 'display
				   (if (>= 22 (- (match-end 1)
						 (match-beginning 0)))
				       '(space :align-to 24)
				     '(space :width 2)))
		(setq cont (looking-at "."))