Skip to content

GitLab

Commit 8a946354 authored by Sam Steingold's avatar Sam Steingold
Browse files
Options

Converted backquote to the new style.

parent c6aedc92
Hide whitespace changes
Inline Side-by-side
Showing with 848 additions and 848 deletions
lisp/ChangeLog
View file @ 8a946354
2001-11-27 Sam Steingold <sds@gnu.org>
* ansi-color.el, bookmark.el, dired.el, emerge.el, fast-lock.el
* lazy-lock.el, mouse-sel.el, mail/feedmail.el
* emacs-lisp/advice.el, emacs-lisp/checkdoc.el, emacs-lisp/ewoc.el
* obsolete/c-mode.el, obsolete/cplus-md.el
* progmodes/dcl-mode.el, progmodes/idlw-shell.el, progmodes/idlwave.el
* term/sun-mouse.el, textmodes/artist.el:
Converted backquote to the new style.
2001-11-27 Richard M. Stallman <rms@gnu.org>
* cus-edit.el (custom-load-symbol): Don't always load locate-library.
......
lisp/ansi-color.el
View file @ 8a946354
......@@ -223,20 +223,20 @@ This is a good function to put in `comint-output-filter-functions'."
(eval-when-compile
;; We use this to preserve or protect things when modifying text
;; properties. Stolen from lazy-lock and font-lock. Ugly!!!
;; Probably most of this is not needed?
(defmacro save-buffer-state (varlist &rest body)
"Bind variables according to VARLIST and eval BODY restoring buffer state."
(` (let* ((,@ (append varlist
'((modified (buffer-modified-p)) (buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
before-change-functions after-change-functions
deactivate-mark buffer-file-name buffer-file-truename))))
(,@ body)
(when (and (not modified) (buffer-modified-p))
(set-buffer-modified-p nil)))))
(put 'save-buffer-state 'lisp-indent-function 1))
;; We use this to preserve or protect things when modifying text
;; properties. Stolen from lazy-lock and font-lock. Ugly!!!
;; Probably most of this is not needed?
(defmacro save-buffer-state (varlist &rest body)
"Bind variables according to VARLIST and eval BODY restoring buffer state."
`(let* (,@(append varlist
'((modified (buffer-modified-p)) (buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
before-change-functions after-change-functions
deactivate-mark buffer-file-name buffer-file-truename)))
,@body
(when (and (not modified) (buffer-modified-p))
(set-buffer-modified-p nil))))
(put 'save-buffer-state 'lisp-indent-function 1))
(defun ansi-color-unfontify-region (beg end &rest xemacs-stuff)
"Replacement function for `font-lock-default-unfontify-region'.
......
lisp/bookmark.el
View file @ 8a946354
......@@ -539,21 +539,20 @@ being set. This might change someday.
Optional second arg INFO-NODE means this bookmark is at info node
INFO-NODE, so record this fact in the bookmark's entry."
(let ((the-record
(` ((filename . (, (bookmark-buffer-file-name)))
(front-context-string
. (, (if (>= (- (point-max) (point)) bookmark-search-size)
(buffer-substring-no-properties
(point)
(+ (point) bookmark-search-size))
nil)))
(rear-context-string
. (, (if (>= (- (point) (point-min)) bookmark-search-size)
(buffer-substring-no-properties
(point)
(- (point) bookmark-search-size))
nil)))
(position . (, (point)))
))))
`((filename . ,(bookmark-buffer-file-name))
(front-context-string
. ,(if (>= (- (point-max) (point)) bookmark-search-size)
(buffer-substring-no-properties
(point)
(+ (point) bookmark-search-size))
nil))
(rear-context-string
. ,(if (>= (- (point) (point-min)) bookmark-search-size)
(buffer-substring-no-properties
(point)
(- (point) bookmark-search-size))
nil))
(position . ,(point)))))
;; Now fill in the optional parts:
......@@ -661,11 +660,11 @@ affect point."
(ann (nth 4 record)))
(list
name
(` ((filename . (, filename))
(front-context-string . (, (or front-str "")))
(rear-context-string . (, (or rear-str "")))
(position . (, position))
(annotation . (, ann)))))))
`((filename . ,filename)
(front-context-string . ,(or front-str ""))
(rear-context-string . ,(or rear-str ""))
(position . ,position)
(annotation . ,ann)))))
old-list))
......@@ -1347,7 +1346,7 @@ for a file, defaulting to the file defined by variable
(set-buffer (let ((enable-local-variables nil))
(find-file-noselect file)))
(goto-char (point-min))
(let ((print-length nil)
(let ((print-length nil)
(print-level nil))
(delete-region (point-min) (point-max))
(bookmark-insert-file-format-version-stamp)
......
lisp/dired.el
View file @ 8a946354
......@@ -317,26 +317,26 @@ Subexpression 2 must end right before the \\n or \\r.")
;; It should end with a noun that can be pluralized by adding `s'.
;; Return value is the number of files marked, or nil if none were marked.
(defmacro dired-mark-if (predicate msg)
(` (let (buffer-read-only count)
(save-excursion
(setq count 0)
(if (, msg) (message "Marking %ss..." (, msg)))
(goto-char (point-min))
(while (not (eobp))
(if (, predicate)
(progn
(delete-char 1)
(insert dired-marker-char)
(setq count (1+ count))))
(forward-line 1))
(if (, msg) (message "%s %s%s %s%s."
count
(, msg)
(dired-plural-s count)
(if (eq dired-marker-char ?\040) "un" "")
(if (eq dired-marker-char dired-del-marker)
"flagged" "marked"))))
(and (> count 0) count))))
`(let (buffer-read-only count)
(save-excursion
(setq count 0)
(if ,msg (message "Marking %ss..." ,msg))
(goto-char (point-min))
(while (not (eobp))
(if ,predicate
(progn
(delete-char 1)
(insert dired-marker-char)
(setq count (1+ count))))
(forward-line 1))
(if ,msg (message "%s %s%s %s%s."
count
,msg
(dired-plural-s count)
(if (eq dired-marker-char ?\040) "un" "")
(if (eq dired-marker-char dired-del-marker)
"flagged" "marked"))))
(and (> count 0) count)))
(defmacro dired-map-over-marks (body arg &optional show-progress)
"Eval BODY with point on each marked line. Return a list of BODY's results.
......
lisp/emacs-lisp/advice.el
View file @ 8a946354
......@@ -149,7 +149,7 @@
;; generates an advised definition of the `documentation' function, and
;; it will enable automatic advice activation when functions get defined.
;; All of this can be undone at any time with `M-x ad-stop-advice'.
;;
;;
;; If you experience any strange behavior/errors etc. that you attribute to
;; Advice or to some ill-advised function do one of the following:
......@@ -368,7 +368,7 @@
;; If this is a problem one can always specify an interactive form in a
;; before/around/after advice to gain control over argument values that
;; were supplied interactively.
;;
;;
;; Then the body forms of the various advices in the various classes of advice
;; are assembled in order. The forms of around advice L are normally part of
;; one of the forms of around advice L-1. An around advice can specify where
......@@ -381,7 +381,7 @@
;; whose form depends on the type of the original function. The variable
;; `ad-return-value' will be set to its result. This variable is visible to
;; all pieces of advice which can access and modify it before it gets returned.
;;
;;
;; The semantic structure of advised functions that contain protected pieces
;; of advice is the same. The only difference is that `unwind-protect' forms
;; make sure that the protected advice gets executed even if some previous
......@@ -943,7 +943,7 @@
;;
;; We start by defining an innocent looking function `foo' that simply
;; adds 1 to its argument X:
;;
;;
;; (defun foo (x)
;; "Add 1 to X."
;; (1+ x))
......@@ -1905,30 +1905,30 @@ current head at every iteration. If RESULT-FORM is supplied its value will
be returned at the end of the iteration, nil otherwise. The iteration can be
exited prematurely with `(ad-do-return [VALUE])'."
(let ((expansion
(` (let ((ad-dO-vAr (, (car (cdr varform))))
(, (car varform)))
(while ad-dO-vAr
(setq (, (car varform)) (car ad-dO-vAr))
(,@ body)
;;work around a backquote bug:
;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong
;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar)))
(, '(setq ad-dO-vAr (cdr ad-dO-vAr))))
(, (car (cdr (cdr varform))))))))
`(let ((ad-dO-vAr ,(car (cdr varform)))
,(car varform))
(while ad-dO-vAr
(setq ,(car varform) (car ad-dO-vAr))
,@body
;;work around a backquote bug:
;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong
;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar)))
,'(setq ad-dO-vAr (cdr ad-dO-vAr)))
,(car (cdr (cdr varform))))))
;;ok, this wastes some cons cells but only during compilation:
(if (catch 'contains-return
(ad-substitute-tree
(function (lambda (subtree)
(cond ((eq (car-safe subtree) 'ad-dolist))
((eq (car-safe subtree) 'ad-do-return)
(throw 'contains-return t)))))
(cond ((eq (car-safe subtree) 'ad-dolist))
((eq (car-safe subtree) 'ad-do-return)
(throw 'contains-return t)))))
'identity body)
nil)
(` (catch 'ad-dO-eXiT (, expansion)))
expansion)))
`(catch 'ad-dO-eXiT ,expansion)
expansion)))
(defmacro ad-do-return (value)
(` (throw 'ad-dO-eXiT (, value))))
`(throw 'ad-dO-eXiT ,value))
(if (not (get 'ad-dolist 'lisp-indent-hook))
(put 'ad-dolist 'lisp-indent-hook 1))
......@@ -1944,15 +1944,15 @@ exited prematurely with `(ad-do-return [VALUE])'."
(let ((saved-function (intern (format "ad-real-%s" function))))
;; Make sure the compiler is loaded during macro expansion:
(require 'byte-compile "bytecomp")
(` (if (not (fboundp '(, saved-function)))
(progn (fset '(, saved-function) (symbol-function '(, function)))
;; Copy byte-compiler properties:
(,@ (if (get function 'byte-compile)
(` ((put '(, saved-function) 'byte-compile
'(, (get function 'byte-compile)))))))
(,@ (if (get function 'byte-opcode)
(` ((put '(, saved-function) 'byte-opcode
'(, (get function 'byte-opcode))))))))))))
`(if (not (fboundp ',saved-function))
(progn (fset ',saved-function (symbol-function ',function))
;; Copy byte-compiler properties:
,@(if (get function 'byte-compile)
`((put ',saved-function 'byte-compile
',(get function 'byte-compile))))
,@(if (get function 'byte-opcode)
`((put ',saved-function 'byte-opcode
',(get function 'byte-opcode))))))))
(defun ad-save-real-definitions ()
;; Macro expansion will hardcode the values of the various byte-compiler
......@@ -1986,16 +1986,16 @@ exited prematurely with `(ad-do-return [VALUE])'."
(defmacro ad-pushnew-advised-function (function)
"Add FUNCTION to `ad-advised-functions' unless its already there."
(` (if (not (assoc (symbol-name (, function)) ad-advised-functions))
(setq ad-advised-functions
(cons (list (symbol-name (, function)))
ad-advised-functions)))))
`(if (not (assoc (symbol-name ,function) ad-advised-functions))
(setq ad-advised-functions
(cons (list (symbol-name ,function))
ad-advised-functions))))
(defmacro ad-pop-advised-function (function)
"Remove FUNCTION from `ad-advised-functions'."
(` (setq ad-advised-functions
(delq (assoc (symbol-name (, function)) ad-advised-functions)
ad-advised-functions))))
`(setq ad-advised-functions
(delq (assoc (symbol-name ,function) ad-advised-functions)
ad-advised-functions)))
(defmacro ad-do-advised-functions (varform &rest body)
"`ad-dolist'-style iterator that maps over `ad-advised-functions'.
......@@ -2003,23 +2003,23 @@ exited prematurely with `(ad-do-return [VALUE])'."
BODY-FORM...)
On each iteration VAR will be bound to the name of an advised function
\(a symbol)."
(` (ad-dolist ((, (car varform))
ad-advised-functions
(, (car (cdr varform))))
(setq (, (car varform)) (intern (car (, (car varform)))))
(,@ body))))
`(ad-dolist (,(car varform)
ad-advised-functions
,(car (cdr varform)))
(setq ,(car varform) (intern (car ,(car varform))))
,@body))
(if (not (get 'ad-do-advised-functions 'lisp-indent-hook))
(put 'ad-do-advised-functions 'lisp-indent-hook 1))
(defmacro ad-get-advice-info (function)
(` (get (, function) 'ad-advice-info)))
`(get ,function 'ad-advice-info))
(defmacro ad-set-advice-info (function advice-info)
(` (put (, function) 'ad-advice-info (, advice-info))))
`(put ,function 'ad-advice-info ,advice-info))
(defmacro ad-copy-advice-info (function)
(` (ad-copy-tree (get (, function) 'ad-advice-info))))
`(ad-copy-tree (get ,function 'ad-advice-info)))
(defmacro ad-is-advised (function)
"Return non-nil if FUNCTION has any advice info associated with it.
......@@ -2034,7 +2034,7 @@ Assumes that FUNCTION has not yet been advised."
(defmacro ad-get-advice-info-field (function field)
"Retrieve the value of the advice info FIELD of FUNCTION."
(` (cdr (assq (, field) (ad-get-advice-info (, function))))))
`(cdr (assq ,field (ad-get-advice-info ,function))))
(defun ad-set-advice-info-field (function field value)
"Destructively modify VALUE of the advice info FIELD of FUNCTION."
......@@ -2160,8 +2160,8 @@ Redefining advices affect the construction of an advised definition."
(defvar ad-activate-on-top-level t)
(defmacro ad-with-auto-activation-disabled (&rest body)
(` (let ((ad-activate-on-top-level nil))
(,@ body))))
`(let ((ad-activate-on-top-level nil))
,@body))
(defun ad-safe-fset (symbol definition)
"A safe `fset' which will never call `ad-activate-internal' recursively."
......@@ -2183,16 +2183,16 @@ Redefining advices affect the construction of an advised definition."
(intern (format "ad-Orig-%s" function)))
(defmacro ad-get-orig-definition (function)
(` (let ((origname (ad-get-advice-info-field (, function) 'origname)))
(if (fboundp origname)
(symbol-function origname)))))
`(let ((origname (ad-get-advice-info-field ,function 'origname)))
(if (fboundp origname)
(symbol-function origname))))
(defmacro ad-set-orig-definition (function definition)
(` (ad-safe-fset
(ad-get-advice-info-field function 'origname) (, definition))))
`(ad-safe-fset
(ad-get-advice-info-field function 'origname) ,definition))
(defmacro ad-clear-orig-definition (function)
(` (fmakunbound (ad-get-advice-info-field (, function) 'origname))))
`(fmakunbound (ad-get-advice-info-field ,function 'origname)))
;; @@ Interactive input functions:
......@@ -2300,7 +2300,7 @@ be used to prompt for the function."
(defmacro ad-find-advice (function class name)
"Find the first advice of FUNCTION in CLASS with NAME."
(` (assq (, name) (ad-get-advice-info-field (, function) (, class)))))
`(assq ,name (ad-get-advice-info-field ,function ,class)))
(defun ad-advice-position (function class name)
"Return position of first advice of FUNCTION in CLASS with NAME."
......@@ -2458,11 +2458,11 @@ will clear the cache."
(defmacro ad-macrofy (definition)
"Take a lambda function DEFINITION and make a macro out of it."
(` (cons 'macro (, definition))))
`(cons 'macro ,definition))
(defmacro ad-lambdafy (definition)
"Take a macro function DEFINITION and make a lambda out of it."
(` (cdr (, definition))))
`(cdr ,definition))
;; There is no way to determine whether some subr is a special form or not,
;; hence we need this list (which is probably out of date):
......@@ -2492,16 +2492,16 @@ will clear the cache."
(defmacro ad-macro-p (definition)
;;"non-nil if DEFINITION is a macro."
(` (eq (car-safe (, definition)) 'macro)))
`(eq (car-safe ,definition) 'macro))
(defmacro ad-lambda-p (definition)
;;"non-nil if DEFINITION is a lambda expression."
(` (eq (car-safe (, definition)) 'lambda)))
`(eq (car-safe ,definition) 'lambda))
;; see ad-make-advice for the format of advice definitions:
(defmacro ad-advice-p (definition)
;;"non-nil if DEFINITION is a piece of advice."
(` (eq (car-safe (, definition)) 'advice)))
`(eq (car-safe ,definition) 'advice))
;; Emacs/Lemacs cross-compatibility
;; (compiled-function-p is an obsolete function in Emacs):
......@@ -2511,15 +2511,15 @@ will clear the cache."
(defmacro ad-compiled-p (definition)
"Return non-nil if DEFINITION is a compiled byte-code object."
(` (or (byte-code-function-p (, definition))
(and (ad-macro-p (, definition))
(byte-code-function-p (ad-lambdafy (, definition)))))))
`(or (byte-code-function-p ,definition)
(and (ad-macro-p ,definition)
(byte-code-function-p (ad-lambdafy ,definition)))))
(defmacro ad-compiled-code (compiled-definition)
"Return the byte-code object of a COMPILED-DEFINITION."
(` (if (ad-macro-p (, compiled-definition))
(ad-lambdafy (, compiled-definition))
(, compiled-definition))))
`(if (ad-macro-p ,compiled-definition)
(ad-lambdafy ,compiled-definition)
,compiled-definition))
(defun ad-lambda-expression (definition)
"Return the lambda expression of a function/macro/advice DEFINITION."
......@@ -2551,13 +2551,13 @@ supplied to make subr arglist lookup more efficient."
;; Store subr-args as `((arg1 arg2 ...))' so I can distinguish
;; a defined empty arglist `(nil)' from an undefined arglist:
(defmacro ad-define-subr-args (subr arglist)
(` (put (, subr) 'ad-subr-arglist (list (, arglist)))))
`(put ,subr 'ad-subr-arglist (list ,arglist)))
(defmacro ad-undefine-subr-args (subr)
(` (put (, subr) 'ad-subr-arglist nil)))
`(put ,subr 'ad-subr-arglist nil))
(defmacro ad-subr-args-defined-p (subr)
(` (get (, subr) 'ad-subr-arglist)))
`(get ,subr 'ad-subr-arglist))
(defmacro ad-get-subr-args (subr)
(` (car (get (, subr) 'ad-subr-arglist))))
`(car (get ,subr 'ad-subr-arglist)))
(defun ad-subr-arglist (subr-name)
"Retrieve arglist of the subr with SUBR-NAME.
......@@ -2761,17 +2761,16 @@ element is its actual current value, and the third element is either
`required', `optional' or `rest' depending on the type of the argument."
(let* ((parsed-arglist (ad-parse-arglist arglist))
(rest (nth 2 parsed-arglist)))
(` (list
(,@ (mapcar (function
(lambda (req)
(` (list '(, req) (, req) 'required))))
(nth 0 parsed-arglist)))
(,@ (mapcar (function
(lambda (opt)
(` (list '(, opt) (, opt) 'optional))))
(nth 1 parsed-arglist)))
(,@ (if rest (list (` (list '(, rest) (, rest) 'rest)))))
))))
`(list
,@(mapcar (function
(lambda (req)
`(list ',req ,req 'required)))
(nth 0 parsed-arglist))
,@(mapcar (function
(lambda (opt)
`(list ',opt ,opt 'optional)))
(nth 1 parsed-arglist))
,@(if rest (list `(list ',rest ,rest 'rest))))))
(defun ad-arg-binding-field (binding field)
(cond ((eq field 'name) (car binding))
......@@ -2785,7 +2784,7 @@ element is its actual current value, and the third element is either
(defun ad-element-access (position list)
(cond ((= position 0) (list 'car list))
((= position 1) (` (car (cdr (, list)))))
((= position 1) `(car (cdr ,list)))
(t (list 'nth position list))))
(defun ad-access-argument (arglist index)
......@@ -2814,11 +2813,11 @@ to be accessed, it returns a list with the index and name."
(let ((argument-access (ad-access-argument arglist index)))
(cond ((consp argument-access)
;; should this check whether there actually is something to set?
(` (setcar (, (ad-list-access
(car argument-access) (car (cdr argument-access))))
(, value-form))))
`(setcar ,(ad-list-access
(car argument-access) (car (cdr argument-access)))
,value-form))
(argument-access
(` (setq (, argument-access) (, value-form))))
`(setq ,argument-access ,value-form))
(t (error "ad-set-argument: No argument at position %d of `%s'"
index arglist)))))
......@@ -2830,12 +2829,12 @@ to be accessed, it returns a list with the index and name."
(rest-arg (nth 2 parsed-arglist))
args-form)
(if (< index (length reqopt-args))
(setq args-form (` (list (,@ (nthcdr index reqopt-args))))))
(setq args-form `(list ,@(nthcdr index reqopt-args))))
(if rest-arg
(if args-form
(setq args-form (` (nconc (, args-form) (, rest-arg))))
(setq args-form (ad-list-access (- index (length reqopt-args))
rest-arg))))
(setq args-form `(nconc ,args-form ,rest-arg))
(setq args-form (ad-list-access (- index (length reqopt-args))
rest-arg))))
args-form))
(defun ad-set-arguments (arglist index values-form)
......@@ -2850,34 +2849,34 @@ The assignment starts at position INDEX."
arglist index
(ad-element-access values-index 'ad-vAlUeS))
set-forms))
(setq set-forms
(cons (if (= (car argument-access) 0)
(list 'setq
(car (cdr argument-access))
(ad-list-access values-index 'ad-vAlUeS))
(list 'setcdr
(ad-list-access (1- (car argument-access))
(car (cdr argument-access)))
(ad-list-access values-index 'ad-vAlUeS)))
set-forms))
;; terminate loop
(setq arglist nil))
(setq set-forms
(cons (if (= (car argument-access) 0)
(list 'setq
(car (cdr argument-access))
(ad-list-access values-index 'ad-vAlUeS))
(list 'setcdr
(ad-list-access (1- (car argument-access))
(car (cdr argument-access)))
(ad-list-access values-index 'ad-vAlUeS)))
set-forms))
;; terminate loop
(setq arglist nil))
(setq index (1+ index))
(setq values-index (1+ values-index)))
(if (null set-forms)
(error "ad-set-arguments: No argument at position %d of `%s'"
index arglist)
(if (= (length set-forms) 1)
;; For exactly one set-form we can use values-form directly,...
(ad-substitute-tree
(function (lambda (form) (eq form 'ad-vAlUeS)))
(function (lambda (form) values-form))
(car set-forms))
;; ...if we have more we have to bind it to a variable:
(` (let ((ad-vAlUeS (, values-form)))
(,@ (reverse set-forms))
;; work around the old backquote bug:
(, 'ad-vAlUeS)))))))
(if (= (length set-forms) 1)
;; For exactly one set-form we can use values-form directly,...
(ad-substitute-tree
(function (lambda (form) (eq form 'ad-vAlUeS)))
(function (lambda (form) values-form))
(car set-forms))
;; ...if we have more we have to bind it to a variable:
`(let ((ad-vAlUeS ,values-form))
,@(reverse set-forms)
;; work around the old backquote bug:
,'ad-vAlUeS)))))
(defun ad-insert-argument-access-forms (definition arglist)
"Expands arg-access text macros in DEFINITION according to ARGLIST."
......@@ -3071,11 +3070,11 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
((ad-interactive-form origdef)
(if (and (symbolp function) (get function 'elp-info))
(interactive-form (aref (get function 'elp-info) 2))
(ad-interactive-form origdef)))
(ad-interactive-form origdef)))
;; Otherwise we must have a subr: make it interactive if
;; we have to and initialize required arguments in case
;; it is called interactively:
(orig-interactive-p
(orig-interactive-p
(interactive-form origdef))))
(orig-form
(cond ((or orig-special-form-p orig-macro-p)
......@@ -3104,7 +3103,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
;; in order to do proper prompting:
`(if (interactive-p)
(call-interactively ',origname)
,(ad-make-mapped-call orig-arglist
,(ad-make-mapped-call orig-arglist
advised-arglist
origname)))
;; And now for normal functions and non-interactive subrs
......@@ -3126,7 +3125,7 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
(ad-get-enabled-advices function 'after)))))
(defun ad-assemble-advised-definition
(