/[emacs]/emacs/lisp/info.el
ViewVC logotype

Diff of /emacs/lisp/info.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.360 by kfstorm, Fri Jul 4 21:40:22 2003 UTC revision 1.361 by monnier, Fri Jul 4 23:05:35 2003 UTC
# Line 910  a case-insensitive match is tried." Line 910  a case-insensitive match is tried."
910                      nodename end)                      nodename end)
911                  (re-search-backward "^\^_")                  (re-search-backward "^\^_")
912                  (search-forward "Node: ")                  (search-forward "Node: ")
913                  (setq nodename (Info-following-node-name))                  (setq nodename
914                          (and (looking-at (Info-following-node-name-re))
915                               (match-string 1)))
916                  (search-forward "\n\^_" nil 'move)                  (search-forward "\n\^_" nil 'move)
917                  (beginning-of-line)                  (beginning-of-line)
918                  (setq end (point))                  (setq end (point))
# Line 1209  If FORK is a string, it is the name to u Line 1211  If FORK is a string, it is the name to u
1211                    nodename)                    nodename)
1212      (setq filename (if (= (match-beginning 1) (match-end 1))      (setq filename (if (= (match-beginning 1) (match-end 1))
1213                         ""                         ""
1214                       (substring nodename (match-beginning 2) (match-end 2)))                       (match-string 2 nodename))
1215            nodename (substring nodename (match-beginning 3) (match-end 3)))            nodename (match-string 3 nodename))
1216      (let ((trim (string-match "\\s *\\'" filename)))      (let ((trim (string-match "\\s *\\'" filename)))
1217        (if trim (setq filename (substring filename 0 trim))))        (if trim (setq filename (substring filename 0 trim))))
1218      (let ((trim (string-match "\\s *\\'" nodename)))      (let ((trim (string-match "\\s *\\'" nodename)))
# Line 1393  If FORK is a string, it is the name to u Line 1395  If FORK is a string, it is the name to u
1395  (defun Info-extract-pointer (name &optional errorname)  (defun Info-extract-pointer (name &optional errorname)
1396    "Extract the value of the node-pointer named NAME.    "Extract the value of the node-pointer named NAME.
1397  If there is none, use ERRORNAME in the error message;  If there is none, use ERRORNAME in the error message;
1398  if ERRORNAME is nil, just return nil.  if ERRORNAME is nil, just return nil."
1399  Bind this in case the user sets it to nil."    ;; Bind this in case the user sets it to nil.
1400    (let ((case-fold-search t))    (let ((case-fold-search t))
1401      (save-excursion      (save-excursion
1402        (save-restriction        (goto-char (point-min))
1403          (goto-char (point-min))        (let ((bound (point)))
1404          (let ((bound (point)))          (forward-line 1)
1405            (forward-line 1)          (cond ((re-search-backward
1406            (cond ((re-search-backward (concat name ":") bound t)                  (concat name ":" (Info-following-node-name-re)) bound t)
1407                   (goto-char (match-end 0))                 (match-string 1))
1408                   (Info-following-node-name))                ((not (eq errorname t))
1409                  ((not (eq errorname t))                 (error "Node has no %s"
1410                   (error "Node has no %s"                        (capitalize (or errorname name)))))))))
                         (capitalize (or errorname name))))))))))  
1411    
1412  (defun Info-following-node-name (&optional allowedchars)  (defun Info-following-node-name-re (&optional allowedchars)
1413    "Return the node name in the buffer following point.    "Return a regexp matching a node name.
1414  ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp  ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp
1415  saying which chars may appear in the node name."  saying which chars may appear in the node name.
1416    (skip-chars-forward " \t")  Submatch 1 is the complete node name.
1417    (buffer-substring-no-properties  Submatch 2 if non-nil is the parenthesized file name part of the node name.
1418     (point)  Submatch 3 is the local part of the node name.
1419     (progn  End of submatch 0, 1, and 3 are the same, so you can safely concat."
1420       (while (looking-at (concat "[" (or allowedchars "^,\t\n") "]"))    (concat "[ \t]*"                      ;Skip leading space.
1421         (skip-chars-forward (concat (or allowedchars "^,\t\n") "("))            "\\(\\(([^)]+)\\)?"   ;Node name can start with a file name.
1422         (if (looking-at "(")            "\\([" (or allowedchars "^,\t\n") "]*" ;Any number of allowed chars.
1423             (skip-chars-forward "^)")))            "[" (or allowedchars "^,\t\n") " ]" ;The last char can't be a space.
1424       (skip-chars-backward " ")            "\\|\\)\\)"))                       ;Allow empty node names.
      (point))))  
1425    
1426  (defun Info-next ()  (defun Info-next ()
1427    "Go to the next node of this node."    "Go to the next node of this node."
# Line 1480  FOOTNOTENAME may be an abbreviation of t Line 1480  FOOTNOTENAME may be an abbreviation of t
1480    
1481         (goto-char (point-min))         (goto-char (point-min))
1482         (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)         (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
1483           (setq str (buffer-substring-no-properties           (setq str (match-string-no-properties 1))
                     (match-beginning 1)  
                     (1- (point))))  
1484           ;; See if this one should be the default.           ;; See if this one should be the default.
1485           (and (null default)           (and (null default)
1486                (<= (match-beginning 0) start-point)                (<= (match-beginning 0) start-point)
# Line 1502  FOOTNOTENAME may be an abbreviation of t Line 1500  FOOTNOTENAME may be an abbreviation of t
1500           (if (eq default t) (setq default str))           (if (eq default t) (setq default str))
1501           (if (eq alt-default t) (setq alt-default str))           (if (eq alt-default t) (setq alt-default str))
1502           ;; Don't add this string if it's a duplicate.           ;; Don't add this string if it's a duplicate.
1503           ;; We use a loop instead of "(assoc str completions)" because           (or (assoc-string str completions t)
1504           ;; we want to do a case-insensitive compare.               (push str completions))))
          (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))))))  
1505       ;; If no good default was found, try an alternate.       ;; If no good default was found, try an alternate.
1506       (or default       (or default
1507           (setq default alt-default))           (setq default alt-default))
1508       ;; If only one cross-reference found, then make it default.       ;; If only one cross-reference found, then make it default.
1509       (if (eq (length completions) 1)       (if (eq (length completions) 1)
1510           (setq default (car (car completions))))           (setq default (car completions)))
1511       (if completions       (if completions
1512           (let ((input (completing-read (if default           (let ((input (completing-read (if default
1513                                             (concat                                             (concat
# Line 1551  FOOTNOTENAME may be an abbreviation of t Line 1540  FOOTNOTENAME may be an abbreviation of t
1540        (setq i (+ i 1)))        (setq i (+ i 1)))
1541      (Info-goto-node target)))      (Info-goto-node target)))
1542    
1543    (defconst Info-menu-entry-name-re "\\(?:[^:\n]+\\|:[^,.;() \t\n]\\)*"
1544      "Regexp that matches a menu entry name upto but not including the colon.
1545    Because of ambiguities, this should be concatenated with something like
1546    `:' and `Info-following-node-name-re'.")
1547    
1548  (defun Info-extract-menu-node-name (&optional multi-line)  (defun Info-extract-menu-node-name (&optional multi-line)
1549    (skip-chars-forward " \t\n")    (skip-chars-forward " \t\n")
1550    (let ((beg (point))    (when (looking-at (concat Info-menu-entry-name-re ":\\(:\\|"
1551          str)                              (Info-following-node-name-re
1552      (while (progn                               (if multi-line "^.,\t" "^.,\t\n")) "\\)"))
1553               (skip-chars-forward "^:")      (replace-regexp-in-string
1554               (forward-char 1)       "[ \n]+" " "
1555               (not (looking-at ":*[,.;() \t\n]"))))       (or (match-string 2)
1556      (setq str           ;; If the node name is the menu entry name (using `entry::').
1557            (if (looking-at ":")           (buffer-substring (match-beginning 0) (1- (match-beginning 1)))))))
               (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)))  
1558    
1559  ;; No one calls this.  ;; No one calls this.
1560  ;;(defun Info-menu-item-sequence (list)  ;;(defun Info-menu-item-sequence (list)
# Line 1576  FOOTNOTENAME may be an abbreviation of t Line 1566  FOOTNOTENAME may be an abbreviation of t
1566  (defvar Info-complete-next-re nil)  (defvar Info-complete-next-re nil)
1567  (defvar Info-complete-cache nil)  (defvar Info-complete-cache nil)
1568    
1569  (defconst Info-node-spec-re "[^.,:(]*\\(([^)]*)[^.,:]*\\)?[,:.]"  (defconst Info-node-spec-re
1570      (concat (Info-following-node-name-re "^.,:") "[,:.]")
1571    "Regexp to match the text after a : until the terminating `.'.")    "Regexp to match the text after a : until the terminating `.'.")
1572    
1573  (defun Info-complete-menu-item (string predicate action)  (defun Info-complete-menu-item (string predicate action)
# Line 1603  FOOTNOTENAME may be an abbreviation of t Line 1594  FOOTNOTENAME may be an abbreviation of t
1594             (concat "\n\\* +" (regexp-quote string) ":") nil t)             (concat "\n\\* +" (regexp-quote string) ":") nil t)
1595          (let ((pattern (concat "\n\\* +\\("          (let ((pattern (concat "\n\\* +\\("
1596                                 (regexp-quote string)                                 (regexp-quote string)
1597                                 "[^\t\n]*?\\):" Info-node-spec-re))                                 Info-menu-entry-name-re "\\):" Info-node-spec-re))
1598                completions)                completions)
1599            ;; Check the cache.            ;; Check the cache.
1600            (if (and (equal (nth 0 Info-complete-cache) Info-current-file)            (if (and (equal (nth 0 Info-complete-cache) Info-current-file)
# Line 2382  if point is in a menu item description, Line 2373  if point is in a menu item description,
2373            (save-excursion            (save-excursion
2374              (goto-char (point-min))              (goto-char (point-min))
2375              (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)              (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
2376                (setq str (buffer-substring                (setq str (match-string 1))
                          (match-beginning 1)  
                          (1- (point))))  
2377                (setq i 0)                (setq i 0)
2378                (while (setq i (string-match "[ \n\t]+" str i))                (while (setq i (string-match "[ \n\t]+" str i))
2379                  (setq str (concat (substring str 0 i) " "                  (setq str (concat (substring str 0 i) " "
# Line 2807  the variable `Info-file-list-for-emacs'. Line 2796  the variable `Info-file-list-for-emacs'.
2796              (let* ((nbeg (match-beginning 2))              (let* ((nbeg (match-beginning 2))
2797                     (nend (match-end 2))                     (nend (match-end 2))
2798                     (tbeg (match-beginning 1))                     (tbeg (match-beginning 1))
2799                     (tag (buffer-substring tbeg (match-end 1))))                     (tag (match-string 1)))
2800                (if (string-equal tag "Node")                (if (string-equal tag "Node")
2801                    (put-text-property nbeg nend 'font-lock-face 'info-header-node)                    (put-text-property nbeg nend 'font-lock-face 'info-header-node)
2802                  (put-text-property nbeg nend 'font-lock-face 'info-header-xref)                  (put-text-property nbeg nend 'font-lock-face 'info-header-xref)
# Line 2826  the variable `Info-file-list-for-emacs'. Line 2815  the variable `Info-file-list-for-emacs'.
2815                                      ((equal tag "Up") Info-up-link-keymap))))))                                      ((equal tag "Up") Info-up-link-keymap))))))
2816            (when Info-use-header-line            (when Info-use-header-line
2817              (goto-char (point-min))              (goto-char (point-min))
2818              (let ((header-end (save-excursion (end-of-line) (point)))              (let ((header-end (line-end-position))
2819                    header)                    header)
2820                ;; If we find neither Next: nor Prev: link, show the entire                ;; If we find neither Next: nor Prev: link, show the entire
2821                ;; node header.  Otherwise, don't show the File: and Node:                ;; node header.  Otherwise, don't show the File: and Node:
# Line 2838  the variable `Info-file-list-for-emacs'. Line 2827  the variable `Info-file-list-for-emacs'.
2827                    (progn                    (progn
2828                      (goto-char (match-beginning 1))                      (goto-char (match-beginning 1))
2829                      (setq header (buffer-substring (point) header-end)))                      (setq header (buffer-substring (point) header-end)))
2830                  (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" nil t)                  (if (re-search-forward "node:[ \t]*[^ \t]+[ \t]*" header-end t)
2831                      (setq header                      (setq header
2832                            (concat "No next, prev or up links  --  "                            (concat "No next, prev or up links  --  "
2833                                    (buffer-substring (point) header-end)))                                    (buffer-substring (point) header-end)))
# Line 2945  the variable `Info-file-list-for-emacs'. Line 2934  the variable `Info-file-list-for-emacs'.
2934                     (< (- (point-max) (point)) Info-fontify-maximum-menu-size))                     (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
2935            (let ((n 0)            (let ((n 0)
2936                  cont)                  cont)
2937              (while (re-search-forward (concat "^\\* +\\([^:\t\n]*\\)\\(:"              (while (re-search-forward
2938                                                Info-node-spec-re                      (concat "^\\* +\\(" Info-menu-entry-name-re "\\)\\(:"
2939                                                "\\([ \t]*\\)\\)")                              Info-node-spec-re "\\([ \t]*\\)\\)")
2940                                        nil t)                      nil t)
2941                (setq n (1+ n))                (setq n (1+ n))
2942                (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys                (if (and (<= n 9) (zerop (% n 3))) ; visual aids to help with 1-9 keys
2943                    (put-text-property (match-beginning 0)                    (put-text-property (match-beginning 0)
# Line 2964  the variable `Info-file-list-for-emacs'. Line 2953  the variable `Info-file-list-for-emacs'.
2953                        '(font-lock-face info-xref                        '(font-lock-face info-xref
2954                          mouse-face highlight))))                          mouse-face highlight))))
2955                (when (eq Info-hide-note-references t)                (when (eq Info-hide-note-references t)
2956                  (put-text-property (match-beginning 2) (1- (match-end 4))                  (put-text-property (match-beginning 2) (1- (match-end 6))
2957                                     'invisible t)                                     'invisible t)
2958                  ;; We need a stretchable space like :align-to but with                  ;; We need a stretchable space like :align-to but with
2959                  ;; a minimum value.                  ;; a minimum value.
2960                  (put-text-property (1- (match-end 4)) (match-end 4) 'display                  (put-text-property (1- (match-end 6)) (match-end 6) 'display
2961                                     (if (>= 22 (- (match-end 1)                                     (if (>= 22 (- (match-end 1)
2962                                                   (match-beginning 0)))                                                   (match-beginning 0)))
2963                                         '(space :align-to 24)                                         '(space :align-to 24)

Legend:
Removed from v.1.360  
changed lines
  Added in v.1.361

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26