From d8f1319a795ea3a63222eeb943f5023b8462ac38 Mon Sep 17 00:00:00 2001 From: Gerd Moellmann Date: Sun, 21 Nov 1999 14:50:21 +0000 Subject: [PATCH] Use new backquote syntax. --- lisp/ChangeLog | 5 + lisp/emacs-lisp/cust-print.el | 129 +++++++----------- lisp/emacs-lisp/edebug.el | 245 +++++++++++++++++----------------- lisp/progmodes/hideif.el | 72 +++++----- 4 files changed, 211 insertions(+), 240 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 24ec6d40c13..e701e21a873 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +1999-11-21 Gerd Moellmann + + * emacs-lisp/edebug.el, emacs-lisp/cust-print.el, + progmodes/hideif.el: Use new backquote syntax. + 1999-11-21 Ken Manheimer * icomplete.el (icomplete-completions): Use an explicit variable diff --git a/lisp/emacs-lisp/cust-print.el b/lisp/emacs-lisp/cust-print.el index 0c80b6c8bdb..2d70c12973d 100644 --- a/lisp/emacs-lisp/cust-print.el +++ b/lisp/emacs-lisp/cust-print.el @@ -9,7 +9,6 @@ ;; LCD Archive Entry: ;; cust-print|Daniel LaLiberte|liberte@cs.uiuc.edu ;; |Handle print-level, print-circle and more. -;; |$Date: 1994/04/05 21:05:09 $|$Revision: 1.14 $| ;; This file is part of GNU Emacs. @@ -24,54 +23,10 @@ ;; 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. - -;;; =============================== -;;; $Header: $ -;;; $Log: cust-print.el,v $ -;;; Revision 1.14 1994/04/05 21:05:09 liberte -;;; Change install- and uninstall- to -install and -uninstall. -;;; -;;; Revision 1.13 1994/03/24 20:26:05 liberte -;;; Change "internal" to "original" throughout. -;;; (add-custom-printer, delete-custom-printer) replace customizers. -;;; (with-custom-print) new -;;; (custom-prin1-to-string) Made it more robust. -;;; -;;; Revision 1.4 1994/03/23 20:34:29 liberte -;;; * Change "emacs" to "original" - I just can't decide. -;;; -;;; Revision 1.3 1994/02/21 21:25:36 liberte -;;; * Make custom-prin1-to-string more robust when errors occur. -;;; * Change "internal" to "emacs". -;;; -;;; Revision 1.2 1993/11/22 22:36:36 liberte -;;; * Simplified and generalized printer customization. -;;; custom-printers is an alist of (PREDICATE . PRINTER) pairs -;;; for any data types. The PRINTER function should print to -;;; `standard-output' add-custom-printer and delete-custom-printer -;;; change custom-printers. -;;; -;;; * Installation function now called install-custom-print. The -;;; old name is still around for now. -;;; -;;; * New macro with-custom-print (added earlier) - executes like -;;; progn but with custom-print activated temporarily. -;;; -;;; * Cleaned up comments for replacements of standardard printers. -;;; -;;; * Changed custom-prin1-to-string to use a temporary buffer. -;;; -;;; * Option custom-print-vectors (added earlier) - controls whether -;;; vectors should be printed according to print-length and -;;; print-length. Emacs doesnt do this, but cust-print would -;;; otherwise do it only if custom printing is required. -;;; -;;; * Uninterned symbols are treated as non-read-equivalent. -;;; +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. - ;;; Commentary: ;; This package provides a general print handler for prin1 and princ @@ -127,7 +82,12 @@ ;;; Code: -;;========================================================= + +(defgroup cust-print nil + "Handles print-level and print-circle." + :prefix "print-" + :group 'lisp + :group 'extensions) ;; If using cl-packages: @@ -157,9 +117,7 @@ '(in-package cust-print) -(require 'backquote) - -;; Emacs 18 doesnt have defalias. +;; Emacs 18 doesn't have defalias. ;; Provide def for byte compiler. (eval-and-compile (or (fboundp 'defalias) (fset 'defalias 'fset))) @@ -172,7 +130,7 @@ ;; "*Controls how many elements of a list, at each level, are printed. ;;This is defined by emacs.") -(defvar print-level nil +(defcustom print-level nil "*Controls how many levels deep a nested data object will print. If nil, printing proceeds recursively and may lead to @@ -183,10 +141,12 @@ Also see `print-length' and `print-circle'. If non-nil, components at levels equal to or greater than `print-level' are printed simply as `#'. The object to be printed is at level 0, and if the object is a list or vector, its top-level components are at -level 1.") +level 1." + :type '(choice (const nil) integer) + :group 'cust-print) -(defvar print-circle nil +(defcustom print-circle nil "*Controls the printing of recursive structures. If nil, printing proceeds recursively and may lead to @@ -200,15 +160,19 @@ representation) and `#N#' in place of each subsequent occurrence, where N is a positive decimal integer. There is no way to read this representation in standard Emacs, -but if you need to do so, try the cl-read.el package.") +but if you need to do so, try the cl-read.el package." + :type 'boolean + :group 'cust-print) -(defvar custom-print-vectors nil +(defcustom custom-print-vectors nil "*Non-nil if printing of vectors should obey print-level and print-length. For Emacs 18, setting print-level, or adding custom print list or vector handling will make this happen anyway. Emacs 19 obeys -print-level, but not for vectors.") +print-level, but not for vectors." + :type 'boolean + :group 'cust-print) ;; Custom printers @@ -227,7 +191,7 @@ Don't modify this variable directly. Use `add-custom-printer' and `delete-custom-printer'") ;; Should cust-print-original-princ and cust-print-prin be exported symbols? ;; Or should the standard printers functions be replaced by -;; CP ones in elisp so that CP internal functions need not be called? +;; CP ones in Emacs Lisp so that CP internal functions need not be called? (defun add-custom-printer (pred printer) "Add a pair of PREDICATE and PRINTER to `custom-printers'. @@ -252,20 +216,20 @@ Any pair that has the same PREDICATE is first removed." (defun cust-print-update-custom-printers () ;; Modify the definition of cust-print-use-custom-printer (defalias 'cust-print-use-custom-printer - ;; We dont really want to require the byte-compiler. + ;; We don't really want to require the byte-compiler. ;; (byte-compile - (` (lambda (object) - (cond - (,@ (mapcar (function - (lambda (pair) - (` (((, (car pair)) object) - ((, (cdr pair)) object))))) - custom-printers)) - ;; Otherwise return nil. - (t nil) - ))) - ;; ) - )) + `(lambda (object) + (cond + ,@(mapcar (function + (lambda (pair) + `((,(car pair) object) + (,(cdr pair) object)))) + custom-printers) + ;; Otherwise return nil. + (t nil) + )) + ;; ) + )) ;; Saving and restoring emacs printing routines. @@ -330,11 +294,11 @@ by running `custom-print-uninstall'." (defalias 'with-custom-print-funcs 'with-custom-print) (defmacro with-custom-print (&rest body) "Temporarily install the custom print package while executing BODY." - (` (unwind-protect - (progn - (custom-print-install) - (,@ body)) - (custom-print-uninstall)))) + `(unwind-protect + (progn + (custom-print-install) + ,@body) + (custom-print-uninstall))) ;; Lisp replacements for prin1 and princ, and for some subrs that use them @@ -363,20 +327,23 @@ This is the custom-print replacement for the standard `princ'." (cust-print-top-level object stream 'cust-print-original-princ)) -(defun custom-prin1-to-string (object) +(defun custom-prin1-to-string (object &optional noescape) "Return a string containing the printed representation of OBJECT, any Lisp object. Quoting characters are used when needed to make output -that `read' can handle, whenever this is possible. +that `read' can handle, whenever this is possible, unless the optional +second argument NOESCAPE is non-nil. This is the custom-print replacement for the standard `prin1-to-string'." (let ((buf (get-buffer-create " *custom-print-temp*"))) ;; We must erase the buffer before printing in case an error - ;; occured during the last prin1-to-string and we are in debugger. + ;; occurred during the last prin1-to-string and we are in debugger. (save-excursion (set-buffer buf) (erase-buffer)) ;; We must be in the current-buffer when the print occurs. - (custom-prin1 object buf) + (if noescape + (custom-princ object buf) + (custom-prin1 object buf)) (save-excursion (set-buffer buf) (buffer-string) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 97b85a2564c..ba53427c1e4 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -266,7 +266,7 @@ If the result is non-nil, then break. Errors are ignored." "Set the edebug-form-spec property of SYMBOL according to SPEC. Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol \(naming a function), or a list." - (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec))))) + `(put (quote ,symbol) 'edebug-form-spec (quote ,spec))) (defmacro def-edebug-form-spec (symbol spec-form) "For compatibility with old version. Use `def-edebug-spec' instead." @@ -398,13 +398,13 @@ save-restriction. BODY may change the current buffer, and the restriction will be restored to the original buffer, and the current buffer remains current. Return the result of the last expression in BODY." - (` (let ((edebug:s-r-beg (point-min-marker)) - (edebug:s-r-end (point-max-marker))) - (unwind-protect - (progn (,@ body)) - (save-excursion - (set-buffer (marker-buffer edebug:s-r-beg)) - (narrow-to-region edebug:s-r-beg edebug:s-r-end)))))) + `(let ((edebug:s-r-beg (point-min-marker)) + (edebug:s-r-end (point-max-marker))) + (unwind-protect + (progn ,@body) + (save-excursion + (set-buffer (marker-buffer edebug:s-r-beg)) + (narrow-to-region edebug:s-r-beg edebug:s-r-end))))) ;;; Display @@ -850,11 +850,11 @@ or if an error occurs, leave point after it with mark at the original point." (put 'edebug-storing-offsets 'lisp-indent-hook 1) (defmacro edebug-storing-offsets (point &rest body) - (` (unwind-protect - (progn - (edebug-store-before-offset (, point)) - (,@ body)) - (edebug-store-after-offset (point))))) + `(unwind-protect + (progn + (edebug-store-before-offset ,point) + ,@body) + (edebug-store-after-offset (point)))) ;;; Reader for Emacs Lisp. @@ -1214,9 +1214,9 @@ This controls how we read comma constructs.") (defun edebug-wrap-def-body (forms) "Wrap the FORMS of a definition body." (if edebug-def-interactive - (` (let (((, (edebug-interactive-p-name)) - (interactive-p))) - (, (edebug-make-enter-wrapper forms)))) + `(let ((,(edebug-interactive-p-name) + (interactive-p))) + ,(edebug-make-enter-wrapper forms)) (edebug-make-enter-wrapper forms))) @@ -1228,16 +1228,15 @@ This controls how we read comma constructs.") ;; Do this after parsing since that may find a name. (setq edebug-def-name (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon"))) - (` (edebug-enter - (quote (, edebug-def-name)) - (, (if edebug-inside-func - (` (list (,@ - ;; Doesn't work with more than one def-body!! - ;; But the list will just be reversed. - (nreverse edebug-def-args)))) - 'nil)) - (function (lambda () (,@ forms))) - ))) + `(edebug-enter + (quote ,edebug-def-name) + ,(if edebug-inside-func + `(list (;; Doesn't work with more than one def-body!! + ;; But the list will just be reversed. + ,@(nreverse edebug-def-args))) + 'nil) + (function (lambda () ,@forms)) + )) (defvar edebug-form-begin-marker) ; the mark for def being instrumented @@ -2333,12 +2332,12 @@ error is signaled again." (defmacro edebug-tracing (msg &rest body) "Print MSG in *edebug-trace* before and after evaluating BODY. The result of BODY is also printed." - (` (let ((edebug-stack-depth (1+ edebug-stack-depth)) - edebug-result) - (edebug-print-trace-before (, msg)) - (prog1 (setq edebug-result (progn (,@ body))) - (edebug-print-trace-after - (format "%s result: %s" (, msg) edebug-result)))))) + `(let ((edebug-stack-depth (1+ edebug-stack-depth)) + edebug-result) + (edebug-print-trace-before ,msg) + (prog1 (setq edebug-result (progn ,@body)) + (edebug-print-trace-after + (format "%s result: %s" ,msg edebug-result))))) (defun edebug-print-trace-before (msg) "Function called to print trace info before expression evaluation. @@ -2998,14 +2997,14 @@ configurations become the same as the current configuration." (if edebug-save-windows "on" "off"))) (defmacro edebug-changing-windows (&rest body) - (` (let ((window (selected-window))) - (setq edebug-inside-windows (edebug-current-windows t)) - (edebug-set-windows edebug-outside-windows) - (,@ body) ;; Code to change edebug-save-windows - (setq edebug-outside-windows (edebug-current-windows - edebug-save-windows)) - ;; Problem: what about outside windows that are deleted inside? - (edebug-set-windows edebug-inside-windows)))) + `(let ((window (selected-window))) + (setq edebug-inside-windows (edebug-current-windows t)) + (edebug-set-windows edebug-outside-windows) + ,@body;; Code to change edebug-save-windows + (setq edebug-outside-windows (edebug-current-windows + edebug-save-windows)) + ;; Problem: what about outside windows that are deleted inside? + (edebug-set-windows edebug-inside-windows))) (defun edebug-toggle-save-selected-window () "Toggle the saving and restoring of the selected window. @@ -3542,89 +3541,89 @@ edebug-mode." (defmacro edebug-outside-excursion (&rest body) "Evaluate an expression list in the outside context. Return the result of the last expression." - (` (save-excursion ; of current-buffer - (if edebug-save-windows - (progn - ;; After excursion, we will - ;; restore to current window configuration. - (setq edebug-inside-windows - (edebug-current-windows edebug-save-windows)) - ;; Restore outside windows. - (edebug-set-windows edebug-outside-windows))) - - (set-buffer edebug-buffer) ; why? - ;; (use-local-map edebug-outside-map) - (set-match-data edebug-outside-match-data) - ;; Restore outside context. - (let (;; (edebug-inside-map (current-local-map)) ;; restore map?? - (last-command-char edebug-outside-last-command-char) - (last-command-event edebug-outside-last-command-event) - (last-command edebug-outside-last-command) - (this-command edebug-outside-this-command) - (unread-command-char edebug-outside-unread-command-char) - (unread-command-event edebug-outside-unread-command-event) - (unread-command-events edebug-outside-unread-command-events) - (current-prefix-arg edebug-outside-current-prefix-arg) - (last-input-char edebug-outside-last-input-char) - (last-input-event edebug-outside-last-input-event) - (last-event-frame edebug-outside-last-event-frame) - (last-nonmenu-event edebug-outside-last-nonmenu-event) - (track-mouse edebug-outside-track-mouse) - (standard-output edebug-outside-standard-output) - (standard-input edebug-outside-standard-input) - - (executing-kbd-macro edebug-outside-executing-macro) - (defining-kbd-macro edebug-outside-defining-kbd-macro) - (pre-command-hook edebug-outside-pre-command-hook) - (post-command-hook edebug-outside-post-command-hook) - - ;; See edebug-display - (overlay-arrow-position edebug-outside-o-a-p) - (overlay-arrow-string edebug-outside-o-a-s) - (cursor-in-echo-area edebug-outside-c-i-e-a) - ) - (unwind-protect - (save-excursion ; of edebug-buffer - (set-buffer edebug-outside-buffer) - (goto-char edebug-outside-point) - (if (marker-buffer (edebug-mark-marker)) - (set-marker (edebug-mark-marker) edebug-outside-mark)) - (,@ body)) - - ;; Back to edebug-buffer. Restore rest of inside context. - ;; (use-local-map edebug-inside-map) - (if edebug-save-windows - ;; Restore inside windows. - (edebug-set-windows edebug-inside-windows)) - - ;; Save values that may have been changed. - (setq - edebug-outside-last-command-char last-command-char - edebug-outside-last-command-event last-command-event - edebug-outside-last-command last-command - edebug-outside-this-command this-command - edebug-outside-unread-command-char unread-command-char - edebug-outside-unread-command-event unread-command-event - edebug-outside-unread-command-events unread-command-events - edebug-outside-current-prefix-arg current-prefix-arg - edebug-outside-last-input-char last-input-char - edebug-outside-last-input-event last-input-event - edebug-outside-last-event-frame last-event-frame - edebug-outside-last-nonmenu-event last-nonmenu-event - edebug-outside-track-mouse track-mouse - edebug-outside-standard-output standard-output - edebug-outside-standard-input standard-input - - edebug-outside-executing-macro executing-kbd-macro - edebug-outside-defining-kbd-macro defining-kbd-macro - edebug-outside-pre-command-hook pre-command-hook - edebug-outside-post-command-hook post-command-hook - - edebug-outside-o-a-p overlay-arrow-position - edebug-outside-o-a-s overlay-arrow-string - edebug-outside-c-i-e-a cursor-in-echo-area - ))) ; let - ))) + `(save-excursion ; of current-buffer + (if edebug-save-windows + (progn + ;; After excursion, we will + ;; restore to current window configuration. + (setq edebug-inside-windows + (edebug-current-windows edebug-save-windows)) + ;; Restore outside windows. + (edebug-set-windows edebug-outside-windows))) + + (set-buffer edebug-buffer) ; why? + ;; (use-local-map edebug-outside-map) + (set-match-data edebug-outside-match-data) + ;; Restore outside context. + (let (;; (edebug-inside-map (current-local-map)) ;; restore map?? + (last-command-char edebug-outside-last-command-char) + (last-command-event edebug-outside-last-command-event) + (last-command edebug-outside-last-command) + (this-command edebug-outside-this-command) + (unread-command-char edebug-outside-unread-command-char) + (unread-command-event edebug-outside-unread-command-event) + (unread-command-events edebug-outside-unread-command-events) + (current-prefix-arg edebug-outside-current-prefix-arg) + (last-input-char edebug-outside-last-input-char) + (last-input-event edebug-outside-last-input-event) + (last-event-frame edebug-outside-last-event-frame) + (last-nonmenu-event edebug-outside-last-nonmenu-event) + (track-mouse edebug-outside-track-mouse) + (standard-output edebug-outside-standard-output) + (standard-input edebug-outside-standard-input) + + (executing-kbd-macro edebug-outside-executing-macro) + (defining-kbd-macro edebug-outside-defining-kbd-macro) + (pre-command-hook edebug-outside-pre-command-hook) + (post-command-hook edebug-outside-post-command-hook) + + ;; See edebug-display + (overlay-arrow-position edebug-outside-o-a-p) + (overlay-arrow-string edebug-outside-o-a-s) + (cursor-in-echo-area edebug-outside-c-i-e-a) + ) + (unwind-protect + (save-excursion ; of edebug-buffer + (set-buffer edebug-outside-buffer) + (goto-char edebug-outside-point) + (if (marker-buffer (edebug-mark-marker)) + (set-marker (edebug-mark-marker) edebug-outside-mark)) + ,@body) + + ;; Back to edebug-buffer. Restore rest of inside context. + ;; (use-local-map edebug-inside-map) + (if edebug-save-windows + ;; Restore inside windows. + (edebug-set-windows edebug-inside-windows)) + + ;; Save values that may have been changed. + (setq + edebug-outside-last-command-char last-command-char + edebug-outside-last-command-event last-command-event + edebug-outside-last-command last-command + edebug-outside-this-command this-command + edebug-outside-unread-command-char unread-command-char + edebug-outside-unread-command-event unread-command-event + edebug-outside-unread-command-events unread-command-events + edebug-outside-current-prefix-arg current-prefix-arg + edebug-outside-last-input-char last-input-char + edebug-outside-last-input-event last-input-event + edebug-outside-last-event-frame last-event-frame + edebug-outside-last-nonmenu-event last-nonmenu-event + edebug-outside-track-mouse track-mouse + edebug-outside-standard-output standard-output + edebug-outside-standard-input standard-input + + edebug-outside-executing-macro executing-kbd-macro + edebug-outside-defining-kbd-macro defining-kbd-macro + edebug-outside-pre-command-hook pre-command-hook + edebug-outside-post-command-hook post-command-hook + + edebug-outside-o-a-p overlay-arrow-position + edebug-outside-o-a-s overlay-arrow-string + edebug-outside-c-i-e-a cursor-in-echo-area + ))) ; let + )) (defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used. diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 7415fb4a939..5b93696c101 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -356,9 +356,9 @@ that form should be displayed.") (defun hif-infix-to-prefix (token-list) "Convert list of tokens in infix into prefix list" -; (message "hif-infix-to-prefix: %s" token-list) + ; (message "hif-infix-to-prefix: %s" token-list) (if (= 1 (length token-list)) - (` (hif-lookup (quote (, (car token-list))))) + `(hif-lookup (quote ,(car token-list))) (hif-parse-if-exp token-list)) ) @@ -489,41 +489,41 @@ that form should be displayed.") (defun hif-factor () "Parse a factor: '!' factor | '(' expr ')' | 'defined(' id ')' | id." (cond - ((eq hif-token 'not) - (hif-nexttoken) - (list 'not (hif-factor))) - - ((eq hif-token 'lparen) - (hif-nexttoken) - (let ((result (hif-expr))) - (if (not (eq hif-token 'rparen)) - (error "Bad token in parenthesized expression: %s" hif-token) - (hif-nexttoken) - result))) - - ((eq hif-token 'hif-defined) - (hif-nexttoken) - (if (not (eq hif-token 'lparen)) - (error "Error: expected \"(\" after \"defined\"")) - (hif-nexttoken) - (let ((ident hif-token)) - (if (memq hif-token '(or and not hif-defined lparen rparen)) - (error "Error: unexpected token: %s" hif-token)) - (hif-nexttoken) - (if (not (eq hif-token 'rparen)) - (error "Error: expected \")\" after identifier")) - (hif-nexttoken) - (` (hif-defined (quote (, ident)))) - )) - - (t ; identifier - (let ((ident hif-token)) - (if (memq ident '(or and)) - (error "Error: missing identifier")) + ((eq hif-token 'not) + (hif-nexttoken) + (list 'not (hif-factor))) + + ((eq hif-token 'lparen) + (hif-nexttoken) + (let ((result (hif-expr))) + (if (not (eq hif-token 'rparen)) + (error "Bad token in parenthesized expression: %s" hif-token) (hif-nexttoken) - (` (hif-lookup (quote (, ident)))) - )) - )) + result))) + + ((eq hif-token 'hif-defined) + (hif-nexttoken) + (if (not (eq hif-token 'lparen)) + (error "Error: expected \"(\" after \"defined\"")) + (hif-nexttoken) + (let ((ident hif-token)) + (if (memq hif-token '(or and not hif-defined lparen rparen)) + (error "Error: unexpected token: %s" hif-token)) + (hif-nexttoken) + (if (not (eq hif-token 'rparen)) + (error "Error: expected \")\" after identifier")) + (hif-nexttoken) + `(hif-defined (quote ,ident)) + )) + + (t ; identifier + (let ((ident hif-token)) + (if (memq ident '(or and)) + (error "Error: missing identifier")) + (hif-nexttoken) + `(hif-lookup (quote ,ident)) + )) + )) (defun hif-mathify (val) "Treat VAL as a number: if it's t or nil, use 1 or 0." -- 2.39.5