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