1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
|
;;; x-symbol-macs.el --- macros used when compiling or interpreting x-symbol.el
;; Copyright (C) 1998-2002 Free Software Foundation, Inc.
;;
;; Author: Christoph Wedler <wedler@users.sourceforge.net>
;; Maintainer: (Please use `M-x x-symbol-package-bug' to contact the maintainer)
;; Version: 4.5
;; Keywords: WYSIWYG, LaTeX, HTML, wp, math, internationalization
;; X-URL: http://x-symbol.sourceforge.net/
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; If you want to use package x-symbol, please visit the URL (use
;; \\[x-symbol-package-web]) and read the info (use \\[x-symbol-package-info]).
;; Macro expansion must not dependent on Mule vs no-Mule! Depending on Emacs
;; vs XEmacs is OK, since the elc files aren't compatible anyway.
;;; Code:
(provide 'x-symbol-macs)
(require 'cl)
;;;===========================================================================
;;;
;;;===========================================================================
(defmacro x-symbol-ignore-property-changes (&rest body)
(if (featurep 'xemacs)
(cons 'progn body)
(let ((modified (gensym "--x-symbol-modified--")))
`(let ((,modified (buffer-modified-p))
(buffer-undo-list t)
(inhibit-read-only t)
(inhibit-modification-hooks t)
(inhibit-point-motion-hooks t))
(unwind-protect
(progn ,@body)
(and (not ,modified) (buffer-modified-p)
(set-buffer-modified-p nil)))))))
;;;===========================================================================
;;; Function used by macros and the macros
;;;===========================================================================
(defun x-symbol-set/push-assq/assoc (x key alist pushp test)
(let* ((temp (gensym "--x-symbol-set/push-assq/assoc-temp--"))
(evalp (and (consp key) (null (eq (car key) 'quote))))
(keysymb (if evalp
(gensym "--x-symbol-set/push-assq/assoc-temp--")
key))
(keydef (and evalp (list (list keysymb key)))))
`(let* (,@keydef
(,temp (,test ,keysymb ,alist)))
(if ,temp
(setcdr ,temp ,(if pushp `(cons ,x (cdr ,temp)) x))
(setq ,alist (cons (,(if pushp 'list 'cons) ,keysymb ,x) ,alist)))
,temp)))
(defmacro x-symbol-set-assq (x key alist)
"Set X to be the association for KEY in ALIST.
If no car of an element in ALIST is `eq' to KEY, inserts (KEY . X) at
the head of ALIST."
(x-symbol-set/push-assq/assoc x key alist nil 'assq))
(defmacro x-symbol-set-assoc (x key alist)
"Set X to be the association for KEY in ALIST.
If no car of an element in ALIST is `equal' to KEY, inserts (KEY . X) at
the head of ALIST."
(x-symbol-set/push-assq/assoc x key alist nil 'assoc))
(defmacro x-symbol-push-assq (x key alist)
"Insert X at the head of the association for KEY in ALIST.
If no car of an element in ALIST is `eq' to KEY, inserts (KEY X) at the
head of ALIST. An element (KEY A B) would look like (KEY X A B) after
the operation."
(x-symbol-set/push-assq/assoc x key alist t 'assq))
(defmacro x-symbol-push-assoc (x key alist)
"Insert X at the head of the association for KEY in ALIST.
If no car of an element in ALIST is `equal' to KEY, inserts (KEY X) at
the head of ALIST. An element (KEY A B) would look like (KEY X A B)
after the operation."
(x-symbol-set/push-assq/assoc x key alist t 'assoc))
;;;===========================================================================
;;; Macros
;;;===========================================================================
(defmacro x-symbol-dolist-delaying (spec cond &rest body)
;; checkdoc-params: (spec)
"Loop over a list delaying elements if condition yields non-nil.
The macro looks like
(x-symbol-dolist-delaying (VAR LIST [WORKING [DELAYED]]) COND BODY...)
Bind VAR to each `car' from LIST, in turn. If COND yields nil, evaluate
BODY. Otherwise, BODY with VAR bound to the list value is evaluated
after all other list values have been processed. Return all list
values which could not been processed.
The looping is done in cycles. In each cycle, the value of WORKING,
which defaults to some internal symbol, is the list of elements still to
be processed during the current cycle. VAR is always the head of
WORKING. If COND yields non-nil, VAR is inserted at the head of the
list stored in DELAYED which defaults to some internal symbol. At the
end of each CYCLE, WORKING is set to the reversed value of DELAYED. The
macro ends if all elements has been processed or all elements in a cycle
has been inserted into the delayed list."
(let ((working (or (nth 2 spec)
(gensym "--x-symbol-dolist-delaying-temp--")))
(delayed (or (nth 3 spec)
(gensym "--x-symbol-dolist-delaying-temp--")))
(non-circ (gensym "--x-symbol-dolist-delaying-temp--")))
`(block nil
(let ((,working ,(nth 1 spec))
(,non-circ t)
,delayed
,(car spec))
(while (and ,working ,non-circ)
(setq ,delayed nil
,non-circ nil)
(while ,working
(setq ,(car spec) (car ,working))
(if ,cond
(setq ,delayed (cons ,(car spec) ,delayed))
,@body
(setq ,non-circ t))
(setq ,working (cdr ,working)))
(setq ,working (nreverse ,delayed)))
,working))))
(defmacro x-symbol-do-plist (spec &rest body)
;; checkdoc-params: (spec)
"Loop over a property list.
The macro looks like
(x-symbol-do-plist (PROP VAR PLIST) BODY...)
Evaluate BODY with each PROP bound to each property of PLIST and VAR
bound to the corresponding value, in turn. PROP and VAR can also be nil
if their value is not important. Return nil."
(let ((plist (gensym "--x-symbol-do-plist-temp--")))
`(block nil
(let ((,plist ,(nth 2 spec))
,@(and (car spec) (list (car spec)))
,@(and (nth 1 spec) (list (nth 1 spec))))
(while ,plist
(setq ,@(and (car spec) `(,(car spec) (car ,plist)))
,@(and (nth 1 spec) `(,(nth 1 spec) (cadr ,plist))))
,@body
(setq ,plist (cddr ,plist)))
nil))))
(defmacro x-symbol-while-charsym (spec &rest body)
"(x-symbol-while-charsym (CHARSYM CHAR) BODY...)"
(unless (and (consp spec)
(symbolp (car spec))
(symbolp (cadr spec))
(null (cddr spec)))
(error "Wrong call of `x-symbol-while-charsym'."))
(let ((charsym (car spec))
(char (cadr spec)))
`(let (,charsym ,char)
(block nil
(skip-chars-forward "\000-\177")
(while (setq ,char (char-after))
(if (setq ,charsym
,(if (featurep 'xemacs)
'(x-symbol-encode-charsym-after)
;; no need for nomule byte-comp in Emacs => inline
`(get-char-table ,char x-symbol-mule-char-table)))
(progn ,@body)
(forward-char x-symbol-encode-rchars))
(skip-chars-forward "\000-\177"))))))
(defmacro x-symbol-encode-for-charsym (spec &rest body)
"(x-symbol-while-charsym ((TOKEN-TABLE FCHAR-TABLE FCHAR-FALLBACK-TABLE) TOKEN CHARSYM)) BODY...)"
(let* ((tables (car spec))
(vars (cdr spec))
(fchar-table (cadr tables))
(fchar-fb-table (caddr tables))
(token (car vars))
(charsym (or (cadr vars)
(gensym "--x-symbol-encode-for-charsym-temp--")))
(char (gensym "--x-symbol-encode-for-charsym-temp--"))
(fchar (gensym "--x-symbol-encode-for-charsym-temp--")))
`(let (,fchar ,token)
(x-symbol-while-charsym ,(list charsym char)
(cond ((and ,fchar-table
(setq ,fchar (gethash ,charsym ,fchar-table)))
;; fchar-fb-table = nil => no recoding
(if (or (null ,fchar-fb-table) (eq ,fchar ,char))
(forward-char x-symbol-encode-rchars)
(insert ,fchar)
(delete-char x-symbol-encode-rchars)))
((setq ,token (gethash ,charsym ,(car tables)))
,@body)
((setq ,fchar (gethash ,charsym ,fchar-fb-table))
(if (eq ,fchar ,char)
(forward-char x-symbol-encode-rchars)
(insert ,fchar)
(delete-char x-symbol-encode-rchars)))
(t
(forward-char x-symbol-encode-rchars)))))))
(defmacro x-symbol-decode-for-charsym (spec undefined &rest body)
"(x-symbol-decode-for-charsym ((REGEXP DECODE-OBARRAY CASE-FN) DEFN BEG END) UNDEFINED BODY...)"
(let* ((grammar (car spec))
(case-fn (caddar spec))
(defn (cadr spec))
(beg (caddr spec))
(end (cadddr spec)))
`(let (,beg ,end ,defn)
(block nil
(while (re-search-forward ,(car grammar) nil t)
(setq ,beg (match-beginning 0)
,end (match-end 0))
(if (setq ,defn (intern-soft
,(if case-fn
`(if ,case-fn
(funcall ,case-fn
(buffer-substring ,beg ,end))
(buffer-substring ,beg ,end))
`(buffer-substring ,beg ,end))
,(cadr grammar)))
(progn
(setq ,defn (symbol-value ,defn)) ; nil shouldn't happen
,@body)
,@(if undefined (list undefined))))))))
(defmacro x-symbol-decode-unique-test (token-spec unique)
`(and ,unique
(or (cddr ,token-spec)
(and (hash-table-p ,unique)
(gethash (car ,token-spec) ,unique)))))
(defmacro x-symbol-set-buffer-multibyte ()
;; Make sure the buffer is not in unibyte mode (for Emacs).
(unless (featurep 'xemacs)
'(set-buffer-multibyte t)))
;;; Local IspellPersDict: .ispell_xsymb
;;; x-symbol-macs.el ends here
|
