|
14
|
1 ;;; dsssl.el --- DSSSL parser
|
|
|
2 ;; Author: wmperry
|
|
|
3 ;; Created: 1996/12/18 21:10:58
|
|
|
4 ;; Version: 1.11
|
|
|
5 ;; Keywords:
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
|
9 ;;;
|
|
|
10 ;;; This file is part of GNU Emacs.
|
|
|
11 ;;;
|
|
|
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
13 ;;; it under the terms of the GNU General Public License as published by
|
|
|
14 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;;; any later version.
|
|
|
16 ;;;
|
|
|
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
20 ;;; GNU General Public License for more details.
|
|
|
21 ;;;
|
|
|
22 ;;; You should have received a copy of the GNU General Public License
|
|
|
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
24 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
25 ;;; Boston, MA 02111-1307, USA.
|
|
|
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
27
|
|
|
28 (require 'cl)
|
|
|
29
|
|
|
30 (if (not (fboundp 'cl-copy-hashtable))
|
|
|
31 (defun cl-copy-hashtable (h)
|
|
|
32 (let ((new (make-hash-table)))
|
|
|
33 (cl-maphash (function (lambda (k v) (cl-puthash k v new))) h)
|
|
|
34 new)))
|
|
|
35
|
|
|
36 ;; We need to have this up at the top to avoid compilation warnings in
|
|
|
37 ;; 'make' in dsssl-eval. Call me anal.
|
|
|
38 (defstruct flow-object
|
|
|
39 (name 'unknown :read-only t) ; Name of this flow object
|
|
|
40 (properties nil)
|
|
|
41 (children nil)
|
|
|
42 (parent nil)
|
|
|
43 )
|
|
|
44
|
|
|
45 (defconst dsssl-builtin-functions
|
|
|
46 '(not boolean\? case equal\? null\? list\? list length append
|
|
|
47 reverse list-tail list-ref member symbol\? keyword\? quantity\?
|
|
|
48 number\? real\? integer\? = < > <= >= + * - / max min abs quotient
|
|
|
49 modulo remainder floor ceiling truncate round number->string
|
|
|
50 string->number char\? char=\? char-property string\? string
|
|
|
51 string-length string-ref string=\? substring string-append
|
|
|
52 procedure\? apply external-procedure make time time->string quote
|
|
|
53 char-downcase indentity error let)
|
|
|
54 "A list of all the builtin DSSSL functions that we support.")
|
|
|
55
|
|
|
56 (defsubst dsssl-check-args (args expected)
|
|
|
57 ;; Signal an error if we don't have the expected # of arguments
|
|
|
58 (or (= (length args) expected)
|
|
|
59 (error "Wrong # arguments (expected %d): %d" expected (length args))))
|
|
|
60
|
|
|
61 (defsubst dsssl-min-args (args min)
|
|
|
62 (or (>= (length args) min)
|
|
|
63 (error "Wrong # arguments (expected at least %d): %d" min
|
|
|
64 (length args))))
|
|
|
65
|
|
|
66 (defun dsssl-call-function (func args)
|
|
|
67 (declare (special defines units))
|
|
|
68 (let ((old-defines nil)
|
|
|
69 (old-units nil)
|
|
|
70 (func-args (nth 1 func))
|
|
|
71 (real-func (nth 2 func))
|
|
|
72 (retval nil))
|
|
|
73 ;; Make sure we got the right # of arguments
|
|
|
74 (dsssl-check-args args (length func-args))
|
|
|
75
|
|
|
76 ;; make sure we evaluate all the arguments in the old environment
|
|
|
77 (setq args (mapcar 'dsssl-eval args))
|
|
|
78
|
|
|
79 ;; Save the old environment
|
|
|
80 (setq old-defines (cl-copy-hashtable defines)
|
|
|
81 old-units (cl-copy-hashtable units))
|
|
|
82
|
|
|
83 ;; Create the function's environment
|
|
|
84 (while func-args
|
|
|
85 (cl-puthash (car func-args) (car args) defines)
|
|
|
86 (setq func-args (cdr func-args)
|
|
|
87 args (cdr args)))
|
|
|
88
|
|
|
89 ;; Now evaluate the function body, returning the value of the last one
|
|
|
90 (while real-func
|
|
|
91 (setq retval (dsssl-eval (car real-func))
|
|
|
92 real-func (cdr real-func)))
|
|
|
93
|
|
|
94 ;; Restore the previous environment
|
|
|
95 (setq defines old-defines
|
|
|
96 units old-units)
|
|
|
97
|
|
|
98 ;; And we are out of here baby!
|
|
|
99 retval))
|
|
|
100
|
|
|
101 (defun dsssl-eval (form)
|
|
|
102 ;; We expect to have a 'defines' and 'units' hashtable floating around
|
|
|
103 ;; from higher up the call stack.
|
|
|
104 (declare (special defines units))
|
|
|
105 (cond
|
|
|
106 ((consp form) ; A function call
|
|
|
107 (let ((func (car form))
|
|
|
108 (args (cdr form)))
|
|
|
109 (case func
|
|
|
110 (cons
|
|
|
111 (dsssl-check-args args 2)
|
|
|
112 (cons (dsssl-eval (pop args)) (dsssl-eval (pop args))))
|
|
|
113 (cdr
|
|
|
114 (dsssl-check-args args 1)
|
|
|
115 (cdr (dsssl-eval (pop args))))
|
|
|
116 (car
|
|
|
117 (dsssl-check-args args 1)
|
|
|
118 (car (dsssl-eval (pop args))))
|
|
|
119 (not
|
|
|
120 (dsssl-check-args args 1)
|
|
|
121 (not (dsssl-eval (car args))))
|
|
|
122 (boolean\?
|
|
|
123 (dsssl-check-args args 1)
|
|
|
124 (and (symbolp (car args))
|
|
|
125 (memq (car args) '(\#f \#t))))
|
|
|
126 (if
|
|
|
127 (dsssl-min-args args 2)
|
|
|
128 (let ((val (dsssl-eval (pop args))))
|
|
|
129 (if val
|
|
|
130 (dsssl-eval (nth 0 args))
|
|
|
131 (if (nth 1 args)
|
|
|
132 (dsssl-eval (nth 1 args))))))
|
|
|
133 (let ; FIXME
|
|
|
134 )
|
|
|
135 (case
|
|
|
136 (dsssl-min-args args 2)
|
|
|
137 (let* ((val (dsssl-eval (pop args)))
|
|
|
138 (conditions args)
|
|
|
139 (done nil)
|
|
|
140 (possibles nil)
|
|
|
141 (cur nil))
|
|
|
142 (while (and conditions (not done))
|
|
|
143 (setq cur (pop conditions)
|
|
|
144 possibles (nth 0 cur))
|
|
|
145 (if (or (and (listp possibles)
|
|
|
146 (member val possibles))
|
|
|
147 (equal val possibles)
|
|
|
148 (memq possibles '(default otherwise)))
|
|
|
149 (setq done (dsssl-eval (nth 1 cur)))))
|
|
|
150 done))
|
|
|
151 (equal\?
|
|
|
152 (dsssl-check-args args 2)
|
|
|
153 (equal (dsssl-eval (car args)) (dsssl-eval (cadr args))))
|
|
|
154 (null\?
|
|
|
155 (dsssl-check-args args 1)
|
|
|
156 (null (dsssl-eval (car args))))
|
|
|
157 (list\?
|
|
|
158 (dsssl-check-args args 1)
|
|
|
159 (listp (dsssl-eval (car args))))
|
|
|
160 (list
|
|
|
161 (mapcar 'dsssl-eval args))
|
|
|
162 (length
|
|
|
163 (dsssl-check-args args 1)
|
|
|
164 (length (dsssl-eval (car args))))
|
|
|
165 (append
|
|
|
166 (apply 'append (mapcar 'dsssl-eval args)))
|
|
|
167 (reverse
|
|
|
168 (dsssl-check-args args 1)
|
|
|
169 (reverse (dsssl-eval (car args))))
|
|
|
170 (list-tail
|
|
|
171 (dsssl-check-args args 2)
|
|
|
172 (nthcdr (dsssl-eval (car args)) (dsssl-eval (cadr args))))
|
|
|
173 (list-ref
|
|
|
174 (dsssl-check-args args 2)
|
|
|
175 (nth (dsssl-eval (car args)) (dsssl-eval (cadr args))))
|
|
|
176 (member
|
|
|
177 (dsssl-check-args args 2)
|
|
|
178 (member (dsssl-eval (car args)) (dsssl-eval (cadr args))))
|
|
|
179 (symbol\?
|
|
|
180 (dsssl-check-args args 1)
|
|
|
181 (symbolp (dsssl-eval (car args))))
|
|
|
182 (keyword\?
|
|
|
183 (dsssl-check-args args 1)
|
|
|
184 (keywordp (dsssl-eval (car args))))
|
|
|
185 (quantity\?
|
|
|
186 (dsssl-check-args args 1)
|
|
|
187 (error "%s not implemented yet." func))
|
|
|
188 (number\?
|
|
|
189 (dsssl-check-args args 1)
|
|
|
190 (numberp (dsssl-eval (car args))))
|
|
|
191 (real\?
|
|
|
192 (dsssl-check-args args 1)
|
|
|
193 (let ((rval (dsssl-eval (car args))))
|
|
|
194 (and (numberp rval)
|
|
|
195 (/= (truncate rval) rval))))
|
|
|
196 (integer\?
|
|
|
197 (dsssl-check-args args 1)
|
|
|
198 (let ((rval (dsssl-eval (car args))))
|
|
|
199 (and (numberp rval)
|
|
|
200 (= (truncate rval) rval))))
|
|
|
201 ((= < > <= >=)
|
|
|
202 (dsssl-min-args args 2)
|
|
|
203 (let ((not-done t)
|
|
|
204 (initial (dsssl-eval (car args)))
|
|
|
205 (next nil))
|
|
|
206 (setq args (cdr args))
|
|
|
207 (while (and args not-done)
|
|
|
208 (setq next (dsssl-eval (car args))
|
|
|
209 args (cdr args)
|
|
|
210 not-done (funcall func initial next)
|
|
|
211 initial next))
|
|
|
212 not-done))
|
|
|
213 ((+ *)
|
|
|
214 (dsssl-min-args args 2)
|
|
|
215 (let ((acc (dsssl-eval (car args))))
|
|
|
216 (setq args (cdr args))
|
|
|
217 (while args
|
|
|
218 (setq acc (funcall func acc (dsssl-eval (car args)))
|
|
|
219 args (cdr args)))
|
|
|
220 acc))
|
|
|
221 (-
|
|
|
222 (dsssl-min-args args 1)
|
|
|
223 (apply func (mapcar 'dsssl-eval args)))
|
|
|
224 (/
|
|
|
225 (dsssl-min-args args 1)
|
|
|
226 (if (= (length args) 1)
|
|
|
227 (/ 1 (dsssl-eval (car args)))
|
|
|
228 (apply func (mapcar 'dsssl-eval args))))
|
|
|
229 ((max min)
|
|
|
230 (apply func (mapcar 'dsssl-eval args)))
|
|
|
231 (abs
|
|
|
232 (dsssl-check-args args 1)
|
|
|
233 (abs (dsssl-eval (car args))))
|
|
|
234 (quotient ; FIXME
|
|
|
235 (error "`%s' not implemented yet!" func))
|
|
|
236 (modulo
|
|
|
237 (dsssl-check-args args 2)
|
|
|
238 (mod (dsssl-eval (car args)) (dsssl-eval (cadr args))))
|
|
|
239 (remainder
|
|
|
240 (dsssl-check-args args 2)
|
|
|
241 (% (dsssl-eval (car args)) (dsssl-eval (cadr args))))
|
|
|
242 ((floor ceiling truncate round)
|
|
|
243 (dsssl-check-args args 1)
|
|
|
244 (funcall func (dsssl-eval (car args))))
|
|
|
245 (number->string
|
|
|
246 (dsssl-min-args args 1)
|
|
|
247 (if (= (length args) 1)
|
|
|
248 (number-to-string (dsssl-eval (car args)))
|
|
|
249 (if (= (length args) 2) ; They gave us a radix
|
|
|
250 (error "Radix arg not supported yet.")
|
|
|
251 (dsssl-check-args args 1))))
|
|
|
252 (string->number
|
|
|
253 (dsssl-min-args args 1)
|
|
|
254 (if (= (length args) 1)
|
|
|
255 (string-to-number (dsssl-eval (car args)))
|
|
|
256 (if (= (length args) 2) ; They gave us a radix
|
|
|
257 (error "Radix arg not supported yet.")
|
|
|
258 (dsssl-check-args args 1))))
|
|
|
259 (char\?
|
|
|
260 (dsssl-check-args args 1)
|
|
|
261 (characterp (dsssl-eval (car args))))
|
|
|
262 (char=\?
|
|
|
263 (dsssl-check-args args 2)
|
|
|
264 (char-equal (dsssl-eval (car args)) (dsssl-eval (cadr args))))
|
|
|
265 (char-downcase
|
|
|
266 (dsssl-check-args args 1)
|
|
|
267 (downcase (dsssl-eval (car args))))
|
|
|
268 (char-property ; FIXME
|
|
|
269 (error "`%s' not implemented yet!" func))
|
|
|
270 (string\?
|
|
|
271 (dsssl-check-args args 1)
|
|
|
272 (stringp (dsssl-eval (car args))))
|
|
|
273 (string
|
|
|
274 (dsssl-min-args args 1)
|
|
|
275 (mapconcat 'char-to-string (mapcar 'dsssl-eval args) ""))
|
|
|
276 (string-length
|
|
|
277 (dsssl-check-args args 1)
|
|
|
278 (length (dsssl-eval (car args))))
|
|
|
279 (string-ref
|
|
|
280 (dsssl-check-args args 2)
|
|
|
281 (aref (dsssl-eval (car args)) (dsssl-eval (cadr args))))
|
|
|
282 (string=\?
|
|
|
283 (dsssl-check-args args 2)
|
|
|
284 (string= (dsssl-eval (car args)) (dsssl-eval (cadr args))))
|
|
|
285 (substring
|
|
|
286 (substring (dsssl-eval (pop args))
|
|
|
287 (dsssl-eval (pop args))
|
|
|
288 (dsssl-eval (pop args))))
|
|
|
289 (string-append
|
|
|
290 (let ((rval ""))
|
|
|
291 (while args
|
|
|
292 (setq rval (concat rval (dsssl-eval (pop args)))))
|
|
|
293 rval))
|
|
|
294 (procedure\?
|
|
|
295 (dsssl-check-args args 1)
|
|
|
296 (let* ((sym (dsssl-eval (car args)))
|
|
|
297 (def (cl-gethash sym defines)))
|
|
|
298 (or (memq sym dsssl-builtin-functions)
|
|
|
299 (and def (listp def) (eq (car def) 'lambda)))))
|
|
|
300 (apply ; FIXME
|
|
|
301 )
|
|
|
302 (external-procedure ; FIXME
|
|
|
303 )
|
|
|
304 (make
|
|
|
305 (let* ((type (dsssl-eval (pop args)))
|
|
|
306 (symname nil)
|
|
|
307 (props nil)
|
|
|
308 (tail nil)
|
|
|
309 (children nil)
|
|
|
310 (temp nil)
|
|
|
311 )
|
|
|
312 ;; Massage :children into the last slot
|
|
|
313 (setq props (mapcar 'dsssl-eval args)
|
|
|
314 tail (last props)
|
|
|
315 children (car tail))
|
|
|
316 (if (consp tail)
|
|
|
317 (setcar tail nil))
|
|
|
318 (if (not (car props))
|
|
|
319 (setq props nil))
|
|
|
320 (setq temp (- (length props) 1))
|
|
|
321 ;; Not sure if we should really bother with this or not, but
|
|
|
322 ;; it does at least make it look more common-lispy keywordish
|
|
|
323 ;; and such. DSSSL keywords look like font-weight:, this makes
|
|
|
324 ;; it :font-weight
|
|
|
325 (while (>= temp 0)
|
|
|
326 (setq symname (symbol-name (nth temp props)))
|
|
|
327 (if (string-match "^\\(.*\\):$" symname)
|
|
|
328 (setf (nth temp props)
|
|
|
329 (intern (concat ":" (match-string 1 symname)))))
|
|
|
330 (setq temp (- temp 2)))
|
|
|
331
|
|
|
332 ;; Create the actual flow object
|
|
|
333 (make-flow-object :name type
|
|
|
334 :children children
|
|
|
335 :properties props)
|
|
|
336 )
|
|
|
337 )
|
|
|
338 (time
|
|
|
339 (mapconcat 'int-to-string (current-time) ":"))
|
|
|
340 (time->string
|
|
|
341 (dsssl-check-args args 1)
|
|
|
342 (current-time-string
|
|
|
343 (mapcar 'string-to-int
|
|
|
344 (split-string (dsssl-eval (car args)) ":"))))
|
|
|
345 (quote
|
|
|
346 (dsssl-check-args args 1)
|
|
|
347 (car args))
|
|
|
348 (identity
|
|
|
349 (dsssl-check-args args 1)
|
|
|
350 (dsssl-eval (car args)))
|
|
|
351 (error
|
|
|
352 (apply 'error (mapcar 'dsssl-eval args)))
|
|
|
353 (otherwise
|
|
|
354 ;; A non-built-in function - look it up
|
|
|
355 (let ((def (cl-gethash func defines)))
|
|
|
356 (if (and def (listp def) (eq (car def) 'lambda))
|
|
|
357 (dsssl-call-function def args)
|
|
|
358 (error "Symbol's function definition is void: %s" func))))
|
|
|
359 )
|
|
|
360 )
|
|
|
361 )
|
|
|
362 ((symbolp form) ; A variable
|
|
|
363 ;; A DSSSL keyword!
|
|
|
364 (if (string-match ":$" (symbol-name form))
|
|
|
365 form
|
|
|
366 (let ((val (cl-gethash form defines 'ThIS-Is_A_BOgUs-VariuhhBBLE)))
|
|
|
367 (if (not (eq val 'ThIS-Is_A_BOgUs-VariuhhBBLE))
|
|
|
368 val
|
|
|
369 ;; Ok, we got a bogus variable, but maybe it is really a UNIT
|
|
|
370 ;; dereference. Check.
|
|
|
371 (let ((name (symbol-name form))
|
|
|
372 (the-units nil)
|
|
|
373 (number nil)
|
|
|
374 (conversion nil))
|
|
|
375 (if (not (string-match "^\\([0-9.]+\\)\\([a-zA-Z]+\\)$" name))
|
|
|
376 (error "Symbol's value as variable is void: %s" form)
|
|
|
377 (setq number (string-to-int (match-string 1 name))
|
|
|
378 the-units (intern (downcase (match-string 2 name)))
|
|
|
379 conversion (cl-gethash the-units units))
|
|
|
380 (if (or (not conversion) (not (numberp conversion)))
|
|
|
381 (error "Symbol's value as variable is void: %s" form)
|
|
|
382 (* number conversion))))))))
|
|
|
383 (t
|
|
|
384 form)
|
|
|
385 )
|
|
|
386 )
|
|
|
387
|
|
|
388 (defsubst dsssl-predeclared ()
|
|
|
389 (declare (special defines units))
|
|
|
390 (cl-puthash '\#f nil defines)
|
|
|
391 (cl-puthash 'nil nil defines)
|
|
|
392 (cl-puthash '\#t t defines)
|
|
|
393 ;; NOTE: All units are stored internally as points.
|
|
|
394 (cl-puthash 'in (float 72) units)
|
|
|
395 (cl-puthash 'mm (float (* 72 25.4)) units)
|
|
|
396 (cl-puthash 'cm (float (* 72 2.54)) units)
|
|
|
397 )
|
|
|
398
|
|
|
399 (defun dsssl-parse (buf)
|
|
|
400 ;; Return the full representation of the DSSSL stylesheet as a series
|
|
|
401 ;; of LISP objects.
|
|
|
402 (let ((defines (make-hash-table :size 13))
|
|
|
403 (units (make-hash-table :size 13))
|
|
|
404 (buf-contents nil))
|
|
|
405 (dsssl-predeclared)
|
|
|
406 (save-excursion
|
|
|
407 (setq buf-contents (if (or (bufferp buf) (get-buffer buf))
|
|
|
408 (progn
|
|
|
409 (set-buffer buf)
|
|
|
410 (buffer-string))
|
|
|
411 buf))
|
|
|
412 (set-buffer (generate-new-buffer " *dsssl-style*"))
|
|
|
413 (insert buf-contents)
|
|
|
414 (goto-char (point-min))
|
|
|
415 (skip-chars-forward " \t\n\r")
|
|
|
416 (if (looking-at "<!") ; DOCTYPE present
|
|
|
417 (progn
|
|
|
418 ;; This should _DEFINITELY_ be smarter
|
|
|
419 (search-forward ">" nil t)
|
|
|
420 ))
|
|
|
421 (let ((result nil)
|
|
|
422 (temp nil)
|
|
|
423 (save-pos nil))
|
|
|
424 (while (not (eobp))
|
|
|
425 (condition-case ()
|
|
|
426 (setq save-pos (point)
|
|
|
427 temp (read (current-buffer)))
|
|
|
428 (invalid-read-syntax
|
|
|
429 ;; This disgusting hack is in here so that we can basically
|
|
|
430 ;; extend the lisp reader to gracefully deal with converting
|
|
|
431 ;; DSSSL #\A to Emacs-Lisp ?A notation. If you know of a
|
|
|
432 ;; better way, please feel free to send me some email.
|
|
|
433 (setq temp nil)
|
|
|
434 (backward-char 1)
|
|
|
435 (if (looking-at "#\\\\")
|
|
|
436 (replace-match "?")
|
|
|
437 (insert "\\"))
|
|
|
438 (goto-char save-pos))
|
|
|
439 (error nil))
|
|
|
440 (cond
|
|
|
441 ((null temp)
|
|
|
442 nil)
|
|
|
443 ((listp temp)
|
|
|
444 (case (car temp)
|
|
|
445 (define-unit
|
|
|
446 (cl-puthash (cadr temp) (dsssl-eval (caddr temp))
|
|
|
447 units))
|
|
|
448 (define
|
|
|
449 (if (listp (cadr temp))
|
|
|
450 ;; A function
|
|
|
451 (cl-puthash (caadr temp)
|
|
|
452 (list 'lambda
|
|
|
453 (cdadr temp)
|
|
|
454 (cddr temp)) defines)
|
|
|
455 ;; A normal define
|
|
|
456 (cl-puthash (cadr temp)
|
|
|
457 (dsssl-eval (caddr temp)) defines)))
|
|
|
458 (otherwise
|
|
|
459 (setq result (cons temp result)))))
|
|
|
460 (t
|
|
|
461 (setq result (cons temp result))))
|
|
|
462 (skip-chars-forward " \t\n\r"))
|
|
|
463 (kill-buffer (current-buffer))
|
|
|
464 (list defines units (nreverse result))))))
|
|
|
465
|
|
|
466 (defun dsssl-test (x)
|
|
|
467 (let* ((result (dsssl-parse x))
|
|
|
468 (defines (nth 0 result))
|
|
|
469 (units (nth 1 result))
|
|
|
470 (forms (nth 2 result)))
|
|
|
471 (mapcar 'dsssl-eval forms)))
|
|
|
472
|
|
|
473
|
|
|
474 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
475 ;;; The flow object classes.
|
|
|
476 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
477 (defmacro flow-object-property (obj prop &optional default)
|
|
|
478 "Return property PROP of the DSSSL flow object OBJ.
|
|
|
479 OBJ can be any flow object class, as long as it was properly derived
|
|
|
480 from the base `flow-object' class."
|
|
|
481 (` (plist-get (flow-object-properties (, obj)) (, prop) (, default))))
|
|
|
482
|
|
|
483 ;; Now for specific types of flow objects
|
|
|
484 ;; Still to do:
|
|
|
485 ;;; display-group
|
|
|
486 ;;; paragraph
|
|
|
487 ;;; sequence
|
|
|
488 ;;; line-field
|
|
|
489 ;;; paragraph-break
|
|
|
490 ;;; simple-page-sequence
|
|
|
491 ;;; score
|
|
|
492 ;;; table
|
|
|
493 ;;; table-row
|
|
|
494 ;;; table-cell
|
|
|
495 ;;; rule
|
|
|
496 ;;; external-graphic
|
|
|
497
|
|
|
498
|
|
|
499 (provide 'dsssl)
|
