]> code.delx.au - gnu-emacs/blobdiff - lisp/info.el
(bookmark-make-cell-function, bookmark-search-size)
[gnu-emacs] / lisp / info.el
index b3c59c498a4bca7c1aefbc2b81f0b15743ab7258..c546979327d94802e5893cadf93c2d98342dc2c2 100644 (file)
@@ -1,7 +1,8 @@
 ;;; 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
@@ -10,7 +11,7 @@
 
 ;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -145,7 +146,7 @@ The Lisp code is executed when the node is selected.")
   :type 'boolean
   :group 'info)
 
-(defcustom Info-fontify-maximum-menu-size 1000000
+(defcustom Info-fontify-maximum-menu-size 100000
   "*Maximum size of menu to fontify if `font-lock-mode' is non-nil.
 Set to nil to disable node fontification."
   :type 'integer
@@ -288,7 +289,7 @@ It doesn't contain directory names or file name extensions added by Info.")
 
 (defvar Info-current-subfile nil
   "Info subfile that is actually in the *info* buffer now.
-nil if current Info file is not split into subfiles.")
+It is nil if current Info file is not split into subfiles.")
 
 (defvar Info-current-node nil
   "Name of node that Info is now looking at, or nil.")
@@ -706,8 +707,8 @@ otherwise, that defaults to `Top'."
   (Info-find-node-2 nil nodename))
 
 ;; It's perhaps a bit nasty to kill the *info* buffer to force a re-read,
-;; but at least it keeps this routine (which is only for the benefit of
-;; makeinfo-buffer) out of the way of normal operations.
+;; but at least it keeps this routine (which is for makeinfo-buffer and
+;; Info-revert-buffer-function) out of the way of normal operations.
 ;;
 (defun Info-revert-find-node (filename nodename)
   "Go to an Info node FILENAME and NODENAME, re-reading disk contents.
@@ -739,6 +740,11 @@ is preserved, if possible."
       (if new-history
          (setq Info-history (cons new-history Info-history))))))
 
+(defun Info-revert-buffer-function (ignore-auto noconfirm)
+  (when (or noconfirm (y-or-n-p "Revert info buffer? "))
+    (Info-revert-find-node Info-current-file Info-current-node)
+    (message "Reverted %s" Info-current-file)))
+
 (defun Info-find-in-tag-table-1 (marker regexp case-fold)
   "Find a node in a tag table.
 MARKER specifies the buffer and position to start searching at.
@@ -1400,8 +1406,8 @@ any double quotes or backslashes must be escaped (\\\",\\\\)."
 
 (defvar Info-mode-line-node-keymap
   (let ((map (make-sparse-keymap)))
-    (define-key map [mode-line mouse-1] 'Info-scroll-up)
-    (define-key map [mode-line mouse-3] 'Info-scroll-down)
+    (define-key map [mode-line mouse-1] 'Info-mouse-scroll-up)
+    (define-key map [mode-line mouse-3] 'Info-mouse-scroll-down)
     map)
   "Keymap to put on the Info node name in the mode line.")
 
@@ -2620,6 +2626,15 @@ in other ways.)"
         (t (Info-next-preorder)))
       (scroll-up))))
 
+(defun Info-mouse-scroll-up (e)
+  "Scroll one screenful forward in Info, using the mouse.
+See `Info-scroll-up'."
+  (interactive "e")
+  (save-selected-window
+    (if (eventp e)
+       (select-window (posn-window (event-start e))))
+    (Info-scroll-up)))
+
 (defun Info-scroll-down ()
   "Scroll one screenful back in Info, considering all nodes as one sequence.
 If point is within the menu of a node, and `Info-scroll-prefer-subnodes'
@@ -2646,6 +2661,15 @@ parent node."
        (Info-last-preorder)
       (scroll-down))))
 
+(defun Info-mouse-scroll-down (e)
+  "Scroll one screenful backward in Info, using the mouse.
+See `Info-scroll-down'."
+  (interactive "e")
+  (save-selected-window
+    (if (eventp e)
+       (select-window (posn-window (event-start e))))
+    (Info-scroll-down)))
+
 (defun Info-next-reference (&optional recur)
   "Move cursor to the next cross-reference or menu item in the node."
   (interactive)
@@ -3244,16 +3268,20 @@ If FORK is non-nil, it i spassed to `Info-goto-node'."
 (defvar info-tool-bar-map
   (if (display-graphic-p)
       (let ((map (make-sparse-keymap)))
-       (tool-bar-local-item-from-menu 'Info-exit "close" map Info-mode-map)
-       (tool-bar-local-item-from-menu 'Info-history-back "left-arrow" map Info-mode-map)
-       (tool-bar-local-item-from-menu 'Info-history-forward "right-arrow" map Info-mode-map)
-       (tool-bar-local-item-from-menu 'Info-prev "prev-node" map Info-mode-map)
-       (tool-bar-local-item-from-menu 'Info-next "next-node" map Info-mode-map)
+       (tool-bar-local-item-from-menu 'Info-history-back "left-arrow" map Info-mode-map
+                                      :rtl "right-arrow")
+       (tool-bar-local-item-from-menu 'Info-history-forward "right-arrow" map Info-mode-map
+                                      :rtl "left-arrow")
+       (tool-bar-local-item-from-menu 'Info-prev "prev-node" map Info-mode-map
+                                      :rtl "next-node")
+       (tool-bar-local-item-from-menu 'Info-next "next-node" map Info-mode-map
+                                      :rtl "prev-node")
        (tool-bar-local-item-from-menu 'Info-up "up-node" map Info-mode-map)
        (tool-bar-local-item-from-menu 'Info-top-node "home" map Info-mode-map)
        (tool-bar-local-item-from-menu 'Info-goto-node "jump-to" map Info-mode-map)
        (tool-bar-local-item-from-menu 'Info-index "index" map Info-mode-map)
        (tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map)
+       (tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map)
        map)))
 
 (defvar Info-menu-last-node nil)
@@ -3331,7 +3359,7 @@ With a zero prefix arg, put the name inside a function call to `info'."
   (unless Info-current-node
     (error "No current Info node"))
   (let ((node (if (stringp Info-current-file)
-                 (concat "(" (file-name-nondirectory Info-current-file) ")"
+                 (concat "(" (file-name-nondirectory Info-current-file) ") "
                          Info-current-node))))
     (if (zerop (prefix-numeric-value arg))
         (setq node (concat "(info \"" node "\")")))
@@ -3347,6 +3375,7 @@ With a zero prefix arg, put the name inside a function call to `info'."
 (put 'Info-mode 'no-clone-indirect t)
 
 (defvar tool-bar-map)
+(defvar bookmark-make-cell-function)
 
 ;; Autoload cookie needed by desktop.el
 ;;;###autoload
@@ -3445,7 +3474,7 @@ Advanced commands:
   (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)
@@ -3456,7 +3485,11 @@ Advanced commands:
        'Info-isearch-push-state)
   (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-cell-function)
+       'Info-bookmark-make-cell)
   (run-mode-hooks 'Info-mode-hook))
 
 ;; When an Info buffer is killed, make sure the associated tags buffer
@@ -3466,7 +3499,8 @@ Advanced commands:
        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))))
@@ -4056,7 +4090,8 @@ the variable `Info-file-list-for-emacs'."
       ;; Fontify http and ftp references
       (goto-char (point-min))
       (when not-fontified-p
-        (while (re-search-forward "[hf]t?tp://[^ \t\n\"`({<>})']+" nil t)
+        (while (re-search-forward "\\(https?\\|ftp\\)://[^ \t\n\"`({<>})']+"
+                                  nil t)
           (add-text-properties (match-beginning 0) (match-end 0)
                                '(font-lock-face info-xref
                                                 mouse-face highlight
@@ -4284,6 +4319,97 @@ BUFFER is the buffer speedbar is requesting buttons for."
 (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-cell (annotation &optional info-node)
+  (let ((the-record
+         `((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))
+           (position . ,(point))
+          (info-node . ,info-node)
+          (handler . Info-bookmark-jump))))
+
+    ;; Now fill in the optional parts:
+
+    ;; Take no chances with text properties
+    (set-text-properties 0 (length annotation) nil annotation)
+
+    (if annotation
+        (nconc the-record (list (cons 'annotation annotation))))
+
+    ;; Finally, return the completed record.
+    the-record))
+
+(defvar bookmark-current-bookmark)
+(declare-function bookmark-get-filename              "bookmark" (bookmark))
+(declare-function bookmark-get-front-context-string  "bookmark" (bookmark))
+(declare-function bookmark-get-rear-context-string   "bookmark" (bookmark))
+(declare-function bookmark-get-position              "bookmark" (bookmark))
+(declare-function bookmark-get-info-node             "bookmark" (bookmark))
+(declare-function bookmark-file-or-variation-thereof "bookmark" (file))
+(declare-function bookmark-jump-noselect             "bookmark" (str))
+
+;;;###autoload
+(defun Info-bookmark-jump (bmk)
+  ;; This implements the `handler' function interface for record type returned
+  ;; by `Info-make-cell-function', which see.
+  (let* ((file (expand-file-name (bookmark-get-filename bmk)))
+         (forward-str            (bookmark-get-front-context-string bmk))
+         (behind-str             (bookmark-get-rear-context-string bmk))
+         (place                  (bookmark-get-position bmk))
+        (info-node              (bookmark-get-info-node bmk))
+        (orig-file              file))
+    (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))))
+            ;; added by db
+            (setq bookmark-current-bookmark bmk)
+           `((buffer ,(current-buffer)) (position ,(point)))))
+
+      ;; Else unable to find the marked file, so ask if user wants to
+      ;; relocate the bookmark, else remind them to consider deletion.
+      (ding)
+      (if (y-or-n-p (concat (file-name-nondirectory orig-file)
+                            " nonexistent.  Relocate \""
+                            bmk
+                            "\"? "))
+          (progn
+            (bookmark-relocate bmk)
+            ;; gasp!  It's a recursive function call in Emacs Lisp!
+            (bookmark-jump-noselect bmk))
+        (message
+         "Bookmark not relocated; consider removing it \(%s\)." bmk)
+        nil))))
+
 (provide 'info)
 
 ;; arch-tag: f2480fe2-2139-40c1-a49b-6314991164ac