From: yamaoka Date: Tue, 4 Sep 2007 09:08:33 +0000 (+0000) Subject: * broken.el (broken-facility, if-broken, when-broken) X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=0d21514f12263c7d94f7c843ec5253c166e89851;p=elisp%2Fapel.git * 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. --- diff --git a/ChangeLog b/ChangeLog index e3bbf8a..cb9e153 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,28 @@ +2007-09-04 Katsumi Yamaoka + + * 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. + + 2007-02-14 MORIOKA Tomohiko * APEL: Version 10.7 released. diff --git a/broken.el b/broken.el index 81d1ec6..4117413 100644 --- a/broken.el +++ b/broken.el @@ -58,51 +58,59 @@ FACILITY must be symbol. 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 diff --git a/filename.el b/filename.el index 6aa4edd..680bce3 100644 --- a/filename.el +++ b/filename.el @@ -102,26 +102,30 @@ Moreover, if you want to convert Japanese filename to roman string by kakasi, 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)) diff --git a/pccl.el b/pccl.el index 088d5c9..5b2724c 100644 --- a/pccl.el +++ b/pccl.el @@ -55,7 +55,7 @@ "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 @@ -86,12 +86,11 @@ Value is a list of transformed arguments." (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)) @@ -114,43 +113,43 @@ Value is a list of transformed arguments." '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." diff --git a/poe.el b/poe.el index 89c097e..2e82bce 100644 --- a/poe.el +++ b/poe.el @@ -915,20 +915,20 @@ APEL provides this as dummy for compatibility.") (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) @@ -937,18 +937,22 @@ The value of the last form in FORMS is returned, like `progn'. 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. @@ -964,41 +968,48 @@ If MESSAGE is nil, the echo area and message log buffer are unchanged. 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) diff --git a/product.el b/product.el index b49d698..41fd897 100644 --- a/product.el +++ b/product.el @@ -232,21 +232,26 @@ PRODUCT-DEF is a definition of the product." (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. diff --git a/pym.el b/pym.el index 46c85ef..8905e21 100644 --- a/pym.el +++ b/pym.el @@ -63,15 +63,16 @@ 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) @@ -79,15 +80,16 @@ See also the function `defun'." 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) @@ -95,15 +97,16 @@ See also the function `defmacro'." 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. @@ -111,35 +114,37 @@ See also the function `defalias'." (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. @@ -152,26 +157,26 @@ See also the function `defun'." 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. @@ -184,26 +189,26 @@ See also the function `defmacro'." 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. @@ -216,26 +221,26 @@ See also the macro `defsubst'." 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. @@ -246,7 +251,8 @@ See also the macro `defsubst'." "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) diff --git a/static.el b/static.el index 34d6f1b..e7aaa29 100644 --- a/static.el +++ b/static.el @@ -29,38 +29,38 @@ "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) @@ -68,8 +68,8 @@ 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."