emacs: lisp/emacs-lisp/autoload.el comparison

comparison lisp/emacs-lisp/autoload.el @ 5837:fd1e2c6f7bf5

(autoload-trim-file-name): New function. (generate-file-autoloads): Bind print-readably to t for Lucid. Use autoload-trim-file-name on FILE when inserting the name. Scan written text and fix up ^L to \f and ( at bol to \(. (update-file-autoloads): When we find a later file's section, set FOUND to 'new. If FOUND is 'new after loop, check file for autoload cookies and don't call generate-file-autoloads if none. (update-directory-autoloads): Get absolute file names from directory-files. (batch-update-autoloads): Rewrite from jwz to process later files in a directory after one file errs.

author	Roland McGrath <roland@gnu.org>
date	Mon, 07 Feb 1994 22:19:05 +0000
parents	b1e5e6efed1d
children	d01185037467

comparison

equal deleted inserted replaced

-:6d7ceb4493e3
+:fd1e2c6f7bf5
 (put 'defun    'doc-string-elt 3)
 (put 'defvar   'doc-string-elt 3)
 (put 'defconst 'doc-string-elt 3)
 (put 'defmacro 'doc-string-elt 3)
+(defun autoload-trim-file-name (file)
+;; Returns a relative pathname of FILE including the last directory.
+(setq file (expand-file-name file))
+(file-relative-name file
+		      (file-name-directory
+		       (directory-file-name
+			(file-name-directory file)))))
 (defun generate-file-autoloads (file)
 "Insert at point a loaddefs autoload section for FILE.
 autoloads are generated for defuns and defmacros in FILE
 marked by `generate-autoload-cookie' (which see).
 If FILE is being visited in a buffer, the contents of the buffer
 	(load-name (let ((name (file-name-nondirectory file)))
 		     (if (string-match "\\.elc?$" name)
 			 (substring name 0 (match-beginning 0))
 		       name)))
 	(print-length nil)
+	(print-readably t)		; This does something in Lucid Emacs.
 	(float-output-format nil)
 	(done-any nil)
 	(visited (get-file-buffer file))
 	output-end)
 		  (cond
 		   ((looking-at (regexp-quote generate-autoload-cookie))
 		    (search-forward generate-autoload-cookie)
 		    (skip-chars-forward " \t")
 		    (setq done-any t)
-		    (if (eolp)
+		    (let ((begin (save-excursion (set-buffer outbuf)
-			;; Read the next form and make an autoload.
+						 (point))))
-			(let* ((form (prog1 (read (current-buffer))
+		      (if (eolp)
-				       (forward-line 1)))
+			  ;; Read the next form and make an autoload.
-			       (autoload (make-autoload form load-name))
+			  (let* ((form (prog1 (read (current-buffer))
-			       (doc-string-elt (get (car-safe form)
+					 (forward-line 1)))
-						    'doc-string-elt)))
+				 (autoload (make-autoload form load-name))
-			  (if autoload
+				 (doc-string-elt (get (car-safe form)
-			      (setq autoloads-done (cons (nth 1 form)
+						      'doc-string-elt)))
-							 autoloads-done))
+			    (if autoload
-			    (setq autoload form))
+				(setq autoloads-done (cons (nth 1 form)
-			  (if (and doc-string-elt
+							   autoloads-done))
-				   (stringp (nth doc-string-elt autoload)))
+			      (setq autoload form))
-			      ;; We need to hack the printing because the
+			    (if (and doc-string-elt
-			      ;; doc-string must be printed specially for
+				     (stringp (nth doc-string-elt autoload)))
-			      ;; make-docfile (sigh).
+				;; We need to hack the printing because the
-			      (let* ((p (nthcdr (1- doc-string-elt)
+				;; doc-string must be printed specially for
-						autoload))
+				;; make-docfile (sigh).
-				     (elt (cdr p)))
+				(let* ((p (nthcdr (1- doc-string-elt)
-				(setcdr p nil)
+						  autoload))
-				(princ "\n(" outbuf)
+				       (elt (cdr p)))
-				(let ((print-escape-newlines t))
+				  (setcdr p nil)
-				  (mapcar (function (lambda (elt)
+				  (princ "\n(" outbuf)
-						      (prin1 elt outbuf)
+				  (let ((print-escape-newlines t))
-						      (princ " " outbuf)))
+				    (mapcar (function (lambda (elt)
-					  autoload))
+							(prin1 elt outbuf)
-				(princ "\"\\\n" outbuf)
+							(princ " " outbuf)))
-				(princ (substring
+					    autoload))
-					(prin1-to-string (car elt)) 1)
+				  (princ "\"\\\n" outbuf)
-				       outbuf)
+				  (let ((begin (save-excursion
-				(if (null (cdr elt))
+						 (set-buffer outbuf)
-				    (princ ")" outbuf)
+						 (point))))
-				  (princ " " outbuf)
 				  (princ (substring
-					  (prin1-to-string (cdr elt))
+					  (prin1-to-string (car elt)) 1)
-					  1)
+					 outbuf)
-					 outbuf))
+				  ;; Insert a backslash before each ( that
-				(terpri outbuf))
+				  ;; appears at the beginning of a line in
-			    (print autoload outbuf)))
+				  ;; the doc string.
-		      ;; Copy the rest of the line to the output.
+				  (save-excursion
-		      (let ((begin (point)))
+				    (set-buffer outbuf)
-			(forward-line 1)
+				    (save-excursion
-			(princ (buffer-substring begin (point)) outbuf))))
+				      (while (search-backward "\n(" begin t)
-			((looking-at ";")
+					(forward-char 1)
-			 ;; Don't read the comment.
+					(insert "\\"))))
-			 (forward-line 1))
+				  (if (null (cdr elt))
-			(t
+				      (princ ")" outbuf)
-			 (forward-sexp 1)
+				    (princ " " outbuf)
-			 (forward-line 1)))))))
+				    (princ (substring
+					    (prin1-to-string (cdr elt))
+					    1)
+					   outbuf))
+				  (terpri outbuf))
+			      (print autoload outbuf)))
+			;; Copy the rest of the line to the output.
+			(let ((begin (point)))
+			  (forward-line 1)
+			  (princ (buffer-substring begin (point)) outbuf)))
+		      (save-excursion
+			(set-buffer outbuf)
+			;; Replace literal ^Ls with \f in what we just wrote.
+			(save-excursion
+			  (while (search-backward "\f" begin t)
+			    (delete-char 1)
+			    (insert "\\f"))))))
+		   ((looking-at ";")
+		    ;; Don't read the comment.
+		    (forward-line 1))
+		   (t
+		    (forward-sexp 1)
+		    (forward-line 1)))))))
 	(or visited
 	    ;; We created this buffer, so we should kill it.
 	    (kill-buffer (current-buffer)))
 	(set-buffer outbuf)
 	(setq output-end (point-marker))))
 (if done-any
 	(progn
 	  (insert generate-autoload-section-header)
-	  (prin1 (list 'autoloads autoloads-done load-name file
+	  (prin1 (list 'autoloads autoloads-done load-name
+		       (autoload-trim-file-name file)
 		       (nth 5 (file-attributes file)))
 		 outbuf)
 	  (terpri outbuf)
-	  (insert ";;; Generated autoloads from " file "\n")
+	  (insert ";;; Generated autoloads from "
+		  (autoload-trim-file-name file) "\n")
 	  (goto-char output-end)
 	  (insert generate-autoload-section-trailer)))
 (message "Generating autoloads for %s...done" file)))
 (defconst generated-autoload-file "loaddefs.el"
 		     ;; We've come to a section alphabetically later than
 		     ;; LOAD-NAME.  We assume the file is in order and so
 		     ;; there must be no section for LOAD-NAME.  We will
 		     ;; insert one before the section here.
 		     (goto-char (match-beginning 0))
-		     (setq found t)))))
+		     (setq found 'new)))))
-	  (if (eq found t)
+	  (or (eq found 'up-to-date)
+	      (and (eq found 'new)
+		   ;; Check that FILE has any cookies before generating a
+		   ;; new section for it.
+		   (save-excursion
+		     (set-buffer (find-file-noselect file))
+		     (save-excursion
+		       (widen)
+		       (goto-char (point-min))
+		       (if (search-forward (concat "\n"
+						   generate-autoload-cookie)
+					   nil t)
+			   nil
+			 (if (interactive-p)
+			     (message file " has no autoloads"))
+			 t))))
 	      (generate-file-autoloads file))
 	  (setq done t)))
 (if (interactive-p) (save-buffer))
 (if (and (null existing-buffer)
 	       (setq existing-buffer (get-file-buffer file)))
 ;;;###autoload
 (defun update-directory-autoloads (dir)
 "Run \\[update-file-autoloads] on each .el file in DIR."
 (interactive "DUpdate autoloads for directory: ")
 (mapcar 'update-file-autoloads
-	  (directory-files dir nil "\\.el$"))
+	  (directory-files dir t "\\.el$"))
 (if (interactive-p)
 (save-excursion
 	(set-buffer (find-file-noselect generated-autoload-file))
 	(save-buffer))))
 Each file will be processed even if an error occurred previously.
 For example, invoke \"emacs -batch -f batch-update-autoloads *.el\""
 (if (not noninteractive)
 (error "batch-update-autoloads is to be used only with -batch"))
 (let ((lost nil)
-	(args command-line-args-left))
+	(args command-line-args-left)
-(while args
+	(enable-local-eval nil))	;Don't query in batch mode.
-(catch 'file
+(message "Updating autoloads in %s..." generated-autoload-file)
-	(condition-case lossage
+(let ((frob (function
-	    (if (file-directory-p (expand-file-name (car args)))
+		 (lambda (file)
-		(update-directory-autoloads (car args))
+		   (condition-case lossage
-	      (update-file-autoloads (car args)))
+		       (update-file-autoloads file)
-	  (error (progn (message ">>Error processing %s: %s"
+		     (error
-				 (car args) lossage)
+		      (princ ">>Error processing ")
-			(setq lost t)
+		      (princ file)
-			(throw 'file nil)))))
+		      (princ ": ")
-(setq args (cdr args)))
+		      (if (fboundp 'display-error)
+			  (display-error lossage nil)
+			(prin1 lossage))
+		      (princ "\n")
+		      (setq lost t)))))))
+(while args
+	(if (file-directory-p (expand-file-name (car args)))
+	    (let ((rest (directory-files (car args) t "\\.el$")))
+	      (while rest
+		(funcall frob (car rest))
+		(setq rest (cdr rest))))
+	  (funcall frob (car args)))
+	(setq args (cdr args)))
 (save-some-buffers t)
 (message "Done")
 (kill-emacs (if lost 1 0))))
 (provide 'autoload)

Mercurial > emacs

comparison lisp/emacs-lisp/autoload.el @ 5837:fd1e2c6f7bf5