(unless-broken, check-broken-facility): Don't use backquotes.
* filename.el (filename-special-filter-1): Don't use backquotes.
* pccl.el (define-ccl-program, transform-make-coding-system-args):
Don't use backquotes.
* poe.el (save-current-buffer, with-current-buffer)
(with-temp-file, with-temp-message, with-temp-buffer)
(with-output-to-string): Don't use backquotes.
* product.el (product-provide): Don't use backquotes.
* pym.el (defun-maybe, defmacro-maybe, defsubst-maybe)
(defalias-maybe, defvar-maybe, defconst-maybe, defun-maybe-cond)
(defmacro-maybe-cond, defsubst-maybe-cond, def-edebug-spec): Don't
use backquotes.
* static.el (static-if, static-when, static-unless)
(static-condition-case, static-defconst): Don't use backquotes.
+2007-09-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * broken.el (broken-facility, if-broken, when-broken)
+ (unless-broken, check-broken-facility): Don't use backquotes.
+
+ * filename.el (filename-special-filter-1): Don't use backquotes.
+
+ * pccl.el (define-ccl-program, transform-make-coding-system-args):
+ Don't use backquotes.
+
+ * poe.el (save-current-buffer, with-current-buffer)
+ (with-temp-file, with-temp-message, with-temp-buffer)
+ (with-output-to-string): Don't use backquotes.
+
+ * product.el (product-provide): Don't use backquotes.
+
+ * pym.el (defun-maybe, defmacro-maybe, defsubst-maybe)
+ (defalias-maybe, defvar-maybe, defconst-maybe, defun-maybe-cond)
+ (defmacro-maybe-cond, defsubst-maybe-cond, def-edebug-spec): Don't
+ use backquotes.
+
+ * static.el (static-if, static-when, static-unless)
+ (static-condition-case, static-defconst): Don't use backquotes.
+
+\f
2007-02-14 MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
* APEL: Version 10.7 released.
If ASSERTION is not omitted and evaluated to nil and NO-NOTICE is nil,
it is noticed."
- (` (static-if (, assertion)
- (eval-and-compile
- (broken-facility-internal '(, facility) (, docstring) t))
- (eval-when-compile
- (when (and '(, assertion) (not '(, no-notice))
- notice-non-obvious-broken-facility)
- (message "BROKEN FACILITY DETECTED: %s" (, docstring)))
- nil)
- (eval-and-compile
- (broken-facility-internal '(, facility) (, docstring) nil)))))
+ (list 'static-if assertion
+ (list 'eval-and-compile
+ (list 'broken-facility-internal
+ (list 'quote facility) docstring t))
+ (list 'eval-when-compile
+ (list 'when (list 'and
+ (list 'quote assertion)
+ (list 'not (list 'quote no-notice))
+ 'notice-non-obvious-broken-facility)
+ (list 'message "BROKEN FACILITY DETECTED: %s"
+ docstring))
+ nil)
+ (list 'eval-and-compile
+ (list 'broken-facility-internal
+ (list 'quote facility) docstring nil))))
(put 'if-broken 'lisp-indent-function 2)
(defmacro if-broken (facility then &rest else)
"If FACILITY is broken, expand to THEN, otherwise (progn . ELSE)."
- (` (static-if (broken-p '(, facility))
- (, then)
- (,@ else))))
-
+ (nconc (list 'static-if (list 'broken-p (list 'quote facility))
+ then)
+ else))
(put 'when-broken 'lisp-indent-function 1)
(defmacro when-broken (facility &rest body)
"If FACILITY is broken, expand to (progn . BODY), otherwise nil."
- (` (static-when (broken-p '(, facility))
- (,@ body))))
+ (nconc (list 'static-when (list 'broken-p (list 'quote facility)))
+ body))
(put 'unless-broken 'lisp-indent-function 1)
(defmacro unless-broken (facility &rest body)
"If FACILITY is not broken, expand to (progn . BODY), otherwise nil."
- (` (static-unless (broken-p '(, facility))
- (,@ body))))
+ (nconc (list 'static-unless (list 'broken-p (list 'quote facility)))
+ body))
(defmacro check-broken-facility (facility)
"Check FACILITY is broken or not. If the status is different on
compile(macro expansion) time and run time, warn it."
- (` (if-broken (, facility)
- (unless (broken-p '(, facility))
- (message "COMPILE TIME ONLY BROKEN FACILITY DETECTED: %s"
- (or
- '(, (broken-facility-description facility))
- (broken-facility-description '(, facility)))))
- (when (broken-p '(, facility))
- (message "RUN TIME ONLY BROKEN FACILITY DETECTED: %s"
- (or
- (broken-facility-description '(, facility))
- '(, (broken-facility-description facility))))))))
+ (list 'if-broken facility
+ (list 'unless (list 'broken-p (list 'quote facility))
+ (list 'message "COMPILE TIME ONLY BROKEN FACILITY DETECTED: %s"
+ (list 'or
+ (list 'quote (broken-facility-description
+ facility))
+ (list 'broken-facility-description
+ (list 'quote facility)))))
+ (list 'when (list 'broken-p (list 'quote facility))
+ (list 'message "RUN TIME ONLY BROKEN FACILITY DETECTED: %s"
+ (list 'or
+ (list 'broken-facility-description
+ (list 'quote facility))
+ (list 'quote (broken-facility-description
+ facility)))))))
;;; @ end
inc-i '(1+ i))
(setq sref 'aref
inc-i '(+ i (char-length chr))))
- (` (let ((len (length (, string)))
- (b 0)(i 0)
- (dest ""))
- (while (< i len)
- (let ((chr ((, sref) (, string) i))
- (lst filename-replacement-alist)
- ret)
- (while (and lst (not ret))
+ (list
+ 'let (list (list 'len (list 'length string))
+ '(b 0) '(i 0)
+ '(dest ""))
+ (list 'while '(< i len)
+ (list
+ 'let (list (list 'chr (list sref string 'i))
+ '(lst filename-replacement-alist)
+ 'ret)
+ '(while (and lst (not ret))
(if (if (functionp (car (car lst)))
(setq ret (funcall (car (car lst)) chr))
(setq ret (memq chr (car (car lst)))))
t ; quit this loop.
(setq lst (cdr lst))))
- (if ret
- (setq dest (concat dest (substring (, string) b i)
- (cdr (car lst)))
- i (, inc-i)
- b i)
- (setq i (, inc-i)))))
- (concat dest (substring (, string) b)))))))
+ (list 'if 'ret
+ (list 'setq
+ 'dest (list 'concat 'dest
+ (list 'substring string 'b 'i)
+ '(cdr (car lst)))
+ 'i inc-i
+ 'b 'i)
+ (list 'setq 'i inc-i))))
+ (list 'concat 'dest (list 'substring string 'b))))))
(defun filename-special-filter (string)
(filename-special-filter-1 string))
"When CCL-PROGRAM is too long, internal buffer is extended automatically."
(let ((try-ccl-compile t)
(prog (eval (ad-get-arg 1))))
- (ad-set-arg 1 (` '(, prog)))
+ (ad-set-arg 1 (list 'quote prog))
(while try-ccl-compile
(setq try-ccl-compile nil)
(condition-case sig
(setq properties (plist-put properties 'pre-write-conversion tmp)))
(cond
((eq type 'shift-jis)
- (` ((, name) 1 (, mnemonic) (, doc-string)
- nil (, properties) (, eol-type))))
+ (list name 1 mnemonic doc-string nil properties eol-type))
((eq type 'iso2022) ; This is not perfect.
(if (plist-get props 'escape-quoted)
(error "escape-quoted is not supported: %S"
- (` ((, name) (, type) (, doc-string) (, props)))))
+ (list name type doc-string props)))
(let ((g0 (plist-get props 'charset-g0))
(g1 (plist-get props 'charset-g1))
(g2 (plist-get props 'charset-g2))
'japanese-jisx0208-1978))))
(if (charsetp g0)
(if (plist-get props 'force-g0-on-output)
- (setq g0 (` (nil (, g0))))
- (setq g0 (` ((, g0) t)))))
+ (setq g0 (list nil g0))
+ (setq g0 (list g0 t))))
(if (charsetp g1)
(if (plist-get props 'force-g1-on-output)
- (setq g1 (` (nil (, g1))))
- (setq g1 (` ((, g1) t)))))
+ (setq g1 (list nil g1))
+ (setq g1 (list g1 t))))
(if (charsetp g2)
(if (plist-get props 'force-g2-on-output)
- (setq g2 (` (nil (, g2))))
- (setq g2 (` ((, g2) t)))))
+ (setq g2 (list nil g2))
+ (setq g2 (list g2 t))))
(if (charsetp g3)
(if (plist-get props 'force-g3-on-output)
- (setq g3 (` (nil (, g3))))
- (setq g3 (` ((, g3) t)))))
- (` ((, name) 2 (, mnemonic) (, doc-string)
- ((, g0) (, g1) (, g2) (, g3)
- (, (plist-get props 'short))
- (, (not (plist-get props 'no-ascii-eol)))
- (, (not (plist-get props 'no-ascii-cntl)))
- (, (plist-get props 'seven))
- t
- (, (not (plist-get props 'lock-shift)))
- (, use-roman)
- (, use-oldjis)
- (, (plist-get props 'no-iso6429))
- nil nil nil nil)
- (, properties) (, eol-type)))))
+ (setq g3 (list nil g3))
+ (setq g3 (list g3 t))))
+ (list name 2 mnemonic doc-string
+ (list g0 g1 g2 g3
+ (plist-get props 'short)
+ (not (plist-get props 'no-ascii-eol))
+ (not (plist-get props 'no-ascii-cntl))
+ (plist-get props 'seven)
+ t
+ (not (plist-get props 'lock-shift))
+ use-roman
+ use-oldjis
+ (plist-get props 'no-iso6429)
+ nil nil nil nil)
+ properties eol-type)))
((eq type 'big5)
- (` ((, name) 3 (, mnemonic) (, doc-string)
- nil (, properties) (, eol-type))))
+ (list name 3 mnemonic doc-string
+ nil properties eol-type))
((eq type 'ccl)
- (` ((, name) 4 (, mnemonic) (, doc-string)
- ((, (plist-get props 'decode)) . (, (plist-get props 'encode)))
- (, properties) (, eol-type))))
+ (list name 4 mnemonic doc-string
+ (cons (plist-get props 'decode) (plist-get props 'encode))
+ properties eol-type))
(t
(error "unsupported XEmacs style make-coding-style arguments: %S"
- (` ((, name) (, type) (, doc-string) (, props))))))))
+ (list name type doc-string props))))))
(defadvice make-coding-system
(before ccl-compat (name type &rest ad-subr-args) activate)
"Emulate XEmacs style make-coding-system."
(defmacro-maybe save-current-buffer (&rest body)
"Save the current buffer; execute BODY; restore the current buffer.
Executes BODY just like `progn'."
- (` (let ((orig-buffer (current-buffer)))
- (unwind-protect
- (progn (,@ body))
- (if (buffer-live-p orig-buffer)
- (set-buffer orig-buffer))))))
+ (list 'let '((orig-buffer (current-buffer)))
+ (list 'unwind-protect
+ (cons 'progn body)
+ '(if (buffer-live-p orig-buffer)
+ (set-buffer orig-buffer)))))
;; Emacs 20.1/XEmacs 20.3(?) and later: (with-current-buffer BUFFER &rest BODY)
(defmacro-maybe with-current-buffer (buffer &rest body)
"Execute the forms in BODY with BUFFER as the current buffer.
The value returned is the value of the last form in BODY.
See also `with-temp-buffer'."
- (` (save-current-buffer
- (set-buffer (, buffer))
- (,@ body))))
+ (cons 'save-current-buffer
+ (cons (list 'set-buffer buffer)
+ body)))
;; Emacs 20.1/XEmacs 20.3(?) and later: (with-temp-file FILE &rest FORMS)
(defmacro-maybe with-temp-file (file &rest forms)
See also `with-temp-buffer'."
(let ((temp-file (make-symbol "temp-file"))
(temp-buffer (make-symbol "temp-buffer")))
- (` (let (((, temp-file) (, file))
- ((, temp-buffer)
- (get-buffer-create (generate-new-buffer-name " *temp file*"))))
- (unwind-protect
- (prog1
- (with-current-buffer (, temp-buffer)
- (,@ forms))
- (with-current-buffer (, temp-buffer)
- (widen)
- (write-region (point-min) (point-max) (, temp-file) nil 0)))
- (and (buffer-name (, temp-buffer))
- (kill-buffer (, temp-buffer))))))))
+ (list 'let (list (list temp-file file)
+ (list temp-buffer
+ '(get-buffer-create
+ (generate-new-buffer-name " *temp file*"))))
+ (list
+ 'unwind-protect
+ (list
+ 'prog1
+ (cons 'with-current-buffer (cons temp-buffer forms))
+ (list 'with-current-buffer temp-buffer
+ '(widen)
+ (list 'write-region '(point-min) '(point-max)
+ temp-file nil 0)))
+ (list 'and
+ (list 'buffer-name temp-buffer)
+ (list 'kill-buffer temp-buffer))))))
;; Emacs 20.4 and later: (with-temp-message MESSAGE &rest BODY)
;; This macro uses `current-message', which appears in v20.
Use a MESSAGE of \"\" to temporarily clear the echo area."
(let ((current-message (make-symbol "current-message"))
(temp-message (make-symbol "with-temp-message")))
- (` (let (((, temp-message) (, message))
- ((, current-message)))
- (unwind-protect
- (progn
- (when (, temp-message)
- (setq (, current-message) (current-message))
- (message "%s" (, temp-message))
- (,@ body))
- (and (, temp-message) (, current-message)
- (message "%s" (, current-message))))))))))
+ (list 'let (list (list temp-message message)
+ (list current-message))
+ (list
+ 'unwind-protect
+ (list
+ 'progn
+ (nconc (list 'when temp-message
+ (list 'setq current-message '(current-message))
+ (list 'message "%s" temp-message))
+ body)
+ (list 'and temp-message current-message
+ (list 'message "%s" current-message))))))))
;; Emacs 20.1/XEmacs 20.3(?) and later: (with-temp-buffer &rest FORMS)
(defmacro-maybe with-temp-buffer (&rest forms)
"Create a temporary buffer, and evaluate FORMS there like `progn'.
See also `with-temp-file' and `with-output-to-string'."
(let ((temp-buffer (make-symbol "temp-buffer")))
- (` (let (((, temp-buffer)
- (get-buffer-create (generate-new-buffer-name " *temp*"))))
- (unwind-protect
- (with-current-buffer (, temp-buffer)
- (,@ forms))
- (and (buffer-name (, temp-buffer))
- (kill-buffer (, temp-buffer))))))))
+ (list 'let (list (list temp-buffer
+ '(get-buffer-create
+ (generate-new-buffer-name " *temp*"))))
+ (list
+ 'unwind-protect
+ (cons 'with-current-buffer
+ (cons temp-buffer
+ forms))
+ (list 'and
+ (list 'buffer-name temp-buffer)
+ (list 'kill-buffer temp-buffer))))))
;; Emacs 20.1/XEmacs 20.3(?) and later: (with-output-to-string &rest BODY)
(defmacro-maybe with-output-to-string (&rest body)
"Execute BODY, return the text it sent to `standard-output', as a string."
- (` (let ((standard-output
- (get-buffer-create (generate-new-buffer-name " *string-output*"))))
- (let ((standard-output standard-output))
- (,@ body))
- (with-current-buffer standard-output
- (prog1
- (buffer-string)
- (kill-buffer nil))))))
+ (list 'let '((standard-output
+ (get-buffer-create
+ (generate-new-buffer-name " *string-output*"))))
+ (cons 'let (cons '((standard-output standard-output))
+ body))
+ '(with-current-buffer standard-output
+ (prog1
+ (buffer-string)
+ (kill-buffer nil)))))
;; Emacs 20.1 and later: (combine-after-change-calls &rest BODY)
(defmacro-maybe combine-after-change-calls (&rest body)
(product-version (product-version product))
(product-code-name (product-code-name product))
(product-version-string (product-version-string product)))
- (` (progn
- (, product-def)
- (put (, feature) 'product
- (let ((product (product-find-by-name (, product-name))))
- (product-run-checkers product '(, product-version))
- (and (, product-family)
- (product-add-to-family (, product-family)
- (, product-name)))
- (product-add-feature product (, feature))
- (if (equal '(, product-version) (product-version product))
- product
- (vector (, product-name) (, product-family)
- '(, product-version) (, product-code-name)
- nil nil nil (, product-version-string)))))
- (, feature-def)))))
+ (list 'progn
+ product-def
+ (list 'put feature '(quote product)
+ (list
+ 'let
+ (list (list 'product
+ (list 'product-find-by-name product-name)))
+ (list 'product-run-checkers 'product
+ (list 'quote product-version))
+ (list 'and product-family
+ (list 'product-add-to-family
+ product-family product-name))
+ (list 'product-add-feature 'product feature)
+ (list 'if (list 'equal (list 'quote product-version)
+ '(product-version product))
+ 'product
+ (list 'vector product-name product-family
+ (list 'quote product-version) product-code-name
+ nil nil nil product-version-string))))
+ feature-def)))
(defun product-version-as-string (product)
"Return version number of product as a string.
See also the function `defun'."
(or (and (fboundp name)
(not (get name 'defun-maybe)))
- (` (or (fboundp (quote (, name)))
- (prog1
- (defun (, name) (,@ everything-else))
- ;; This `defun' will be compiled to `fset',
- ;; which does not update `load-history'.
- ;; We must update `current-load-list' explicitly.
- (setq current-load-list
- (cons (quote (, name)) current-load-list))
- (put (quote (, name)) 'defun-maybe t))))))
+ (list 'or (list 'fboundp (list 'quote name))
+ (list
+ 'prog1
+ (nconc (list 'defun name) everything-else)
+ ;; This `defun' will be compiled to `fset',
+ ;; which does not update `load-history'.
+ ;; We must update `current-load-list' explicitly.
+ (list 'setq 'current-load-list
+ (list 'cons (list 'quote name) 'current-load-list))
+ (list 'put (list 'quote name) '(quote defun-maybe) t)))))
(put 'defmacro-maybe 'lisp-indent-function 'defun)
(defmacro defmacro-maybe (name &rest everything-else)
See also the function `defmacro'."
(or (and (fboundp name)
(not (get name 'defmacro-maybe)))
- (` (or (fboundp (quote (, name)))
- (prog1
- (defmacro (, name) (,@ everything-else))
- ;; This `defmacro' will be compiled to `fset',
- ;; which does not update `load-history'.
- ;; We must update `current-load-list' explicitly.
- (setq current-load-list
- (cons (quote (, name)) current-load-list))
- (put (quote (, name)) 'defmacro-maybe t))))))
+ (list 'or (list 'fboundp (list 'quote name))
+ (list
+ 'prog1
+ (nconc (list 'defmacro name) everything-else)
+ ;; This `defmacro' will be compiled to `fset',
+ ;; which does not update `load-history'.
+ ;; We must update `current-load-list' explicitly.
+ (list 'setq 'current-load-list
+ (list 'cons (list 'quote name) 'current-load-list))
+ (list 'put (list 'quote name) '(quote defmacro-maybe) t)))))
(put 'defsubst-maybe 'lisp-indent-function 'defun)
(defmacro defsubst-maybe (name &rest everything-else)
See also the macro `defsubst'."
(or (and (fboundp name)
(not (get name 'defsubst-maybe)))
- (` (or (fboundp (quote (, name)))
- (prog1
- (defsubst (, name) (,@ everything-else))
- ;; This `defsubst' will be compiled to `fset',
- ;; which does not update `load-history'.
- ;; We must update `current-load-list' explicitly.
- (setq current-load-list
- (cons (quote (, name)) current-load-list))
- (put (quote (, name)) 'defsubst-maybe t))))))
+ (list 'or (list 'fboundp (list 'quote name))
+ (list
+ 'prog1
+ (nconc (list 'defsubst name) everything-else)
+ ;; This `defsubst' will be compiled to `fset',
+ ;; which does not update `load-history'.
+ ;; We must update `current-load-list' explicitly.
+ (list 'setq 'current-load-list
+ (list 'cons (list 'quote name) 'current-load-list))
+ (list 'put (list 'quote name) '(quote defsubst-maybe) t)))))
(defmacro defalias-maybe (symbol definition)
"Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
(setq symbol (eval symbol))
(or (and (fboundp symbol)
(not (get symbol 'defalias-maybe)))
- (` (or (fboundp (quote (, symbol)))
- (prog1
- (defalias (quote (, symbol)) (, definition))
- ;; `defalias' updates `load-history' internally.
- (put (quote (, symbol)) 'defalias-maybe t))))))
+ (list 'or (list 'fboundp (list 'quote symbol))
+ (list
+ 'prog1
+ (list 'defalias (list 'quote symbol) definition)
+ (list 'put (list 'quote symbol) '(quote defalias-maybe) t)))))
(defmacro defvar-maybe (name &rest everything-else)
"Define NAME as a variable if NAME is not defined.
See also the function `defvar'."
(or (and (boundp name)
(not (get name 'defvar-maybe)))
- (` (or (boundp (quote (, name)))
- (prog1
- (defvar (, name) (,@ everything-else))
- ;; byte-compiler will generate code to update
- ;; `load-history'.
- (put (quote (, name)) 'defvar-maybe t))))))
+ (list 'or (list 'boundp (list 'quote name))
+ (list
+ 'prog1
+ (nconc (list 'defvar name) everything-else)
+ ;; byte-compiler will generate code to update
+ ;; `load-history'.
+ (list 'put (list 'quote name) '(quote defvar-maybe) t)))))
(defmacro defconst-maybe (name &rest everything-else)
"Define NAME as a constant variable if NAME is not defined.
See also the function `defconst'."
(or (and (boundp name)
(not (get name 'defconst-maybe)))
- (` (or (boundp (quote (, name)))
- (prog1
- (defconst (, name) (,@ everything-else))
- ;; byte-compiler will generate code to update
- ;; `load-history'.
- (put (quote (, name)) 'defconst-maybe t))))))
+ (list 'or (list 'boundp (list 'quote name))
+ (list
+ 'prog1
+ (nconc (list 'defconst name) everything-else)
+ ;; byte-compiler will generate code to update
+ ;; `load-history'.
+ (list 'put (list 'quote name) '(quote defconst-maybe) t)))))
(defmacro defun-maybe-cond (name args &optional doc &rest clauses)
"Define NAME as a function if NAME is not defined.
doc nil))
(or (and (fboundp name)
(not (get name 'defun-maybe)))
- (` (or (fboundp (quote (, name)))
- (prog1
- (static-cond
- (,@ (mapcar
- (function
- (lambda (case)
- (list (car case)
- (if doc
- (` (defun (, name) (, args)
- (, doc)
- (,@ (cdr case))))
- (` (defun (, name) (, args)
- (,@ (cdr case))))))))
- clauses)))
- ;; This `defun' will be compiled to `fset',
- ;; which does not update `load-history'.
- ;; We must update `current-load-list' explicitly.
- (setq current-load-list
- (cons (quote (, name)) current-load-list))
- (put (quote (, name)) 'defun-maybe t))))))
+ (list 'or (list 'fboundp (list 'quote name))
+ (list
+ 'prog1
+ (cons 'static-cond
+ (mapcar
+ (function
+ (lambda (case)
+ (list (car case)
+ (if doc
+ (nconc (list 'defun name args doc)
+ (cdr case))
+ (nconc (list 'defun name args)
+ (cdr case))))))
+ clauses))
+ ;; This `defun' will be compiled to `fset',
+ ;; which does not update `load-history'.
+ ;; We must update `current-load-list' explicitly.
+ (list 'setq 'current-load-list
+ (list 'cons (list 'quote name) 'current-load-list))
+ (list 'put (list 'quote name) '(quote defun-maybe) t)))))
(defmacro defmacro-maybe-cond (name args &optional doc &rest clauses)
"Define NAME as a macro if NAME is not defined.
doc nil))
(or (and (fboundp name)
(not (get name 'defmacro-maybe)))
- (` (or (fboundp (quote (, name)))
- (prog1
- (static-cond
- (,@ (mapcar
- (function
- (lambda (case)
- (list (car case)
- (if doc
- (` (defmacro (, name) (, args)
- (, doc)
- (,@ (cdr case))))
- (` (defmacro (, name) (, args)
- (,@ (cdr case))))))))
- clauses)))
- ;; This `defmacro' will be compiled to `fset',
- ;; which does not update `load-history'.
- ;; We must update `current-load-list' explicitly.
- (setq current-load-list
- (cons (quote (, name)) current-load-list))
- (put (quote (, name)) 'defmacro-maybe t))))))
+ (list 'or (list 'fboundp (list 'quote name))
+ (list
+ 'prog1
+ (cons 'static-cond
+ (mapcar
+ (function
+ (lambda (case)
+ (list (car case)
+ (if doc
+ (nconc (list 'defmacro name args doc)
+ (cdr case))
+ (nconc (list 'defmacro name args)
+ (cdr case))))))
+ clauses))
+ ;; This `defmacro' will be compiled to `fset',
+ ;; which does not update `load-history'.
+ ;; We must update `current-load-list' explicitly.
+ (list 'setq 'current-load-list
+ (list 'cons (list 'quote name) 'current-load-list))
+ (list 'put (list 'quote name) '(quote defmacro-maybe) t)))))
(defmacro defsubst-maybe-cond (name args &optional doc &rest clauses)
"Define NAME as an inline function if NAME is not defined.
doc nil))
(or (and (fboundp name)
(not (get name 'defsubst-maybe)))
- (` (or (fboundp (quote (, name)))
- (prog1
- (static-cond
- (,@ (mapcar
- (function
- (lambda (case)
- (list (car case)
- (if doc
- (` (defsubst (, name) (, args)
- (, doc)
- (,@ (cdr case))))
- (` (defsubst (, name) (, args)
- (,@ (cdr case))))))))
- clauses)))
- ;; This `defsubst' will be compiled to `fset',
- ;; which does not update `load-history'.
- ;; We must update `current-load-list' explicitly.
- (setq current-load-list
- (cons (quote (, name)) current-load-list))
- (put (quote (, name)) 'defsubst-maybe t))))))
+ (list 'or (list 'fboundp (list 'quote name))
+ (list
+ 'prog1
+ (cons 'static-cond
+ (mapcar
+ (function
+ (lambda (case)
+ (list (car case)
+ (if doc
+ (nconc (list 'defsubst name args doc)
+ (cdr case))
+ (nconc (list 'defsubst name args)
+ (cdr case))))))
+ clauses))
+ ;; This `defsubst' will be compiled to `fset',
+ ;; which does not update `load-history'.
+ ;; We must update `current-load-list' explicitly.
+ (list 'setq 'current-load-list
+ (list 'cons (list 'quote name) 'current-load-list))
+ (list 'put (list 'quote name) '(quote defsubst-maybe) t)))))
;;; Edebug spec.
"Set the edebug-form-spec property of SYMBOL according to SPEC.
Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
\(naming a function\), or a list."
- (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
+ (list 'put (list 'quote symbol)
+ '(quote edebug-form-spec) (list 'quote spec)))
;; edebug-spec for `def*-maybe' macros.
(def-edebug-spec defun-maybe defun)
"Like `if', but evaluate COND at compile time."
(if (eval cond)
then
- (` (progn (,@ else)))))
+ (cons 'progn else)))
(put 'static-when 'lisp-indent-function 1)
(defmacro static-when (cond &rest body)
"Like `when', but evaluate COND at compile time."
(if (eval cond)
- (` (progn (,@ body)))))
+ (cons 'progn body)))
(put 'static-unless 'lisp-indent-function 1)
(defmacro static-unless (cond &rest body)
"Like `unless', but evaluate COND at compile time."
(if (eval cond)
nil
- (` (progn (,@ body)))))
+ (cons 'progn body)))
(put 'static-condition-case 'lisp-indent-function 2)
(defmacro static-condition-case (var bodyform &rest handlers)
"Like `condition-case', but evaluate BODYFORM at compile time."
- (eval (` (condition-case (, var)
- (list (quote quote) (, bodyform))
- (,@ (mapcar
- (if var
- (function
- (lambda (h)
- (` ((, (car h))
- (list (quote funcall)
- (function (lambda ((, var)) (,@ (cdr h))))
- (list (quote quote) (, var)))))))
- (function
- (lambda (h)
- (` ((, (car h)) (quote (progn (,@ (cdr h)))))))))
- handlers))))))
+ (eval (nconc (list 'condition-case var
+ (list 'list '(quote quote) bodyform))
+ (mapcar
+ (function
+ (lambda (h)
+ (list (car h)
+ (if var
+ (list 'list '(quote funcall)
+ (list 'function
+ (nconc (list 'lambda (list var))
+ (cdr h)))
+ (list 'list '(quote quote) var))
+ (list 'quote (cons 'progn (cdr h)))))))
+ handlers))))
(put 'static-defconst 'lisp-indent-function 'defun)
(defmacro static-defconst (symbol initvalue &optional docstring)
The variable SYMBOL can be referred at both compile time and run time."
(let ((value (eval initvalue)))
- (eval (` (defconst (, symbol) (quote (, value)) (, docstring))))
- (` (defconst (, symbol) (quote (, value)) (, docstring)))))
+ (eval (list 'defconst symbol (list 'quote value) docstring))
+ (list 'defconst symbol (list 'quote value) docstring)))
(defmacro static-cond (&rest clauses)
"Like `cond', but evaluate CONDITION part of each clause at compile time."
projects / elisp / apel.git / commitdiff