Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-style.el @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 9ee227acff29
children 131b0175ea99
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
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/12/13 18:01:46 3 ;; Created: 1997/01/17 14:27:39
4 ;; Version: 1.23 4 ;; Version: 1.25
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 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
10 ;;; 10 ;;;
11 ;;; This file is part of GNU Emacs. 11 ;;; This file is part of GNU Emacs.
12 ;;; 12 ;;;
13 ;;; 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
14 ;;; 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
37 (require 'cl) 37 (require 'cl)
38 (require 'css) 38 (require 'css)
39 39
40 40
41 41
42 (defun w3-handle-style (&optional args) 42 (defun w3-handle-style (&optional plist)
43 (let ((fname (or (cdr-safe (assq 'href args)) 43 (let ((url (or (plist-get plist 'href)
44 (cdr-safe (assq 'src args)) 44 (plist-get plist 'src)
45 (cdr-safe (assq 'uri args)))) 45 (plist-get plist 'uri)))
46 (type (downcase (or (cdr-safe (assq 'notation args)) 46 (media (intern (downcase (or (plist-get plist 'media) "all"))))
47 "experimental"))) 47 (type (downcase (or (plist-get plist 'notation) "text/css")))
48 (url-working-buffer " *style*") 48 (url-working-buffer " *style*")
49 (base (cdr-safe (assq 'base args)))
50 (stylesheet nil) 49 (stylesheet nil)
51 (defines nil) 50 (defines nil)
52 (cur-sheet w3-current-stylesheet) 51 (cur-sheet w3-current-stylesheet)
53 (string (cdr-safe (assq 'data args)))) 52 (string (plist-get plist 'data)))
54 (if fname (setq fname (url-expand-file-name fname 53 (if (not (memq media (css-active-device-types)))
55 (cdr-safe 54 nil ; Not applicable to us!
56 (assoc base w3-base-alist))))) 55 (save-excursion
57 (save-excursion 56 (set-buffer (get-buffer-create url-working-buffer))
58 (set-buffer (get-buffer-create url-working-buffer)) 57 (erase-buffer)
59 (erase-buffer) 58 (setq url-be-asynchronous nil)
60 (setq url-be-asynchronous nil) 59 (cond
61 (cond 60 ((member type '("experimental" "arena" "w3c-style" "css" "text/css"))
62 ((member type '("experimental" "arena" "w3c-style" "css" "text/css")) 61 (setq stylesheet (css-parse url string cur-sheet)))
63 (setq stylesheet (css-parse fname string cur-sheet))) 62 (t
64 (t 63 (w3-warn 'html "Unknown stylesheet notation: %s" type))))
65 (w3-warn 'html "Unknown stylesheet notation: %s" type)))) 64 (setq w3-current-stylesheet stylesheet))))
66 (setq w3-current-stylesheet stylesheet)
67 )
68 )
69 65
70 (defun w3-display-stylesheet (&optional sheet) 66 (defun w3-display-stylesheet (&optional sheet)
71 (interactive) 67 (interactive)
72 (if (not sheet) (setq sheet w3-current-stylesheet)) 68 (if (not sheet) (setq sheet w3-current-stylesheet))
73 (css-display sheet)) 69 (css-display sheet))