]> code.delx.au - gnu-emacs/blobdiff - lisp/info.el
Add 2008 to copyright years.
[gnu-emacs] / lisp / info.el
index 74183046031918d5361adc734a4c446ebff122b6..66ca4b61000010a53ebc3245ad07ce669252d79c 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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 Free Software Foundation, Inc.
+;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: help
@@ -10,7 +10,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,8 +145,9 @@ The Lisp code is executed when the node is selected.")
   :type 'boolean
   :group 'info)
 
-(defcustom Info-fontify-maximum-menu-size 1000000
-  "*Maximum size of menu to fontify if `font-lock-mode' is non-nil."
+(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
   :group 'info)
 
@@ -287,7 +288,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.")
@@ -1314,16 +1315,25 @@ any double quotes or backslashes must be escaped (\\\",\\\\)."
              nil t)
        (let* ((start (match-beginning 1))
               (parameter-alist (Info-split-parameter-string (match-string 2)))
-              (src (cdr (assoc-string "src" parameter-alist)))
-              (image-file (if src (if (file-name-absolute-p src) src
-                                    (concat default-directory src))
-                            ""))
-              (image (if (file-exists-p image-file)
-                         (create-image image-file)
-                       "[broken image]")))
-         (if (not (get-text-property start 'display))
-             (add-text-properties
-              start (point) `(display ,image rear-nonsticky (display)))))))
+               (src (cdr (assoc-string "src" parameter-alist))))
+          (if (display-images-p)
+              (let* ((image-file (if src (if (file-name-absolute-p src) src
+                                           (concat default-directory src))
+                                   ""))
+                     (image (if (file-exists-p image-file)
+                                (create-image image-file)
+                              "[broken image]")))
+                (if (not (get-text-property start 'display))
+                    (add-text-properties
+                     start (point) `(display ,image rear-nonsticky (display)))))
+            ;; text-only display, show alternative text if provided, or
+            ;; otherwise a clue that there's meant to be a picture
+            (delete-region start (point))
+            (insert (or (cdr (assoc-string "text" parameter-alist))
+                        (cdr (assoc-string "alt" parameter-alist))
+                        (and src
+                             (concat "[image:" src "]"))
+                        "[image]"))))))
     (set-buffer-modified-p nil)))
 
 ;; Texinfo 4.7 adds cookies of the form ^@^H[NAME CONTENTS ^@^H].
@@ -1390,8 +1400,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.")
 
@@ -2610,6 +2620,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'
@@ -2636,6 +2655,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)
@@ -3234,16 +3262,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)
@@ -3435,7 +3467,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 +3488,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))))
@@ -3705,6 +3738,7 @@ the variable `Info-file-list-for-emacs'."
            (fontify-visited-p ; visited nodes need to be re-fontified
             (and Info-fontify-visited-nodes
                  ;; Don't take time to refontify visited nodes in huge nodes
+                Info-fontify-maximum-menu-size
                  (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size)))
            rbeg rend)
 
@@ -3940,6 +3974,7 @@ the variable `Info-file-list-for-emacs'."
       (when (and (or not-fontified-p fontify-visited-p)
                  (search-forward "\n* Menu:" nil t)
                  ;; Don't take time to annotate huge menus
+                Info-fontify-maximum-menu-size
                  (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
         (let ((n 0)
               cont)
@@ -4044,7 +4079,7 @@ 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