diff options
| -rw-r--r-- | lisp/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/ansi-color.el | 28 | ||||
| -rw-r--r-- | lisp/bookmark.el | 41 | ||||
| -rw-r--r-- | lisp/dired.el | 40 | ||||
| -rw-r--r-- | lisp/emacs-lisp/advice.el | 509 | ||||
| -rw-r--r-- | lisp/emacs-lisp/checkdoc.el | 24 | ||||
| -rw-r--r-- | lisp/emacs-lisp/ewoc.el | 16 | ||||
| -rw-r--r-- | lisp/emerge.el | 244 | ||||
| -rw-r--r-- | lisp/fast-lock.el | 90 | ||||
| -rw-r--r-- | lisp/lazy-lock.el | 42 | ||||
| -rw-r--r-- | lisp/mail/feedmail.el | 20 | ||||
| -rw-r--r-- | lisp/mouse-sel.el | 120 | ||||
| -rw-r--r-- | lisp/obsolete/c-mode.el | 168 | ||||
| -rw-r--r-- | lisp/obsolete/cplus-md.el | 168 | ||||
| -rw-r--r-- | lisp/progmodes/dcl-mode.el | 11 | ||||
| -rw-r--r-- | lisp/progmodes/idlw-shell.el | 57 | ||||
| -rw-r--r-- | lisp/progmodes/idlwave.el | 32 | ||||
| -rw-r--r-- | lisp/term/sun-mouse.el | 52 | ||||
| -rw-r--r-- | lisp/textmodes/artist.el | 24 |
19 files changed, 848 insertions, 848 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6d25f62ace2..c6699bf7197 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +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. diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 51421add42c..0412392cd05 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -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'. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 6ac3c0f9d9a..3c258b2689b 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -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) diff --git a/lisp/dired.el b/lisp/dired.el index d7217b60f21..bc49f0bf301 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -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. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index c13bff9e7cc..36ae0e33884 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -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 - (type args docstring interactive orig &optional befores arounds afters) + (type args docstring interactive orig &optional befores arounds afters) "Assembles an original and its advices into an advised function. It constructs a function or macro definition according to TYPE which has to @@ -3139,58 +3138,58 @@ should be modified. The assembled function will be returned." (let (before-forms around-form around-form-protected after-forms definition) (ad-dolist (advice befores) - (cond ((and (ad-advice-protected advice) - before-forms) - (setq before-forms - (` ((unwind-protect - (, (ad-prognify before-forms)) - (,@ (ad-body-forms - (ad-advice-definition advice)))))))) - (t (setq before-forms - (append before-forms - (ad-body-forms (ad-advice-definition advice))))))) - - (setq around-form (` (setq ad-return-value (, orig)))) + (cond ((and (ad-advice-protected advice) + before-forms) + (setq before-forms + `((unwind-protect + ,(ad-prognify before-forms) + ,@(ad-body-forms + (ad-advice-definition advice)))))) + (t (setq before-forms + (append before-forms + (ad-body-forms (ad-advice-definition advice))))))) + + (setq around-form `(setq ad-return-value ,orig)) (ad-dolist (advice (reverse arounds)) - ;; If any of the around advices is protected then we - ;; protect the complete around advice onion: - (if (ad-advice-protected advice) - (setq around-form-protected t)) - (setq around-form - (ad-substitute-tree - (function (lambda (form) (eq form 'ad-do-it))) - (function (lambda (form) around-form)) - (ad-prognify (ad-body-forms (ad-advice-definition advice)))))) + ;; If any of the around advices is protected then we + ;; protect the complete around advice onion: + (if (ad-advice-protected advice) + (setq around-form-protected t)) + (setq around-form + (ad-substitute-tree + (function (lambda (form) (eq form 'ad-do-it))) + (function (lambda (form) around-form)) + (ad-prognify (ad-body-forms (ad-advice-definition advice)))))) (setq after-forms (if (and around-form-protected before-forms) - (` ((unwind-protect - (, (ad-prognify before-forms)) - (, around-form)))) - (append before-forms (list around-form)))) + `((unwind-protect + ,(ad-prognify before-forms) + ,around-form)) + (append before-forms (list around-form)))) (ad-dolist (advice afters) - (cond ((and (ad-advice-protected advice) - after-forms) - (setq after-forms - (` ((unwind-protect - (, (ad-prognify after-forms)) - (,@ (ad-body-forms - (ad-advice-definition advice)))))))) - (t (setq after-forms - (append after-forms - (ad-body-forms (ad-advice-definition advice))))))) + (cond ((and (ad-advice-protected advice) + after-forms) + (setq after-forms + `((unwind-protect + ,(ad-prognify after-forms) + ,@(ad-body-forms + (ad-advice-definition advice)))))) + (t (setq after-forms + (append after-forms + (ad-body-forms (ad-advice-definition advice))))))) (setq definition - (` ((,@ (if (memq type '(macro special-form)) '(macro))) - lambda - (, args) - (,@ (if docstring (list docstring))) - (,@ (if interactive (list interactive))) - (let (ad-return-value) - (,@ after-forms) - (, (if (eq type 'special-form) - '(list 'quote ad-return-value) - 'ad-return-value)))))) + `(,@(if (memq type '(macro special-form)) '(macro)) + lambda + ,args + ,@(if docstring (list docstring)) + ,@(if interactive (list interactive)) + (let (ad-return-value) + ,@after-forms + ,(if (eq type 'special-form) + '(list 'quote ad-return-value) + 'ad-return-value)))) (ad-insert-argument-access-forms definition args))) @@ -3266,14 +3265,14 @@ should be modified. The assembled function will be returned." ;; a lot cheaper than reconstructing an advised definition. (defmacro ad-get-cache-definition (function) - (` (car (ad-get-advice-info-field (, function) 'cache)))) + `(car (ad-get-advice-info-field ,function 'cache))) (defmacro ad-get-cache-id (function) - (` (cdr (ad-get-advice-info-field (, function) 'cache)))) + `(cdr (ad-get-advice-info-field ,function 'cache))) (defmacro ad-set-cache (function definition id) - (` (ad-set-advice-info-field - (, function) 'cache (cons (, definition) (, id))))) + `(ad-set-advice-info-field + ,function 'cache (cons ,definition ,id))) (defun ad-clear-cache (function) "Clears a previously cached advised definition of FUNCTION. @@ -3451,21 +3450,21 @@ advised definition from scratch." (symbol-function 'ad-make-origname)) (frozen-definition (unwind-protect - (progn - ;; Make sure we construct a proper docstring: - (ad-safe-fset 'ad-make-advised-definition-docstring - 'ad-make-freeze-docstring) - ;; Make sure `unique-origname' is used as the origname: - (ad-safe-fset 'ad-make-origname (lambda (x) unique-origname)) - ;; No we reset all current advice information to nil and - ;; generate an advised definition that's solely determined - ;; by ADVICE and the current origdef of FUNCTION: - (ad-set-advice-info function nil) - (ad-add-advice function advice class position) - ;; The following will provide proper real docstrings as - ;; well as a definition that will make the compiler happy: - (ad-set-orig-definition function orig-definition) - (ad-make-advised-definition function)) + (progn + ;; Make sure we construct a proper docstring: + (ad-safe-fset 'ad-make-advised-definition-docstring + 'ad-make-freeze-docstring) + ;; Make sure `unique-origname' is used as the origname: + (ad-safe-fset 'ad-make-origname (lambda (x) unique-origname)) + ;; No we reset all current advice information to nil and + ;; generate an advised definition that's solely determined + ;; by ADVICE and the current origdef of FUNCTION: + (ad-set-advice-info function nil) + (ad-add-advice function advice class position) + ;; The following will provide proper real docstrings as + ;; well as a definition that will make the compiler happy: + (ad-set-orig-definition function orig-definition) + (ad-make-advised-definition function)) ;; Restore the old advice state: (ad-set-advice-info function old-advice-info) ;; Restore functions: @@ -3476,17 +3475,17 @@ advised definition from scratch." (let* ((macro-p (ad-macro-p frozen-definition)) (body (cdr (if macro-p (ad-lambdafy frozen-definition) - frozen-definition)))) - (` (progn - (if (not (fboundp '(, unique-origname))) - (fset '(, unique-origname) - ;; avoid infinite recursion in case the function - ;; we want to freeze is already advised: - (or (ad-get-orig-definition '(, function)) - (symbol-function '(, function))))) - ((, (if macro-p 'defmacro 'defun)) - (, function) - (,@ body)))))))) + frozen-definition)))) + `(progn + (if (not (fboundp ',unique-origname)) + (fset ',unique-origname + ;; avoid infinite recursion in case the function + ;; we want to freeze is already advised: + (or (ad-get-orig-definition ',function) + (symbol-function ',function)))) + (,(if macro-p 'defmacro 'defun) + ,function + ,@body)))))) ;; @@ Activation and definition handling: @@ -3812,13 +3811,13 @@ See Info node `(elisp)Advising Functions' for comprehensive documentation." (let* ((class (car args)) (name (if (not (ad-class-p class)) (error "defadvice: Invalid advice class: %s" class) - (nth 1 args))) + (nth 1 args))) (position (if (not (ad-name-p name)) (error "defadvice: Invalid advice name: %s" name) - (setq args (nthcdr 2 args)) - (if (ad-position-p (car args)) - (prog1 (car args) - (setq args (cdr args)))))) + (setq args (nthcdr 2 args)) + (if (ad-position-p (car args)) + (prog1 (car args) + (setq args (cdr args)))))) (arglist (if (listp (car args)) (prog1 (car args) (setq args (cdr args))))) @@ -3826,18 +3825,18 @@ See Info node `(elisp)Advising Functions' for comprehensive documentation." (mapcar (function (lambda (flag) - (let ((completion - (try-completion (symbol-name flag) ad-defadvice-flags))) - (cond ((eq completion t) flag) - ((assoc completion ad-defadvice-flags) - (intern completion)) - (t (error "defadvice: Invalid or ambiguous flag: %s" - flag)))))) + (let ((completion + (try-completion (symbol-name flag) ad-defadvice-flags))) + (cond ((eq completion t) flag) + ((assoc completion ad-defadvice-flags) + (intern completion)) + (t (error "defadvice: Invalid or ambiguous flag: %s" + flag)))))) args)) (advice (ad-make-advice name (memq 'protect flags) (not (memq 'disable flags)) - (` (advice lambda (, arglist) (,@ body))))) + `(advice lambda ,arglist ,@body))) (preactivation (if (memq 'preactivate flags) (ad-preactivate-advice function advice class position)))) @@ -3846,25 +3845,25 @@ See Info node `(elisp)Advising Functions' for comprehensive documentation." ;; jwz's idea: Freeze the advised definition into a dumpable ;; defun/defmacro whose docs can be written to the DOC file: (ad-make-freeze-definition function advice class position) - ;; the normal case: - (` (progn - (ad-add-advice '(, function) '(, advice) '(, class) '(, position)) - (,@ (if preactivation - (` ((ad-set-cache - '(, function) - ;; the function will get compiled: - (, (cond ((ad-macro-p (car preactivation)) - (` (ad-macrofy - (function - (, (ad-lambdafy - (car preactivation))))))) - (t (` (function - (, (car preactivation))))))) - '(, (car (cdr preactivation)))))))) - (,@ (if (memq 'activate flags) - (` ((ad-activate '(, function) - (, (if (memq 'compile flags) t))))))) - '(, function)))))) + ;; the normal case: + `(progn + (ad-add-advice ',function ',advice ',class ',position) + ,@(if preactivation + `((ad-set-cache + ',function + ;; the function will get compiled: + ,(cond ((ad-macro-p (car preactivation)) + `(ad-macrofy + (function + ,(ad-lambdafy + (car preactivation))))) + (t `(function + ,(car preactivation)))) + ',(car (cdr preactivation))))) + ,@(if (memq 'activate flags) + `((ad-activate ',function + ,(if (memq 'compile flags) t)))) + ',function)))) ;; @@ Tools: @@ -3880,39 +3879,39 @@ undone on exit of this macro." (current-bindings (mapcar (function (lambda (function) - (setq index (1+ index)) - (list (intern (format "ad-oRiGdEf-%d" index)) - (` (symbol-function '(, function)))))) + (setq index (1+ index)) + (list (intern (format "ad-oRiGdEf-%d" index)) + `(symbol-function ',function)))) functions))) - (` (let (, current-bindings) - (unwind-protect - (progn - (,@ (progn - ;; Make forms to redefine functions to their - ;; original definitions if they are advised: - (setq index -1) - (mapcar - (function - (lambda (function) - (setq index (1+ index)) - (` (ad-safe-fset - '(, function) - (or (ad-get-orig-definition '(, function)) - (, (car (nth index current-bindings)))))))) - functions))) - (,@ body)) - (,@ (progn - ;; Make forms to back-define functions to the definitions - ;; they had outside this macro call: - (setq index -1) - (mapcar - (function - (lambda (function) - (setq index (1+ index)) - (` (ad-safe-fset - '(, function) - (, (car (nth index current-bindings))))))) - functions)))))))) + `(let ,current-bindings + (unwind-protect + (progn + ,@(progn + ;; Make forms to redefine functions to their + ;; original definitions if they are advised: + (setq index -1) + (mapcar + (function + (lambda (function) + (setq index (1+ index)) + `(ad-safe-fset + ',function + (or (ad-get-orig-definition ',function) + ,(car (nth index current-bindings)))))) + functions)) + ,@body) + ,@(progn + ;; Make forms to back-define functions to the definitions + ;; they had outside this macro call: + (setq index -1) + (mapcar + (function + (lambda (function) + (setq index (1+ index)) + `(ad-safe-fset + ',function + ,(car (nth index current-bindings))))) + functions)))))) (if (not (get 'ad-with-originals 'lisp-indent-hook)) (put 'ad-with-originals 'lisp-indent-hook 1)) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 8c8472272e2..2639a93dea8 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -176,18 +176,18 @@ ;; From custom web page for compatibility between versions of custom: (eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro custom-add-option (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro custom-add-option (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + `(defvar ,var ,value ,doc)))) (defcustom checkdoc-autofix-flag 'semiautomatic "*Non-nil means attempt auto-fixing of doc strings. diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el index 6bb26507ec2..66509589467 100644 --- a/lisp/emacs-lisp/ewoc.el +++ b/lisp/emacs-lisp/ewoc.el @@ -219,14 +219,14 @@ buffer will *not* have been changed. Return value of last form in FORMS." (let ((old-buffer (make-symbol "old-buffer")) (hnd (make-symbol "ewoc"))) - (` (let* (((, old-buffer) (current-buffer)) - ((, hnd) (, ewoc)) - (dll (ewoc--dll (, hnd))) - (,@ varlist)) - (set-buffer (ewoc--buffer (, hnd))) - (unwind-protect - (progn (,@ forms)) - (set-buffer (, old-buffer))))))) + `(let* ((,old-buffer (current-buffer)) + (,hnd ,ewoc) + (dll (ewoc--dll ,hnd)) + ,@varlist) + (set-buffer (ewoc--buffer ,hnd)) + (unwind-protect + (progn ,@forms) + (set-buffer ,old-buffer))))) (defmacro ewoc--set-buffer-bind-dll (ewoc &rest forms) `(ewoc--set-buffer-bind-dll-let* ,ewoc nil ,@forms)) diff --git a/lisp/emerge.el b/lisp/emerge.el index 551ba3503e1..68e857ff245 100644 --- a/lisp/emerge.el +++ b/lisp/emerge.el @@ -57,12 +57,12 @@ (defmacro emerge-eval-in-buffer (buffer &rest forms) "Macro to switch to BUFFER, evaluate FORMS, returns to original buffer. Differs from `save-excursion' in that it doesn't save the point and mark." - (` (let ((StartBuffer (current-buffer))) + `(let ((StartBuffer (current-buffer))) (unwind-protect - (progn - (set-buffer (, buffer)) - (,@ forms)) - (set-buffer StartBuffer))))) + (progn + (set-buffer ,buffer) + ,@forms) + (set-buffer StartBuffer)))) (defmacro emerge-defvar-local (var value doc) "Defines SYMBOL as an advertised variable. @@ -70,10 +70,10 @@ Performs a defvar, then executes `make-variable-buffer-local' on the variable. Also sets the `preserved' property, so that `kill-all-local-variables' (called by major-mode setting commands) won't destroy Emerge control variables." - (` (progn - (defvar (, var) (, value) (, doc)) - (make-variable-buffer-local '(, var)) - (put '(, var) 'preserved t)))) + `(progn + (defvar ,var ,value ,doc) + (make-variable-buffer-local ',var) + (put ',var 'preserved t))) ;; Add entries to minor-mode-alist so that emerge modes show correctly (defvar emerge-minor-modes-list @@ -567,7 +567,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") ;;; Setup functions for two-file mode. (defun emerge-files-internal (file-A file-B &optional startup-hooks quit-hooks - output-file) + output-file) (if (not (file-readable-p file-A)) (error "File `%s' does not exist or is not readable" file-A)) (if (not (file-readable-p file-B)) @@ -587,10 +587,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (if temp (setq file-A temp startup-hooks - (cons (` (lambda () (delete-file (, file-A)))) + (cons `(lambda () (delete-file ,file-A)) startup-hooks)) - ;; Verify that the file matches the buffer - (emerge-verify-file-buffer)))) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer)))) (emerge-eval-in-buffer buffer-B (widen) @@ -598,10 +598,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (if temp (setq file-B temp startup-hooks - (cons (` (lambda () (delete-file (, file-B)))) + (cons `(lambda () (delete-file ,file-B)) startup-hooks)) - ;; Verify that the file matches the buffer - (emerge-verify-file-buffer)))) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer)))) (emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks output-file))) @@ -741,10 +741,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (if temp (setq file-A temp startup-hooks - (cons (` (lambda () (delete-file (, file-A)))) + (cons `(lambda () (delete-file ,file-A)) startup-hooks)) - ;; Verify that the file matches the buffer - (emerge-verify-file-buffer)))) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer)))) (emerge-eval-in-buffer buffer-B (widen) @@ -752,10 +752,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (if temp (setq file-B temp startup-hooks - (cons (` (lambda () (delete-file (, file-B)))) + (cons `(lambda () (delete-file ,file-B)) startup-hooks)) - ;; Verify that the file matches the buffer - (emerge-verify-file-buffer)))) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer)))) (emerge-eval-in-buffer buffer-ancestor (widen) @@ -763,10 +763,10 @@ This is *not* a user option, since Emerge uses it for its own processing.") (if temp (setq file-ancestor temp startup-hooks - (cons (` (lambda () (delete-file (, file-ancestor)))) + (cons `(lambda () (delete-file ,file-ancestor)) startup-hooks)) - ;; Verify that the file matches the buffer - (emerge-verify-file-buffer)))) + ;; Verify that the file matches the buffer + (emerge-verify-file-buffer)))) (emerge-setup-with-ancestor buffer-A file-A buffer-B file-B buffer-ancestor file-ancestor startup-hooks quit-hooks output-file))) @@ -901,7 +901,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (emerge-read-file-name "Output file" emerge-last-dir-output f f nil))))) (if file-out - (add-hook 'quit-hooks (` (lambda () (emerge-files-exit (, file-out)))))) + (add-hook 'quit-hooks `(lambda () (emerge-files-exit ,file-out)))) (emerge-files-internal file-A file-B startup-hooks quit-hooks @@ -923,7 +923,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (emerge-read-file-name "Output file" emerge-last-dir-output f f nil))))) (if file-out - (add-hook 'quit-hooks (` (lambda () (emerge-files-exit (, file-out)))))) + (add-hook 'quit-hooks `(lambda () (emerge-files-exit ,file-out)))) (emerge-files-with-ancestor-internal file-A file-B file-ancestor startup-hooks quit-hooks @@ -951,17 +951,17 @@ This is *not* a user option, since Emerge uses it for its own processing.") (write-region (point-min) (point-max) emerge-file-B nil 'no-message)) (emerge-setup (get-buffer buffer-A) emerge-file-A (get-buffer buffer-B) emerge-file-B - (cons (` (lambda () - (delete-file (, emerge-file-A)) - (delete-file (, emerge-file-B)))) + (cons `(lambda () + (delete-file ,emerge-file-A) + (delete-file ,emerge-file-B)) startup-hooks) quit-hooks nil))) ;;;###autoload (defun emerge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor - &optional startup-hooks - quit-hooks) + &optional startup-hooks + quit-hooks) "Run Emerge on two buffers, giving another buffer as the ancestor." (interactive "bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ") @@ -982,11 +982,11 @@ This is *not* a user option, since Emerge uses it for its own processing.") (get-buffer buffer-B) emerge-file-B (get-buffer buffer-ancestor) emerge-file-ancestor - (cons (` (lambda () - (delete-file (, emerge-file-A)) - (delete-file (, emerge-file-B)) - (delete-file - (, emerge-file-ancestor)))) + (cons `(lambda () + (delete-file ,emerge-file-A) + (delete-file ,emerge-file-B) + (delete-file + ,emerge-file-ancestor)) startup-hooks) quit-hooks nil))) @@ -1001,7 +1001,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (setq command-line-args-left (nthcdr 3 command-line-args-left)) (emerge-files-internal file-a file-b nil - (list (` (lambda () (emerge-command-exit (, file-out)))))))) + (list `(lambda () (emerge-command-exit ,file-out)))))) ;;;###autoload (defun emerge-files-with-ancestor-command () @@ -1015,15 +1015,15 @@ This is *not* a user option, since Emerge uses it for its own processing.") (setq file-anc (nth 1 command-line-args-left)) (setq file-out (nth 4 command-line-args-left)) (setq command-line-args-left (nthcdr 5 command-line-args-left))) - ;; arguments are "file-a file-b ancestor file-out" - (setq file-a (nth 0 command-line-args-left)) - (setq file-b (nth 1 command-line-args-left)) - (setq file-anc (nth 2 command-line-args-left)) - (setq file-out (nth 3 command-line-args-left)) - (setq command-line-args-left (nthcdr 4 command-line-args-left))) + ;; arguments are "file-a file-b ancestor file-out" + (setq file-a (nth 0 command-line-args-left)) + (setq file-b (nth 1 command-line-args-left)) + (setq file-anc (nth 2 command-line-args-left)) + (setq file-out (nth 3 command-line-args-left)) + (setq command-line-args-left (nthcdr 4 command-line-args-left))) (emerge-files-with-ancestor-internal file-a file-b file-anc nil - (list (` (lambda () (emerge-command-exit (, file-out)))))))) + (list `(lambda () (emerge-command-exit ,file-out)))))) (defun emerge-command-exit (file-out) (emerge-write-and-delete file-out) @@ -1036,7 +1036,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (setq emerge-file-out file-out) (emerge-files-internal file-a file-b nil - (list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func))))) + (list `(lambda () (emerge-remote-exit ,file-out ',emerge-exit-func))) file-out) (throw 'client-wait nil)) @@ -1045,7 +1045,7 @@ This is *not* a user option, since Emerge uses it for its own processing.") (setq emerge-file-out file-out) (emerge-files-with-ancestor-internal file-a file-b file-anc nil - (list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func))))) + (list `(lambda () (emerge-remote-exit ,file-out ',emerge-exit-func))) file-out) (throw 'client-wait nil)) @@ -1070,17 +1070,17 @@ This is *not* a user option, since Emerge uses it for its own processing.") (emerge-revisions-internal file revision-A revision-B startup-hooks (if arg - (cons (` (lambda () - (shell-command - (, (format "%s %s" emerge-rcs-ci-program file))))) + (cons `(lambda () + (shell-command + ,(format "%s %s" emerge-rcs-ci-program file))) quit-hooks) - quit-hooks))) + quit-hooks))) ;;;###autoload (defun emerge-revisions-with-ancestor (arg file revision-A - revision-B ancestor - &optional - startup-hooks quit-hooks) + revision-B ancestor + &optional + startup-hooks quit-hooks) "Emerge two RCS revisions of a file, with another revision as ancestor." (interactive (list current-prefix-arg @@ -1095,14 +1095,14 @@ This is *not* a user option, since Emerge uses it for its own processing.") file revision-A revision-B ancestor startup-hooks (if arg (let ((cmd )) - (cons (` (lambda () - (shell-command - (, (format "%s %s" emerge-rcs-ci-program file))))) + (cons `(lambda () + (shell-command + ,(format "%s %s" emerge-rcs-ci-program file))) quit-hooks)) - quit-hooks))) + quit-hooks))) (defun emerge-revisions-internal (file revision-A revision-B &optional - startup-hooks quit-hooks output-file) + startup-hooks quit-hooks output-file) (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) (buffer-B (get-buffer-create (format "%s,%s" file revision-B))) (emerge-file-A (emerge-make-temp-file "A")) @@ -1127,18 +1127,18 @@ This is *not* a user option, since Emerge uses it for its own processing.") ;; Do the merge (emerge-setup buffer-A emerge-file-A buffer-B emerge-file-B - (cons (` (lambda () - (delete-file (, emerge-file-A)) - (delete-file (, emerge-file-B)))) + (cons `(lambda () + (delete-file ,emerge-file-A) + (delete-file ,emerge-file-B)) startup-hooks) - (cons (` (lambda () (emerge-files-exit (, file)))) + (cons `(lambda () (emerge-files-exit ,file)) quit-hooks) nil))) (defun emerge-revision-with-ancestor-internal (file revision-A revision-B - ancestor - &optional startup-hooks - quit-hooks output-file) + ancestor + &optional startup-hooks + quit-hooks output-file) (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A))) (buffer-B (get-buffer-create (format "%s,%s" file revision-B))) (buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor))) @@ -1175,12 +1175,12 @@ This is *not* a user option, since Emerge uses it for its own processing.") (emerge-setup-with-ancestor buffer-A emerge-file-A buffer-B emerge-file-B buffer-ancestor emerge-ancestor - (cons (` (lambda () - (delete-file (, emerge-file-A)) - (delete-file (, emerge-file-B)) - (delete-file (, emerge-ancestor)))) + (cons `(lambda () + (delete-file ,emerge-file-A) + (delete-file ,emerge-file-B) + (delete-file ,emerge-ancestor)) startup-hooks) - (cons (` (lambda () (emerge-files-exit (, file)))) + (cons `(lambda () (emerge-files-exit ,file)) quit-hooks) output-file))) @@ -1225,26 +1225,26 @@ Otherwise, the A or B file present is copied to the output file." (goto-char (match-end 0)) ;; Store the filename in the right variable (cond - ((string-equal tag "a") - (if file-A - (error "This line has two `A' entries")) - (setq file-A file)) - ((string-equal tag "b") - (if file-B - (error "This line has two `B' entries")) - (setq file-B file)) - ((or (string-equal tag "anc") (string-equal tag "ancestor")) - (if file-ancestor - (error "This line has two `ancestor' entries")) - (setq file-ancestor file)) - ((or (string-equal tag "out") (string-equal tag "output")) - (if file-out - (error "This line has two `output' entries")) - (setq file-out file)) - (t - (error "Unrecognized entry")))) - ;; If the match on the entry pattern failed - (error "Unparsable entry"))) + ((string-equal tag "a") + (if file-A + (error "This line has two `A' entries")) + (setq file-A file)) + ((string-equal tag "b") + (if file-B + (error "This line has two `B' entries")) + (setq file-B file)) + ((or (string-equal tag "anc") (string-equal tag "ancestor")) + (if file-ancestor + (error "This line has two `ancestor' entries")) + (setq file-ancestor file)) + ((or (string-equal tag "out") (string-equal tag "output")) + (if file-out + (error "This line has two `output' entries")) + (setq file-out file)) + (t + (error "Unrecognized entry")))) + ;; If the match on the entry pattern failed + (error "Unparsable entry"))) ;; Make sure that file-A and file-B are present (if (not (or (and file-A file-B) file-out)) (error "Must have both `A' and `B' entries")) @@ -1255,37 +1255,37 @@ Otherwise, the A or B file present is copied to the output file." (beginning-of-line 2) ;; Execute the correct command (cond - ;; Merge of two files with ancestor - ((and file-A file-B file-ancestor) - (message "Merging %s and %s..." file-A file-B) - (emerge-files-with-ancestor (not (not file-out)) file-A file-B - file-ancestor file-out - nil - ;; When done, return to this buffer. - (list - (` (lambda () - (switch-to-buffer (, (current-buffer))) - (message "Merge done.")))))) - ;; Merge of two files without ancestor - ((and file-A file-B) - (message "Merging %s and %s..." file-A file-B) - (emerge-files (not (not file-out)) file-A file-B file-out - nil - ;; When done, return to this buffer. - (list - (` (lambda () - (switch-to-buffer (, (current-buffer))) - (message "Merge done.")))))) - ;; There is an output file (or there would have been an error above), - ;; but only one input file. - ;; The file appears to have been deleted in one version; do nothing. - ((and file-ancestor emerge-execute-line-deletions) - (message "No action.")) - ;; The file should be copied from the version that contains it - (t (let ((input-file (or file-A file-B))) - (message "Copying...") - (copy-file input-file file-out) - (message "%s copied to %s." input-file file-out)))))) + ;; Merge of two files with ancestor + ((and file-A file-B file-ancestor) + (message "Merging %s and %s..." file-A file-B) + (emerge-files-with-ancestor (not (not file-out)) file-A file-B + file-ancestor file-out + nil + ;; When done, return to this buffer. + (list + `(lambda () + (switch-to-buffer ,(current-buffer)) + (message "Merge done."))))) + ;; Merge of two files without ancestor + ((and file-A file-B) + (message "Merging %s and %s..." file-A file-B) + (emerge-files (not (not file-out)) file-A file-B file-out + nil + ;; When done, return to this buffer. + (list + `(lambda () + (switch-to-buffer ,(current-buffer)) + (message "Merge done."))))) + ;; There is an output file (or there would have been an error above), + ;; but only one input file. + ;; The file appears to have been deleted in one version; do nothing. + ((and file-ancestor emerge-execute-line-deletions) + (message "No action.")) + ;; The file should be copied from the version that contains it + (t (let ((input-file (or file-A file-B))) + (message "Copying...") + (copy-file input-file file-out) + (message "%s copied to %s." input-file file-out)))))) ;;; Sample function for creating information for emerge-execute-line diff --git a/lisp/fast-lock.el b/lisp/fast-lock.el index bc32f31ce53..40773787324 100644 --- a/lisp/fast-lock.el +++ b/lisp/fast-lock.el @@ -187,51 +187,51 @@ (error "`fast-lock' was written for long file name systems")) (eval-when-compile - ;; - ;; We don't do this at the top-level as we only use non-autoloaded macros. - (require 'cl) - ;; - ;; We use this to preserve or protect things when modifying text properties. - (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 verify that a face should be saved. - (defmacro fast-lock-save-facep (face) - "Return non-nil if FACE is one of `fast-lock-save-faces'." - (` (or (null fast-lock-save-faces) - (if (symbolp (, face)) - (memq (, face) fast-lock-save-faces) - (let ((faces (, face))) - (while (unless (memq (car faces) fast-lock-save-faces) - (setq faces (cdr faces)))) - faces))))) - ;; - ;; We use this for compatibility with a future Emacs. - (or (fboundp 'with-temp-message) - (defmacro with-temp-message (message &rest body) - (` (let ((temp-message (, message)) current-message) - (unwind-protect - (progn - (when temp-message - (setq current-message (current-message)) - (message temp-message)) - (,@ body)) - (when temp-message - (message current-message))))))) - ;; - ;; We use this for compatibility with a future Emacs. - (or (fboundp 'defcustom) - (defmacro defcustom (symbol value doc &rest args) - (` (defvar (, symbol) (, value) (, doc)))))) + ;; + ;; We don't do this at the top-level as we only use non-autoloaded macros. + (require 'cl) + ;; + ;; We use this to preserve or protect things when modifying text properties. + (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 verify that a face should be saved. + (defmacro fast-lock-save-facep (face) + "Return non-nil if FACE is one of `fast-lock-save-faces'." + `(or (null fast-lock-save-faces) + (if (symbolp ,face) + (memq ,face fast-lock-save-faces) + (let ((faces ,face)) + (while (unless (memq (car faces) fast-lock-save-faces) + (setq faces (cdr faces)))) + faces)))) + ;; + ;; We use this for compatibility with a future Emacs. + (or (fboundp 'with-temp-message) + (defmacro with-temp-message (message &rest body) + `(let ((temp-message ,message) current-message) + (unwind-protect + (progn + (when temp-message + (setq current-message (current-message)) + (message temp-message)) + ,@body) + (when temp-message + (message current-message)))))) + ;; + ;; We use this for compatibility with a future Emacs. + (or (fboundp 'defcustom) + (defmacro defcustom (symbol value doc &rest args) + `(defvar ,symbol ,value ,doc)))) ;(defun fast-lock-submit-bug-report () ; "Submit via mail a bug report on fast-lock.el." diff --git a/lisp/lazy-lock.el b/lisp/lazy-lock.el index 82737a9d02a..04a777895f1 100644 --- a/lisp/lazy-lock.el +++ b/lisp/lazy-lock.el @@ -271,29 +271,29 @@ (require 'font-lock) (eval-when-compile - ;; We don't do this at the top-level as we only use non-autoloaded macros. - (require 'cl) - ;; - ;; We use this to preserve or protect things when modifying text properties. - (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 for clarity and speed. Naughty but nice. - (defmacro do-while (test &rest body) - "(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil. + ;; We don't do this at the top-level as we only use non-autoloaded macros. + (require 'cl) + ;; + ;; We use this to preserve or protect things when modifying text properties. + (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 for clarity and speed. Naughty but nice. + (defmacro do-while (test &rest body) + "(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil. The order of execution is thus BODY, TEST, BODY, TEST and so on until TEST returns nil." - (` (while (progn (,@ body) (, test))))) - (put 'do-while 'lisp-indent-function (get 'while 'lisp-indent-function))) + `(while (progn ,@body ,test))) + (put 'do-while 'lisp-indent-function (get 'while 'lisp-indent-function))) (defvar lazy-lock-mode nil) ; Whether we are turned on. (defvar lazy-lock-buffers nil) ; For deferral. diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index a5679073064..8a69ae7802d 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -291,16 +291,16 @@ ;; If you write software that must work without the new custom, you ;; can use this hack stolen from w3-cus.el: (eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defcustom (var value doc &rest args) + `(defvar ,var ,value ,doc)))) (eval-when-compile (require 'smtpmail)) (autoload 'mail-do-fcc "sendmail") diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el index e732fad03da..34b912e3334 100644 --- a/lisp/mouse-sel.el +++ b/lisp/mouse-sel.el @@ -50,9 +50,9 @@ ;; ;; * Pressing mouse-2 while selecting or extending copies selection ;; to the kill ring. Pressing mouse-1 or mouse-3 kills it. -;; +;; ;; * Double-clicking mouse-3 also kills selection. -;; +;; ;; * M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2 ;; & mouse-3, but operate on the X secondary selection rather than the ;; primary selection and region. @@ -71,7 +71,7 @@ ;; ;; ;; But only in the selected window ;; (setq highlight-nonselected-windows nil) -;; +;; ;; ;; Enable pending-delete ;; (delete-selection-mode 1) ;; @@ -79,7 +79,7 @@ ;; of mouse-sel-default-bindings before loading mouse-sel. ;; ;; (a) If mouse-sel-default-bindings = t (the default) -;; +;; ;; Mouse sets and insert selection ;; mouse-1 mouse-select ;; mouse-2 mouse-insert-selection @@ -90,19 +90,19 @@ ;; interprogram-paste-function = nil ;; ;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste -;; +;; ;; Mouse sets selection, and pastes from kill-ring ;; mouse-1 mouse-select ;; mouse-2 mouse-yank-at-click ;; mouse-3 mouse-extend -;; +;; ;; Selection/kill-ring interaction is retained ;; interprogram-cut-function = x-select-text ;; interprogram-paste-function = x-cut-buffer-or-selection-value -;; +;; ;; What you lose is the ability to select some text in ;; delete-selection-mode and yank over the top of it. -;; +;; ;; (c) If mouse-sel-default-bindings = nil, no bindings are made. ;; ;; * By default, mouse-insert-selection (mouse-2) inserts the selection at @@ -286,11 +286,11 @@ primary selection and region." ;;=== Internal Variables/Constants ======================================== -(defvar mouse-sel-primary-thing nil +(defvar mouse-sel-primary-thing nil "Type of PRIMARY selection in current buffer.") (make-variable-buffer-local 'mouse-sel-primary-thing) -(defvar mouse-sel-secondary-thing nil +(defvar mouse-sel-secondary-thing nil "Type of SECONDARY selection in current buffer.") (make-variable-buffer-local 'mouse-sel-secondary-thing) @@ -311,7 +311,7 @@ where SELECTION-NAME = name of selection OVERLAY-SYMBOL = name of variable containing overlay to use SELECTION-THING-SYMBOL = name of variable where the current selection type for this selection should be stored.") - + (defvar mouse-sel-set-selection-function (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) 'x-set-selection @@ -356,7 +356,7 @@ Feel free to re-define this function to support your own desired multi-click semantics." (let* ((next-char (char-after (point))) (char-syntax (if next-char (char-syntax next-char)))) - (if mouse-sel-cycle-clicks + (if mouse-sel-cycle-clicks (setq nclicks (1+ (% (1- nclicks) 4)))) (cond ((= nclicks 1) nil) @@ -393,17 +393,17 @@ multi-click semantics." (defun mouse-sel-region-to-primary (orig-window) "Convert region to PRIMARY overlay and deactivate region. -Argument ORIG-WINDOW specifies the window the cursor was in when the -originating command was issued, and is used to determine whether the +Argument ORIG-WINDOW specifies the window the cursor was in when the +originating command was issued, and is used to determine whether the region was visible or not." (if transient-mark-mode (let ((overlay (mouse-sel-selection-overlay 'PRIMARY))) (cond - ((and mark-active - (or highlight-nonselected-windows + ((and mark-active + (or highlight-nonselected-windows (eq orig-window (selected-window)))) ;; Region was visible, so convert region to overlay - (move-overlay overlay (region-beginning) (region-end) + (move-overlay overlay (region-beginning) (region-end) (current-buffer))) ((eq orig-window (selected-window)) ;; Point was visible, so set overlay at point @@ -437,24 +437,22 @@ dragged right-to-left." "Evaluate forms at mouse position. Move to the end position of EVENT, execute FORMS, and restore original point and window." - (` - (let ((posn (event-end (, event)))) - (if posn (mouse-minibuffer-check (, event))) - (if (and posn (not (windowp (posn-window posn)))) - (error "Cursor not in text area of window")) - (let (orig-window orig-point-marker) - (setq orig-window (selected-window)) - (if posn (select-window (posn-window posn))) - (setq orig-point-marker (point-marker)) - (if (and posn (numberp (posn-point posn))) - (goto-char (posn-point posn))) - (unwind-protect - (progn - (,@ forms)) - (goto-char (marker-position orig-point-marker)) - (move-marker orig-point-marker nil) - (select-window orig-window) - ))))) + `(let ((posn (event-end ,event))) + (if posn (mouse-minibuffer-check ,event)) + (if (and posn (not (windowp (posn-window posn)))) + (error "Cursor not in text area of window")) + (let (orig-window orig-point-marker) + (setq orig-window (selected-window)) + (if posn (select-window (posn-window posn))) + (setq orig-point-marker (point-marker)) + (if (and posn (numberp (posn-point posn))) + (goto-char (posn-point posn))) + (unwind-protect + (progn + ,@forms) + (goto-char (marker-position orig-point-marker)) + (move-marker orig-point-marker nil) + (select-window orig-window))))) (put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1) @@ -466,7 +464,7 @@ point and window." Click sets point & mark to click position. Dragging extends region/selection. -Multi-clicking selects word/lines/paragraphs, as determined by +Multi-clicking selects word/lines/paragraphs, as determined by 'mouse-sel-determine-selection-thing. Clicking mouse-2 while selecting copies selected text to the kill-ring. @@ -485,7 +483,7 @@ This should be bound to a down-mouse event." Click sets the start of the secondary selection to click position. Dragging extends the secondary selection. -Multi-clicking selects word/lines/paragraphs, as determined by +Multi-clicking selects word/lines/paragraphs, as determined by 'mouse-sel-determine-selection-thing. Clicking mouse-2 while selecting copies selected text to the kill-ring. @@ -535,12 +533,12 @@ This should be bound to a down-mouse event." (defun mouse-extend-internal (selection &optional initial-event) "Extend specified SELECTION using the mouse. Track mouse-motion events, adjusting the SELECTION appropriately. -Optional argument INITIAL-EVENT specifies an initial down-mouse event to -process. +Optional argument INITIAL-EVENT specifies an initial down-mouse event to +process. See documentation for mouse-select-internal for more details." (mouse-sel-eval-at-event-end initial-event - (let ((orig-cursor-type + (let ((orig-cursor-type (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))) (unwind-protect @@ -563,16 +561,16 @@ See documentation for mouse-select-internal for more details." (setq min (point) max min) (set thing-symbol nil)) - + ;; Bar cursor (if (fboundp 'modify-frame-parameters) (modify-frame-parameters (selected-frame) '((cursor-type . bar)))) - + ;; Handle dragging (track-mouse - + (while (if initial-event ; Use initial event (prog1 (setq event initial-event) @@ -580,12 +578,12 @@ See documentation for mouse-select-internal for more details." (setq event (read-event)) (and (consp event) (memq (car event) '(mouse-movement switch-frame)))) - + (let ((selection-thing (symbol-value thing-symbol)) (end (event-end event))) - + (cond - + ;; Ignore any movement outside the frame ((eq (car-safe event) 'switch-frame) nil) ((and (posn-window end) @@ -594,7 +592,7 @@ See documentation for mouse-select-internal for more details." (window-frame posn-w) posn-w)) (window-frame orig-window)))) nil) - + ;; Different window, same frame ((not (eq (posn-window end) orig-window)) (let ((end-row (cdr (cdr (mouse-position))))) @@ -606,16 +604,16 @@ See documentation for mouse-select-internal for more details." (mouse-scroll-subr orig-window (1+ (- end-row bottom)) overlay min)) ))) - + ;; On the mode line ((eq (posn-point end) 'mode-line) (mouse-scroll-subr orig-window 1 overlay min)) - + ;; In original window (t (goto-char (posn-point end))) - + ) - + ;; Determine direction of drag (cond ((and (not direction) (not (eq min max))) @@ -624,12 +622,12 @@ See documentation for mouse-select-internal for more details." (setq direction -1)) ((and (not (eq direction 1)) (>= (point) max)) (setq direction 1))) - + (if (not selection-thing) nil - + ;; If dragging forward, goal is next character (if (and (eq direction 1) (not (eobp))) (forward-char 1)) - + ;; Move to start/end of selected thing (let ((goal (point))) (goto-char (if (eq 1 direction) min max)) @@ -643,25 +641,25 @@ See documentation for mouse-select-internal for more details." (if (> (* direction (- goal (point))) 0) end (point))))) (error)))) - + ;; Move overlay (move-overlay overlay (if (eq 1 direction) min (point)) (if (eq -1 direction) max (point)) (current-buffer)) - + ))) ; end track-mouse ;; Finish up after dragging (let ((overlay-start (overlay-start overlay)) (overlay-end (overlay-end overlay))) - + ;; Set selection (if (not (eq overlay-start overlay-end)) (mouse-sel-set-selection selection (buffer-substring overlay-start overlay-end))) - + ;; Handle copy/kill (let (this-command) (cond @@ -683,9 +681,9 @@ See documentation for mouse-select-internal for more details." ;; Restore cursor (if (fboundp 'modify-frame-parameters) - (modify-frame-parameters + (modify-frame-parameters (selected-frame) (list (cons 'cursor-type orig-cursor-type)))) - + )))) ;;=== Paste =============================================================== @@ -705,7 +703,7 @@ If `mouse-yank-at-point' is non-nil, insert at point instead." (defun mouse-insert-selection-internal (selection event) "Insert the contents of the named SELECTION at mouse click. If `mouse-yank-at-point' is non-nil, insert at point instead." - (unless mouse-yank-at-point + (unless mouse-yank-at-point (mouse-set-point event)) (when mouse-sel-get-selection-function (push-mark (point) 'nomsg) diff --git a/lisp/obsolete/c-mode.el b/lisp/obsolete/c-mode.el index 2be4ea9ed18..a76d963283a 100644 --- a/lisp/obsolete/c-mode.el +++ b/lisp/obsolete/c-mode.el @@ -207,99 +207,97 @@ regardless of where in the line point is when the TAB command is used." ;; This is actually the expression for C++ mode, but it's used for C too. (defvar c-imenu-generic-expression - (` - ((nil - (, - (concat - "^" ; beginning of line is required + `((nil + ,(concat + "^" ; beginning of line is required "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" - "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no - "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? + "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no + "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? - "\\(" ; last type spec including */& + "\\(" ; last type spec including */& "[a-zA-Z0-9_:]+" - "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace - "\\)?" ; if there is a last type spec - "\\(" ; name; take that into the imenu entry - "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... - ; (may not contain * because then - ; "a::operator char*" would become "char*"!) + "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace + "\\)?" ; if there is a last type spec + "\\(" ; name; take that into the imenu entry + "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... + ; (may not contain * because then + ; "a::operator char*" would become "char*"!) "\\|" "\\([a-zA-Z0-9_:~]*::\\)?operator" - "[^a-zA-Z1-9_][^(]*" ; ...or operator + "[^a-zA-Z1-9_][^(]*" ; ...or operator " \\)" "[ \t]*([^)]*)[ \t\n]*[^ ;]" ; require something other than a ; after - ; the (...) to avoid prototypes. Can't - ; catch cases with () inside the parentheses - ; surrounding the parameters - ; (like "int foo(int a=bar()) {...}" + ; the (...) to avoid prototypes. Can't + ; catch cases with () inside the parentheses + ; surrounding the parameters + ; (like "int foo(int a=bar()) {...}" - )) 6) + ) 6) ("Class" - (, (concat - "^" ; beginning of line is required - "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" - "class[ \t]+" - "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get - "[ \t]*[:{]" - )) 2) -;; Example of generic expression for finding prototypes, structs, unions, enums. -;; Uncomment if you want to find these too. It will be a bit slower gathering -;; the indexes. -; ("Prototypes" -; (, -; (concat -; "^" ; beginning of line is required -; "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" -; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no -; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? - -; "\\(" ; last type spec including */& -; "[a-zA-Z0-9_:]+" -; "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace -; "\\)?" ; if there is a last type spec -; "\\(" ; name; take that into the imenu entry -; "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... -; ; (may not contain * because then -; ; "a::operator char*" would become "char*"!) -; "\\|" -; "\\([a-zA-Z0-9_:~]*::\\)?operator" -; "[^a-zA-Z1-9_][^(]*" ; ...or operator -; " \\)" -; "[ \t]*([^)]*)[ \t\n]*;" ; require ';' after -; ; the (...) Can't -; ; catch cases with () inside the parentheses -; ; surrounding the parameters -; ; (like "int foo(int a=bar());" -; )) 6) -; ("Struct" -; (, (concat -; "^" ; beginning of line is required -; "\\(static[ \t]+\\)?" ; there may be static or const. -; "\\(const[ \t]+\\)?" -; "struct[ \t]+" -; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get -; "[ \t]*[{]" -; )) 3) -; ("Enum" -; (, (concat -; "^" ; beginning of line is required -; "\\(static[ \t]+\\)?" ; there may be static or const. -; "\\(const[ \t]+\\)?" -; "enum[ \t]+" -; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get -; "[ \t]*[{]" -; )) 3) -; ("Union" -; (, (concat -; "^" ; beginning of line is required -; "\\(static[ \t]+\\)?" ; there may be static or const. -; "\\(const[ \t]+\\)?" -; "union[ \t]+" -; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get -; "[ \t]*[{]" -; )) 3) - )) + ,(concat + "^" ; beginning of line is required + "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" + "class[ \t]+" + "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get + "[ \t]*[:{]" + ) 2) + ;; Example of generic expression for finding prototypes, structs, unions, enums. + ;; Uncomment if you want to find these too. It will be a bit slower gathering + ;; the indexes. + ; ("Prototypes" + ; (, + ; (concat + ; "^" ; beginning of line is required + ; "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" + ; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no + ; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? + + ; "\\(" ; last type spec including */& + ; "[a-zA-Z0-9_:]+" + ; "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace + ; "\\)?" ; if there is a last type spec + ; "\\(" ; name; take that into the imenu entry + ; "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... + ; ; (may not contain * because then + ; ; "a::operator char*" would become "char*"!) + ; "\\|" + ; "\\([a-zA-Z0-9_:~]*::\\)?operator" + ; "[^a-zA-Z1-9_][^(]*" ; ...or operator + ; " \\)" + ; "[ \t]*([^)]*)[ \t\n]*;" ; require ';' after + ; ; the (...) Can't + ; ; catch cases with () inside the parentheses + ; ; surrounding the parameters + ; ; (like "int foo(int a=bar());" + ; )) 6) + ; ("Struct" + ; (, (concat + ; "^" ; beginning of line is required + ; "\\(static[ \t]+\\)?" ; there may be static or const. + ; "\\(const[ \t]+\\)?" + ; "struct[ \t]+" + ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get + ; "[ \t]*[{]" + ; )) 3) + ; ("Enum" + ; (, (concat + ; "^" ; beginning of line is required + ; "\\(static[ \t]+\\)?" ; there may be static or const. + ; "\\(const[ \t]+\\)?" + ; "enum[ \t]+" + ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get + ; "[ \t]*[{]" + ; )) 3) + ; ("Union" + ; (, (concat + ; "^" ; beginning of line is required + ; "\\(static[ \t]+\\)?" ; there may be static or const. + ; "\\(const[ \t]+\\)?" + ; "union[ \t]+" + ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get + ; "[ \t]*[{]" + ; )) 3) + ) "Imenu generic expression for C mode. See `imenu-generic-expression'.") (defun c-mode () @@ -1439,7 +1437,7 @@ If within a string or comment, move by sentences instead of statements." (parse-partial-sexp beg (point) nil nil state))) (and (not (nth 3 new-state)) (not (nth 5 new-state)))) - (indent-for-comment))))))))))) + (indent-for-comment))))))))))))) ;; Look at all comment-start strings in the current line after point. ;; Return t if one of them starts a real comment. diff --git a/lisp/obsolete/cplus-md.el b/lisp/obsolete/cplus-md.el index 1b0c0e0b946..8df342ba4d2 100644 --- a/lisp/obsolete/cplus-md.el +++ b/lisp/obsolete/cplus-md.el @@ -174,99 +174,97 @@ list. Nil indicates to just after the paren." :group 'old-c++) (defvar c++-imenu-generic-expression - (` - ((nil - (, - (concat - "^" ; beginning of line is required + `((nil + ,(concat + "^" ; beginning of line is required "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" - "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no - "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? + "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no + "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? - "\\(" ; last type spec including */& + "\\(" ; last type spec including */& "[a-zA-Z0-9_:]+" - "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace - "\\)?" ; if there is a last type spec - "\\(" ; name; take that into the imenu entry - "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... - ; (may not contain * because then - ; "a::operator char*" would become "char*"!) + "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace + "\\)?" ; if there is a last type spec + "\\(" ; name; take that into the imenu entry + "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... + ; (may not contain * because then + ; "a::operator char*" would become "char*"!) "\\|" "\\([a-zA-Z0-9_:~]*::\\)?operator" - "[^a-zA-Z1-9_][^(]*" ; ...or operator + "[^a-zA-Z1-9_][^(]*" ; ...or operator " \\)" "[ \t]*([^)]*)[ \t\n]*[^ ;]" ; require something other than a ; after - ; the (...) to avoid prototypes. Can't - ; catch cases with () inside the parentheses - ; surrounding the parameters - ; (like "int foo(int a=bar()) {...}" + ; the (...) to avoid prototypes. Can't + ; catch cases with () inside the parentheses + ; surrounding the parameters + ; (like "int foo(int a=bar()) {...}" - )) 6) + ) 6) ("Class" - (, (concat - "^" ; beginning of line is required - "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" - "class[ \t]+" - "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get - "[ \t]*[:{]" - )) 2) -;; Example of generic expression for finding prototypes, structs, unions, enums. -;; Uncomment if you want to find these too. It will be a bit slower gathering -;; the indexes. -; ("Prototypes" -; (, -; (concat -; "^" ; beginning of line is required -; "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" -; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no -; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? + ,(concat + "^" ; beginning of line is required + "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" + "class[ \t]+" + "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get + "[ \t]*[:{]" + ) 2) + ;; Example of generic expression for finding prototypes, structs, unions, enums. + ;; Uncomment if you want to find these too. It will be a bit slower gathering + ;; the indexes. + ; ("Prototypes" + ; (, + ; (concat + ; "^" ; beginning of line is required + ; "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>" + ; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; type specs; there can be no + ; "\\([a-zA-Z0-9_:]+[ \t]+\\)?" ; more than 3 tokens, right? -; "\\(" ; last type spec including */& -; "[a-zA-Z0-9_:]+" -; "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace -; "\\)?" ; if there is a last type spec -; "\\(" ; name; take that into the imenu entry -; "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... -; ; (may not contain * because then -; ; "a::operator char*" would become "char*"!) -; "\\|" -; "\\([a-zA-Z0-9_:~]*::\\)?operator" -; "[^a-zA-Z1-9_][^(]*" ; ...or operator -; " \\)" -; "[ \t]*([^)]*)[ \t\n]*;" ; require ';' after -; ; the (...) Can't -; ; catch cases with () inside the parentheses -; ; surrounding the parameters -; ; (like "int foo(int a=bar());" -; )) 6) -; ("Struct" -; (, (concat -; "^" ; beginning of line is required -; "\\(static[ \t]+\\)?" ; there may be static or const. -; "\\(const[ \t]+\\)?" -; "struct[ \t]+" -; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get -; "[ \t]*[{]" -; )) 3) -; ("Enum" -; (, (concat -; "^" ; beginning of line is required -; "\\(static[ \t]+\\)?" ; there may be static or const. -; "\\(const[ \t]+\\)?" -; "enum[ \t]+" -; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get -; "[ \t]*[{]" -; )) 3) -; ("Union" -; (, (concat -; "^" ; beginning of line is required -; "\\(static[ \t]+\\)?" ; there may be static or const. -; "\\(const[ \t]+\\)?" -; "union[ \t]+" -; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get -; "[ \t]*[{]" -; )) 3) - )) + ; "\\(" ; last type spec including */& + ; "[a-zA-Z0-9_:]+" + ; "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)" ; either pointer/ref sign or whitespace + ; "\\)?" ; if there is a last type spec + ; "\\(" ; name; take that into the imenu entry + ; "[a-zA-Z0-9_:~]+" ; member function, ctor or dtor... + ; ; (may not contain * because then + ; ; "a::operator char*" would become "char*"!) + ; "\\|" + ; "\\([a-zA-Z0-9_:~]*::\\)?operator" + ; "[^a-zA-Z1-9_][^(]*" ; ...or operator + ; " \\)" + ; "[ \t]*([^)]*)[ \t\n]*;" ; require ';' after + ; ; the (...) Can't + ; ; catch cases with () inside the parentheses + ; ; surrounding the parameters + ; ; (like "int foo(int a=bar());" + ; )) 6) + ; ("Struct" + ; (, (concat + ; "^" ; beginning of line is required + ; "\\(static[ \t]+\\)?" ; there may be static or const. + ; "\\(const[ \t]+\\)?" + ; "struct[ \t]+" + ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get + ; "[ \t]*[{]" + ; )) 3) + ; ("Enum" + ; (, (concat + ; "^" ; beginning of line is required + ; "\\(static[ \t]+\\)?" ; there may be static or const. + ; "\\(const[ \t]+\\)?" + ; "enum[ \t]+" + ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get + ; "[ \t]*[{]" + ; )) 3) + ; ("Union" + ; (, (concat + ; "^" ; beginning of line is required + ; "\\(static[ \t]+\\)?" ; there may be static or const. + ; "\\(const[ \t]+\\)?" + ; "union[ \t]+" + ; "\\([a-zA-Z0-9_]+\\)" ; this is the string we want to get + ; "[ \t]*[{]" + ; )) 3) + ) "Imenu generic expression for C++ mode. See `imenu-generic-expression'.") (defun c++-mode () @@ -721,7 +719,7 @@ Returns nil if line starts inside a string, t if in a comment." (if (eq (preceding-char) ?\)) (forward-sexp -1)) ;; Get initial indentation of the line we are on. - (current-indentation)))))))))) + (current-indentation))))))))))) (defun c++-backward-to-noncomment (lim) (let (opoint stop) @@ -880,7 +878,7 @@ Returns nil if line starts inside a string, t if in a comment." (point)) t) (progn (indent-for-comment) - (beginning-of-line)))))))))) + (beginning-of-line))))))))))) (defun fill-c++-comment () "Fill a comment contained in consecutive lines containing point. diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index 104495c81b5..a79da3c8308 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -237,13 +237,12 @@ never indented." :group 'dcl) (defcustom dcl-imenu-generic-expression - (` - ((nil "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):[ \t]+SUBROUTINE\\b" 1) - ((, dcl-imenu-label-labels) + `((nil "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):[ \t]+SUBROUTINE\\b" 1) + (,dcl-imenu-label-labels "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):\\([ \t]\\|$\\)" 1) - ((, dcl-imenu-label-goto) "\\s-GOTO[ \t]+\\([A-Za-z0-9_\$]+\\)" 1) - ((, dcl-imenu-label-gosub) "\\s-GOSUB[ \t]+\\([A-Za-z0-9_\$]+\\)" 1) - ((, dcl-imenu-label-call) "\\s-CALL[ \t]+\\([A-Za-z0-9_\$]+\\)" 1))) + (,dcl-imenu-label-goto "\\s-GOTO[ \t]+\\([A-Za-z0-9_\$]+\\)" 1) + (,dcl-imenu-label-gosub "\\s-GOSUB[ \t]+\\([A-Za-z0-9_\$]+\\)" 1) + (,dcl-imenu-label-call "\\s-CALL[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)) "*Default imenu generic expression for DCL. The default includes SUBROUTINE labels in the main listing and diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index ec1729becaa..1626bd911dc 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -4,7 +4,7 @@ ;; Author: Chris Chase <chase@att.com> ;; Maintainer: Carsten Dominik <dominik@strw.leidenuniv.nl> ;; Version: 4.7 -;; Date: $Date: 2000/12/19 11:13:34 $ +;; Date: $Date: 2001/07/16 12:22:59 $ ;; Keywords: processes ;; This file is part of GNU Emacs. @@ -99,17 +99,17 @@ (defvar idlwave-shell-have-new-custom nil) (eval-and-compile - ;; Kludge to allow `defcustom' for Emacs 19. - (condition-case () (require 'custom) (error nil)) - (if (and (featurep 'custom) - (fboundp 'custom-declare-variable) - (fboundp 'defface)) - ;; We've got what we needed - (setq idlwave-shell-have-new-custom t) - ;; We have the old or no custom-library, hack around it! - (defmacro defgroup (&rest args) nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) + ;; Kludge to allow `defcustom' for Emacs 19. + (condition-case () (require 'custom) (error nil)) + (if (and (featurep 'custom) + (fboundp 'custom-declare-variable) + (fboundp 'defface)) + ;; We've got what we needed + (setq idlwave-shell-have-new-custom t) + ;; We have the old or no custom-library, hack around it! + (defmacro defgroup (&rest args) nil) + (defmacro defcustom (var value doc &rest args) + `(defvar ,var ,value ,doc)))) ;;; Customizations: idlwave-shell group @@ -2382,16 +2382,16 @@ command." (idlwave-shell-send-command idlwave-shell-bp-query '(progn - (idlwave-shell-filter-bp) - (setq idlwave-shell-old-bp idlwave-shell-bp-alist)) + (idlwave-shell-filter-bp) + (setq idlwave-shell-old-bp idlwave-shell-bp-alist)) 'hide) ;; Get sources for IDL compiled procedures followed by setting ;; breakpoint. (idlwave-shell-send-command idlwave-shell-sources-query - (` (progn - (idlwave-shell-sources-filter) - (idlwave-shell-set-bp2 (quote (, bp))))) + `(progn + (idlwave-shell-sources-filter) + (idlwave-shell-set-bp2 (quote ,bp))) 'hide)) (defun idlwave-shell-set-bp2 (bp) @@ -2403,11 +2403,11 @@ only after reaching the statement count times." (let* ((arg (idlwave-shell-bp-get bp 'count)) (key (cond - ((not (and arg (numberp arg))) "") - ((= arg 1) - ",/once") - ((> arg 1) - (format ",after=%d" arg)))) + ((not (and arg (numberp arg))) "") + ((= arg 1) + ",/once") + ((> arg 1) + (format ",after=%d" arg)))) (line (idlwave-shell-bp-get bp 'line))) (idlwave-shell-send-command (concat "breakpoint,'" @@ -2415,10 +2415,9 @@ only after reaching the statement count times." (if (integerp line) (setq line (int-to-string line))) key) ;; Check for failure and look for breakpoint in IDL's list - (` (progn - (if (idlwave-shell-set-bp-check (quote (, bp))) - (idlwave-shell-set-bp3 (quote (, bp))))) - ) + `(progn + (if (idlwave-shell-set-bp-check (quote ,bp)) + (idlwave-shell-set-bp3 (quote ,bp)))) ;; do not hide output nil 'preempt))) @@ -2426,9 +2425,9 @@ only after reaching the statement count times." (defun idlwave-shell-set-bp3 (bp) "Find the breakpoint in IDL's internal list of breakpoints." (idlwave-shell-send-command idlwave-shell-bp-query - (` (progn - (idlwave-shell-filter-bp) - (idlwave-shell-new-bp (quote (, bp))))) + `(progn + (idlwave-shell-filter-bp) + (idlwave-shell-new-bp (quote ,bp))) 'hide 'preempt)) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 03f78af3acf..b470e96f3d1 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -4,7 +4,7 @@ ;; Author: Chris Chase <chase@att.com> ;; Maintainer: Carsten Dominik <dominik@strw.leidenuniv.nl> ;; Version: 4.7 -;; Date: $Date: 2000/12/19 11:12:40 $ +;; Date: $Date: 2001/07/16 12:22:59 $ ;; Keywords: languages ;; This file is part of GNU Emacs. @@ -140,14 +140,14 @@ (eval-when-compile (require 'cl)) (eval-and-compile - ;; Kludge to allow `defcustom' for Emacs 19. - (condition-case () (require 'custom) (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old or no custom-library, hack around it! - (defmacro defgroup (&rest args) nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) + ;; Kludge to allow `defcustom' for Emacs 19. + (condition-case () (require 'custom) (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old or no custom-library, hack around it! + (defmacro defgroup (&rest args) nil) + (defmacro defcustom (var value doc &rest args) + `(defvar ,var ,value ,doc)))) (defgroup idlwave nil "Major mode for editing IDL/WAVE CL .pro files" @@ -1360,8 +1360,8 @@ Normally a space.") (defmacro idlwave-keyword-abbrev (&rest args) "Creates a function for abbrev hooks to call `idlwave-check-abbrev' with args." - (` (quote (lambda () - (, (append '(idlwave-check-abbrev) args)))))) + `(quote (lambda () + ,(append '(idlwave-check-abbrev) args)))) ;; If I take the time I can replace idlwave-keyword-abbrev with ;; idlwave-code-abbrev and remove the quoted abbrev check from @@ -1373,11 +1373,11 @@ Normally a space.") "Creates a function for abbrev hooks that ensures abbrevs are not quoted. Specifically, if the abbrev is in a comment or string it is unexpanded. Otherwise ARGS forms a list that is evaluated." - (` (quote (lambda () - (, (prin1-to-string args)) ;; Puts the code in the doc string - (if (idlwave-quoted) - (progn (unexpand-abbrev) nil) - (, (append args))))))) + `(quote (lambda () + ,(prin1-to-string args) ;; Puts the code in the doc string + (if (idlwave-quoted) + (progn (unexpand-abbrev) nil) + ,(append args))))) (defvar idlwave-mode-map (make-sparse-keymap) "Keymap used in IDL mode.") diff --git a/lisp/term/sun-mouse.el b/lisp/term/sun-mouse.el index 91c63fdb066..c77bba42d28 100644 --- a/lisp/term/sun-mouse.el +++ b/lisp/term/sun-mouse.el @@ -133,19 +133,19 @@ Just like the Common Lisp function of the same name." ;;; All the useful code bits (defmacro sm::hit-code (hit) - (` (nth 0 (, hit)))) + `(nth 0 ,hit)) ;;; The button, or buttons if a chord. (defmacro sm::hit-button (hit) - (` (logand sm::ButtonBits (nth 0 (, hit))))) + `(logand sm::ButtonBits (nth 0 ,hit))) ;;; The shift, control, and meta flags. (defmacro sm::hit-shiftmask (hit) - (` (logand sm::ShiftmaskBits (nth 0 (, hit))))) + `(logand sm::ShiftmaskBits (nth 0 ,hit))) ;;; Set if a double click (but not a chord). (defmacro sm::hit-double (hit) - (` (logand sm::DoubleBits (nth 0 (, hit))))) + `(logand sm::DoubleBits (nth 0 ,hit))) ;;; Set on button release (as opposed to button press). (defmacro sm::hit-up (hit) - (` (logand sm::UpBits (nth 0 (, hit))))) + `(logand sm::UpBits (nth 0 ,hit))) ;;; Screen x position. (defmacro sm::hit-x (hit) (list 'nth 1 hit)) ;;; Screen y position. @@ -153,8 +153,8 @@ Just like the Common Lisp function of the same name." ;;; Milliseconds since last hit. (defmacro sm::hit-delta (hit) (list 'nth 3 hit)) -(defmacro sm::hit-up-p (hit) ; A predicate. - (` (not (zerop (sm::hit-up (, hit)))))) +(defmacro sm::hit-up-p (hit) ; A predicate. + `(not (zerop (sm::hit-up ,hit)))) ;;; ;;; Loc accessors. for sm::window-xy @@ -166,12 +166,12 @@ Just like the Common Lisp function of the same name." (defmacro eval-in-buffer (buffer &rest forms) "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer." ;; When you don't need the complete window context of eval-in-window - (` (let ((StartBuffer (current-buffer))) + `(let ((StartBuffer (current-buffer))) (unwind-protect - (progn - (set-buffer (, buffer)) - (,@ forms)) - (set-buffer StartBuffer))))) + (progn + (set-buffer ,buffer) + ,@forms) + (set-buffer StartBuffer)))) (put 'eval-in-buffer 'lisp-indent-function 1) @@ -179,12 +179,12 @@ Just like the Common Lisp function of the same name." ;;; (defmacro eval-in-window (window &rest forms) "Switch to WINDOW, evaluate FORMS, return to original window." - (` (let ((OriginallySelectedWindow (selected-window))) - (unwind-protect - (progn - (select-window (, window)) - (,@ forms)) - (select-window OriginallySelectedWindow))))) + `(let ((OriginallySelectedWindow (selected-window))) + (unwind-protect + (progn + (select-window ,window) + ,@forms) + (select-window OriginallySelectedWindow)))) (put 'eval-in-window 'lisp-indent-function 1) ;;; @@ -196,14 +196,14 @@ Just like the Common Lisp function of the same name." "Switches to each window and evaluates FORM. Optional argument YESMINI says to include the minibuffer as a window. This is a macro, and does not evaluate its arguments." - (` (let ((OriginallySelectedWindow (selected-window))) - (unwind-protect - (while (progn - (, form) - (not (eq OriginallySelectedWindow - (select-window - (next-window nil (, yesmini))))))) - (select-window OriginallySelectedWindow))))) + `(let ((OriginallySelectedWindow (selected-window))) + (unwind-protect + (while (progn + ,form + (not (eq OriginallySelectedWindow + (select-window + (next-window nil ,yesmini)))))) + (select-window OriginallySelectedWindow)))) (put 'eval-in-window 'lisp-indent-function 0) (defun move-to-loc (x y) diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 3ace091f018..73fc15b6fbf 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -192,18 +192,18 @@ (eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro defface (var values doc &rest args) - (` (make-face (, var)))) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ;; We've got what we needed + ;; We have the old custom-library, hack around it! + (defmacro defgroup (&rest args) + nil) + (defmacro defface (var values doc &rest args) + `(make-face ,var)) + (defmacro defcustom (var value doc &rest args) + `(defvar ,var ,value ,doc)))) ;; User options ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv |