annotate lisp/w3/dsssl.el @ 134:34a5b81f86ba r20-2b1

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