Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-display.el @ 88:821dec489c24 r20-0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0
author cvs
date Mon, 13 Aug 2007 09:09:59 +0200
parents 364816949b59
children 0d2f883870bc
comparison
equal deleted inserted replaced
87:7df2982f5c17 88:821dec489c24
1 ;;; w3-display.el --- display engine v99999 1 ;;; w3-display.el --- display engine v99999
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/01/26 00:16:07 3 ;; Created: 1997/01/31 04:26:17
4 ;; Version: 1.112 4 ;; Version: 1.115
5 ;; Keywords: faces, help, hypermedia 5 ;; Keywords: faces, help, hypermedia
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
30 (require 'css) 30 (require 'css)
31 (require 'font) 31 (require 'font)
32 (require 'w3-widget) 32 (require 'w3-widget)
33 (require 'w3-imap) 33 (require 'w3-imap)
34 34
35 (autoload 'sentence-ify "flame")
36 (autoload 'string-ify "flame")
37 (autoload '*flame "flame")
38 (if (not (fboundp 'flatten)) (autoload 'flatten "flame"))
39 (defvar w3-cookie-cache nil)
40
35 (defmacro w3-d-s-var-def (var) 41 (defmacro w3-d-s-var-def (var)
36 (` (make-variable-buffer-local (defvar (, var) nil)))) 42 (` (make-variable-buffer-local (defvar (, var) nil))))
37 43
38 (w3-d-s-var-def w3-display-open-element-stack) 44 (w3-d-s-var-def w3-display-open-element-stack)
39 (w3-d-s-var-def w3-display-alignment-stack) 45 (w3-d-s-var-def w3-display-alignment-stack)
53 (w3-d-s-var-def w3-face-font-weight) 59 (w3-d-s-var-def w3-face-font-weight)
54 (w3-d-s-var-def w3-face-font-variant) 60 (w3-d-s-var-def w3-face-font-variant)
55 (w3-d-s-var-def w3-face-font-size) 61 (w3-d-s-var-def w3-face-font-size)
56 (w3-d-s-var-def w3-face-font-family) 62 (w3-d-s-var-def w3-face-font-family)
57 (w3-d-s-var-def w3-face-font-size) 63 (w3-d-s-var-def w3-face-font-size)
64 (w3-d-s-var-def w3-face-font-style)
58 (w3-d-s-var-def w3-face-font-spec) 65 (w3-d-s-var-def w3-face-font-spec)
59 (w3-d-s-var-def w3-face-text-decoration) 66 (w3-d-s-var-def w3-face-text-decoration)
60 (w3-d-s-var-def w3-face-face) 67 (w3-d-s-var-def w3-face-face)
61 (w3-d-s-var-def w3-face-descr) 68 (w3-d-s-var-def w3-face-descr)
62 (w3-d-s-var-def w3-face-pixmap) 69 (w3-d-s-var-def w3-face-pixmap)
77 84
78 (defmacro w3-get-all-face-info () 85 (defmacro w3-get-all-face-info ()
79 (` 86 (`
80 (progn 87 (progn
81 (w3-get-face-info font-family) 88 (w3-get-face-info font-family)
89 (w3-get-face-info font-style)
82 (w3-get-face-info font-weight) 90 (w3-get-face-info font-weight)
83 (w3-get-face-info font-variant) 91 (w3-get-face-info font-variant)
84 (w3-get-face-info font-size) 92 (w3-get-face-info font-size)
85 (w3-get-face-info text-decoration) 93 (w3-get-face-info text-decoration)
86 ;;(w3-get-face-info pixmap) 94 ;;(w3-get-face-info pixmap)
96 (progn 104 (progn
97 (w3-pop-face-info font-family) 105 (w3-pop-face-info font-family)
98 (w3-pop-face-info font-weight) 106 (w3-pop-face-info font-weight)
99 (w3-pop-face-info font-variant) 107 (w3-pop-face-info font-variant)
100 (w3-pop-face-info font-size) 108 (w3-pop-face-info font-size)
109 (w3-pop-face-info font-style)
101 (w3-pop-face-info text-decoration) 110 (w3-pop-face-info text-decoration)
102 ;;(w3-pop-face-info pixmap) 111 ;;(w3-pop-face-info pixmap)
103 (w3-pop-face-info color) 112 (w3-pop-face-info color)
104 (w3-pop-face-info background-color)))) 113 (w3-pop-face-info background-color))))
105 114
230 (set-font-style-by-keywords w3-face-font-spec 239 (set-font-style-by-keywords w3-face-font-spec
231 (car w3-face-text-decoration))) 240 (car w3-face-text-decoration)))
232 (if w3-face-font-variant 241 (if w3-face-font-variant
233 (set-font-style-by-keywords w3-face-font-spec 242 (set-font-style-by-keywords w3-face-font-spec
234 (car w3-face-font-variant))) 243 (car w3-face-font-variant)))
244 (if w3-face-font-style
245 (set-font-style-by-keywords w3-face-font-spec
246 (car w3-face-font-style)))
235 (setq w3-face-descr (list w3-face-font-spec 247 (setq w3-face-descr (list w3-face-font-spec
236 (car w3-face-color) 248 (car w3-face-color)
237 (car w3-face-background-color)) 249 (car w3-face-background-color))
238 w3-face-face (cdr-safe (assoc w3-face-descr w3-face-cache))) 250 w3-face-face (cdr-safe (assoc w3-face-descr w3-face-cache)))
239 (if (or w3-face-face (not (or (car w3-face-color) 251 (if (or w3-face-face (not (or (car w3-face-color)
356 (point) (list 'face w3-active-faces 'duplicable t)) 368 (point) (list 'face w3-active-faces 'duplicable t))
357 (if (car w3-active-voices) 369 (if (car w3-active-voices)
358 (add-text-properties w3-scratch-start-point (point) 370 (add-text-properties w3-scratch-start-point (point)
359 (list 'personality (car w3-active-voices)))) 371 (list 'personality (car w3-active-voices))))
360 ) 372 )
373
374 (defun w3-display-get-cookie (args)
375 (if (not (fboundp 'cookie))
376 "Sorry, no cookies today."
377 (let* ((href (or (w3-get-attribute 'href) (w3-get-attribute 'src)))
378 (fname (or (cdr-safe (assoc href w3-cookie-cache))
379 (url-generate-unique-filename "%s.cki")))
380 (st (or (cdr-safe (assq 'start args)) "Loading cookies..."))
381 (nd (or (cdr-safe (assq 'end args)) "Loading cookies... done.")))
382 (if (not (file-exists-p fname))
383 (save-excursion
384 (set-buffer (generate-new-buffer " *cookie*"))
385 (url-insert-file-contents href)
386 (write-region (point-min) (point-max) fname 5)
387 (setq w3-cookie-cache (cons (cons href fname) w3-cookie-cache))))
388 (cookie fname st nd))))
361 389
362 (defun w3-widget-echo (widget &rest ignore) 390 (defun w3-widget-echo (widget &rest ignore)
363 (let ((url (widget-get widget 'href)) 391 (let ((url (widget-get widget 'href))
364 (name (widget-get widget 'name)) 392 (name (widget-get widget 'name))
365 (text (buffer-substring (widget-get widget :from) 393 (text (buffer-substring (widget-get widget :from)
695 (base (w3-get-attribute 'base)) 723 (base (w3-get-attribute 'base))
696 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href))) 724 (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href)))
697 (widget nil) 725 (widget nil)
698 (align (or (w3-get-attribute 'align) 726 (align (or (w3-get-attribute 'align)
699 (w3-get-style-info 'vertical-align node)))) 727 (w3-get-style-info 'vertical-align node))))
700 (setq widget (widget-create 'image 728 (if (assq '*table-autolayout w3-display-open-element-stack)
701 :value-face w3-active-faces 729 (insert alt)
702 'src src ; Where to load the image from 730 (setq widget (widget-create 'image
703 'alt alt ; Textual replacement 731 :value-face w3-active-faces
704 'ismap ismap ; Is it a server-side map? 732 'src src ; Where to load the image from
705 'usemap usemap ; Is it a client-side map? 733 'alt alt ; Textual replacement
706 'href href ; Hyperlink destination 734 'ismap ismap ; Is it a server-side map?
707 )) 735 'usemap usemap ; Is it a client-side map?
708 (widget-put widget 'buffer (current-buffer)) 736 'href href ; Hyperlink destination
709 (w3-maybe-start-image-download widget) 737 ))
710 (goto-char (point-max))))) 738 (widget-put widget 'buffer (current-buffer))
739 (w3-maybe-start-image-download widget)
740 (goto-char (point-max))))))
711 741
712 ;; The table handling 742 ;; The table handling
713 743
714 (defvar w3-display-table-cut-words-p nil 744 (defvar w3-display-table-cut-words-p nil
715 "*Whether to cut words that are oversized in table cells") 745 "*Whether to cut words that are oversized in table cells")
1858 (style 1888 (style
1859 (w3-handle-style (alist-to-plist 1889 (w3-handle-style (alist-to-plist
1860 (cons (cons 'data (apply 'concat (nth 2 node))) 1890 (cons (cons 'data (apply 'concat (nth 2 node)))
1861 (nth 1 node)))) 1891 (nth 1 node))))
1862 (w3-handle-empty-tag)) 1892 (w3-handle-empty-tag))
1893 ;; Emacs-W3 stuff that cannot be expressed in a stylesheet
1894 (pinhead
1895 ;; This check is so that we don't screw up table auto-layout
1896 ;; by changing our text midway through the parse/layout/display
1897 ;; steps.
1898 (if (nth 2 node)
1899 nil
1900 (setcar (cddr node)
1901 (list
1902 (if (fboundp 'yow)
1903 (yow)
1904 "AIEEEEE! I am having an UNDULATING EXPERIENCE!"))))
1905 (w3-handle-content node))
1906 (flame
1907 (if (nth 2 node)
1908 nil
1909 (setcar
1910 (cddr node)
1911 (list
1912 (condition-case ()
1913 (concat
1914 (sentence-ify
1915 (string-ify
1916 (append-suffixes-hack (flatten (*flame))))))
1917 (error
1918 "You know, everything is really a graphics editor.")))))
1919 (w3-handle-content node))
1920 (cookie
1921 (if (nth 2 node)
1922 nil
1923 (setcar
1924 (cddr node)
1925 (list
1926 (w3-display-get-cookie args))))
1927 (w3-handle-content node))
1928 ;; Generic formatting - all things that can be fully specified
1929 ;; by a CSS stylesheet.
1863 (otherwise 1930 (otherwise
1864 ;; Generic formatting
1865 (w3-handle-content node)) 1931 (w3-handle-content node))
1866 ) ; case tag 1932 ) ; case tag
1867 ) ; stringp content 1933 ) ; stringp content
1868 ) ; while content 1934 ) ; while content
1869 ) ; while content-stack 1935 ) ; while content-stack