X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5938202c7df85400fe553745d8012f908fe827da..69008bcff4efd4190e3628299580313875a74080:/lisp/info.el diff --git a/lisp/info.el b/lisp/info.el index cefe603a40..b34fd013df 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1,7 +1,7 @@ ;;; info.el --- info package for Emacs -;; Copyright (C) 1985,86,92,93,94,95,96,97,98,99,2000,01,02,03,2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help @@ -83,7 +83,11 @@ The Lisp code is executed when the node is selected.") :group 'info) (defface info-xref - '((((class color) (background light)) :foreground "blue" :underline t) + '((((min-colors 88) + (class color) (background light)) :foreground "blue1" :underline t) + (((class color) (background light)) :foreground "blue" :underline t) + (((min-colors 88) + (class color) (background dark)) :foreground "cyan1" :underline t) (((class color) (background dark)) :foreground "cyan" :underline t) (t :underline t)) "Face for Info cross-references." @@ -511,9 +515,10 @@ in all the directories in that path." ;; since the argument will then be parsed improperly. This also ;; has the added benefit of allowing node names to be included ;; following the parenthesized filename. - (if (and (stringp file) (string-match "(.*)" file)) - (Info-goto-node file) - (Info-goto-node (concat "(" file ")"))) + (Info-goto-node + (if (and (stringp file) (string-match "(.*)" file)) + file + (concat "(" file ")"))) (if (zerop (buffer-size)) (Info-directory)))) @@ -1340,7 +1345,9 @@ any double quotes or backslashes must be escaped (\\\",\\\\)." ;; Go to an info node specified with a filename-and-nodename string ;; of the sort that is found in pointers in nodes. -;;;###autoload +;; Don't autoload this function: the correct entry point for other packages +;; to use is `info'. --Stef +;; ;;;###autoload (defun Info-goto-node (nodename &optional fork) "Go to info node named NODENAME. Give just NODENAME or (FILENAME)NODENAME. If NODENAME is of the form (FILENAME)NODENAME, the node is in the Info file @@ -1372,6 +1379,43 @@ If FORK is a string, it is the name to use for the new buffer." (defvar Info-read-node-completion-table) +(defun Info-read-node-name-2 (string path-and-suffixes action) + "Virtual completion table for file names input in Info node names. +PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." + (let* ((names nil) + (suffixes (remove "" (cdr path-and-suffixes))) + (suffix (concat (regexp-opt suffixes t) "\\'")) + (string-dir (file-name-directory string)) + (dirs + (if (file-name-absolute-p string) + (list (file-name-directory string)) + (car path-and-suffixes)))) + (dolist (dir dirs) + (unless dir + (setq dir default-directory)) + (if string-dir (setq dir (expand-file-name string-dir dir))) + (when (file-directory-p dir) + (dolist (file (file-name-all-completions + (file-name-nondirectory string) dir)) + ;; If the file name has no suffix or a standard suffix, + ;; include it. + (and (or (null (file-name-extension file)) + (string-match suffix file)) + ;; But exclude subfiles of split info files. + (not (string-match "-[0-9]+\\'" file)) + ;; And exclude backup files. + (not (string-match "~\\'" file)) + (push (if string-dir (concat string-dir file) file) names)) + ;; If the file name ends in a standard suffix, + ;; add the unsuffixed name as a completion option. + (when (string-match suffix file) + (setq file (substring file 0 (match-beginning 0))) + (push (if string-dir (concat string-dir file) file) names))))) + (cond + ((eq action t) (all-completions string names)) + ((null action) (try-completion string names)) + (t (test-completion string names))))) + ;; This function is used as the "completion table" while reading a node name. ;; It does completion using the alist in Info-read-node-completion-table ;; unless STRING starts with an open-paren. @@ -1382,15 +1426,16 @@ If FORK is a string, it is the name to use for the new buffer." (let ((file (substring string 1))) (cond ((eq code nil) - (let ((comp (try-completion file 'locate-file-completion + (let ((comp (try-completion file 'Info-read-node-name-2 (cons Info-directory-list (mapcar 'car Info-suffix-list))))) (cond ((eq comp t) (concat string ")")) (comp (concat "(" comp))))) - ((eq code t) (all-completions file 'locate-file-completion - (cons Info-directory-list - (mapcar 'car Info-suffix-list)))) + ((eq code t) + (all-completions file 'Info-read-node-name-2 + (cons Info-directory-list + (mapcar 'car Info-suffix-list)))) (t nil)))) ;; If a file name was given, then any node is fair game. ((string-match "\\`(" string) @@ -1406,6 +1451,10 @@ If FORK is a string, it is the name to use for the new buffer." (t (test-completion string Info-read-node-completion-table predicate)))) +;; Arrange to highlight the proper letters in the completion list buffer. +(put 'Info-read-node-name-1 'completion-base-size-function + (lambda () 1)) + (defun Info-read-node-name (prompt &optional default) (let* ((completion-ignore-case t) (Info-read-node-completion-table (Info-build-node-completions)) @@ -3239,7 +3288,10 @@ Advanced commands: (make-local-variable 'line-move-ignore-invisible) (setq line-move-ignore-invisible t) (make-local-variable 'desktop-save-buffer) + (make-local-variable 'widen-automatically) + (setq widen-automatically nil) (setq desktop-save-buffer 'Info-desktop-buffer-misc-data) + (add-hook 'kill-buffer-hook 'Info-kill-buffer nil t) (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (add-hook 'isearch-mode-hook 'Info-isearch-start nil t) @@ -3252,7 +3304,14 @@ Advanced commands: (set (make-local-variable 'search-whitespace-regexp) Info-search-whitespace-regexp) (Info-set-mode-line) - (run-hooks 'Info-mode-hook)) + (run-mode-hooks 'Info-mode-hook)) + +;; When an Info buffer is killed, make sure the associated tags buffer +;; is killed too. +(defun Info-kill-buffer () + (and (eq major-mode 'Info-mode) + Info-tag-table-buffer + (kill-buffer Info-tag-table-buffer))) (defun Info-clone-buffer-hook () (when (bufferp Info-tag-table-buffer) @@ -3287,7 +3346,7 @@ which returns to Info mode for browsing. (setq buffer-read-only nil) (force-mode-line-update) (buffer-enable-undo (current-buffer)) - (run-hooks 'Info-edit-mode-hook)) + (run-mode-hooks 'Info-edit-mode-hook)) (defun Info-edit () "Edit the contents of this Info node. @@ -3465,29 +3524,37 @@ the variable `Info-file-list-for-emacs'." (t (Info-goto-emacs-command-node command))))) -(defface Info-title-1-face - '((((type tty pc) (class color)) :foreground "yellow" :weight bold) - (t :height 1.2 :inherit Info-title-2-face)) - "Face for Info titles at level 1." +(defface info-title-1 + '((((type tty pc) (class color)) :foreground "green" :weight bold) + (t :height 1.2 :inherit info-title-2)) + "Face for info titles at level 1." :group 'info) +;; backward-compatibility alias +(put 'Info-title-1-face 'face-alias 'info-title-1) -(defface Info-title-2-face +(defface info-title-2 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) - (t :height 1.2 :inherit Info-title-3-face)) - "Face for Info titles at level 2." + (t :height 1.2 :inherit info-title-3)) + "Face for info titles at level 2." :group 'info) +;; backward-compatibility alias +(put 'Info-title-2-face 'face-alias 'info-title-2) -(defface Info-title-3-face +(defface info-title-3 '((((type tty pc) (class color)) :weight bold) - (t :height 1.2 :inherit Info-title-4-face)) - "Face for Info titles at level 3." + (t :height 1.2 :inherit info-title-4)) + "Face for info titles at level 3." :group 'info) +;; backward-compatibility alias +(put 'Info-title-3-face 'face-alias 'info-title-3) -(defface Info-title-4-face +(defface info-title-4 '((((type tty pc) (class color)) :weight bold) (t :weight bold :inherit variable-pitch)) - "Face for Info titles at level 4." + "Face for info titles at level 4." :group 'info) +;; backward-compatibility alias +(put 'Info-title-4-face 'face-alias 'info-title-4) (defface info-menu-header '((((type tty pc)) @@ -3627,10 +3694,10 @@ Preserve text properties." nil t) (let* ((c (preceding-char)) (face - (cond ((= c ?*) 'Info-title-1-face) - ((= c ?=) 'Info-title-2-face) - ((= c ?-) 'Info-title-3-face) - (t 'Info-title-4-face)))) + (cond ((= c ?*) 'info-title-1) + ((= c ?=) 'info-title-2) + ((= c ?-) 'info-title-3) + (t 'info-title-4)))) (put-text-property (match-beginning 1) (match-end 1) 'font-lock-face face)) ;; This is a serious problem for trying to handle multiple @@ -3787,77 +3854,78 @@ Preserve text properties." (let ((n 0) cont) (while (re-search-forward - (concat "^\\* +\\(" Info-menu-entry-name-re "\\)\\(:" - Info-node-spec-re "\\([ \t]*\\)\\)") + (concat "^\\* Menu:\\|\\(?:^\\* +\\(" Info-menu-entry-name-re "\\)\\(:" + Info-node-spec-re "\\([ \t]*\\)\\)\\)") nil t) - (when not-fontified-p - (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))) - (when not-fontified-p - (add-text-properties - (match-beginning 1) (match-end 1) - (list - 'help-echo (if (and (match-end 3) - (not (equal (match-string 3) ""))) - (concat "mouse-2: go to " (match-string 3)) - "mouse-2: go to this node") - 'mouse-face 'highlight))) - (when (or not-fontified-p fontify-visited-p) - (add-text-properties - (match-beginning 1) (match-end 1) - (list - 'font-lock-face - ;; Display visited menu items in a different face - (if (and Info-fontify-visited-nodes - (save-match-data - (let ((node (if (equal (match-string 3) "") - (match-string 1) - (match-string 3))) - (file (file-name-nondirectory Info-current-file)) - (hl Info-history-list) - res) - (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) - (setq file (file-name-nondirectory - (match-string 1 node)) - node (if (equal (match-string 2 node) "") - "Top" - (match-string 2 node)))) - (while hl - (if (and (string-equal node (nth 1 (car hl))) - (string-equal file - (file-name-nondirectory - (nth 0 (car hl))))) - (setq res (car hl) hl nil) - (setq hl (cdr hl)))) - res))) 'info-xref-visited 'info-xref)))) - (when (and not-fontified-p (memq Info-hide-note-references '(t hide))) - (put-text-property (match-beginning 2) (1- (match-end 6)) - 'invisible t) - ;; Unhide the file name in parens - (if (and (match-end 4) (not (eq (char-after (match-end 4)) ?.))) - (remove-text-properties (match-beginning 4) (match-end 4) - '(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 ".")) - (while (and (= (forward-line 1) 0) - (looking-at "\\([ \t]+\\)[^*\n]")) - (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))) - (setq cont t)))))) + (when (match-beginning 1) + (when not-fontified-p + (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))) + (when not-fontified-p + (add-text-properties + (match-beginning 1) (match-end 1) + (list + 'help-echo (if (and (match-end 3) + (not (equal (match-string 3) ""))) + (concat "mouse-2: go to " (match-string 3)) + "mouse-2: go to this node") + 'mouse-face 'highlight))) + (when (or not-fontified-p fontify-visited-p) + (add-text-properties + (match-beginning 1) (match-end 1) + (list + 'font-lock-face + ;; Display visited menu items in a different face + (if (and Info-fontify-visited-nodes + (save-match-data + (let ((node (if (equal (match-string 3) "") + (match-string 1) + (match-string 3))) + (file (file-name-nondirectory Info-current-file)) + (hl Info-history-list) + res) + (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) + (setq file (file-name-nondirectory + (match-string 1 node)) + node (if (equal (match-string 2 node) "") + "Top" + (match-string 2 node)))) + (while hl + (if (and (string-equal node (nth 1 (car hl))) + (string-equal file + (file-name-nondirectory + (nth 0 (car hl))))) + (setq res (car hl) hl nil) + (setq hl (cdr hl)))) + res))) 'info-xref-visited 'info-xref)))) + (when (and not-fontified-p (memq Info-hide-note-references '(t hide))) + (put-text-property (match-beginning 2) (1- (match-end 6)) + 'invisible t) + ;; Unhide the file name in parens + (if (and (match-end 4) (not (eq (char-after (match-end 4)) ?.))) + (remove-text-properties (match-beginning 4) (match-end 4) + '(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 ".")) + (while (and (= (forward-line 1) 0) + (looking-at "\\([ \t]+\\)[^*\n]")) + (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))) + (setq cont t))))))) ;; Fontify menu headers ;; Add the face `info-menu-header' to any header before a menu entry @@ -3887,16 +3955,6 @@ Preserve text properties." (set-buffer-modified-p nil)))) - -;; When an Info buffer is killed, make sure the associated tags buffer -;; is killed too. -(defun Info-kill-buffer () - (and (eq major-mode 'Info-mode) - Info-tag-table-buffer - (kill-buffer Info-tag-table-buffer))) - -(add-hook 'kill-buffer-hook 'Info-kill-buffer) - ;;; Speedbar support: ;; These functions permit speedbar to display the "tags" in the ;; current info node. @@ -4122,5 +4180,5 @@ BUFFER is the buffer speedbar is requesting buttons for." (provide 'info) -;;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac +;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac ;;; info.el ends here