xemacs-beta: lisp/info.el comparison

comparison lisp/info.el @ 371:cc15677e0335 r21-2b1

Import from CVS: tag r21-2b1

author	cvs
date	Mon, 13 Aug 2007 11:03:08 +0200
parents	a4f53d9b3154
children	6240c7796c7a

comparison

equal deleted inserted replaced

-:bd866891f083
+:cc15677e0335
 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;; General Public License for more details.
 ;; You should have received a copy of the GNU General Public License
 ;; along with XEmacs; see the file COPYING.  If not, write to the
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 ;;; Synched up with: Not synched with FSF.
 use any existing `dir' or `localdir' file and ignore info
 directories containing none
 `always' auto-generate a directory listing ignoring existing
 `dir' and `localdir' files
 `if-missing', the default, auto-generates a directory listing
 if no `dir' or `localdir' file is present.  Otherwise the
 contents of any of these files is used instead.
 `if-outdated' auto-generates a directory listing if the `dir'
 and `localdir' are either inexistent or outdated (touched
 less recently than an info file in the same directory)."
 :type '(choice (const :tag "never" never)
 		 (const :tag "always" always)
 		 (const :tag "if-missing" if-missing)
 		 (const :tag "if-outdated" if-outdated))
 :group 'info)
 (defcustom Info-save-auto-generated-dir nil
 "*Whether an auto-generated info directory listing should be saved.
 Possible values are:
 nil or `never', the default, auto-generated info directory
 information will never be saved.
 `always', auto-generated info directory information will be saved to
 a `dir' file in the same directory overwriting it if it exists
 `conservative', auto-generated info directory information will be saved
 to a `dir' file in the same directory but the user is asked before
 overwriting any existing file."
 :type '(choice (const :tag "never" never)
 		 (const :tag "always" always)
 		 (const :tag "conservative" conservative))
 :group 'info)
-(defconst Info-emacs-info-file-name "xemacs.info"
+(defvar Info-emacs-info-file-name "xemacs.info"
-"The filename of the XEmacs info for `Info-goto-emacs-command-node'
+"The filename of the XEmacs info for
-(`\\<help-mode-map>\\[Info-goto-emacs-command-node]')")
+`Info-goto-emacs-command-node' (`\\<help-mode-map>\\[Info-goto-emacs-command-node]')")
 ;;;###autoload
 (defvar Info-directory-list nil
 "List of directories to search for Info documentation files.
 The first directory in this list, the \"dir\" file there will become
-the (dir)Top node of the Info documentation tree.
+the (dir)Top node of the Info documentation tree.  If you wish to
+modify the info search path, use `M-x customize-variable,
-Note: DO NOT use the `customize' interface to change the value of this
+Info-directory-list' to do so.")
-variable.  Its value is created dynamically on each startup, depending
-on XEmacs packages installed on the system.  If you want to change the
+(defcustom Info-localdir-heading-regexp
-search path, make the needed modifications on the variable's value
+"^Locally installed XEmacs Packages:?"
-from .emacs.  For instance:
-(setq Info-directory-list (cons \"~/info\" Info-directory-list))")
-;; This could as well be hard-coded since ${srcdir}/info/dir is in CVS --dv
-(defconst Info-localdir-heading-regexp "^Local Packages:$"
 "The menu part of localdir files will be inserted below this topic
-heading.")
+heading."
+:type 'regexp
+:group 'info)
 (defface info-node '((t (:bold t :italic t)))
 "Face used for node links in info."
 :group 'info-faces)
 (defface info-xref '((t (:bold t)))
 "Face used for cross-references in info."
 :group 'info-faces)
-;; This list is based on Karl Berry-s advice about extensions `info' itself
+;; Is this right for NT?  .zip, with -c for to stdout, right?
-;; might encounter. --dv
+(defvar Info-suffix-list '( ("" . nil)
-(defcustom Info-suffix-list '(("" . nil)
+			    (".info" . nil)
-			      (".info" . nil)
+			    (".info.gz" . "gzip -dc %s")
-			      (".gz" . "gzip -dc %s")
+			    (".info-z" . "gzip -dc %s")
-			      (".info.gz" . "gzip -dc %s")
+			    (".info.Z" . "uncompress -c %s")
-			      (".z" . "gzip -dc %s")
+			    (".gz" . "gzip -dc %s")
-			      (".info.z" . "gzip -dc %s")
+			    (".Z" . "uncompress -c %s")
-			      (".bz2" . "bzip2 -dc %s")
+			    (".zip" . "unzip -c %s") )
-			      (".info.bz2" . "bzip2 -dc %s")
+"List of file name suffixes and associated decoding commands.
-			      (".Z" . "uncompress -c %s")
-			      (".info.Z" . "uncompress -c %s")
-			      (".zip" . "unzip -c %s")
-			      (".info.zip" . "unzip -c %s")
-			      (".y" . "cat %s | unyabba")
-			      ("info.y" . "cat %s | unyabba")
-			      ;; These ones are for MS-DOS filenames.
-			      (".inf" . nil)
-			      (".igz" . "gzip -dc %s")
-			      (".inz" . "gzip -c %s"))
-"*List of file name suffixes and associated decoding commands.
 Each entry should be (SUFFIX . STRING); if STRING contains %s, that is
 changed to name of the file to decode, otherwise the file is given to
-the command as standard input.  If STRING is nil, no decoding is done."
+the command as standard input.  If STRING is nil, no decoding is done.")
-:type '(repeat (cons (string :tag "suffix")
-		       (choice :tag "command"
+(defvar Info-footnote-tag "Note"
-			       (const  :tag "none" :value nil)
-			       (string :tag ""))))
-:group 'info)
-(defcustom Info-footnote-tag "Note"
 "*Symbol that identifies a footnote or cross-reference.
-All \"*Note\" references will be changed to use this word instead."
+All \"*Note\" references will be changed to use this word instead.")
-:type 'string
-:group 'info)
 (defvar Info-current-file nil
 "Info file that Info is now looking at, or nil.
 This is the name that was specified in Info, not the actual file name.
 It doesn't contain directory names or file name extensions added by Info.")
 (defvar Info-current-annotation-completions nil
 "Cached completion list for current annotation files.")
 (defvar Info-index-alternatives nil
 "List of possible matches for last Info-index command.")
 (defvar Info-index-first-alternative nil)
 (defcustom Info-annotations-path '("~/.xemacs/info.notes"
 "~/.infonotes"
 				   "/usr/lib/info.notes")
 This is the file .../info/dir, which contains the topmost node of the
 Info hierarchy.  The first time you invoke Info you start off
 looking at that node, which is (dir)Top.
 File: dir	Node: Top	This is the top of the INFO tree
 This (the Directory node) gives a menu of major topics.
 * Menu: The list of major topics begins on the next line.
 ")
-(defcustom Info-no-description-string "[No description available]"
+(defvar Info-no-description-string "[No description available]"
-"*Description string for info files that have none"
+"Description string for info files that have none")
-:type 'string
-:group 'info)
 ;;;###autoload
 (defun info (&optional file)
 "Enter Info, the documentation browser.
 Optional argument FILE specifies the file to examine;
 ;; empty filename is simple case
 ((null filename)
 (Info-find-file-node nil nodename no-going-back tryfile line))
 ;; Convert filename to lower case if not found as specified.
 ;; Expand it, look harder...
-((let ((fname (substitute-in-file-name filename))
+((let (temp temp-downcase found
-	  temp found)
+	       (fname (substitute-in-file-name filename)))
 (let ((dirs (cond
-		   ;; If specified name starts with `./', then just try
+		   ((string-match "^\\./" fname) ; If specified name starts with `./'
-		   ;; current directory. No point in searching for an absolute
+		    (list default-directory)) ; then just try current directory.
-		   ;; file name
-		   ((string-match "^\\./" fname)
-		    (list default-directory))
 		   ((file-name-absolute-p fname)
-		    '(nil))
+		    '(nil))		; No point in searching for an absolute file name
 		   (Info-additional-search-directory-list
 		    (append Info-directory-list
 			    Info-additional-search-directory-list))
 		   (t Info-directory-list))))
 	;; Search the directory list for file FNAME.
 	(while (and dirs (not found))
 	  (setq temp (expand-file-name fname (car dirs)))
-	  (setq found (Info-suffixed-file temp))
+	  (setq temp-downcase
+		(expand-file-name (downcase fname) (car dirs)))
+	  (if (equal temp-downcase temp) (setq temp-downcase nil))
+	  ;; Try several variants of specified name.
+	  ;; Try downcasing, appending a suffix, or both.
+	  (setq found (Info-suffixed-file temp temp-downcase))
 	  (setq dirs (cdr dirs)))
 	(if found
 	    (progn (setq filename (expand-file-name found))
 		   t))))
 (Info-find-file-node filename nodename no-going-back tryfile line))
 ;; Look for a URL.  This pattern is stolen from w3.el to prevent
 ;; loading it if we won't need it.
 ;; constructed Info-dir-contents.
 (defvar Info-dir-file-attributes nil)
 (defun Info-insert-dir ()
 "Construct the Info directory node by merging the files named
-\"dir\" or \"localdir\" from the directories in `Info-directory-list'.
+\"dir\" or \"localdir\" from the directories in `Info-directory-list'
 The \"dir\" files will take precedence in cases where both exist.  It
 sets the *info* buffer's `default-directory' to the first directory we
 actually get any text from."
 (if (and Info-dir-contents Info-dir-file-attributes
 	   ;; Verify that none of the files we used has changed
 ;; Search the directory list for the directory file.
 (while dirs
 	(let ((truename (file-truename (expand-file-name (car dirs)))))
 	  (or (member truename dirs-done)
 	      (member (directory-file-name truename) dirs-done)
-	      ;; Karl Berry recently added the ability all possibilities for
+	      ;; Try several variants of specified name.
-	      ;; extension as for normal info files. This code however is
+	      ;; Try upcasing, appending `.info', or both.
-	      ;; still unsatisfactory: if one day, we find a compressed dir
+	      (let* (buf
-	      ;; file (which looks possible), we should be able to handle it
+		     file
-	      ;; (which means decompress and read it, update it, save and
+		     (attrs
-	      ;; recompress it). --dv
+		      (or
-	      (let ((trials '("dir" "DIR"
+		       (progn (setq file (expand-file-name "dir" truename))
-			      "dir.info" "DIR.INFO"
+			      (file-attributes file))
-			      "dir.inf" "DIR.INF"
+		       (progn (setq file (expand-file-name "DIR" truename))
-			      "localdir" "LOCALDIR"
+			      (file-attributes file))
-			      "localdir.info" "LOCALDIR.INFO"
+		       (progn (setq file (expand-file-name "dir.info" truename))
-			      "localdir.inf" "LOCALDIR.INF"))
+			      (file-attributes file))
-		    buf file attrs)
+		       (progn (setq file (expand-file-name "DIR.INFO" truename))
-		(catch 'found
+			      (file-attributes file))
-		  (while (setq file (pop trials))
+		       (progn (setq file (expand-file-name "localdir" truename))
-		    (setq file (expand-file-name file truename))
+			      (file-attributes file))
-		    (and (setq attrs (file-attributes file))
+		       (progn (setq file (expand-file-name "dir" truename))
-			 (throw 'found t))))
+			      nil)
-		(unless file
+		       )))
-		  (setq file (expand-file-name "dir" truename)))
 		(setq dirs-done
 		      (cons truename
 			    (cons (directory-file-name truename)
 				  dirs-done)))
 		(Info-maybe-update-dir file)
 		      (set-buffer (or buf
 				      (generate-new-buffer
 				       (if (string-match "localdir" file)
 					   "localdir"
 					 "info dir"))))
 		      (if (not buf)
 			  (insert-file-contents file))
 		      (if (string-match "localdir" (buffer-name))
 			  (setq lbuffers (cons (current-buffer) lbuffers))
 			(setq buffers (cons (current-buffer) buffers)))
 		      (if attrs
 			  (setq Info-dir-file-attributes
 				(cons (cons file attrs)
 				      Info-dir-file-attributes)))))))
 	  (or (cdr dirs) (setq Info-dir-contents-directory (car dirs)))
 	  (setq dirs (cdr dirs))))
 ;; ensure that the localdir files are inserted last, and reverse
 ;; the list of them so that when they get pushed in, they appear
 ;; in the same order they got specified in the path, from top to
 ;; bottom.
 (nconc buffers (reverse lbuffers))
 (or buffers
 	  (error "Can't find the Info directory node"))
 ;; Distinguish the dir file that comes with Emacs from all the
 ;; others.  Yes, that is really what this is supposed to do.
 ;; If it doesn't work, fix it.
 		  (search-forward "\n\^_" nil 'move)
 		  (beginning-of-line)
 		  (setq end (point))
 		  (setq nodes (cons (list nodename other beg end) nodes))))))
 	  (setq others (cdr others))))
 ;; Add to the main menu a menu item for each other node.
 (re-search-forward "^\\* Menu:" nil t)
 (forward-line 1)
 (let ((menu-items '("top"))
 	    (nodes nodes)
 (message "Composing main Info directory...done"))
 (setq Info-dir-contents (buffer-string)))
 (setq default-directory Info-dir-contents-directory)
 (setq buffer-file-name (caar Info-dir-file-attributes)))
-(defmacro Info-directory-files (dir-file &optional all full nosort files-only)
-"Return a list of Info files living in the same directory as DIR-FILE.
-This list actually contains the files living in this directory, except for
-the dir file itself and the secondary info files (foo-1 foo-2 etc).
-If the optional argument ALL is non nil, the secondary info files are also
-included in the list.
-Please refer to the function `directory-files' for the meaning of the other
-optional arguments."
-`(let* ((dir (file-name-directory ,dir-file))
-	  (all-files (remove ,dir-file (directory-files dir ',full nil ',nosort
-							',files-only))))
-(setq all-files
-	   (if ,full
-	       (remove (concat dir ".")
-		       (remove (concat dir "..") all-files))
-	     (remove "."
-		     (remove ".." all-files))))
-(if ,all
-	 all-files
-(let ((suff-match
-	      (concat "-[0-9]+\\("
-		      ;; Extract all known compression suffixes from
-		      ;; Info-suffix-list. These suffixes can typically  be
-		      ;; found in entries of the form `.info.something'.
-		      (let ((suff-list Info-suffix-list)
-			    suff regexp)
-			(while (setq suff (pop suff-list))
-			  (and (string-match "^\\.info" (car suff))
-			       (setq regexp (concat regexp
-						    (regexp-quote
-						     (substring
-						      (car suff) 5))
-						    (and suff-list "\\|")))))
-			regexp)
-		      "\\)?$"))
-	     info-files file)
-	 (while (setq file (pop all-files))
-	   (or (string-match suff-match file)
-	       (push file info-files)))
-	 (reverse info-files)
-	 ))
-))
 (defun Info-maybe-update-dir (file)
 "Rebuild dir or localdir according to `Info-auto-generate-directory'."
 (unless (or (not (file-exists-p (file-name-directory file)))
-	      (null (Info-directory-files file 'all)))
+	      (null (directory-files (file-name-directory file) nil "\\.info")))
 (if (not (find-buffer-visiting file))
 	(if (not (file-exists-p file))
 	    (if (or (eq Info-auto-generate-directory 'always)
 		    (eq Info-auto-generate-directory 'if-missing))
 		(Info-build-dir-anew (file-name-directory file)))
 	  (if (or (eq Info-auto-generate-directory 'always)
 		  (and (eq Info-auto-generate-directory 'if-outdated)
 		       (Info-dir-outdated-p file)))
 	      (Info-rebuild-dir file))))))
 (defun Info-dir-outdated-p (file)
 "Return non-nil if dir or localdir is outdated.
 dir or localdir are outdated when an info file in the same
 directory has been modified more recently."
 (let ((dir-mod-time (nth 5 (file-attributes file)))
-	f-mod-time newer)
+	f-mod-time
+	newer)
 (setq Info-dir-newer-info-files nil)
 (mapcar
 '(lambda (f)
 	(prog2
 	    (setq f-mod-time (nth 5 (file-attributes f)))
 	    (setq newer (or (> (car f-mod-time) (car dir-mod-time))
 			    (and (= (car f-mod-time) (car dir-mod-time))
-				 (> (car (cdr f-mod-time))
+				 (> (car (cdr f-mod-time)) (car (cdr dir-mod-time))))))
-				    (car (cdr dir-mod-time))))))
+	  (if (and (file-readable-p f)
-	  (if (and (file-readable-p f) newer)
+		   newer)
 	      (setq Info-dir-newer-info-files
 		    (cons f Info-dir-newer-info-files)))))
-(Info-directory-files file nil 'fullname 'nosort t))
+(directory-files (file-name-directory file)
+		      'fullname
+		      ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
+		      'nosort
+		      t))
 Info-dir-newer-info-files))
 (defun Info-extract-dir-entry-from (file)
 "Extract the dir entry from the info FILE.
 The dir entry is delimited by the markers `START-INFO-DIR-ENTRY'
 (let (entry entries)
 (save-excursion
 (save-restriction
 	(narrow-to-region beg end)
 	(goto-char beg)
-	(while (re-search-forward
+	(while (re-search-forward "^\\* \\([^:]+\\):\\([ \t]*(\\([^)]*\\))\\w*\\.\\|:\\)" nil t)
-		"^\\* \\([^:]+\\):\\([ \t]*(\\([^)]*\\))\\w*\\.\\|:\\)" nil t)
 	  (setq entry (list (match-string 2)
 			    (match-string 1)
 			    (downcase (or (match-string 3)
 					  (match-string 1)))))
 	  (setq entry
 		(cons (nreverse
 		       (cdr
 			(nreverse
 			 (split-string
 			  (buffer-substring
 			   (re-search-forward "[ \t]*" nil t)
 			   (or (and (re-search-forward "^[^ \t]" nil t)
 				    (goto-char (match-beginning 0)))
 			       (point-max)))
 			  "[ \t]*\n[ \t]*"))))
 	       (setq len (length (concat (car e)
 					 (car (cdr e)))))
 	       (if (> len description-col)
 		   (setq description-col len)))
 	    entries)
 (setq description-col (+ 5 description-col))
 (mapcar '(lambda (e)
 	       (setq e (cdr e))		; Drop filename
 	       (insert "* " (car e) ":" (car (cdr e)))
 	       (setq e (car (cdr (cdr e))))
 	       (while e
 (insert "\n")))
 (defun Info-build-dir-anew (directory)
 "Build info directory information for DIRECTORY.
 The generated directory listing may be saved to a `dir' according
 to the value of `Info-save-auto-generated-dir'"
 (save-excursion
 (let* ((dirfile (expand-file-name "dir" directory))
 	   (to-temp (or (null Info-save-auto-generated-dir)
 			(eq Info-save-auto-generated-dir 'never)
 			(and (not (file-writable-p dirfile))
-			     (message "File not writable %s. Using temporary."
+			     (message "File not writable %s. Using temporary." dirfile))))
-				      dirfile))))
+	   (info-files
-	   (info-files (Info-directory-files dirfile nil 'fullname nil t)))
+	    (directory-files directory
+			     'fullname
+			     ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
+			     nil
+			     t)))
 (if to-temp
 	  (message "Creating temporary dir in %s..." directory)
 	(message "Creating %s..." dirfile))
 (set-buffer (find-file-noselect dirfile t))
 (setq buffer-read-only nil)
 (erase-buffer)
-(insert Info-dir-prologue "Info files in " directory ":\n\n")
+(insert Info-dir-prologue
-(Info-dump-dir-entries
+	      "Info files in " directory ":\n\n")
-(mapcar
+(Info-dump-dir-entries
+(mapcar
 	'(lambda (f)
 	   (or (Info-extract-dir-entry-from f)
 	       (list 'dummy
-		     (progn (string-match "\\([^.]*\\)\\(\\..*\\)?$"
+		     (progn
-					  (file-name-nondirectory f))
+		       (string-match "\\(.*\\)\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
-			    (capitalize
+				     (file-name-nondirectory f))
-			     (match-string 1 (file-name-nondirectory f))))
+		       (capitalize (match-string 1 (file-name-nondirectory f))))
 		     ":"
 		     (list Info-no-description-string))))
 	info-files))
 (if to-temp
 	  (set-buffer-modified-p nil)
 	(message "Creating %s...done" dirfile)))))
 (defun Info-rebuild-dir (file)
 "Build info directory information in the directory of dir FILE.
 Description of info files are merged from the info files in the
 directory and the contents of FILE with the description in info files
 taking precedence over descriptions in FILE.
 The generated directory listing may be saved to a `dir' according to
 the value of `Info-save-auto-generated-dir' "
 (save-excursion
 (save-restriction
 (let (dir-section-contents dir-full-contents
 	    dir-entry
 	    file-dir-entry
 	    mark next-section
 	    not-first-section
 	    (to-temp
 	     (or (null Info-save-auto-generated-dir)
 		 (eq Info-save-auto-generated-dir 'never)
 		 (and (eq Info-save-auto-generated-dir 'always)
 		      (not (file-writable-p file))
 		      (message "File not writable %s. Using temporary." file))
 		 (and (eq Info-save-auto-generated-dir 'conservative)
 		      (or (and (not (file-writable-p file))
-			       (message
+			       (message "File not writable %s. Using temporary." file))
-				"File not writable %s. Using temporary." file))
+			  (not (y-or-n-p
-			  (not (y-or-n-p
+				(message "%s is outdated. Overwrite ? "
-				(message "%s is outdated. Overwrite ? "
 					 file))))))))
 	(set-buffer (find-file-noselect file t))
 	(setq buffer-read-only nil)
 	(if to-temp
 	    (message "Rebuilding temporary %s..." file)
 		       (re-search-forward "^\\* Menu:.*$" nil t)
 		       (setq mark (and (re-search-forward "^\\* " nil t)
 				       (match-beginning 0))))
 	    (throw 'done nil))
 	  (setq dir-full-contents (Info-parse-dir-entries mark (point-max)))
-	  (setq next-section (or (and (re-search-forward
+	  (setq next-section (or (and (re-search-forward "^[^* \t].*:[ \t]*$" nil t)
-				       "^[^* \t].*:[ \t]*$" nil t)
 				      (match-beginning 0))
 				 (point-max)))
 	  (while next-section
 	    (narrow-to-region mark next-section)
-	    (setq dir-section-contents (nreverse (Info-parse-dir-entries
+	    (setq dir-section-contents (nreverse (Info-parse-dir-entries (point-min)
-						  (point-min) (point-max))))
+									 (point-max))))
-	    (mapcar
+	    (mapcar '(lambda (file)
-	     '(lambda (file)
+		       (setq dir-entry (assoc (downcase
-		(setq dir-entry (assoc (downcase
+					       (file-name-sans-extension
-					(file-name-sans-extension
+						(file-name-nondirectory file)))
-					 (file-name-nondirectory file)))
+					      dir-section-contents)
-				       dir-section-contents)
+			     file-dir-entry (Info-extract-dir-entry-from file))
-		      file-dir-entry (Info-extract-dir-entry-from file))
+		       (if dir-entry
-		(if dir-entry
+			   (if file-dir-entry
-		    (if file-dir-entry
+			       ;; A dir entry in the info file takes precedence over an
-			;; A dir entry in the info file takes precedence over
+			       ;; existing entry in the dir file
-			;; an existing entry in the dir file
+			       (setcdr dir-entry (cdr file-dir-entry)))
-			(setcdr dir-entry (cdr file-dir-entry)))
+			 (unless (or not-first-section
-		  (unless (or not-first-section
+				     (assoc (downcase
-			      (assoc (downcase
+					 (file-name-sans-extension
-				      (file-name-sans-extension
+					  (file-name-nondirectory file)))
-				       (file-name-nondirectory file)))
+					dir-full-contents))
-				     dir-full-contents))
+			   (if file-dir-entry
-		    (if file-dir-entry
+			       (setq dir-section-contents (cons file-dir-entry
-			(setq dir-section-contents
+								dir-section-contents))
-			      (cons file-dir-entry dir-section-contents))
+			     (setq dir-section-contents
-		      (setq dir-section-contents
+				   (cons (list 'dummy
-			    (cons (list 'dummy
+					       (capitalize (file-name-sans-extension
-					(capitalize (file-name-sans-extension
+							    (file-name-nondirectory file)))
-						     (file-name-nondirectory
+					       ":"
-						      file)))
+					       (list Info-no-description-string))
-					":"
+					 dir-section-contents))))))
-					(list Info-no-description-string))
+		    Info-dir-newer-info-files)
-				  dir-section-contents))))))
-	     Info-dir-newer-info-files)
 	    (delete-region (point-min) (point-max))
 	    (Info-dump-dir-entries (nreverse dir-section-contents))
 	    (widen)
 	    (if (= next-section (point-max))
 		(setq next-section nil)
 	      (or (setq mark (and (re-search-forward "^\\* " nil t)
 				  (match-beginning 0)))
 		  (throw 'done nil))
-	      (setq next-section (or (and (re-search-forward
+	      (setq next-section (or (and (re-search-forward "^[^* \t].*:[ \t]*$" nil t)
-					   "^[^* \t].*:[ \t]*$" nil t)
 					  (match-beginning 0))
 				     (point-max))))
 	    (setq not-first-section t)))
 	(if to-temp
 	    (progn
 	      (set-buffer-modified-p nil)
 	      (message "Rebuilding temporary %s...done" file))
 	  (save-buffer)
 	  (message "Rebuilding %s...done" file))))))
 ;;;###autoload
 (defun Info-batch-rebuild-dir ()
-"(Re)build `dir' files in the directories remaining on the command line.
+"(Re)build info `dir' files in the directories remaining on the command line.
-Use this from the command line, with `-batch', it won't work in an
+Use this from the command line, with `-batch';
-interactive XEmacs.
+it won't work in an interactive Emacs.
+Each file is processed even if an error occurred previously.
-Each file is processed even if an error occurred previously. For example,
+For example, invoke \"xemacs -batch -f Info-batch-rebuild-dir /usr/local/info\""
-invoke \"xemacs -batch -f Info-batch-rebuild-dir /usr/local/info\""
 ;; command-line-args-left is what is left of the command line (from
 ;; startup.el)
 (defvar command-line-args-left)	; Avoid 'free variable' warning
 (if (not noninteractive)
 (error "`Info-batch-rebuild-dir' is to be used only with -batch"))
 (while command-line-args-left
 (if  (not (file-directory-p (car command-line-args-left)))
 	  (message "Warning: Skipped %s. Not a directory."
 		   (car command-line-args-left))
 	(setq dir (expand-file-name "dir" (car command-line-args-left)))
-	(setq localdir (expand-file-name "localdir"
+	(setq localdir (expand-file-name "localdir" (car command-line-args-left)))
-					 (car command-line-args-left)))
+	(cond
-	(cond
 	 ((file-exists-p dir)
 	  (Info-rebuild-dir dir))
 	 ((file-exists-p localdir)
 	  (Info-rebuild-dir localdir))
 	 (t
 	  (widen)
 	  (erase-buffer)
 	  (Info-insert-file-contents (Info-suffixed-file
 				      (expand-file-name lastfilename
 							(file-name-directory
-							 Info-current-file))
+							 Info-current-file)))
-				      'exact)
 				     t)
 	  (set-buffer-modified-p nil)
 	  (setq Info-current-subfile lastfilename)))
 (goto-char (point-min))
 (search-forward "\n\^_")
 (+ (- nodepos lastfilepos) (point))))
-(defun Info-all-case-regexp (str)
+(defun Info-suffixed-file (name &optional name2)
-(let ((regexp "")
+"Look for NAME with each of the `Info-suffix-list' extensions in
-	(len (length str))
+turn. Optional NAME2 is the name of a fallback info file to check
-	(i 0)
+for; usually a downcased version of NAME."
-	c)
+(let ((suff Info-suffix-list)
-(while (< i len)
+	(found nil)
-(setq c (aref str i))
+	file file2)
-(cond ((or (and (>= c ?A) (<= c ?Z))
+(while (and suff (not found))
-		 (and (>= c ?a) (<= c ?z)))
+(setq file (concat name (caar suff))
-	     (setq regexp (concat regexp
+	    file2 (and name2 (concat name2 (caar suff))))
-				  "["
+(cond
-				  (char-to-string (downcase c))
+((file-regular-p file)
-				  "\\|"
+	(setq found file))
-				  (char-to-string (upcase c))
+((and file2 (file-regular-p file2))
-				  "]")))
+	(setq found file2))
 (t
-	     (setq regexp (concat regexp (char-to-string c)))))
+	(setq suff (cdr suff)))))
-(setq i (1+ i)))
+(or found
-regexp))
+	(and name (when (file-regular-p name)
+		    name))
-(defun Info-suffixed-file (name &optional exact)
+	(and name2 (when (file-regular-p name2)
-"Look for an info file named NAME. This function tries to be smart in
+		     name2)))))
-finding the file corresponding to NAME: if it doesn't exist, several
-variants are looked for, notably by appending suffixes from
-`Info-suffix-list' and by trying to change the characters case in NAME.
-The optional argument EXACT prevents this function from trying different case
-versions of NAME. Only the suffixes are tried."
-(catch 'found
-;; First, try NAME alone:
-(and (file-regular-p name) (throw 'found name))
-;; Then, try different variants
-(let ((suff-match (concat "\\("
-			      (let ((suff-list Info-suffix-list)
-				    suff regexp)
-				(while (setq suff (pop suff-list))
-				  (setq regexp
-					(concat regexp
-						(regexp-quote (car suff))
-						(and suff-list "\\|"))))
-				regexp)
-			      "\\)?$"))
-	  (dir (file-name-directory name))
-	  file files)
-(setq name (file-name-nondirectory name))
-(setq files
-	    (condition-case data ;; protect against invalid directory
-		;; First, try NAME[.<suffix>]
-		(append
-		 (directory-files dir 'fullname
-				  (concat "^" (regexp-quote name) suff-match)
-				  nil t)
-		 (if exact
-		     nil
-		   ;; Then, try to match the name independantly of the
-		   ;; characters case.
-		   (directory-files dir 'fullname
-				    (Info-all-case-regexp
-				     (concat "^"
-					     (regexp-quote name)
-					     suff-match))
-				    nil t)))
-	      (t
-	       (display-warning 'info
-		 (format "directory `%s' error: %s" dir data))
-	       nil)))
-(while (setq file (pop files))
-	(and (file-regular-p file)
-	     (throw 'found file)))
-)))
 (defun Info-insert-file-contents (file &optional visit)
 (setq file (expand-file-name file default-directory))
-(let ((suff Info-suffix-list)
+(let ((suff Info-suffix-list))
-	len)
+(while (and suff (or (<= (length file) (length (car (car suff))))
-(while (and suff
+			 (not (equal (substring file
-		(setq len (length (car (car suff))))
+						(- (length (car (car suff)))))
-		(or (<= (length file) len)
+				     (car (car suff))))))
-		    (not (or
-			  (equal (substring file (- len))
-				 (car (car suff)))
-			  (equal (substring file (- len))
-				 (upcase (car (car suff)))))
-			 )))
 (setq suff (cdr suff)))
 (if (stringp (cdr (car suff)))
 	(let ((command (if (string-match "%s" (cdr (car suff)))
 			   (format (cdr (car suff)) file)
 			 (concat (cdr (car suff)) " < " file))))
 	(list (cons modeline-buffer-id-left-extent "Info: ")
 	      (cons modeline-buffer-id-right-extent
 		    (concat
 		     "("
 		     (if Info-current-file
-			 (let ((name (file-name-nondirectory
+			 (let ((name (file-name-nondirectory Info-current-file)))
-				      Info-current-file)))
+			   (if (string-match "\\.info$" name)
-			   (if (string-match "^\\([^.]*\\)\\..*$" name)
+			       (substring name 0 -5)
-			       (match-string 1 name)
 			     name))
 		       "")
 		     ")"
 		     (or Info-current-node ""))))))
 (defun Info-build-node-completions ()
 (or Info-current-file-completions
 (let ((compl (Info-build-annotation-completions)))
 	(save-excursion
 	  (save-restriction
-	    (widen)
 	    (if (marker-buffer Info-tag-table-marker)
 		(progn
 		  (set-buffer (marker-buffer Info-tag-table-marker))
 		  (goto-char Info-tag-table-marker)
 		  (while (re-search-forward "\nNode: \\(.*\\)\177" nil t)
 		    (setq compl
 			  (cons (list (buffer-substring (match-beginning 1)
 							(match-end 1)))
 				compl))))
+	      (widen)
 	      (goto-char (point-min))
 	      (while (search-forward "\n\^_" nil t)
 		(forward-line 1)
 		(let ((beg (point)))
 		  (forward-line 1)
 		  (if (re-search-backward "Node: *\\([^,\n]*\\) *[,\n\t]"
 					  beg t)
 		      (setq compl
 			    (cons (list (buffer-substring (match-beginning 1)
 							  (match-end 1)))
 				  compl))))))))
 	(setq Info-current-file-completions compl))))
 (if (null Info-current-subfile)
 (progn (re-search-forward regexp) (setq found (point)))
 (condition-case nil
 (progn (re-search-forward regexp) (setq found (point)))
 (search-failed nil)))))
-(if (not found)
+(if (not found)                   ;can only happen in subfile case -- else would have erred
-	  ;; can only happen in subfile case -- else would have erred
 (unwind-protect
 (let ((list ()))
 (set-buffer (marker-buffer Info-tag-table-marker))
 (goto-char (point-min))
 (search-forward "\n\^_\nIndirect:")
 (beginning-of-line)
 (while (not (eobp))
 (re-search-forward "\\(^.*\\): [0-9]+$")
 (goto-char (+ (match-end 1) 2))
 (setq list (cons (cons (read (current-buffer))
-(buffer-substring
+(buffer-substring (match-beginning 1)
-					    (match-beginning 1)
+(match-end 1)))
-					    (match-end 1)))
 list))
 (goto-char (1+ (match-end 0))))
 (setq list (nreverse list)
 list (cdr list)))
 (while list
 (or (and (equal onode Info-current-node)
 (equal ofile Info-current-file))
 (Info-history-add ofile onode opoint)))))
 ;; Extract the value of the node-pointer named NAME.
 ;; If there is none, use ERRORNAME in the error message;
 ;; if ERRORNAME is nil, just return nil.
 (defun Info-extract-pointer (name &optional errorname)
 (save-excursion
 (goto-char (point-min))
 (forward-line 4)
 	         (setq item nil))))
 (list item))))
 ;; there is a problem here in that if several menu items have the same
 ;; name you can only go to the node of the first with this command.
 (Info-goto-node (Info-extract-menu-item menu-item) nil t))
 (defun Info-extract-menu-item (menu-item &optional noerror)
 (save-excursion
 (goto-char (point-min))
 (if (let ((case-fold-search t))
 	  (search-forward "\n* menu:" nil t))
 (while (>= (setq n (1- n)) 0)
 (if (pos-visible-in-window-p (point-min))
 	  (progn
 	    (Info-global-prev)
 	    (message "Node: %s" Info-current-node)
-	    (goto-char (point-max))
+	    (sit-for 0)
-	    (recenter -1)
+	    ;;(scroll-up 1)   ; work around bug in pos-visible-in-window-p
-	    (move-to-window-line 0))
+	    ;;(scroll-down 1)
+	    (while (not (pos-visible-in-window-p (point-max)))
+	      (scroll-up)))
 	(scroll-down)))))
 (defun Info-scroll-prev (arg)
 (interactive "P")
 (if Info-auto-advance
 (if (and (pos-visible-in-window-p (point-min))
 	       (not (eq Info-auto-advance t))
 	       (not (eq last-command this-command)))
 	  (message "Hit %s again to go to previous node"
-		   (if (mouse-event-p last-command-event)
+		   (if (= last-command-char 0)
 		       "mouse button"
-		     (key-description (event-key last-command-event))))
+		     (key-description (char-to-string last-command-char))))
 	(Info-page-prev)
 	(setq this-command 'Info))
 (scroll-down arg)))
 (defun Info-index (topic)
 ;;;###autoload
 (defun Info-elisp-ref (func)
 "Look up an Emacs Lisp function in the Elisp manual in the Info system.
 This command is designed to be used whether you are already in Info or not."
 (interactive (let ((fn (function-at-point))
 		     (enable-recursive-minibuffers t)
 		     val)
 		 (setq val (completing-read
 			    (format "Look up Emacs Lisp function%s: "
 				    (if fn
 					(format " (default %s)" fn)
 	      (setq bufs (cdr bufs))))
 	  (goto-char savept)))))
 (defvar Info-annotate-map nil
 "Local keymap used within `a' command of Info.")
 (if Info-annotate-map
 nil
 ;; (setq Info-annotate-map (nconc (make-sparse-keymap) text-mode-map))
 (setq Info-annotate-map (copy-keymap text-mode-map))
 (define-key Info-annotate-map "\C-c\C-c" 'Info-cease-annotate))
 (defun Info-mouse-track-double-click-hook (event click-count)
 "Handle double-clicks by turning pages, like the `gv' ghostscript viewer"
 (if (/= click-count 2)
 ;; Return nil so any other hooks are performed.
 nil
-(let* ((fw (face-width 'default))
+(let* ((x (event-x-pixel event))
-	     (fh (face-height 'default))
+	     (y (event-y-pixel event))
-	     (x (/ (event-x-pixel event) fw))
+	     (w (window-pixel-width (event-window event)))
-	     (y (/ (event-y-pixel event) fw))
+	     (h (window-pixel-height (event-window event)))
-	     (w (/ (window-pixel-width (event-window event)) fw))
+	     (w/3 (/ w 3))
-	     (h (/ (window-pixel-height (event-window event)) fh))
+	     (w/2 (/ w 2))
-	     (bx 3)
+	     (h/4 (/ h 4)))
-	     (by 2))
 	(cond
-	  ((<= y by) (Info-up) t)
+	  ;; In the top 1/4 and inside the middle 1/3
-	  ((>= y (- h by)) (Info-nth-menu-item 1) t)
+	  ((and (<= y h/4)
-	  ((<= x bx) (Info-prev) t)
+		(and (>= x w/3) (<= x (+ w/3 w/3))))
-	  ((>= x (- w bx)) (Info-next) t)
+	   (Info-up)
-	  (t nil)))))
+	   t)
+	  ;; In the bottom 1/4 and inside the middle 1/3
+	  ((and (>= y (+ h/4 h/4 h/4))
+		(and (>= x w/3) (<= x (+ w/3 w/3))))
+	   (Info-nth-menu-item 1)
+	   t)
+	  ;; In the lower 3/4 and the right 1/2
+	  ;; OR in the upper 1/4 and the right 1/3
+	  ((or (and (>= y h/4) (>= x w/2))
+	       (and (< y h/4) (>= x (+ w/3 w/3))))
+	   (Info-next)
+	   t)
+	  ;; In the lower 3/4 and the left 1/2
+	  ;; OR in the upper 1/4 and the left 1/3
+	  ((or (and (>= y h/4) (< x w/2))
+	       (and (< y h/4) (<= x w/3)))
+	   (Info-prev)
+	   t)
+	  ;; This shouldn't happen.
+	  (t
+	   (error "event out of bounds: %s %s" x y))))))
 (defvar Info-mode-map nil
 "Keymap containing Info commands.")
 (if Info-mode-map
 nil
 (setq Info-mode-map (make-sparse-keymap))
 (suppress-keymap Info-mode-map)
 (define-key Info-mode-map "." 'beginning-of-buffer)
 Space	Scroll forward a full screen.   DEL       Scroll backward.
 b	Go to beginning of node.        Meta->    Go to end of node.
 TAB	Go to next cross-reference.     Meta-TAB  Go to previous ref.
 Mouse commands:
-Left Button	Set point (usual text-mode functionality)
+Left Button	Set point.
 Middle Button	Click on a highlighted node reference to go to it.
 Right Button	Pop up a menu of applicable Info commands.
-Left Button Double Click in window edges:
-Top edge:    Go up to the parent node, like `u'.
-Left edge:   Go to the previous node, like `p'.
-Right edge:  Go to the next node, like `n'.
-Bottom edge: Follow first menu item, like `1'.
 Advanced commands:
 g	Move to node, file, or annotation tag specified by name.
 	Examples:  `g Rectangles' `g (Emacs)Rectangles' `g Emacs'.
 v	Move to file, with filename completion.
 (run-hooks 'Info-mode-hook)
 (Info-set-mode-line))
 (defvar Info-edit-map nil
 "Local keymap used within `e' command of Info.")
 (if Info-edit-map
 nil
 ;; XEmacs: remove FSF stuff
 (setq Info-edit-map (make-sparse-keymap))
 (set-keymap-name Info-edit-map 'Info-edit-map)
 	  (progn
 	    (goto-char (match-end 0))
 	    (while
 		(looking-at "[ \t]*[^:, \t\n]+:[ \t]+\\([^:,\t\n]+\\),?\n?")
 	      (goto-char (match-end 0))
-	      (Info-highlight-region (match-beginning 1) (match-end 1)
+	      (Info-highlight-region (match-beginning 1) (match-end 1) 'info-xref))))
-				     'info-xref))))
 ;; Now get the xrefs in the body
 (goto-char (point-min))
 (while (re-search-forward xref-regexp nil t)
 	(if (= (char-after (1- (match-beginning 0))) ?\") ; hack
 	    nil
-	  (Info-highlight-region (match-beginning 1) (match-end 1)
+	  (Info-highlight-region (match-beginning 1) (match-end 1) 'info-xref)))
-				 'info-xref)))
 ;; then highlight the nodes in the menu.
 (goto-char (point-min))
 (if (and (search-forward "\n* menu:" nil t))
 	  (while (re-search-forward
 		  "^\\* \\([^:\t\n]*\\):?:[ \t\n]" nil t)
-	    (Info-highlight-region (match-beginning 1) (match-end 1)
+	    (Info-highlight-region (match-beginning 1) (match-end 1) 'info-node)))
-				   'info-node)))
 (set-buffer-modified-p nil))))
 (defun Info-construct-menu (&optional event)
 "Construct a menu of Info commands.
 Adds an entry for the node at EVENT, or under point if EVENT is omitted.
 Used to construct the menubar submenu and popup menu."
 (or event (setq event (point)))
 (let ((case-fold-search t)
 	(xref-regexp (concat "\\*"
 			     (regexp-quote Info-footnote-tag)
 			     "[ \n\t]*\\([^:]*\\):"))
 	up-p prev-p next-p menu xrefs subnodes in)
 (save-excursion
 ;; `one-space' fixes "Notes:" xrefs that are split across lines.

Mercurial > hg > xemacs-beta

comparison lisp/info.el @ 371:cc15677e0335 r21-2b1