summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/copyright.el37
-rw-r--r--lisp/emacs-lisp/debug.el146
-rw-r--r--lisp/emacs-lisp/re-builder.el8
-rw-r--r--lisp/emacs-lisp/trace.el86
4 files changed, 156 insertions, 121 deletions
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index a79e53b7dd4..a37dfac9e9a 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -1,6 +1,6 @@
;;; copyright.el --- update the copyright notice in current buffer
-;; Copyright (C) 1991, 92, 93, 94, 95, 1998, 2001, 2003, 2004
+;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1998, 2001, 2003, 2004, 2005
;; Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
@@ -176,6 +176,41 @@ version \\([0-9]+\\), or (at"
;;;###autoload
+(defun copyright-fix-years ()
+ "Convert 2 digit years to 4 digit years.
+Uses heuristic: year >= 50 means 19xx, < 50 means 20xx."
+ (interactive)
+ (widen)
+ (goto-char (point-min))
+ (if (re-search-forward copyright-regexp (+ (point) copyright-limit) t)
+ (let ((s (match-beginning 2)) (e (make-marker))
+ last)
+ (set-marker e (1+ (match-end 2)))
+ (goto-char s)
+ (while (and (< (point) (marker-position e))
+ (re-search-forward "\\([^0-9]\\)\\([0-9]+\\)[^0-9]"
+ (marker-position e) t))
+ (let ((p (point))
+ (sep (match-string 1))
+ (year (string-to-number (match-string 2))))
+ (goto-char (1+ (match-beginning 0)))
+ (unless (= (char-syntax (string-to-char sep)) ?\s)
+ (insert " "))
+ (if (< year 100)
+ (insert (if (>= year 50) "19" "20")))
+ (goto-char p)
+ (setq last p)))
+ (when last
+ (goto-char last)
+ (let ((fill-prefix " "))
+ (fill-region s last))
+ )
+ (set-marker e nil)
+ (copyright-update nil t))
+ (message "No copyright message")
+ (goto-char (point-min))))
+
+;;;###autoload
(define-skeleton copyright
"Insert a copyright by $ORGANIZATION notice at cursor."
"Company: "
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index a84a7aca52c..b637ead05ee 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -1,6 +1,7 @@
;;; debug.el --- debuggers and related commands for Emacs
-;; Copyright (C) 1985, 1986, 1994, 2001, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1994, 2001, 2003, 2005
+;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, tools, maint
@@ -24,7 +25,7 @@
;;; Commentary:
-;; This is a major mode documented in the Emacs manual.
+;; This is a major mode documented in the Emacs Lisp manual.
;;; Code:
@@ -92,6 +93,13 @@ This is to optimize `debugger-make-xrefs'.")
(defvar debugger-outer-inhibit-redisplay)
(defvar debugger-outer-cursor-in-echo-area)
+(defvar inhibit-debug-on-entry nil)
+
+;; When you change this, you may also need to change the number of
+;; frames that the debugger skips.
+(defconst debug-entry-code '(if inhibit-debug-on-entry nil (debug 'debug))
+ "Code added to a function to cause it to call the debugger upon entry.")
+
;;;###autoload
(setq debugger 'debug)
;;;###autoload
@@ -146,6 +154,8 @@ first will be printed into the backtrace buffer."
(setq overriding-terminal-local-map nil)
;; Don't let these magic variables affect the debugger itself.
(let ((last-command nil) this-command track-mouse
+ (inhibit-trace t)
+ (inhibit-debug-on-entry t)
unread-command-events
unread-post-input-method-events
last-input-event last-command-event last-nonmenu-event
@@ -184,12 +194,12 @@ first will be printed into the backtrace buffer."
(message "%s" (buffer-string))
(kill-emacs))
(if (eq (car debugger-args) 'debug)
- ;; Skip the frames for backtrace-debug, byte-code, and debug.
- (backtrace-debug 3 t))
+ ;; Skip the frames for backtrace-debug, byte-code,
+ ;; and debug-entry-code.
+ (backtrace-debug 4 t))
(debugger-reenable)
(message "")
- (let ((inhibit-trace t)
- (standard-output nil)
+ (let ((standard-output nil)
(buffer-read-only t))
(message "")
;; Make sure we unbind buffer-read-only in the right buffer.
@@ -197,15 +207,16 @@ first will be printed into the backtrace buffer."
(recursive-edit)))))
;; Kill or at least neuter the backtrace buffer, so that users
;; don't try to execute debugger commands in an invalid context.
- (if (get-buffer-window debugger-buffer 'visible)
+ (if (get-buffer-window debugger-buffer 0)
;; Still visible despite the save-window-excursion? Maybe it
;; it's in a pop-up frame. It would be annoying to delete and
;; recreate it every time the debugger stops, so instead we'll
- ;; erase it but leave it visible.
- (save-excursion
- (set-buffer debugger-buffer)
+ ;; erase it and hide it but keep it alive.
+ (with-current-buffer debugger-buffer
(erase-buffer)
- (fundamental-mode))
+ (fundamental-mode)
+ (with-selected-window (get-buffer-window debugger-buffer 0)
+ (bury-buffer)))
(kill-buffer debugger-buffer))
(set-match-data debugger-outer-match-data)))
;; Put into effect the modified values of these variables
@@ -248,7 +259,9 @@ That buffer should be current already."
(delete-region (point)
(progn
(search-forward "\n debug(")
- (forward-line 1)
+ (forward-line (if (eq (car debugger-args) 'debug)
+ 2 ; Remove debug-entry-code frame.
+ 1))
(point)))
(insert "Debugger entered")
;; lambda is for debug-on-call when a function call is next.
@@ -421,14 +434,13 @@ will be used, such as in a debug on exit from a frame."
(count 0))
(while (not (eq (cadr (backtrace-frame count)) 'debug))
(setq count (1+ count)))
+ ;; Skip debug-entry-code frame.
+ (when (member '(debug (quote debug)) (cdr (backtrace-frame (1+ count))))
+ (setq count (1+ count)))
(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)))
+ (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
+ (goto-char (match-end 0))
+ (forward-sexp 1))
(forward-line 1)
(while (progn
(forward-char 2)
@@ -474,8 +486,6 @@ Applies to the frame whose line point is on in the backtrace."
(insert ? )))
(beginning-of-line))
-
-
(put 'debugger-env-macro 'lisp-indent-function 0)
(defmacro debugger-env-macro (&rest body)
"Run BODY in original environment."
@@ -543,29 +553,26 @@ Applies to the frame whose line point is on in the backtrace."
'read-expression-history)))
(debugger-env-macro (eval-expression exp)))
-(defvar debugger-mode-map nil)
-(unless debugger-mode-map
- (let ((loop ? ))
- (setq debugger-mode-map (make-keymap))
- (set-keymap-parent debugger-mode-map button-buffer-map)
- (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)
- (define-key debugger-mode-map "R" 'debugger-record-expression)
- (define-key debugger-mode-map "\C-m" 'help-follow)
- (define-key debugger-mode-map [mouse-2] 'push-button)
- ))
-
+(defvar debugger-mode-map
+ (let ((map (make-keymap)))
+ (set-keymap-parent map button-buffer-map)
+ (suppress-keymap map)
+ (define-key map "-" 'negative-argument)
+ (define-key map "b" 'debugger-frame)
+ (define-key map "c" 'debugger-continue)
+ (define-key map "j" 'debugger-jump)
+ (define-key map "r" 'debugger-return-value)
+ (define-key map "u" 'debugger-frame-clear)
+ (define-key map "d" 'debugger-step-through)
+ (define-key map "l" 'debugger-list-functions)
+ (define-key map "h" 'describe-mode)
+ (define-key map "q" 'top-level)
+ (define-key map "e" 'debugger-eval-expression)
+ (define-key map " " 'next-line)
+ (define-key map "R" 'debugger-record-expression)
+ (define-key map "\C-m" 'help-follow)
+ (define-key map [mouse-2] 'push-button)
+ map))
(defcustom debugger-record-buffer "*Debugger-record*"
"*Buffer name for expression values, for \\[debugger-record-expression]."
@@ -616,7 +623,7 @@ Complete list of commands:
(setq truncate-lines t)
(set-syntax-table emacs-lisp-mode-syntax-table)
(use-local-map debugger-mode-map)
- (run-hooks 'debugger-mode-hook))
+ (run-mode-hooks 'debugger-mode-hook))
;;;###autoload
(defun debug-on-entry (function)
@@ -699,39 +706,40 @@ If argument is nil or an empty string, cancel for all functions."
(debug-on-entry-1 function (cdr defn) flag)
(or (eq (car defn) 'lambda)
(error "%s not user-defined Lisp function" function))
- (let ((tail (cddr defn)))
+ (let ((tail (cdr defn)))
;; Skip the docstring.
- (if (stringp (car tail)) (setq tail (cdr tail)))
+ (when (and (stringp (cadr tail)) (cddr tail))
+ (setq tail (cdr tail)))
;; Skip the interactive form.
- (if (eq 'interactive (car-safe (car tail))) (setq tail (cdr tail)))
- (unless (eq flag (equal (car tail) '(debug 'debug)))
+ (when (eq 'interactive (car-safe (cadr tail)))
+ (setq tail (cdr tail)))
+ (unless (eq flag (equal (cadr tail) debug-entry-code))
;; Add/remove debug statement as needed.
- (if (not flag)
- (progn (setcar tail (cadr tail))
- (setcdr tail (cddr tail)))
- (setcdr tail (cons (car tail) (cdr tail)))
- (setcar tail '(debug 'debug))))
+ (if flag
+ (setcdr tail (cons debug-entry-code (cdr tail)))
+ (setcdr tail (cddr tail))))
defn))))
(defun debugger-list-functions ()
"Display a list of all the functions now set to debug on entry."
(interactive)
- (with-output-to-temp-buffer "*Help*"
- (if (null debug-function-list)
- (princ "No debug-on-entry functions now\n")
- (princ "Functions set to debug on entry:\n\n")
- (let ((list debug-function-list))
- (while list
- (prin1 (car list))
- (terpri)
- (setq list (cdr list))))
- (princ "Note: if you have redefined a function, then it may no longer\n")
- (princ "be set to debug on entry, even if it is in the list."))
- (save-excursion
- (set-buffer standard-output)
- (help-mode))))
+ (require 'help-mode)
+ (help-setup-xref '(debugger-list-functions) (interactive-p))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (if (null debug-function-list)
+ (princ "No debug-on-entry functions now\n")
+ (princ "Functions set to debug on entry:\n\n")
+ (dolist (fun debug-function-list)
+ (make-text-button (point) (progn (prin1 fun) (point))
+ 'type 'help-function
+ 'help-args (list fun))
+ (terpri))
+ (terpri)
+ (princ "Note: if you have redefined a function, then it may no longer\n")
+ (princ "be set to debug on entry, even if it is in the list.")))))
(provide 'debug)
-;;; arch-tag: b6ec7047-f801-4103-9c63-d69322db9d3b
+;; arch-tag: b6ec7047-f801-4103-9c63-d69322db9d3b
;;; debug.el ends here
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 019a45213c8..d26a0ae5f38 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -327,10 +327,16 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
"Return binding for SYMBOL in the RE Builder target buffer."
`(with-current-buffer reb-target-buffer ,symbol))
+;;; This is to help people find this in Apropos.
+;;;###autoload
+(defun regexp-builder ()
+ "Alias for `re-builder': Construct a regexp interactively."
+ (interactive)
+ (re-builder))
;;;###autoload
(defun re-builder ()
- "Call up the RE Builder for the current window."
+ "Construct a regexp interactively."
(interactive)
(if (and (string= (buffer-name) reb-buffer)
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index a6ff9b15286..e3d3e9e645e 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -1,6 +1,6 @@
;;; trace.el --- tracing facility for Emacs Lisp functions
-;; Copyright (C) 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1998, 2000, 2005 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
;; Maintainer: FSF
@@ -175,6 +175,9 @@
;; Used to separate new trace output from previous traced runs:
(defvar trace-separator (format "%s\n" (make-string 70 ?=)))
+(defvar inhibit-trace nil
+ "If non-nil, all tracing is temporarily inhibited.")
+
(defun trace-entry-message (function level argument-bindings)
;; Generates a string that describes that FUNCTION has been entered at
;; trace LEVEL with ARGUMENT-BINDINGS.
@@ -183,14 +186,13 @@
(if (> level 1) " " "")
level
function
- (mapconcat (function
- (lambda (binding)
- (concat
- (symbol-name (ad-arg-binding-field binding 'name))
- "="
- ;; do this so we'll see strings:
- (prin1-to-string
- (ad-arg-binding-field binding 'value)))))
+ (mapconcat (lambda (binding)
+ (concat
+ (symbol-name (ad-arg-binding-field binding 'name))
+ "="
+ ;; do this so we'll see strings:
+ (prin1-to-string
+ (ad-arg-binding-field binding 'value))))
argument-bindings
" ")))
@@ -211,43 +213,27 @@
;; (quietly if BACKGROUND is t).
(ad-make-advice
trace-advice-name nil t
- (cond (background
- `(advice
- lambda ()
- (let ((trace-level (1+ trace-level))
- (trace-buffer (get-buffer-create ,buffer)))
- (save-excursion
- (set-buffer trace-buffer)
- (goto-char (point-max))
- ;; Insert a separator from previous trace output:
- (if (= trace-level 1) (insert trace-separator))
- (insert
- (trace-entry-message
- ',function trace-level ad-arg-bindings)))
- ad-do-it
- (save-excursion
- (set-buffer trace-buffer)
- (goto-char (point-max))
- (insert
- (trace-exit-message
- ',function trace-level ad-return-value))))))
- (t `(advice
- lambda ()
- (let ((trace-level (1+ trace-level))
- (trace-buffer (get-buffer-create ,buffer)))
- (pop-to-buffer trace-buffer)
- (goto-char (point-max))
- ;; Insert a separator from previous trace output:
- (if (= trace-level 1) (insert trace-separator))
- (insert
- (trace-entry-message
- ',function trace-level ad-arg-bindings))
- ad-do-it
- (pop-to-buffer trace-buffer)
- (goto-char (point-max))
- (insert
- (trace-exit-message
- ',function trace-level ad-return-value))))))))
+ `(advice
+ lambda ()
+ (let ((trace-level (1+ trace-level))
+ (trace-buffer (get-buffer-create ,buffer)))
+ (unless inhibit-trace
+ (with-current-buffer trace-buffer
+ ,(unless background '(pop-to-buffer trace-buffer))
+ (goto-char (point-max))
+ ;; Insert a separator from previous trace output:
+ (if (= trace-level 1) (insert trace-separator))
+ (insert
+ (trace-entry-message
+ ',function trace-level ad-arg-bindings))))
+ ad-do-it
+ (unless inhibit-trace
+ (with-current-buffer trace-buffer
+ ,(unless background '(pop-to-buffer trace-buffer))
+ (goto-char (point-max))
+ (insert
+ (trace-exit-message
+ ',function trace-level ad-return-value))))))))
(defun trace-function-internal (function buffer background)
;; Adds trace advice for FUNCTION and activates it.
@@ -297,9 +283,9 @@ activated only if the advice of FUNCTION is currently active. If FUNCTION
was not traced this is a noop."
(interactive
(list (ad-read-advised-function "Untrace function: " 'trace-is-traced)))
- (cond ((trace-is-traced function)
- (ad-remove-advice function 'around trace-advice-name)
- (ad-update function))))
+ (when (trace-is-traced function)
+ (ad-remove-advice function 'around trace-advice-name)
+ (ad-update function)))
(defun untrace-all ()
"Untraces all currently traced functions."
@@ -309,5 +295,5 @@ was not traced this is a noop."
(provide 'trace)
-;;; arch-tag: cfd170a7-4932-4331-8c8b-b7151942e5a1
+;; arch-tag: cfd170a7-4932-4331-8c8b-b7151942e5a1
;;; trace.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-28 10:39:45 +0000