Converted backquote to the new style.
This commit is contained in:
parent
c6aedc9284
commit
8a9463543d
19 changed files with 846 additions and 846 deletions
|
@ -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.
|
||||
|
|
|
@ -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'.
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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)))))))
|
||||
(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))))
|
||||
(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))
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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))
|
||||
|
|
244
lisp/emerge.el
244
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
|
||||
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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?
|
||||
,(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 ()
|
||||
|
@ -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.
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -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.")
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue