kpriv/freebsd-ports
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Fix old-style backquotes issue.

Browse source 
PR:		ports/170961
Submitted by:	Yasuhiro KIMURA <yasu@utahime.org>
This commit is contained in:
MANTANI Nobutaka 2012-08-25 12:01:11 +00:00
parent ba15cdb935
commit 85a8a5bfcc
Notes: svn2git 2021-03-31 03:12:20 +00:00 
svn path=/head/; revision=303130
8 changed files with 2250 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
editors/apel/Makefile
View file

@ -7,7 +7,7 @@
PORTNAME= apel
PORTVERSION= ${APEL_VER}
PORTREVISION= 6
PORTREVISION= 7
CATEGORIES= editors elisp
MASTER_SITES= http://kanji.zinbun.kyoto-u.ac.jp/~tomo/lemi/dist/apel/
PKGNAMESUFFIX= -${EMACS_PORT_NAME}

84
editors/apel/files/patch-broken.el Normal file
View file

@ -0,0 +1,84 @@
Index: broken.el
===================================================================
--- broken.el (revision 2)
+++ broken.el (working copy)
@@ -58,51 +58,51 @@
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)))))
+ `(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))))
(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))))
+ `(static-if (broken-p ',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))))
+ `(static-when (broken-p ',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))))
+ `(static-unless (broken-p ',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))))))))
+ `(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))))))
;;; @ end

51
editors/apel/files/patch-filename.el Normal file
View file

@ -0,0 +1,51 @@
Index: filename.el
===================================================================
--- filename.el (revision 2)
+++ filename.el (working copy)
@@ -102,26 +102,26 @@
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))
- (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)))))))
+ `(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))
+ (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))))))
(defun filename-special-filter (string)
(filename-special-filter-1 string))

268
editors/apel/files/patch-pccl.el Normal file
View file

@ -0,0 +1,268 @@
Index: pccl.el
===================================================================
--- pccl.el (revision 2)
+++ pccl.el (working copy)
@@ -27,138 +27,138 @@
(require 'broken)
(broken-facility ccl-usable
- "Emacs has not CCL."
- (and (featurep 'mule)
- (if (featurep 'xemacs)
- (>= emacs-major-version 21)
- (>= emacs-major-version 19))))
+ "Emacs has not CCL."
+ (and (featurep 'mule)
+ (if (featurep 'xemacs)
+ (>= emacs-major-version 21)
+ (>= emacs-major-version 19))))
(unless-broken ccl-usable
- (require 'advice)
+ (require 'advice)
- (if (featurep 'mule)
- (progn
- (require 'ccl)
- (if (featurep 'xemacs)
- (if (>= emacs-major-version 21)
- ;; for XEmacs 21 with mule
- (require 'pccl-20))
- (if (>= emacs-major-version 20)
- ;; for Emacs 20
- (require 'pccl-20)
- ;; for Mule 2.*
- (require 'pccl-om)))))
+ (if (featurep 'mule)
+ (progn
+ (require 'ccl)
+ (if (featurep 'xemacs)
+ (if (>= emacs-major-version 21)
+ ;; for XEmacs 21 with mule
+ (require 'pccl-20))
+ (if (>= emacs-major-version 20)
+ ;; for Emacs 20
+ (require 'pccl-20)
+ ;; for Mule 2.*
+ (require 'pccl-om)))))
- (static-if (or (featurep 'xemacs) (< emacs-major-version 21))
- (defadvice define-ccl-program
- (before accept-long-ccl-program activate)
- "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)))
- (while try-ccl-compile
- (setq try-ccl-compile nil)
- (condition-case sig
- (ccl-compile prog)
- (args-out-of-range
- (if (and (eq (car (cdr sig)) ccl-program-vector)
- (= (car (cdr (cdr sig))) (length ccl-program-vector)))
- (setq ccl-program-vector
- (make-vector (* 2 (length ccl-program-vector)) 0)
- try-ccl-compile t)
- (signal (car sig) (cdr sig)))))))))
+ (static-if (or (featurep 'xemacs) (< emacs-major-version 21))
+ (defadvice define-ccl-program
+ (before accept-long-ccl-program activate)
+ "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)
+ (while try-ccl-compile
+ (setq try-ccl-compile nil)
+ (condition-case sig
+ (ccl-compile prog)
+ (args-out-of-range
+ (if (and (eq (car (cdr sig)) ccl-program-vector)
+ (= (car (cdr (cdr sig))) (length ccl-program-vector)))
+ (setq ccl-program-vector
+ (make-vector (* 2 (length ccl-program-vector)) 0)
+ try-ccl-compile t)
+ (signal (car sig) (cdr sig)))))))))
- (static-when (and (not (featurep 'xemacs)) (< emacs-major-version 21))
- (defun-maybe transform-make-coding-system-args (name type &optional doc-string props)
- "For internal use only.
+ (static-when (and (not (featurep 'xemacs)) (< emacs-major-version 21))
+ (defun-maybe transform-make-coding-system-args (name type &optional doc-string props)
+ "For internal use only.
Transform XEmacs style args for `make-coding-system' to Emacs style.
Value is a list of transformed arguments."
- (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?")))
- (eol-type (plist-get props 'eol-type))
- properties tmp)
- (cond
- ((eq eol-type 'lf) (setq eol-type 'unix))
- ((eq eol-type 'crlf) (setq eol-type 'dos))
- ((eq eol-type 'cr) (setq eol-type 'mac)))
- (if (setq tmp (plist-get props 'post-read-conversion))
- (setq properties (plist-put properties 'post-read-conversion tmp)))
- (if (setq tmp (plist-get props 'pre-write-conversion))
- (setq properties (plist-put properties 'pre-write-conversion tmp)))
- (cond
- ((eq type 'shift-jis)
- (` ((, 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)))))
- (let ((g0 (plist-get props 'charset-g0))
- (g1 (plist-get props 'charset-g1))
- (g2 (plist-get props 'charset-g2))
- (g3 (plist-get props 'charset-g3))
- (use-roman
- (and
- (eq (cadr (assoc 'latin-jisx0201
- (plist-get props 'input-charset-conversion)))
- 'ascii)
- (eq (cadr (assoc 'ascii
- (plist-get props 'output-charset-conversion)))
- 'latin-jisx0201)))
- (use-oldjis
- (and
- (eq (cadr (assoc 'japanese-jisx0208-1978
- (plist-get props 'input-charset-conversion)))
- 'japanese-jisx0208)
- (eq (cadr (assoc 'japanese-jisx0208
- (plist-get props 'output-charset-conversion)))
- 'japanese-jisx0208-1978))))
- (if (charsetp g0)
- (if (plist-get props 'force-g0-on-output)
- (setq g0 (` (nil (, g0))))
- (setq g0 (` ((, g0) t)))))
- (if (charsetp g1)
- (if (plist-get props 'force-g1-on-output)
- (setq g1 (` (nil (, g1))))
- (setq g1 (` ((, g1) t)))))
- (if (charsetp g2)
- (if (plist-get props 'force-g2-on-output)
- (setq g2 (` (nil (, g2))))
- (setq g2 (` ((, 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)))))
- ((eq type 'big5)
- (` ((, 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))))
- (t
- (error "unsupported XEmacs style make-coding-style arguments: %S"
- (` ((, 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."
- (when (and (symbolp type) (not (memq type '(t nil))))
- (let ((args (apply 'transform-make-coding-system-args
- name type ad-subr-args)))
- (setq type (cadr args)
- ad-subr-args (cddr args)))))))
+ (let ((mnemonic (string-to-char (or (plist-get props 'mnemonic) "?")))
+ (eol-type (plist-get props 'eol-type))
+ properties tmp)
+ (cond
+ ((eq eol-type 'lf) (setq eol-type 'unix))
+ ((eq eol-type 'crlf) (setq eol-type 'dos))
+ ((eq eol-type 'cr) (setq eol-type 'mac)))
+ (if (setq tmp (plist-get props 'post-read-conversion))
+ (setq properties (plist-put properties 'post-read-conversion tmp)))
+ (if (setq tmp (plist-get props 'pre-write-conversion))
+ (setq properties (plist-put properties 'pre-write-conversion tmp)))
+ (cond
+ ((eq type 'shift-jis)
+ `(,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)))
+ (let ((g0 (plist-get props 'charset-g0))
+ (g1 (plist-get props 'charset-g1))
+ (g2 (plist-get props 'charset-g2))
+ (g3 (plist-get props 'charset-g3))
+ (use-roman
+ (and
+ (eq (cadr (assoc 'latin-jisx0201
+ (plist-get props 'input-charset-conversion)))
+ 'ascii)
+ (eq (cadr (assoc 'ascii
+ (plist-get props 'output-charset-conversion)))
+ 'latin-jisx0201)))
+ (use-oldjis
+ (and
+ (eq (cadr (assoc 'japanese-jisx0208-1978
+ (plist-get props 'input-charset-conversion)))
+ 'japanese-jisx0208)
+ (eq (cadr (assoc 'japanese-jisx0208
+ (plist-get props 'output-charset-conversion)))
+ 'japanese-jisx0208-1978))))
+ (if (charsetp g0)
+ (if (plist-get props 'force-g0-on-output)
+ (setq g0 `(nil ,g0))
+ (setq g0 `(,g0 t))))
+ (if (charsetp g1)
+ (if (plist-get props 'force-g1-on-output)
+ (setq g1 `(nil ,g1))
+ (setq g1 `(,g1 t))))
+ (if (charsetp g2)
+ (if (plist-get props 'force-g2-on-output)
+ (setq g2 `(nil ,g2))
+ (setq g2 `(,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)))
+ ((eq type 'big5)
+ `(,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))
+ (t
+ (error "unsupported XEmacs style make-coding-style arguments: %S"
+ `(,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."
+ (when (and (symbolp type) (not (memq type '(t nil))))
+ (let ((args (apply 'transform-make-coding-system-args
+ name type ad-subr-args)))
+ (setq type (cadr args)
+ ad-subr-args (cddr args)))))))
;;; @ end

1410
editors/apel/files/patch-poe.el Normal file
View file

File diff suppressed because it is too large Load diff

83
editors/apel/files/patch-product.el Normal file
View file

@ -0,0 +1,83 @@
Index: product.el
===================================================================
--- product.el (revision 2)
+++ product.el (working copy)
@@ -232,21 +232,21 @@
(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)))))
+ `(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)))
(defun product-version-as-string (product)
"Return version number of product as a string.
@@ -293,13 +293,13 @@
PRODUCT is a product structure which returned by `product-define'."
(let (dest)
(product-for-each product nil
- (function
- (lambda (product)
- (let ((str (product-string-1 product nil)))
- (if str
- (setq dest (if dest
- (concat dest " " str)
- str)))))))
+ (function
+ (lambda (product)
+ (let ((str (product-string-1 product nil)))
+ (if str
+ (setq dest (if dest
+ (concat dest " " str)
+ str)))))))
dest))
(defun product-string-verbose (product)
@@ -307,13 +307,13 @@
PRODUCT is a product structure which returned by `product-define'."
(let (dest)
(product-for-each product nil
- (function
- (lambda (product)
- (let ((str (product-string-1 product t)))
- (if str
- (setq dest (if dest
- (concat dest " " str)
- str)))))))
+ (function
+ (lambda (product)
+ (let ((str (product-string-1 product t)))
+ (if str
+ (setq dest (if dest
+ (concat dest " " str)
+ str)))))))
dest))
(defun product-version-compare (v1 v2)

282
editors/apel/files/patch-pym.el Normal file
View file

@ -0,0 +1,282 @@
Index: pym.el
===================================================================
--- pym.el (revision 2)
+++ pym.el (working copy)
@@ -63,15 +63,15 @@
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))))))
+ `(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)))))
(put 'defmacro-maybe 'lisp-indent-function 'defun)
(defmacro defmacro-maybe (name &rest everything-else)
@@ -79,15 +79,15 @@
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))))))
+ `(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)))))
(put 'defsubst-maybe 'lisp-indent-function 'defun)
(defmacro defsubst-maybe (name &rest everything-else)
@@ -95,15 +95,15 @@
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))))))
+ `(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)))))
(defmacro defalias-maybe (symbol definition)
"Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
@@ -111,35 +111,35 @@
(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))))))
+ `(or (fboundp (quote ,symbol))
+ (prog1
+ (defalias (quote ,symbol) ,definition)
+ ;; `defalias' updates `load-history' internally.
+ (put (quote ,symbol) '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))))))
+ `(or (boundp (quote ,name))
+ (prog1
+ (defvar ,name ,@everything-else)
+ ;; byte-compiler will generate code to update
+ ;; `load-history'.
+ (put (quote ,name) '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))))))
+ `(or (boundp (quote ,name))
+ (prog1
+ (defconst ,name ,@everything-else)
+ ;; byte-compiler will generate code to update
+ ;; `load-history'.
+ (put (quote ,name) '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 +152,26 @@
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))))))
+ `(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)))))
(defmacro defmacro-maybe-cond (name args &optional doc &rest clauses)
"Define NAME as a macro if NAME is not defined.
@@ -184,26 +184,26 @@
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))))))
+ `(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)))))
(defmacro defsubst-maybe-cond (name args &optional doc &rest clauses)
"Define NAME as an inline function if NAME is not defined.
@@ -216,26 +216,26 @@
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))))))
+ `(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)))))
;;; Edebug spec.
@@ -246,7 +246,7 @@
"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)))))
+ `(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
;; edebug-spec for `def*-maybe' macros.
(def-edebug-spec defun-maybe defun)

71
editors/apel/files/patch-static.el Normal file
View file

@ -0,0 +1,71 @@
Index: static.el
===================================================================
--- static.el (revision 2)
+++ static.el (working copy)
@@ -29,38 +29,38 @@
"Like `if', but evaluate COND at compile time."
(if (eval cond)
then
- (` (progn (,@ else)))))
+ `(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)))))
+ `(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)))))
+ `(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 `(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))))
(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 `(defconst ,symbol (quote ,value) ,docstring))
+ `(defconst ,symbol (quote ,value) ,docstring)))
(defmacro static-cond (&rest clauses)
"Like `cond', but evaluate CONDITION part of each clause at compile time."