Mercurial > hg > xemacs-beta
annotate lisp/backquote.el @ 5640:e6b5c49f9e13
Add autoload cookie to custom-set-face-bold
| author | Vin Shelton <acs@xemacs.org> |
|---|---|
| date | Sun, 08 Jan 2012 22:29:06 -0500 |
| parents | b9167d522a9a |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; backquote.el --- Full backquote support for elisp. Reverse compatible too. |
| 2 | |
| 3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Maintainer: XEmacs Development Team | |
| 6 ;; Keywords: extensions, dumped | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
10 ;; This file is part of XEmacs. |
| 428 | 11 |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
12 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
13 ;; under the terms of the GNU General Public License as published by the |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
14 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
15 ;; option) any later version. |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
16 |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
17 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
19 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
20 ;; for more details. |
| 428 | 21 |
| 22 ;; You should have received a copy of the GNU General Public License | |
|
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
428
diff
changeset
|
23 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 24 |
| 25 ;;; Synched up with: Not synched with FSF. | |
| 26 | |
| 27 ;;; Commentary: | |
| 28 | |
| 29 ;; This file is dumped with XEmacs. | |
| 30 | |
| 31 ;; The bulk of the code is originally from CMU Common Lisp (original notice | |
| 32 ;; below). | |
| 33 | |
| 34 ;; It correctly supports nested backquotes and backquoted vectors. | |
| 35 | |
| 36 ;; Converted to work with elisp by Miles Bader <miles@cogsci.ed.ac.uk> | |
| 37 | |
| 38 ;; Changes by Jonathan Stigelman <Stig@hackvan.com>: | |
| 39 ;; - Documentation added | |
| 40 ;; - support for old-backquote-compatibility-hook nixed because the | |
| 41 ;; old-backquote compatibility is now done in the reader... | |
| 42 ;; - nixed support for |,.| because | |
| 43 ;; (a) it's not in CLtl2 | |
| 44 ;; (b) ",.foo" is the same as ". ,foo" | |
| 45 ;; (c) because RMS isn't interested in using this version of backquote.el | |
| 46 ;; | |
| 47 ;; ben@xemacs.org added ,. support back in: | |
| 48 ;; (a) yes, it is in CLtl2. Read closely on page 529. | |
| 49 ;; (b) RMS in 19.30 adds C support for ,. even if it's not really | |
| 50 ;; handled. | |
| 51 ;; | |
| 52 ;; ********************************************************************** | |
| 53 ;; This code was written as part of the CMU Common Lisp project at | |
| 54 ;; Carnegie Mellon University, and has been placed in the public domain. | |
| 55 ;; If you want to use this code or any part of CMU Common Lisp, please contact | |
| 56 ;; Scott Fahlman or slisp-group@cs.cmu.edu. | |
| 57 ;; | |
| 58 ;; ********************************************************************** | |
| 59 ;; | |
| 60 ;; BACKQUOTE: Code Spice Lispified by Lee Schumacher. | |
| 61 ;; | |
| 62 ;; The flags passed back by BQ-PROCESS-2 can be interpreted as follows: | |
| 63 ;; | |
| 64 ;; |`,|: [a] => a | |
| 65 ;; NIL: [a] => a ;the NIL flag is used only when a is NIL | |
| 66 ;; T: [a] => a ;the T flag is used when a is self-evaluating | |
| 67 ;; QUOTE: [a] => (QUOTE a) | |
| 68 ;; APPEND: [a] => (APPEND . a) | |
| 69 ;; NCONC: [a] => (NCONC . a) | |
| 70 ;; LIST: [a] => (LIST . a) | |
| 71 ;; LIST*: [a] => (LIST* . a) | |
| 72 ;; | |
| 73 ;; The flags are combined according to the following set of rules: | |
| 74 ;; ([a] means that a should be converted according to the previous table) | |
| 75 ;; | |
| 76 ;; \ car || otherwise | QUOTE or | |`,@| | |`,.| | |
| 77 ;;cdr \ || | T or NIL | | | |
| 78 ;;============================================================================ | |
| 79 ;; |`,| ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a [d]) |NCONC (a [d]) | |
| 80 ;; NIL ||LIST ([a]) |QUOTE (a) |<hair> a |<hair> a | |
| 81 ;;QUOTE or T||LIST* ([a] [d]) |QUOTE (a . d) |APPEND (a [d]) |NCONC (a [d]) | |
| 82 ;; APPEND ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a . d) |NCONC (a [d]) | |
| 83 ;; NCONC ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a [d]) |NCONC (a . d) | |
| 84 ;; LIST ||LIST ([a] . d) |LIST ([a] . d) |APPEND (a [d]) |NCONC (a [d]) | |
| 85 ;; LIST* ||LIST* ([a] . d) |LIST* ([a] . d) |APPEND (a [d]) |NCONC (a [d]) | |
| 86 ;; | |
| 87 ;;<hair> involves starting over again pretending you had read ".,a)" instead | |
| 88 ;; of ",@a)" | |
| 89 ;; | |
| 90 | |
| 91 ;; These are the forms it expects: |backquote| |`| |,| |,@| and |,.|. | |
| 92 | |
| 93 ;;; Code: | |
| 94 | |
| 95 (defconst bq-backquote-marker 'backquote) | |
| 96 (defconst bq-backtick-marker '\`) ; remnant of the old lossage | |
| 97 (defconst bq-comma-marker '\,) | |
| 98 (defconst bq-at-marker '\,@) | |
| 99 (defconst bq-dot-marker '\,\.) | |
| 100 | |
| 101 ;;; ---------------------------------------------------------------- | |
| 102 | |
| 103 (fset '\` 'backquote) | |
| 104 | |
| 105 (defmacro backquote (template) | |
| 106 "Expand the internal representation of a backquoted TEMPLATE into a lisp form. | |
| 107 | |
| 108 The backquote character is like the quote character in that it prevents the | |
| 109 template which follows it from being evaluated, except that backquote | |
| 110 permits you to evaluate portions of the quoted template. A comma character | |
| 111 inside TEMPLATE indicates that the following item should be evaluated. A | |
| 112 comma character may be followed by an at-sign, which indicates that the form | |
| 113 which follows should be evaluated and inserted and \"spliced\" into the | |
| 114 template. Forms following ,@ must evaluate to lists. | |
| 115 | |
| 116 Here is how to use backquotes: | |
| 117 (setq p 'b | |
| 118 q '(c d e)) | |
| 119 `(a ,p ,@q) -> (a b c d e) | |
| 120 `(a . b) -> (a . b) | |
| 121 `(a . ,p) -> (a . b) | |
| 122 | |
| 123 The XEmacs lisp reader expands lisp backquotes as it reads them. | |
| 124 Examples: | |
| 125 `atom is read as (backquote atom) | |
| 126 `(a ,b ,@(c d e)) is read as (backquote (a (\\, b) (\\,\\@ (c d e)))) | |
| 127 `(a . ,p) is read as (backquote (a \\, p)) | |
| 128 | |
| 129 \(backquote TEMPLATE) is a macro that produces code to construct TEMPLATE. | |
| 130 Note that this is very slow in interpreted code, but fast if you compile. | |
| 131 TEMPLATE is one or more nested lists or vectors, which are `almost quoted'. | |
| 132 They are copied recursively, with elements preceded by comma evaluated. | |
| 133 (backquote (a b)) == (list 'a 'b) | |
| 134 (backquote (a [b c])) == (list 'a (vector 'b 'c)) | |
| 135 | |
| 136 However, certain special lists are not copied. They specify substitution. | |
| 137 Lists that look like (\\, EXP) are evaluated and the result is substituted. | |
| 138 (backquote (a (\\, (+ x 5)))) == (list 'a (+ x 5)) | |
| 139 | |
| 140 Elements of the form (\\,\\@ EXP) are evaluated and then all the elements | |
| 141 of the result are substituted. This result must be a list; it may | |
| 142 be `nil'. | |
| 143 | |
| 144 Elements of the form (\\,\\. EXP) are evaluated and then all the elements | |
| 145 of the result are concatenated to the list of preceding elements in the list. | |
| 146 They must occur as the last element of a list (not a vector). | |
| 147 EXP may evaluate to nil. | |
| 148 | |
| 149 As an example, a simple macro `push' could be written: | |
| 150 (defmacro push (v l) | |
| 151 `(setq ,l (cons ,@(list v l)))) | |
| 152 or as | |
| 153 (defmacro push (v l) | |
| 154 `(setq ,l (cons ,v ,l))) | |
| 155 | |
| 156 For backwards compatibility, old-style emacs-lisp backquotes are still read. | |
| 157 OLD STYLE NEW STYLE | |
| 158 (` (foo (, bar) (,@ bing))) `(foo ,bar ,@bing) | |
| 159 | |
| 160 Because of the old-style backquote support, you cannot use a new-style | |
| 161 backquoted form as the first element of a list. Perhaps some day this | |
| 162 restriction will go away, but for now you should be wary of it: | |
| 163 (`(this ,will ,@fail)) | |
| 164 ((` (but (, this) will (,@ work)))) | |
| 165 This is an extremely rare thing to need to do in lisp." | |
| 166 (bq-process template)) | |
| 167 | |
| 168 ;;; ---------------------------------------------------------------- | |
| 169 | |
| 170 (defconst bq-comma-flag 'unquote) | |
| 171 (defconst bq-at-flag 'unquote-splicing) | |
| 172 (defconst bq-dot-flag 'unquote-nconc-splicing) | |
| 173 | |
| 174 (defun bq-process (form) | |
| 175 (let* ((flag-result (bq-process-2 form)) | |
| 176 (flag (car flag-result)) | |
| 177 (result (cdr flag-result))) | |
| 178 (cond ((eq flag bq-at-flag) | |
| 179 (error ",@ after ` in form: %s" form)) | |
| 180 ((eq flag bq-dot-flag) | |
| 181 (error ",. after ` in form: %s" form)) | |
| 182 (t | |
| 183 (bq-process-1 flag result))))) | |
| 184 | |
| 185 ;;; ---------------------------------------------------------------- | |
| 186 | |
| 187 ;;; This does the expansion from table 2. | |
| 188 (defun bq-process-2 (code) | |
| 189 (cond ((vectorp code) | |
|
5281
aa20a889ff14
Remove a couple of redundant functions, backquote.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
428
diff
changeset
|
190 (let* ((dflag-d (bq-process-2 (append code nil)))) |
| 428 | 191 (cons 'vector (bq-process-1 (car dflag-d) (cdr dflag-d))))) |
| 192 ((atom code) | |
| 193 (cond ((null code) (cons nil nil)) | |
| 194 ((or (numberp code) (eq code t)) | |
| 195 (cons t code)) | |
| 196 (t (cons 'quote code)))) | |
| 197 ((eq (car code) bq-at-marker) | |
| 198 (cons bq-at-flag (nth 1 code))) | |
| 199 ((eq (car code) bq-dot-marker) | |
| 200 (cons bq-dot-flag (nth 1 code))) | |
| 201 ((eq (car code) bq-comma-marker) | |
| 202 (bq-comma (nth 1 code))) | |
| 203 ((or (eq (car code) bq-backquote-marker) | |
| 204 (eq (car code) bq-backtick-marker)) ; old lossage | |
| 205 (bq-process-2 (bq-process (nth 1 code)))) | |
| 206 (t (let* ((aflag-a (bq-process-2 (car code))) | |
| 207 (aflag (car aflag-a)) | |
| 208 (a (cdr aflag-a))) | |
| 209 (let* ((dflag-d (bq-process-2 (cdr code))) | |
| 210 (dflag (car dflag-d)) | |
| 211 (d (cdr dflag-d))) | |
| 212 (if (eq dflag bq-at-flag) | |
| 213 ;; get the errors later. | |
| 214 (error ",@ after dot in %s" code)) | |
| 215 (if (eq dflag bq-dot-flag) | |
| 216 (error ",. after dot in %s" code)) | |
| 217 (cond | |
| 218 ((eq aflag bq-at-flag) | |
| 219 (if (null dflag) | |
| 220 (bq-comma a) | |
| 221 (cons 'append | |
| 222 (cond ((eq dflag 'append) | |
| 223 (cons a d )) | |
| 224 (t (list a (bq-process-1 dflag d))))))) | |
| 225 ((eq aflag bq-dot-flag) | |
| 226 (if (null dflag) | |
| 227 (bq-comma a) | |
| 228 (cons 'nconc | |
| 229 (cond ((eq dflag 'nconc) | |
| 230 (cons a d)) | |
| 231 (t (list a (bq-process-1 dflag d))))))) | |
| 232 ((null dflag) | |
| 233 (if (memq aflag '(quote t nil)) | |
| 234 (cons 'quote (list a)) | |
| 235 (cons 'list (list (bq-process-1 aflag a))))) | |
| 236 ((memq dflag '(quote t)) | |
| 237 (if (memq aflag '(quote t nil)) | |
| 238 (cons 'quote (cons a d )) | |
| 239 (cons 'list* (list (bq-process-1 aflag a) | |
| 240 (bq-process-1 dflag d))))) | |
| 241 (t (setq a (bq-process-1 aflag a)) | |
| 242 (if (memq dflag '(list list*)) | |
| 243 (cons dflag (cons a d)) | |
| 244 (cons 'list* | |
| 245 (list a (bq-process-1 dflag d))))))))))) | |
| 246 | |
| 247 ;;; This handles the <hair> cases | |
| 248 (defun bq-comma (code) | |
| 249 (cond ((atom code) | |
| 250 (cond ((null code) | |
| 251 (cons nil nil)) | |
| 252 ((or (numberp code) (eq code 't)) | |
| 253 (cons t code)) | |
| 254 (t (cons bq-comma-flag code)))) | |
| 255 ((eq (car code) 'quote) | |
| 256 (cons (car code) (car (cdr code)))) | |
| 257 ((memq (car code) '(append list list* nconc)) | |
| 258 (cons (car code) (cdr code))) | |
| 259 ((eq (car code) 'cons) | |
| 260 (cons 'list* (cdr code))) | |
| 261 (t (cons bq-comma-flag code)))) | |
| 262 | |
| 263 ;;; This handles table 1. | |
| 264 (defun bq-process-1 (flag thing) | |
| 265 (cond ((or (eq flag bq-comma-flag) | |
| 266 (memq flag '(t nil))) | |
| 267 thing) | |
| 268 ((eq flag 'quote) | |
| 269 (list 'quote thing)) | |
| 270 ((eq flag 'vector) | |
| 271 (list 'apply '(function vector) thing)) | |
|
5281
aa20a889ff14
Remove a couple of redundant functions, backquote.el
Aidan Kehoe <kehoea@parhasard.net>
parents:
428
diff
changeset
|
272 (t (cons flag thing)))) |
| 428 | 273 |
| 274 (provide 'backquote) | |
| 275 | |
| 276 ;;; backquote.el ends here |