;;; info.el --- info package for Emacs
;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(if decoder
(progn
(insert-file-contents-literally fullname visit)
- (let ((buffer-read-only nil)
+ (let ((inhibit-read-only t)
(coding-system-for-write 'no-conversion)
(default-directory (or (file-name-directory fullname)
default-directory)))
where the match was found, and MODE is `major-mode' of the buffer in
which the match was found."
(let ((case-fold-search case-fold))
- (save-excursion
- (set-buffer (marker-buffer marker))
+ (with-current-buffer (marker-buffer marker)
(goto-char marker)
;; Search tag table
;; Switch files if necessary
(or (null filename)
(equal Info-current-file filename)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(setq Info-current-file nil
Info-current-subfile nil
Info-current-file-completions nil
(or Info-tag-table-buffer
(generate-new-buffer " *info tag table*"))))
(setq Info-tag-table-buffer tagbuf)
- (save-excursion
- (set-buffer tagbuf)
+ (with-current-buffer tagbuf
(buffer-disable-undo (current-buffer))
(setq case-fold-search t)
(erase-buffer)
(cons (directory-file-name truename)
dirs-done)))
(if attrs
- (save-excursion
+ (with-current-buffer (generate-new-buffer " info dir")
(or buffers
(message "Composing main Info directory..."))
- (set-buffer (generate-new-buffer " info dir"))
(condition-case nil
(progn
(insert-file-contents file)
(let (lastfilepos
lastfilename)
(if (numberp nodepos)
- (save-excursion
- (set-buffer (marker-buffer Info-tag-table-marker))
+ (with-current-buffer (marker-buffer Info-tag-table-marker)
(goto-char (point-min))
(or (looking-at "\^_")
(search-forward "\n\^_"))
;; Assume previous buffer is in Info-mode.
;; (set-buffer (get-buffer "*info*"))
(or (equal Info-current-subfile lastfilename)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(setq buffer-file-name nil)
(widen)
(erase-buffer)
(defvar Info-read-node-completion-table)
-(defun Info-read-node-name-2 (string path-and-suffixes action)
+(defun Info-read-node-name-2 (dirs suffixes string pred 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))))
+ (setq suffixes (remove "" suffixes))
+ (when (file-name-absolute-p string)
+ (setq dirs (list (file-name-directory string))))
+ (let ((names nil)
+ (suffix (concat (regexp-opt suffixes t) "\\'"))
+ (string-dir (file-name-directory string)))
(dolist (dir dirs)
(unless dir
(setq dir default-directory))
(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)))))
+ (complete-with-action action names string pred)))
;; 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
(cond
;; First complete embedded file names.
((string-match "\\`([^)]*\\'" string)
- (let ((file (substring string 1)))
- (cond
- ((eq code nil)
- (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 'Info-read-node-name-2
- (cons Info-directory-list
- (mapcar 'car Info-suffix-list))))
- (t nil))))
+ (completion-table-with-context
+ "("
+ (apply-partially 'completion-table-with-terminator ")"
+ (apply-partially 'Info-read-node-name-2
+ Info-directory-list
+ (mapcar 'car Info-suffix-list)))
+ (substring string 1)
+ predicate
+ code))
+
;; If a file name was given, then any node is fair game.
((string-match "\\`(" string)
(cond
((eq code t) nil)
(t t)))
;; Otherwise use Info-read-node-completion-table.
- ((eq code nil)
- (try-completion string Info-read-node-completion-table predicate))
- ((eq code t)
- (all-completions string Info-read-node-completion-table predicate))
- (t
- (test-completion string Info-read-node-completion-table predicate))))
+ (t (complete-with-action
+ code Info-read-node-completion-table string predicate))))
;; Arrange to highlight the proper letters in the completion list buffer.
-(put 'Info-read-node-name-1 'completion-base-size-function
- (lambda ()
- (if (string-match "\\`([^)]*\\'"
- (or completion-common-substring
- (minibuffer-completion-contents)))
- 1
- 0)))
-
-(defun Info-read-node-name (prompt &optional default)
+
+
+(defun Info-read-node-name (prompt)
(let* ((completion-ignore-case t)
(Info-read-node-completion-table (Info-build-node-completions))
(nodename (completing-read prompt 'Info-read-node-name-1 nil t)))
(if (equal nodename "")
- (or default
- (Info-read-node-name prompt))
+ (Info-read-node-name prompt)
nodename)))
(defun Info-build-node-completions ()
(1- (point)))
(point-max)))
(while (and (not give-up)
- (save-match-data
- (or (null found)
- (if backward
- (isearch-range-invisible found beg-found)
- (isearch-range-invisible beg-found found))
- ;; Skip node header line
- (and (save-excursion (forward-line -1)
- (looking-at "\^_"))
- (forward-line (if backward -1 1)))
- ;; Skip Tag Table node
- (save-excursion
- (and (search-backward "\^_" nil t)
- (looking-at
- "\^_\n\\(Tag Table\\|Local Variables\\)"))))))
+ (or (null found)
+ (not (funcall isearch-success-function beg-found found))))
(let ((search-spaces-regexp
(if (or (not isearch-mode) isearch-regexp)
Info-search-whitespace-regexp)))
(unwind-protect
;; Try other subfiles.
(let ((list ()))
- (save-excursion
- (set-buffer (marker-buffer Info-tag-table-marker))
+ (with-current-buffer (marker-buffer Info-tag-table-marker)
(goto-char (point-min))
(search-forward "\n\^_\nIndirect:")
(save-restriction
(setq list (cdr list))
(setq give-up nil found nil)
(while (and (not give-up)
- (save-match-data
- (or (null found)
- (if backward
- (isearch-range-invisible found beg-found)
- (isearch-range-invisible beg-found found))
- ;; Skip node header line
- (and (save-excursion (forward-line -1)
- (looking-at "\^_"))
- (forward-line (if backward -1 1)))
- ;; Skip Tag Table node
- (save-excursion
- (and (search-backward "\^_" nil t)
- (looking-at
- "\^_\n\\(Tag Table\\|Local Variables\\)"))))))
+ (or (null found)
+ (not (funcall isearch-success-function beg-found found))))
(let ((search-spaces-regexp
(if (or (not isearch-mode) isearch-regexp)
Info-search-whitespace-regexp)))
(unless isearch-forward 'backward))
(Info-search (if isearch-regexp string (regexp-quote string))
bound noerror count
- (unless isearch-forward 'backward))
- (point)))
+ (unless isearch-forward 'backward)))
+ (point))
(let ((isearch-search-fun-function nil))
(isearch-search-fun))))
(defun Info-isearch-start ()
(setq Info-isearch-initial-node nil))
+
+(defun Info-search-success-function (beg-found found)
+ "Skip invisible text, node header line and Tag Table node."
+ (save-match-data
+ (let ((backward (< found beg-found)))
+ (not
+ (or
+ (if backward
+ (or (text-property-not-all found beg-found 'invisible nil)
+ (text-property-not-all found beg-found 'display nil))
+ (or (text-property-not-all beg-found found 'invisible nil)
+ (text-property-not-all beg-found found 'display nil)))
+ ;; Skip node header line
+ (and (save-excursion (forward-line -1)
+ (looking-at "\^_"))
+ (forward-line (if backward -1 1)))
+ ;; Skip Tag Table node
+ (save-excursion
+ (and (search-backward "\^_" nil t)
+ (looking-at
+ "\^_\n\\(Tag Table\\|Local Variables\\)"))))))))
+
\f
(defun Info-extract-pointer (name &optional errorname)
"Extract the value of the node-pointer named NAME.
;; 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)
- nextnode)
- (goto-char (point-min))
- (search-forward "\n* Menu:")
- (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
- (complete-nodes Info-complete-nodes))
- ;; 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)
- (equal (nth 5 Info-complete-cache) Info-complete-nodes)
- (let ((prev (nth 3 Info-complete-cache)))
- (eq t (compare-strings string 0 (length prev)
- prev 0 nil t))))
- ;; We can reuse the previous list.
- (setq completions (nth 4 Info-complete-cache))
- ;; The cache can't be used.
- (while
- (progn
- (while (re-search-forward pattern nil t)
- (push (match-string-no-properties 1)
- completions))
- ;; Check subsequent nodes if applicable.
- (or (and Info-complete-next-re
- (setq nextnode (Info-extract-pointer "next" t))
- (string-match Info-complete-next-re nextnode))
- (and complete-nodes
- (setq complete-nodes (cdr complete-nodes)
- nextnode (car complete-nodes)))))
- (Info-goto-node nextnode))
- ;; Go back to the start node (for the next completion).
- (unless (equal Info-current-node orignode)
- (Info-goto-node orignode))
- ;; Update the cache.
- (set (make-local-variable 'Info-complete-cache)
- (list Info-current-file Info-current-node
- Info-complete-next-re string completions
- Info-complete-nodes)))
- (if action
- (all-completions string completions predicate)
- (try-completion string completions predicate)))))))
+ (with-current-buffer Info-complete-menu-buffer
+ (save-excursion
+ (let ((completion-ignore-case t)
+ (case-fold-search t)
+ (orignode Info-current-node)
+ nextnode)
+ (goto-char (point-min))
+ (search-forward "\n* Menu:")
+ (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
+ (complete-nodes Info-complete-nodes))
+ ;; 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)
+ (equal (nth 5 Info-complete-cache) Info-complete-nodes)
+ (let ((prev (nth 3 Info-complete-cache)))
+ (eq t (compare-strings string 0 (length prev)
+ prev 0 nil t))))
+ ;; We can reuse the previous list.
+ (setq completions (nth 4 Info-complete-cache))
+ ;; The cache can't be used.
+ (while
+ (progn
+ (while (re-search-forward pattern nil t)
+ (push (match-string-no-properties 1)
+ completions))
+ ;; Check subsequent nodes if applicable.
+ (or (and Info-complete-next-re
+ (setq nextnode (Info-extract-pointer "next" t))
+ (string-match Info-complete-next-re nextnode))
+ (and complete-nodes
+ (setq complete-nodes (cdr complete-nodes)
+ nextnode (car complete-nodes)))))
+ (Info-goto-node nextnode))
+ ;; Go back to the start node (for the next completion).
+ (unless (equal Info-current-node orignode)
+ (Info-goto-node orignode))
+ ;; Update the cache.
+ (set (make-local-variable 'Info-complete-cache)
+ (list Info-current-file Info-current-node
+ Info-complete-next-re string completions
+ Info-complete-nodes)))
+ (if action
+ (all-completions string completions predicate)
+ (try-completion string completions predicate))))))))
(defun Info-menu (menu-item &optional fork)
;; go up to the end of this node.
(goto-char (point-max))
;; Since logically we are done with the node with that menu,
- ;; move on from it.
- (Info-next-preorder))
+ ;; move on from it. But don't add intermediate nodes
+ ;; to the history on recursive calls.
+ (let (Info-history)
+ (Info-next-preorder)))
(t
(error "No more nodes"))))
(defun Info-next-reference (&optional recur)
"Move cursor to the next cross-reference or menu item in the node."
(interactive)
- (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tp://")
+ (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tps?://")
(old-pt (point))
(case-fold-search t))
(or (eobp) (forward-char 1))
(defun Info-prev-reference (&optional recur)
"Move cursor to the previous cross-reference or menu item in the node."
(interactive)
- (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tp://")
+ (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tps?://")
(old-pt (point))
(case-fold-search t))
(or (re-search-backward pat nil t)
If FORK is non-nil, it i spassed to `Info-goto-node'."
(let (node)
(cond
- ((Info-get-token (point) "[hf]t?tp://" "[hf]t?tp://\\([^ \t\n\"`({<>})']+\\)")
+ ((Info-get-token (point) "[hf]t?tps?://" "[hf]t?tps?://\\([^ \t\n\"`({<>})']+\\)")
(setq node t)
(browse-url (browse-url-url-at-point)))
((setq node (Info-get-token (point) "\\*note[ \n\t]+"
(put 'Info-mode 'no-clone-indirect t)
(defvar tool-bar-map)
+(defvar bookmark-make-record-function)
;; Autoload cookie needed by desktop.el
;;;###autoload
(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 'clone-buffer-hook 'Info-clone-buffer nil t)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'Info-isearch-start nil t)
(set (make-local-variable 'isearch-search-fun-function)
'Info-isearch-wrap)
(set (make-local-variable 'isearch-push-state-function)
'Info-isearch-push-state)
+ (set (make-local-variable 'isearch-success-function)
+ 'Info-search-success-function)
(set (make-local-variable 'search-whitespace-regexp)
Info-search-whitespace-regexp)
(set (make-local-variable 'revert-buffer-function)
'Info-revert-buffer-function)
(Info-set-mode-line)
+ (set (make-local-variable 'bookmark-make-record-function)
+ 'Info-bookmark-make-record)
(run-mode-hooks 'Info-mode-hook))
;; When an Info buffer is killed, make sure the associated tags buffer
Info-tag-table-buffer
(kill-buffer Info-tag-table-buffer)))
-(defun Info-clone-buffer-hook ()
+;; Placed on `clone-buffer-hook'.
+(defun Info-clone-buffer ()
(when (bufferp Info-tag-table-buffer)
(setq Info-tag-table-buffer
(with-current-buffer Info-tag-table-buffer (clone-buffer))))
(case-fold-search t)
paragraph-markers
(not-fontified-p ; the node hasn't already been fontified
- (not (let ((where (next-single-property-change (point-min)
+ (not (let ((where (next-single-property-change (point-min)
'font-lock-face)))
(and where (not (= where (point-max)))))))
(fontify-visited-p ; visited nodes need to be re-fontified
(defun Info-speedbar-fetch-file-nodes (nodespec)
"Fetch the subnodes from the info NODESPEC.
NODESPEC is a string of the form: (file)node."
- (save-excursion
- ;; Set up a buffer we can use to fake-out Info.
- (set-buffer (get-buffer-create " *info-browse-tmp*"))
+ ;; Set up a buffer we can use to fake-out Info.
+ (with-current-buffer (get-buffer-create " *info-browse-tmp*")
(if (not (equal major-mode 'Info-mode))
(Info-mode))
;; Get the node into this buffer
(add-to-list 'desktop-buffer-mode-handlers
'(Info-mode . Info-restore-desktop-buffer))
+;;;; Bookmark support
+
+(defvar bookmark-search-size)
+
+;; This is only called from bookmark.el.
+(declare-function bookmark-buffer-file-name "bookmark" ())
+
+(defun Info-bookmark-make-record ()
+ `(,Info-current-node
+ (filename . ,(bookmark-buffer-file-name))
+ (front-context-string
+ . ,(if (>= (- (point-max) (point)) bookmark-search-size)
+ (buffer-substring-no-properties
+ (point)
+ (+ (point) bookmark-search-size))
+ nil))
+ (rear-context-string
+ . ,(if (>= (- (point) (point-min)) bookmark-search-size)
+ (buffer-substring-no-properties
+ (point)
+ (- (point) bookmark-search-size))
+ nil))
+ (info-node . ,Info-current-node)
+ (handler . Info-bookmark-jump)))
+
+
+(defvar bookmark-current-bookmark)
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-file-or-variation-thereof "bookmark" (file))
+(declare-function bookmark-jump-noselect "bookmark" (str))
+(declare-function bookmark-get-bookmark-record "bookmark" (bookmark))
+
+;;;###autoload
+(defun Info-bookmark-jump (bmk)
+ ;; This implements the `handler' function interface for record type returned
+ ;; by `Info-bookmark-make-record', which see.
+ (let* ((file (expand-file-name (bookmark-prop-get bmk 'filename)))
+ (forward-str (bookmark-prop-get bmk 'front-context-string))
+ (behind-str (bookmark-prop-get bmk 'rear-context-string))
+ (info-node (bookmark-prop-get bmk 'info-node)))
+ (if (setq file (bookmark-file-or-variation-thereof file))
+ (save-excursion
+ (save-window-excursion
+ (with-no-warnings
+ (Info-find-node file info-node))
+ ;; Go searching forward first. Then, if forward-str exists and was
+ ;; found in the file, we can search backward for behind-str.
+ ;; Rationale is that if text was inserted between the two in the
+ ;; file, it's better to be put before it so you can read it, rather
+ ;; than after and remain perhaps unaware of the changes.
+ (if forward-str
+ (if (search-forward forward-str (point-max) t)
+ (goto-char (match-beginning 0))))
+ (if behind-str
+ (if (search-backward behind-str (point-min) t)
+ (goto-char (match-end 0))))
+ `((buffer ,(current-buffer)) (position ,(point))))))))
+
(provide 'info)
;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac
HCoop / bpt / emacs.git / blobdiff