diff lisp/info.el @ 274:ca9a9ec9c1c1 r21-0b35

Import from CVS: tag r21-0b35
author cvs
date Mon, 13 Aug 2007 10:29:42 +0200
parents c5d627a313b1
children 90d73dddcdc4
line wrap: on
line diff
--- a/lisp/info.el	Mon Aug 13 10:28:54 2007 +0200
+++ b/lisp/info.el	Mon Aug 13 10:29:42 2007 +0200
@@ -387,15 +387,17 @@
   :type '(repeat directory)
   :group 'info)
 
-(defcustom Info-rebuild-outdated-dir 'ask
+(defcustom Info-rebuild-outdated-dir 'conservative
   "*What to do if the `dir' or `localdir' file needs to be (re)built.
 Possible values are:
 `never' never (re)build the `dir' or `localdir' file
 `always' automatically (re)builds when needed
-`ask' asks the user before  (re)building"
+`ask' asks the user before (re)building
+`conservative' asks the user before overwriting existing files"
   :type '(choice (const :tag "never" never)
 		 (const :tag "always" always)
-		 (const :tag "ask" ask))
+		 (const :tag "ask" ask)
+		 (const :tag "conservative" conservative))
   :group 'info)
 
 (defvar Info-emacs-info-file-name "xemacs.info"
@@ -502,6 +504,9 @@
 
 ")
 
+(defvar Info-no-description-string "[No description available]"
+  "Description string for info files that have none")
+
 ;;;###autoload
 (defun info (&optional file)
   "Enter Info, the documentation browser.
@@ -814,9 +819,7 @@
 		      (cons truename
 			    (cons (directory-file-name truename)
 				  dirs-done)))
-		(if (not (string= truename
-				  (file-truename (car Info-directory-list))))
-		    (Info-maybe-update-dir file))
+		(Info-maybe-update-dir file)
 		(setq attrs (file-attributes file))
 		(if (or (setq buf (find-buffer-visiting file))
 			attrs)
@@ -833,9 +836,10 @@
 		      (if (string-match "localdir" (buffer-name))
 			  (setq lbuffers (cons (current-buffer) lbuffers))
 			(setq buffers (cons (current-buffer) buffers)))
-		      (setq Info-dir-file-attributes
-			    (cons (cons file attrs)
-				  Info-dir-file-attributes))))))
+		      (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))))
       
@@ -974,11 +978,15 @@
     (if (not (find-buffer-visiting file))
 	(if (not (file-exists-p file))
 	    (if (or (eq Info-rebuild-outdated-dir 'always)
+		    (and (eq Info-rebuild-outdated-dir 'conservative)
+			 (not (file-writable-p file)))
 		    (and (eq Info-rebuild-outdated-dir 'ask)
 			 (y-or-n-p (format "No dir file in %s. Rebuild now ? " (file-name-directory file)))))
 		(Info-build-dir-anew (file-name-directory file) (not (file-writable-p file))))
 	  (if (Info-dir-outdated-p file)
 	      (if (or (eq Info-rebuild-outdated-dir 'always)
+		      (and (eq Info-rebuild-outdated-dir 'conservative)
+			   (not (file-writable-p file)))
 		      (and (eq Info-rebuild-outdated-dir 'ask)
 			   (y-or-n-p (format "%s is outdated. Rebuild now ? " file))))
 		  (Info-rebuild-dir file (not (file-writable-p file)))))))))
@@ -988,7 +996,7 @@
 
 (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
+dir or localdir are outdated when a *.info file in the same
 directory has been modified more recently."
   (let ((dir-mod-time (nth 5 (file-attributes file)))
 	f-mod-time
@@ -1012,9 +1020,9 @@
 		      t))
     Info-dir-newer-info-files))
 
-(defun Info-extract-dir-entries-from (file)
-  "Extract dir entries from the info FILE.
-dir entries are delimited by the markers `START-INFO-DIR-ENTRY'
+(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'
 and `END-INFO-DIR-ENTRY'"
   (save-excursion
     (set-buffer (get-buffer-create " *Info-tmp*"))
@@ -1027,29 +1035,83 @@
 	  (setq beg (point))
 	  (unless (null (re-search-forward "^END-INFO-DIR-ENTRY" nil t))
 	    (goto-char (match-beginning 0))
-	    (buffer-substring beg (point))))))))
+	    (car (Info-parse-dir-entries beg (point)))))))))
+
+;; Parse dir entries contained between BEG and END into a list of the form
+;; (filename topic node (description-line-1 description-line-2 ...))
+(defun Info-parse-dir-entries (beg end)
+  (let (entry entries)
+    (save-excursion
+      (save-restriction
+	(narrow-to-region beg end)
+	(goto-char beg)
+	(while (re-search-forward "^\\* \\([^:]+\\):\\([ \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]*"))))
+			    entry))
+	  (setq entries (cons (nreverse entry) entries)))))
+    (nreverse entries)))
+
+(defun Info-dump-dir-entries (entries)
+  (let ((tab-width 8)
+	(description-col 0)
+	len)
+    (mapcar '(lambda (e)
+	       (setq e (cdr e))		; Drop filename
+	       (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
+		 (indent-to-column description-col)
+		 (insert (car e) "\n")
+		 (setq e (cdr e))))
+	    entries)))
+
 
 (defun Info-build-dir-anew (directory to-temp)
   "Build a new info dir file in DIRECTORY"
   (save-excursion
-    (let ((dirfile (expand-file-name "dir" directory)))
+    (let ((dirfile (expand-file-name "dir" directory))
+	  (info-files 
+	   (directory-files directory
+			    'fullname
+			    ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
+			    nil
+			    t)))
       (if to-temp
-	  (message "Creating temporary dir...")
+	  (display-warning 'info (format "Missing info dir file in %s" directory) 'notice)
 	(message "Creating %s..." dirfile))
-      (set-buffer (find-file-noselect 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")
-      (mapcar 
-       '(lambda (f)
-	  (insert (or (Info-extract-dir-entries-from f)
-		    (format "* %s::\t[No description available]\n"
-			    (file-name-sans-extension (file-name-nondirectory f))))))
-       (directory-files directory
-			'fullname
-			".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$"
-			nil
-			t))
+	      "Info files in " directory ":\n\n")
+      (Info-dump-dir-entries 
+       (mapcar 
+	'(lambda (f)
+	   (or (Info-extract-dir-entry-from f)
+	       (list 'dummy
+		     (file-name-sans-extension (file-name-nondirectory f))
+		     ":"
+		     (list Info-no-description-string))))
+	info-files))
       (if to-temp
 	  (set-buffer-modified-p nil)
 	(save-buffer))
@@ -1057,75 +1119,82 @@
 	  (message "Creating temporary dir...done")
 	(message "Creating %s...done" dirfile)))))
 
-(defvar Info-dir-entry-matcher "^\\* \\([^:]+\\):\\([ \t]*(\\(.*\\))\\w*\\.\\|:\\)[ \t]+\\(.*\\)$")
-
-(defun Info-parse-dir-entry (entry)
-  (string-match Info-dir-entry-matcher entry)
-  (list (match-string 1 entry) (match-string 2 entry) (match-string 4 entry)))
 
 (defun Info-rebuild-dir (file to-temp)
   "Update an existing info dir file after info files have been modified"
   (save-excursion
-    (let (dir-contents
-	  dir-entry
-	  file-dir-entry)
-      (set-buffer (find-file-noselect file))
-      (if to-temp
-	  (message "Rebuilding temporary dir...")
-	(message "Rebuilding %s..." file))
-      (setq buffer-read-only nil)
-      (goto-char (point-min))
-      (search-forward "\^_")
-      (re-search-forward "^\\* Menu:.*$" nil t)
-      (narrow-to-region (or (and (re-search-forward Info-dir-entry-matcher nil t)
-				 (match-beginning 0))
-			    (point))
-			(point-max))
-      (goto-char (point-min))
-      (while (re-search-forward Info-dir-entry-matcher nil t)
-	(setq dir-contents (cons (list (downcase (or (match-string 3)
-						     (match-string 1)))
-				       (match-string 1)
-				       (match-string 2)
-				       (match-string 4))
-				 dir-contents)))
-      (mapcar '(lambda (file)
-		 (setq dir-entry (assoc (downcase
+    (save-restriction
+      (let (dir-section-contents dir-full-contents
+	    dir-entry
+	    file-dir-entry
+	    mark next-section
+	    not-first-section)
+	(set-buffer (find-file-noselect file t))
+	(setq buffer-read-only nil)
+	(if to-temp
+	    (display-warning 'info (format "Outdated info dir file: %s" file) 'notice)
+	  (message "Rebuilding %s..." file))
+	(catch 'done
+	  (setq buffer-read-only nil)
+	  (goto-char (point-min))
+	  (unless (and (search-forward "\^_")
+		       (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 "^[^* \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 (point-min)
+									 (point-max))))
+	    (mapcar '(lambda (file)
+		       (setq dir-entry (assoc (downcase
+					       (file-name-sans-extension
+						(file-name-nondirectory file)))
+					      dir-section-contents)
+			     file-dir-entry (Info-extract-dir-entry-from file))
+		       (if dir-entry
+			   (if file-dir-entry
+			       ;; A dir entry in the info file takes precedence over an
+			       ;; existing entry in the dir file
+			       (setcdr dir-entry (cdr file-dir-entry)))
+			 (unless (or not-first-section
+				     (assoc (downcase
 					 (file-name-sans-extension
 					  (file-name-nondirectory file)))
-					dir-contents)
-		       file-dir-entry (Info-extract-dir-entries-from file))
-		 (if dir-entry
-		     (if file-dir-entry
-			 ;; A dir entry in the info file takes precedence over an
-			 ;; existing entry in the dir file
-			 (setcdr dir-entry (Info-parse-dir-entry file-dir-entry)))
-		   (if file-dir-entry
-		       (setq dir-contents (cons (cons 'dummy (Info-parse-dir-entry file-dir-entry))
-						dir-contents))
-		     (setq dir-contents (cons (list 'dummy
-						    (capitalize (file-name-sans-extension
-								 (file-name-nondirectory file)))
-						    ":"
-						    "[No description available]") 
-					      dir-contents)))))
-	      Info-dir-newer-info-files)
-      (delete-region (point-min) (point-max))
-      (mapcar '(lambda (entry)
-		 (setq entry (cdr entry))
-		 (insert (format "* %s:"
-				 (car entry)))
-		 (setq entry (cdr entry))
-		 (insert (car entry))
-		 (insert "\t" (car (cdr entry)) "\n"))
-	      (nreverse dir-contents))
-      (widen)
-      (if to-temp
-	  (set-buffer-modified-p nil)
-	(save-buffer))
-      (if to-temp
-	  (message "Rebuilding temporary dir...done")
-	(message "Rebuilding %s...done" file)))))
+					dir-full-contents))
+			   (if file-dir-entry
+			       (setq dir-section-contents (cons file-dir-entry
+								dir-section-contents))
+			     (setq dir-section-contents 
+				   (cons (list 'dummy
+					       (capitalize (file-name-sans-extension
+							    (file-name-nondirectory file)))
+					       ":"
+					       (list Info-no-description-string)) 
+					 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 "^[^* \t].*:[ \t]*$" nil t)
+					  (match-beginning 0))
+				     (point-max))))
+	    (setq not-first-section t)))
+	(if to-temp
+	    (set-buffer-modified-p nil)
+	  (save-buffer))
+	(if to-temp
+	    (message "Rebuilding temporary dir...done")
+	  (message "Rebuilding %s...done" file))))))
       
 
 (defun Info-history-add (file node point)