Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-style.el @ 80:1ce6082ce73f r20-0b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b90
author cvs
date Mon, 13 Aug 2007 09:06:37 +0200
parents 131b0175ea99
children 6a378aca36af
comparison
equal deleted inserted replaced
79:5b0a5bbffab6 80:1ce6082ce73f
1 ;;; w3-style.el --- Emacs-W3 binding style sheet mechanism 1 ;;; w3-style.el --- Emacs-W3 binding style sheet mechanism
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1996/08/12 03:10:30 3 ;; Created: 1996/12/13 18:01:46
4 ;; Version: 1.13 4 ;; Version: 1.23
5 ;; Keywords: faces, hypermedia 5 ;; Keywords: faces, hypermedia
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996 Free Software Foundation, Inc.
9 ;;; 10 ;;;
10 ;;; This file is not part of GNU Emacs, but the same permissions apply. 11 ;;; This file is part of GNU Emacs.
11 ;;; 12 ;;;
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify 13 ;;; 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 ;;; 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 ;;; the Free Software Foundation; either version 2, or (at your option)
15 ;;; any later version. 16 ;;; any later version.
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details. 21 ;;; GNU General Public License for more details.
21 ;;; 22 ;;;
22 ;;; You should have received a copy of the GNU General Public License 23 ;;; 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 24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;;; Boston, MA 02111-1307, USA.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 28
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;;; A style sheet mechanism for emacs-w3 30 ;;; A style sheet mechanism for emacs-w3
29 ;;; 31 ;;;
31 ;;; experimental W3C mechanism 33 ;;; experimental W3C mechanism
32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 (require 'font) 35 (require 'font)
34 (require 'w3-keyword) 36 (require 'w3-keyword)
35 (require 'cl) 37 (require 'cl)
36 38 (require 'css)
37 (defvar w3-style-css-syntax-table
38 (copy-syntax-table mm-parse-args-syntax-table)
39 "The syntax table for parsing stylesheets")
40
41 (defvar w3-style-ie-compatibility nil
42 "*Whether we want to do Internet Explorer 3.0 compatible parsing of
43 CSS stylesheets.")
44
45 (defun w3-style-css-parse-args (st &optional nd defines)
46 ;; Return an assoc list of attribute/value pairs from a CSS style entry
47 (let (
48 name ; From name=
49 value ; its value
50 results ; Assoc list of results
51 name-pos ; Start of XXXX= position
52 val-pos ; Start of value position
53 )
54 (save-excursion
55 (if (stringp st)
56 (progn
57 (set-buffer (get-buffer-create " *w3-style-temp*"))
58 (set-syntax-table w3-style-css-syntax-table)
59 (erase-buffer)
60 (insert st)
61 (setq st (point-min)
62 nd (point-max)))
63 (set-syntax-table w3-style-css-syntax-table))
64 (save-restriction
65 (if (< nd st)
66 (narrow-to-region nd nd)
67 (narrow-to-region st nd))
68 (goto-char (point-min))
69 (while (not (eobp))
70 (skip-chars-forward ";, \n\t")
71 (setq name-pos (point))
72 (skip-chars-forward "^ \n\t:=,;")
73 (downcase-region name-pos (point))
74 (setq name (buffer-substring name-pos (point)))
75 (skip-chars-forward " \t\n")
76 (if (not (eq (char-after (point)) ?:)) ; There is no value
77 (setq value nil)
78 (skip-chars-forward " \t\n:")
79 (setq val-pos (point)
80 value
81 (cond
82 ((or (= (or (char-after val-pos) 0) ?\")
83 (= (or (char-after val-pos) 0) ?'))
84 (buffer-substring (1+ val-pos)
85 (condition-case ()
86 (prog2
87 (forward-sexp 1)
88 (1- (point))
89 (skip-chars-forward "\""))
90 (error
91 (skip-chars-forward "^ \t\n")
92 (point)))))
93 (t
94 (buffer-substring val-pos
95 (progn
96 (if w3-style-ie-compatibility
97 (skip-chars-forward "^;")
98 (skip-chars-forward "^,;"))
99 (skip-chars-backward " \t")
100 (point)))))))
101 (setq results (cons (cons name value) results))
102 (skip-chars-forward ";, \n\t"))
103 results))))
104
105 (defvar w3-style-css-define-table nil)
106
107 (defun w3-style-css-handle-define ()
108 (let ((name nil)
109 (save-pos (point))
110 (retval nil))
111 (skip-chars-forward "^ \t\r\n") ; Past the name token
112 (downcase-region save-pos (point))
113 (setq name (buffer-substring save-pos (point)))
114 (skip-chars-forward "= \t\r")
115 (setq save-pos (point))
116 (skip-chars-forward "^;")
117 (setq retval (cons name (buffer-substring save-pos (point))))
118 (skip-chars-forward " \t\r\n")
119 retval))
120
121 (defun w3-style-css-handle-import ()
122 (let ((url nil)
123 (save-pos (point)))
124 (if (looking-at "'\"")
125 (condition-case ()
126 (forward-sexp 1)
127 (error (skip-chars-forward "^ \t\r\n;")))
128 (skip-chars-forward "^ \t\r\n;"))
129 (setq url (url-expand-file-name (buffer-substring save-pos (point))))
130 (skip-chars-forward "\"; \t\r\n")
131 (setq save-pos (point))
132 (let ((url-working-buffer (url-generate-new-buffer-name " *styleimport*"))
133 (url-mime-accept-string
134 "text/css ; level=2")
135 (sheet nil))
136 (save-excursion
137 (set-buffer (get-buffer-create url-working-buffer))
138 (setq url-be-asynchronous nil)
139 (url-retrieve url)
140 (w3-style-css-clean)
141 (setq sheet (buffer-string))
142 (set-buffer-modified-p nil)
143 (kill-buffer (current-buffer)))
144 (insert sheet)
145 (goto-char save-pos))))
146
147 (defun w3-style-css-clean ()
148 ;; Nuke comments, etc.
149 (goto-char (point-min))
150 (let ((save-pos nil))
151 (while (search-forward "/*" nil t)
152 (setq save-pos (- (point) 2))
153 (delete-region save-pos
154 (if (search-forward "*/" nil t)
155 (point)
156 (end-of-line)
157 (point)))))
158 (goto-char (point-min))
159 (delete-matching-lines "^[ \t\r]*$") ; Nuke blank lines
160 (w3-replace-regexp "^[ \t\r]+" "") ; Nuke whitespace at beg. of line
161 (w3-replace-regexp "[ \t\r]+$" "") ; Nuke whitespace at end of line
162 (goto-char (point-min)))
163
164 (defun w3-style-css-applies-to (st nd)
165 (let ((results nil)
166 (save-pos nil))
167 (narrow-to-region st nd)
168 (goto-char st)
169 (skip-chars-forward " \t\r\n")
170 (while (not (eobp))
171 (setq save-pos (point))
172 (skip-chars-forward "^,")
173 (skip-chars-backward " \r\t\n")
174 (setq results (cons (buffer-substring save-pos (point)) results))
175 (skip-chars-forward ", \t\r\n"))
176 (widen)
177 results))
178
179 (defun w3-style-active-device-types (&optional device)
180 (let ((types (list 'normal 'default (if w3-running-xemacs 'xemacs 'emacs)))
181 (type (device-type device)))
182 (cond
183 ((featurep 'emacspeak)
184 (setq types (cons 'speech types)))
185 ((eq type 'tty)
186 (if (and (fboundp 'tty-color-list)
187 (/= 0 (length (tty-color-list))))
188 (setq types (cons 'ansi-tty types))
189 (setq types (cons 'tty types))))
190 ((eq 'color (device-class))
191 (if (not (device-bitplanes))
192 (setq types (cons 'color types))
193 (setq types
194 (append
195 (list (intern (format "%dbit-color"
196 (device-bitplanes)))
197 (intern (format "%dbit"
198 (device-bitplanes)))
199 'color) types))
200 (if (= 24 (device-bitplanes))
201 (setq types (cons 'truecolor types)))))
202 ((eq 'grayscale (device-class))
203 (setq types (append (list (intern (format "%dbit-grayscale"
204 (device-bitplanes)))
205 'grayscale)
206 types)))
207 ((eq 'mono (device-class))
208 (setq types (append (list 'mono 'monochrome) types)))
209 (t
210 (setq types (cons 'unknown types))))
211 types))
212
213 (defun w3-style-parse-css (fname &optional string inherit)
214 (let (
215 (url-mime-accept-string
216 "text/css ; level=2")
217 (save-pos nil)
218 (applies-to nil) ; List of tags to apply style to
219 (attrs nil) ; List of name/value pairs
220 (tag nil)
221 (att nil)
222 (cur nil)
223 (val nil)
224 (class nil)
225 (defines nil)
226 (device-type nil)
227 (active-device-types (w3-style-active-device-types (selected-device)))
228 (sheet inherit))
229 (save-excursion
230 (set-buffer (get-buffer-create
231 (url-generate-new-buffer-name " *style*")))
232 (set-syntax-table w3-style-css-syntax-table)
233 (erase-buffer)
234 (if fname (url-insert-file-contents fname))
235 (goto-char (point-max))
236 (if string (insert string))
237 (w3-style-css-clean)
238 (goto-char (point-min))
239 (while (not (eobp))
240 (setq save-pos (point))
241 (cond
242 ;; *sigh* SGML comments are being used to 'hide' data inlined
243 ;; with the <style> tag from older browsers.
244 ((or (looking-at "<!--+") ; begin
245 (looking-at "--+>")) ; end
246 (goto-char (match-end 0)))
247 ;; C++ style comments, and we are doing IE compatibility
248 ((and (looking-at "//") w3-style-ie-compatibility)
249 (end-of-line))
250 ;; Pre-Processor directives
251 ((looking-at "[ \t\r]*@\\([^ \t\r\n]\\)")
252 (let ((directive nil))
253 (skip-chars-forward " @\t\r") ; Past any leading whitespace
254 (setq save-pos (point))
255 (skip-chars-forward "^ \t\r\n") ; Past the @ directive
256 (downcase-region save-pos (point))
257 (setq directive (buffer-substring save-pos (point)))
258 (skip-chars-forward " \t\r") ; Past any trailing whitespace
259 (setq save-pos (point))
260 (cond
261 ((string= directive "define")
262 (let ((retval (w3-style-css-handle-define)))
263 (and defines
264 (setq defines (cons retval defines)))))
265 ((string= directive "import")
266 (w3-style-css-handle-import))
267 (t
268 (w3-warn 'style (format "Unknown directive: @%s" directive)
269 'warning)))))
270 ;; Giving us some output device information
271 ((looking-at "[ \t\r]*:\\([^: \n]+\\):")
272 (downcase-region (match-beginning 1) (match-end 1))
273 (setq device-type (intern (buffer-substring (match-beginning 1)
274 (match-end 1))))
275 (goto-char (match-end 0))
276 (if (not (memq device-type active-device-types))
277 ;; Not applicable to us... skip the info
278 (progn
279 (if (re-search-forward ":[^:{ ]*:" nil t)
280 (goto-char (match-beginning 0))
281 (goto-char (point-max))))))
282 ;; Default is to treat it like a stylesheet declaration
283 (t
284 (skip-chars-forward "^{")
285 ;;(downcase-region save-pos (point))
286 (setq applies-to (w3-style-css-applies-to save-pos (point)))
287 (skip-chars-forward "^{")
288 (setq save-pos (point))
289 (forward-sexp 1)
290 (end-of-line)
291 (skip-chars-backward "\r}")
292 (subst-char-in-region save-pos (point) ?\n ? )
293 (subst-char-in-region save-pos (point) ?\r ? )
294 (setq attrs (w3-style-css-parse-args (1+ save-pos)
295 (point) defines))
296 (skip-chars-forward "}\r\n")
297 (while applies-to
298 (setq cur (car applies-to)
299 applies-to (cdr applies-to))
300 (cond
301 ((string-match "\\([^.]*\\)\\.\\(.*\\)" cur) ; Normal class
302 (setq tag (intern (downcase (match-string 1 cur)))
303 class (match-string 2 cur)))
304 ((string-match "\\(.*\\):\\(.*\\)" cur) ; Pseudo class
305 (setq tag (intern (downcase (match-string 1 cur)))
306 class (match-string 2 cur)))
307 (t ; No class - global
308 (setq tag (intern (downcase cur))
309 class 'internal)))
310 (let ((loop attrs))
311 (while loop
312 (if (stringp (car (car loop)))
313 (setcar (car loop) (intern (car (car loop)))))
314 (setq att (car (car loop))
315 val (cdr (car loop))
316 loop (cdr loop))
317 (case att
318 ((align textalign text-align display white-space)
319 (setq val (intern (downcase val))))
320 ((indent left-margin right-margin top-margin bottom-margin)
321 (setq val (string-to-int val)))
322 (otherwise
323 nil))
324 (let* ((node-1 (assq tag sheet))
325 (node-2 (and node-1 (assoc class node-1)))
326 (node-3 (and node-2 (assq att node-2))))
327 (cond
328 ((not node-1) ; New top-level element
329 (setq sheet (cons (cons tag (list (cons class
330 (list
331 (cons att val)))))
332 sheet)))
333 ((and node-1 (not node-2)) ; New class for existing element
334 (setcdr node-1 (cons (cons class (list (cons att val)))
335 (cdr node-1))))
336 ((and node-2 (not node-3)) ; attribute/value on old class
337 (setcdr node-2 (cons (cons att val) (cdr node-2))))
338 (node-3 ; Replace existing attribute value
339 (setcdr node-3 val)))))))))
340 (skip-chars-forward " \t\r\n"))
341 (set-buffer-modified-p nil)
342 (kill-buffer (current-buffer)))
343 (cons sheet defines)))
344 39
345 40
346 (defvar w3-style-font-size-mappings
347 '(("xx-small" . 0)
348 ("x-small" . 1)
349 ("small" . 2)
350 ("medium" . 3)
351 ("large" . 4)
352 ("x-large" . 5)
353 ("xx-large" . 6)
354 )
355 "A list of font size mappings")
356
357 (defvar w3-style-font-weight-mappings
358 '(("-3" . :extra-light)
359 ("-2" . :light)
360 ("-1" . :demi-light)
361 ("0" . :medium)
362 ("1" . :normal)
363 ("2" . :demi-bold)
364 ("3" . :bold)
365 ("4" . :extrabold)
366 ("bold" . :bold)
367 ("demi-light" . :demi-light)
368 ("demi-bold" . :demi-bold)
369 ("extra-bold" . :extra-bold)
370 ("extra-light". :extra-light)
371 )
372 "A list of font weight mappings.")
373
374 (defun w3-style-font-size-for-index (index)
375 (if (stringp index)
376 (setq index (or
377 (cdr-safe (assoc (downcase index)
378 w3-style-font-size-mappings))
379 3)))
380 (setq index (- index 3))
381 (let ((scaler (if (> index 0)
382 1.44
383 0.695))
384 (size 12))
385 (setq index (abs index))
386 (while (/= index 0)
387 (setq size (* size scaler)
388 index (1- index)))
389 ;; This rounds to the nearest '10'
390 (format "%dpt" (* 10 (round (/ size 10))))))
391
392 (defsubst w3-style-speech-normalize-number (num)
393 (if num (% (abs (read num)) 9)))
394
395 (defun w3-generate-stylesheet-voices (sheet)
396 (let ((todo sheet)
397 cur cur-classes
398 node family gain
399 left right pitch
400 pitch-range stress
401 richness voice
402 )
403 (while todo
404 (setq cur (car todo)
405 cur-classes (cdr cur)
406 todo (cdr todo))
407 (while cur-classes
408 (setq node (cdr (car cur-classes))
409 cur (car cur-classes)
410 cur-classes (cdr cur-classes)
411 family (cdr-safe (assq 'voice-family node))
412 family (if family (intern (downcase family)))
413 gain (w3-style-speech-normalize-number
414 (cdr-safe (assq 'gain node)))
415 left (w3-style-speech-normalize-number
416 (cdr-safe (assq 'left-volume node)))
417 right (w3-style-speech-normalize-number
418 (cdr-safe (assq 'right-volume node)))
419 pitch (w3-style-speech-normalize-number
420 (cdr-safe (assq 'pitch node)))
421 pitch-range (w3-style-speech-normalize-number
422 (cdr-safe (assq 'pitch-range node)))
423 stress (w3-style-speech-normalize-number
424 (cdr-safe (assq 'stress node)))
425 richness (w3-style-speech-normalize-number
426 (cdr-safe (assq 'richness node))))
427 (if (or family gain left right pitch pitch-range stress richness)
428 (setq voice (dtk-personality-from-speech-style
429 (make-dtk-speech-style :family (or family 'paul)
430 :gain (or gain 5)
431 :left-volume (or left 5)
432 :right-volume (or right 5)
433 :average-pitch (or pitch 5)
434 :pitch-range (or pitch-range 5)
435 :stress (or stress 5)
436 :richness (or richness 5))))
437 (setq voice nil))
438 (if voice (setcdr cur (cons (cons 'voice-spec voice) (cdr cur))))
439 )
440 )
441 )
442 )
443
444 (defun w3-style-post-process-stylesheet (sheet)
445 (w3-generate-stylesheet-faces sheet)
446 (if (featurep 'emacspeak)
447 (w3-generate-stylesheet-voices w3-user-stylesheet)))
448
449 (defun w3-style-css-split-font-shorthand (font)
450 ;; [<font-weight> || <font-style>]? <font-size> [ / <line-height> ]? <font-family>
451 (let (weight size height family)
452 (if (not (string-match " *\\([0-9.]+[^ /]+\\)" font))
453 (error "Malformed font shorthand: %s" font))
454 (setq weight (if (/= 0 (match-beginning 0))
455 (substring font 0 (match-beginning 0)))
456 size (match-string 1 font)
457 font (substring font (match-end 0) nil))
458 (if (string-match " */ *\\([^ ]+\\) *" font)
459 ;; they specified a line-height as well
460 (setq height (match-string 1 font)
461 family (substring font (match-end 0) nil))
462 (setq family (url-strip-leading-spaces font)))
463 (list weight size height family)))
464
465 (defun w3-generate-stylesheet-faces (sheet)
466 (let ((todo sheet)
467 (cur nil)
468 (cur-classes nil)
469 (node nil)
470 (fore nil)
471 (back nil)
472 (pixmap nil)
473 (font nil)
474 (family nil)
475 (decoration nil)
476 (style nil)
477 (size nil)
478 (index nil)
479 (shorthand nil)
480 (weight nil)
481 (break-style nil))
482 (while todo
483 (setq cur (car todo)
484 cur-classes (cdr cur)
485 todo (cdr todo))
486 (while cur-classes
487 (setq node (cdr (car cur-classes))
488 cur (car cur-classes)
489 cur-classes (cdr cur-classes)
490 fore (cdr-safe (assq 'color node))
491 back (cdr-safe (assq 'background node))
492 decoration (cdr-safe (assq 'text-decoration node))
493 pixmap (cdr-safe (assq 'backdrop node))
494 index (cdr-safe (assq 'font-size-index node))
495 size (or (and index (w3-style-font-size-for-index index))
496 (cdr-safe (assq 'font-size node)))
497 family (cdr-safe (assq 'font-family node))
498 weight (cdr-safe (assq 'font-weight node))
499 weight (or (cdr-safe (assoc weight
500 w3-style-font-weight-mappings))
501 weight)
502 style (cdr-safe (assq 'font-style node))
503 shorthand (cdr-safe (assq 'font node)))
504
505 ;; Make sure all 'break' items get intern'd
506 (if (or style decoration)
507 (setq style (concat style decoration)))
508 (setq break-style (assq 'break node))
509 (if (and (cdr break-style) (stringp (cdr break-style)))
510 (setcdr break-style (intern (cdr break-style))))
511 (if shorthand
512 (progn
513 (setq shorthand (w3-style-css-split-font-shorthand shorthand))
514 (setq weight (or (nth 0 shorthand) weight)
515 size (or (nth 1 shorthand) size)
516 family (or (nth 3 shorthand) family)
517 weight (or (cdr-safe
518 (assoc weight
519 w3-style-font-weight-mappings))
520 weight))))
521 (if style
522 (setq style (mapcar
523 (function
524 (lambda (x)
525 (while (string-match "-" x)
526 (setq x (concat
527 (substring x 0 (match-beginning 0))
528 (substring x (match-end 0) nil))))
529 (intern-soft
530 (concat "font-set-" (downcase x) "-p"))))
531 (delete "" (split-string style "[ \t&,]")))))
532 (if family (setq family (delete "" (split-string family ","))))
533 (if (or family weight style size)
534 (progn
535 (setq font (make-font :family family :weight weight :size size))
536 (while style
537 (and (fboundp (car style))
538 (funcall (car style) font t))
539 (setq style (cdr style))))
540 (setq font nil))
541 (if font (setcdr cur (cons (cons 'font-spec font) (cdr cur))))
542 (if fore (setcdr cur (cons (cons 'foreground fore) (cdr cur))))
543 (if back (setcdr cur (cons (cons 'background back) (cdr cur))))
544 )
545 )
546 )
547 )
548 41
549 (defun w3-handle-style (&optional args) 42 (defun w3-handle-style (&optional args)
550 (let ((fname (or (cdr-safe (assq 'href args)) 43 (let ((fname (or (cdr-safe (assq 'href args))
551 (cdr-safe (assq 'src args)) 44 (cdr-safe (assq 'src args))
552 (cdr-safe (assq 'uri args)))) 45 (cdr-safe (assq 'uri args))))
564 (save-excursion 57 (save-excursion
565 (set-buffer (get-buffer-create url-working-buffer)) 58 (set-buffer (get-buffer-create url-working-buffer))
566 (erase-buffer) 59 (erase-buffer)
567 (setq url-be-asynchronous nil) 60 (setq url-be-asynchronous nil)
568 (cond 61 (cond
569 ((member type '("experimental" "arena" "w3c-style" "css")) 62 ((member type '("experimental" "arena" "w3c-style" "css" "text/css"))
570 (let ((data (w3-style-parse-css fname string cur-sheet))) 63 (setq stylesheet (css-parse fname string cur-sheet)))
571 (setq stylesheet (nth 0 data)
572 defines (nth 1 data))))
573 (t 64 (t
574 (w3-warn 'html "Unknown stylesheet notation: %s" type)))) 65 (w3-warn 'html "Unknown stylesheet notation: %s" type))))
575 (setq w3-current-stylesheet stylesheet) 66 (setq w3-current-stylesheet stylesheet)
576 (w3-style-post-process-stylesheet w3-current-stylesheet))) 67 )
68 )
577 69
578 (defun w3-display-stylesheet (&optional sheet) 70 (defun w3-display-stylesheet (&optional sheet)
579 (interactive) 71 (interactive)
580 (if (not sheet) (setq sheet w3-current-stylesheet)) 72 (if (not sheet) (setq sheet w3-current-stylesheet))
581 (with-output-to-temp-buffer "W3 Stylesheet" 73 (css-display sheet))
582 (set-buffer standard-output)
583 (emacs-lisp-mode)
584 (require 'pp)
585 (pp sheet (current-buffer))))
586 74
587 (provide 'w3-style) 75 (provide 'w3-style)