Initial revision

lisp/emacs-lisp/autoload.el

+;;; Maintain autoloads in loaddefs.el.
+;;; Copyright (C) 1991 Free Software Foundation, Inc.
+;;; Written by Roland McGrath.
+;;;
+;;; This program 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 1, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but 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.
+;;;
+;;; A copy of the GNU General Public License can be obtained from this
+;;; program's author (send electronic mail to roland@ai.mit.edu) or from
+;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+;;; 02139, USA.
+;;;
+
+(defun make-autoload (form file)
+  "Turn FORM, a defun or defmacro, into an autoload for source file FILE.
+Returns nil if FORM is not a defun or defmacro."
+  (let ((car (car-safe form)))
+    (if (or (eq car 'defun) (eq car 'defmacro))
+	(let (name doc macrop)
+	  (setq macrop (eq car 'defmacro))
+	  (setq form (cdr form))
+	  (setq name (car form))
+	  ;; Ignore the arguments.
+	  (setq form (cdr (cdr form)))
+	  (setq doc (car form))
+	  (if (stringp doc)
+	      (setq form (cdr form))
+	    (setq doc nil))
+	  (list 'autoload (list 'quote name) file doc
+		(eq (car-safe (car form)) 'interactive) macrop))
+      nil)))
+
+(defconst generate-autoload-cookie ";;;###autoload"
+  "Magic comment that tells \\[update-file-autoloads]
+to make the following form into an autoload.  This string should be
+meaningless to Lisp (e.g., a comment).
+
+This string is used:
+
+;;;###autoload
+\(defun function-to-be-autoloaded () ...)
+
+If this string appears alone on a line, the following form will be
+read and an autoload made for it.  If there is further text on the line,
+that text will be copied verbatim to `generated-autoload-file'.")
+
+(defconst generate-autoload-section-header "\f\n;;;### "
+  "String inserted before the form identifying
+the section of autoloads for a file.")
+
+(defconst generate-autoload-section-trailer "\n;;;***\n"
+  "String which indicates the end of the section of autoloads for a file.")
+
+;; Forms which have doc-strings which should be printed specially.
+;; A doc-string-elt property of ELT says that (nth ELT FORM) is
+;; the doc-string in FORM.
+;; Note: defconst and defvar should NOT be marked in this way.
+;; We don't want to produce defconsts and defvars that make-docfile can
+;; grok, because then it would grok them twice, once in foo.el (where they
+;; are given with ;;;###autoload) and once in loaddefs.el.
+(put 'autoload 'doc-string-elt 3)
+
+(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-regexp' (which see).
+If FILE is being visited in a buffer, the contents of the buffer
+are used."
+  (interactive "fGenerate autoloads for file: ")
+  (let ((outbuf (current-buffer))
+	(inbuf (find-file-noselect file))
+	(autoloads-done '())
+	(load-name (let ((name (file-name-nondirectory file)))
+		     (if (string-match "\\.elc?$" name)
+			 (substring name 0 (match-beginning 0))
+		       name)))
+	(print-length nil)
+	(floating-output-format "%20e")
+	(done-any nil)
+	output-end)
+    (message "Generating autoloads for %s..." file)
+    (save-excursion
+      (set-buffer inbuf)
+      (save-excursion
+	(save-restriction
+	  (widen)
+	  (goto-char (point-min))
+	  (while (not (eobp))
+	    (skip-chars-forward " \t\n\f")
+	    (cond ((looking-at (regexp-quote generate-autoload-cookie))
+		   (search-forward generate-autoload-cookie)
+		   (skip-chars-forward " \t")
+		   (setq done-any t)
+		   (if (eolp)
+		       ;; Read the next form and make an autoload.
+		       (let* ((form (prog1 (read (current-buffer))
+				      (forward-line 1)))
+			      (autoload (make-autoload form load-name))
+			      (doc-string-elt (get (car-safe form)
+						   'doc-string-elt)))
+			 (if autoload
+			     (setq autoloads-done (cons (nth 1 form)
+							autoloads-done))
+			   (setq autoload form))
+			 (if (and doc-string-elt
+				  (stringp (nth doc-string-elt autoload)))
+			     ;; We need to hack the printing because the
+			     ;; doc-string must be printed specially for
+			     ;; make-docfile (sigh).
+			     (let* ((p (nthcdr (1- doc-string-elt) autoload))
+				    (elt (cdr p)))
+			       (setcdr p nil)
+			       (princ "\n(" outbuf)
+			       (mapcar (function (lambda (elt)
+						   (prin1 elt outbuf)
+						   (princ " " outbuf)))
+				       autoload)
+			       (princ "\"\\\n" outbuf)
+			       (princ (substring (prin1-to-string (car elt)) 1)
+				      outbuf)
+			       (if (null (cdr elt))
+				   (princ ")" outbuf)
+				 (princ " " outbuf)
+				 (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))))
+		  ((looking-at ";")
+		   ;; Don't read the comment.
+		   (forward-line 1))
+		  (t
+		   (forward-sexp 1)
+		   (forward-line 1))))))
+      (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
+		       (nth 5 (file-attributes file)))
+		 outbuf)
+	  (terpri outbuf)
+	  (insert ";;; Generated autoloads from " file "\n")
+	  (goto-char output-end)
+	  (insert generate-autoload-section-trailer)))
+    (message "Generating autoloads for %s...done" file)))
+
+(defconst generated-autoload-file "loaddefs.el"
+   "*File \\[update-file-autoloads] puts autoloads into.
+A .el file can set this in its local variables section to make its
+autoloads go somewhere else.")
+
+;;;###autoload
+(defun update-file-autoloads (file)
+  "Update the autoloads for FILE in `generated-autoload-file'
+\(which FILE might bind in its local variables)."
+  (interactive "fUpdate autoloads for file: ")
+  (let ((load-name (let ((name (file-name-nondirectory file)))
+		     (if (string-match "\\.elc?$" name)
+			 (substring name 0 (match-beginning 0))
+		       name)))
+	(done nil)
+	(existing-buffer (get-file-buffer file)))
+    (save-excursion
+      ;; We want to get a value for generated-autoload-file from
+      ;; the local variables section if it's there.
+      (set-buffer (find-file-noselect file))
+      (set-buffer (find-file-noselect generated-autoload-file))
+      (save-excursion
+	(save-restriction
+	  (widen)
+	  (goto-char (point-min))
+	  (while (search-forward generate-autoload-section-header nil t)
+	    (let ((form (condition-case ()
+			    (read (current-buffer))
+			  (end-of-file nil))))
+	      (if (string= (nth 2 form) load-name)
+		  (let ((begin (match-beginning 0))
+			(last-time (nth 4 form))
+			(file-time (nth 5 (file-attributes file))))
+		    (if (and (or (null existing-buffer)
+				 (not (buffer-modified-p existing-buffer)))
+			     (listp last-time) (= (length last-time) 2)
+			     (or (> (car last-time) (car file-time))
+				 (and (= (car last-time) (car file-time))
+				      (>= (nth 1 last-time)
+					  (nth 1 file-time)))))
+			(message "Autoload section for %s is up to date."
+				 file)
+		      (search-forward generate-autoload-section-trailer)
+		      (delete-region begin (point))
+		      (generate-file-autoloads file))
+		    (setq done t))))))
+	(if done
+	    ()
+	  ;; Have the user tell us where to put the section.
+	  (save-window-excursion
+	    (switch-to-buffer (current-buffer))
+	    (with-output-to-temp-buffer "*Help*"
+	      (princ (substitute-command-keys
+		      (format "\
+Move point to where the autoload section
+for %s should be inserted.
+Then do \\[exit-recursive-edit]."
+			      file))))
+	    (recursive-edit))
+	  (generate-file-autoloads file)))
+      (if (and (null existing-buffer)
+	       (setq existing-buffer (get-file-buffer file)))
+	  (kill-buffer existing-buffer)))))
+
+;;;###autoload
+(defun update-autoloads-here ()
+  "Update the sections of the current buffer generated by
+\\[update-file-autoloads]."
+  (interactive)
+  (let ((generated-autoload-file (buffer-file-name)))
+    (save-excursion
+      (goto-char (point-min))
+      (while (search-forward generate-autoload-section-header nil t)
+	(let* ((form (condition-case ()
+			 (read (current-buffer))
+		       (end-of-file nil)))
+	       (file (nth 3 form)))
+	  (if (and (stringp file)
+		   (or (get-file-buffer file)
+		       (file-exists-p file)))
+	      ()
+	    (setq file (if (y-or-n-p (format "Library \"%s\" (load \
+file \"%s\") doesn't exist.  Remove its autoload section? "
+					     (nth 2 form) file))
+			   t
+			 (condition-case ()
+			     (read-file-name (format "Find \"%s\" load file: "
+						     (nth 2 form))
+					     nil nil t)
+			   (quit nil)))))
+	  (if file
+	      (let ((begin (match-beginning 0)))
+		(search-forward generate-autoload-section-trailer)
+		(delete-region begin (point))))
+	  (if (stringp file)
+	      (generate-file-autoloads 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$")))
+
+;;;###autoload
+(defun batch-update-autoloads ()
+  "Update the autoloads for the files or directories on the command line.
+Runs \\[update-file-autoloads] on files and \\[update-directory-autoloads]
+on directories.  Must be used only with -batch, and kills Emacs on completion.
+Each file will be processed even if an error occurred previously.
+For example, invoke \"emacs -batch -f batch-byte-compile *.el\""
+  (if (not noninteractive)
+      (error "batch-update-file-autoloads is to be used only with -batch"))
+  (let ((lost nil)
+	(args command-line-args-left))
+    (while args
+      (catch 'file
+	(condition-case lossage
+	    (if (file-directory-p (expand-file-name (car args)))
+		(update-directory-autoloads (car args))
+	      (update-file-autoloads (car args)))
+	  (error (progn (message ">>Error processing %s: %s"
+				 (car args) lossage)
+			(setq lost t)
+			(throw 'file nil)))))
+      (setq args (cdr args)))
+    (save-some-buffers t)
+    (message "Done")
+    (kill-emacs (if lost 1 0))))
+
+(provide 'autoload)

lisp/emacs-lisp/debug.el

+;; Debuggers and related commands for Emacs
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; 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 1, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but 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 GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+(defvar debug-function-list nil
+  "List of functions currently set for debug on entry.")
+
+;;;###autoload
+(setq debugger 'debug)
+;;;###autoload
+(defun debug (&rest debugger-args)
+  "Enter debugger.  Returns if user says \"continue\".
+Arguments are mainly for use when this is called from the internals
+of the evaluator.
+
+You may call with no args, or you may pass nil as the first arg and
+any other args you like.  In that case, the list of args after the
+first will be printed into the backtrace buffer."
+  (message "Entering debugger...")
+  (let (debugger-value
+	(debugger-match-data (match-data))
+	(debug-on-error nil)
+	(debug-on-quit nil)
+	(debugger-buffer (let ((default-major-mode 'fundamental-mode))
+			   (generate-new-buffer "*Backtrace*")))
+	(debugger-old-buffer (current-buffer))
+	(debugger-step-after-exit nil)
+	;; Don't keep reading from an executing kbd macro!
+	(executing-macro nil)
+	(cursor-in-echo-area nil))
+    (unwind-protect
+	(save-excursion
+	  (save-window-excursion
+	    (pop-to-buffer debugger-buffer)
+	    (erase-buffer)
+	    (let ((standard-output (current-buffer))
+		  (print-escape-newlines t)
+		  (print-length 50))
+	      (backtrace))
+	    (goto-char (point-min))
+	    (debugger-mode)
+	    (delete-region (point)
+			   (progn
+			     (search-forward "\n  debug(")
+			     (forward-line 1)
+			     (point)))
+	    (debugger-reenable)
+	    (cond ((memq (car debugger-args) '(lambda debug))
+		   (insert "Entering:\n")
+		   (if (eq (car debugger-args) 'debug)
+		       (progn
+			 (backtrace-debug 4 t)
+			 (delete-char 1)
+			 (insert ?*)
+			 (beginning-of-line))))
+		  ((eq (car debugger-args) 'exit)
+		   (insert "Return value: ")
+		   (setq debugger-value (nth 1 debugger-args))
+		   (prin1 debugger-value (current-buffer))
+		   (insert ?\n)
+		   (delete-char 1)
+		   (insert ? )
+		   (beginning-of-line))
+		  ((eq (car debugger-args) 'error)
+		   (insert "Signalling: ")
+		   (prin1 (nth 1 debugger-args) (current-buffer))
+		   (insert ?\n))
+		  ((eq (car debugger-args) t)
+		   (insert "Beginning evaluation of function call form:\n"))
+		  (t
+		   (prin1 (if (eq (car debugger-args) 'nil)
+			      (cdr debugger-args) debugger-args)
+			  (current-buffer))
+		   (insert ?\n)))
+	    (message "")
+	    (let ((inhibit-trace t)
+		  (standard-output nil)
+		  (buffer-read-only t))
+	      (message "")
+	      (recursive-edit))))
+      ;; So that users do not try to execute debugger commands
+      ;;  in an invalid context
+      (kill-buffer debugger-buffer)
+      (store-match-data debugger-match-data))
+    (setq debug-on-next-call debugger-step-after-exit)
+    debugger-value))
+
+(defun debugger-step-through ()
+  "Proceed, stepping through subexpressions of this expression.
+Enter another debugger on next entry to eval, apply or funcall."
+  (interactive)
+  (setq debugger-step-after-exit t)
+  (message "Proceeding, will debug on next eval or call.")
+  (exit-recursive-edit))
+
+(defun debugger-continue ()
+  "Continue, evaluating this expression without stopping."
+  (interactive)
+  (message "Continuing.")
+  (exit-recursive-edit))
+
+(defun debugger-return-value (val)
+  "Continue, specifying value to return.
+This is only useful when the value returned from the debugger
+will be used, such as in a debug on exit from a frame."
+  (interactive "XReturn value (evaluated): ")
+  (setq debugger-value val)
+  (princ "Returning " t)
+  (prin1 debugger-value)
+  (exit-recursive-edit))
+
+(defun debugger-jump ()
+  "Continue to exit from this frame, with all debug-on-entry suspended."
+  (interactive)
+  ;; Compensate for the two extra stack frames for debugger-jump.
+  (let ((debugger-frame-offset (+ debugger-frame-offset 2)))
+    (debugger-frame))
+  ;; Turn off all debug-on-entry functions
+  ;; but leave them in the list.
+  (let ((list debug-function-list))
+    (while list
+      (fset (car list)
+	    (debug-on-entry-1 (car list) (symbol-function (car list)) nil))
+      (setq list (cdr list))))
+  (message "Continuing through this frame")
+  (exit-recursive-edit))
+
+(defun debugger-reenable ()
+  "Turn all debug-on-entry functions back on."
+  (let ((list debug-function-list))
+    (while list
+      (or (consp (symbol-function (car list)))
+	  (debug-convert-byte-code (car list)))
+      (fset (car list)
+	    (debug-on-entry-1 (car list) (symbol-function (car list)) t))
+      (setq list (cdr list)))))
+
+(defun debugger-frame-number ()
+  "Return number of frames in backtrace before the one point points at."
+  (save-excursion
+    (beginning-of-line)
+    (let ((opoint (point))
+	  (count 0))
+      (goto-char (point-min))
+      (if (or (equal (buffer-substring (point) (+ (point) 6))
+		     "Signal")
+	      (equal (buffer-substring (point) (+ (point) 6))
+		     "Return"))
+	  (progn
+	    (search-forward ":")
+	    (forward-sexp 1)))
+      (forward-line 1)
+      (while (progn
+	       (forward-char 2)
+	       (if (= (following-char) ?\()
+		   (forward-sexp 1)
+		 (forward-sexp 2))
+	       (forward-line 1)
+	       (<= (point) opoint))
+	(setq count (1+ count)))
+      count)))
+
+;; Chosen empirically to account for all the frames
+;; that will exist when debugger-frame is called
+;; within the first one that appears in the backtrace buffer.
+;; Assumes debugger-frame is called from a key;
+;; will be wrong if it is called with Meta-x.
+(defconst debugger-frame-offset 8 "")
+
+(defun debugger-frame ()
+  "Request entry to debugger when this frame exits.
+Applies to the frame whose line point is on in the backtrace."
+  (interactive)
+  (beginning-of-line)
+  (let ((level (debugger-frame-number)))
+    (backtrace-debug (+ level debugger-frame-offset) t))
+  (if (= (following-char) ? )
+      (let ((buffer-read-only nil))
+	(delete-char 1)
+	(insert ?*)))
+  (beginning-of-line))
+
+(defun debugger-frame-clear ()
+  "Do not enter to debugger when this frame exits.
+Applies to the frame whose line point is on in the backtrace."
+  (interactive)
+  (beginning-of-line)
+  (let ((level (debugger-frame-number)))
+    (backtrace-debug (+ level debugger-frame-offset) nil))
+  (if (= (following-char) ?*)
+      (let ((buffer-read-only nil))
+	(delete-char 1)
+	(insert ? )))
+  (beginning-of-line))
+
+(defun debugger-eval-expression (exp)
+  (interactive "xEval: ")
+  (save-excursion
+    (if (null (buffer-name debugger-old-buffer))
+	;; old buffer deleted
+	(setq debugger-old-buffer (current-buffer)))
+    (set-buffer debugger-old-buffer)
+    (eval-expression exp)))
+
+(defvar debugger-mode-map nil)
+(if debugger-mode-map
+    nil
+  (let ((loop ? ))
+    (setq debugger-mode-map (make-keymap))
+    (suppress-keymap debugger-mode-map)
+    (define-key debugger-mode-map "-" 'negative-argument)
+    (define-key debugger-mode-map "b" 'debugger-frame)
+    (define-key debugger-mode-map "c" 'debugger-continue)
+    (define-key debugger-mode-map "j" 'debugger-jump)
+    (define-key debugger-mode-map "r" 'debugger-return-value)
+    (define-key debugger-mode-map "u" 'debugger-frame-clear)
+    (define-key debugger-mode-map "d" 'debugger-step-through)
+    (define-key debugger-mode-map "l" 'debugger-list-functions)
+    (define-key debugger-mode-map "h" 'describe-mode)
+    (define-key debugger-mode-map "q" 'top-level)
+    (define-key debugger-mode-map "e" 'debugger-eval-expression)
+    (define-key debugger-mode-map " " 'next-line)))
+
+(put 'debugger-mode 'mode-class 'special)
+
+(defun debugger-mode ()
+  "Mode for backtrace buffers, selected in debugger.
+\\<debugger-mode-map>
+A line starts with `*' if exiting that frame will call the debugger.
+Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'.
+
+When in debugger due to frame being exited,
+use the \\[debugger-return-value] command to override the value
+being returned from that frame.
+
+Use \\[debug-on-entry] and \\[cancel-debug-on-entry] to control
+which functions will enter the debugger when called.
+
+Complete list of commands:
+\\{debugger-mode-map}"
+  (kill-all-local-variables)    
+  (setq major-mode 'debugger-mode)
+  (setq mode-name "Debugger")
+  (setq truncate-lines t)
+  (set-syntax-table emacs-lisp-mode-syntax-table)
+  (use-local-map debugger-mode-map))
+
+;;;###autoload
+(defun debug-on-entry (function)
+  "Request FUNCTION to invoke debugger each time it is called.
+If the user continues, FUNCTION's execution proceeds.
+Works by modifying the definition of FUNCTION,
+which must be written in Lisp, not predefined.
+Use \\[cancel-debug-on-entry] to cancel the effect of this command.
+Redefining FUNCTION also does that."
+  (interactive "aDebug on entry (to function): ")
+  (debugger-reenable)
+  (if (subrp (symbol-function function))
+      (error "Function %s is a primitive" function))
+  (or (consp (symbol-function function))
+      (debug-convert-byte-code function))
+  (or (consp (symbol-function function))
+      (error "Definition of %s is not a list" function))
+  (fset function (debug-on-entry-1 function (symbol-function function) t))
+  (or (memq function debug-function-list)
+      (setq debug-function-list (cons function debug-function-list)))
+  function)
+
+;;;###autoload
+(defun cancel-debug-on-entry (&optional function)
+  "Undo effect of \\[debug-on-entry] on FUNCTION.
+If argument is nil or an empty string, cancel for all functions."
+  (interactive "aCancel debug on entry (to function): ")
+  (debugger-reenable)
+  (if (and function (not (string= function "")))
+      (progn
+	(fset function
+	      (debug-on-entry-1 function (symbol-function function) nil))
+	(setq debug-function-list (delq function debug-function-list))
+	function)
+    (message "Cancelling debug-on-entry for all functions")
+    (mapcar 'cancel-debug-on-entry debug-function-list)))
+
+(defun debug-convert-byte-code (function)
+  (let ((defn (symbol-function function)))
+    (if (not (consp defn))
+	;; Assume a compiled code object.
+	(let* ((contents (append defn nil))
+	       (body
+		(list (list 'byte-code (nth 1 contents)
+			    (nth 2 contents) (nth 3 contents)))))
+	  (if (nthcdr 5 contents)
+	      (setq body (cons (list 'interactive (nth 5 contents)) body)))
+	  (if (nth 4 contents)
+	      (setq body (cons (nth 4 contents) body)))
+	  (fset function (cons 'lambda (cons (car contents) body)))))))
+
+(defun debug-on-entry-1 (function defn flag)
+  (if (subrp defn)
+      (error "%s is a built-in function" function)
+    (if (eq (car defn) 'macro)
+	(debug-on-entry-1 function (cdr defn) flag)
+      (or (eq (car defn) 'lambda)
+	  (error "%s not user-defined Lisp function" function))
+      (let (tail prec)
+	(if (stringp (car (nthcdr 2 defn)))
+	    (setq tail (nthcdr 3 defn)
+		  prec (list (car defn) (car (cdr defn))
+			     (car (cdr (cdr defn)))))
+	  (setq tail (nthcdr 2 defn)
+		prec (list (car defn) (car (cdr defn)))))