|
2
|
1 ;;; w3-draw.el --- Emacs-W3 drawing functions for new display engine
|
|
0
|
2 ;; Author: wmperry
|
|
2
|
3 ;; Created: 1996/08/25 17:12:32
|
|
|
4 ;; Version: 1.17
|
|
0
|
5 ;; Keywords: faces, help, hypermedia
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2
|
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
0
|
9 ;;;
|
|
|
10 ;;; This file is not part of GNU Emacs, but the same permissions apply.
|
|
|
11 ;;;
|
|
|
12 ;;; 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 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;;; any later version.
|
|
|
16 ;;;
|
|
|
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
20 ;;; GNU General Public License for more details.
|
|
|
21 ;;;
|
|
|
22 ;;; 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 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
26
|
|
|
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2
|
28 ;;; This function will take a stream of HTML from w3-parse-buffer
|
|
0
|
29 ;;; and draw it out
|
|
|
30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
31
|
|
|
32 (require 'w3-vars)
|
|
|
33 (require 'w3-imap)
|
|
|
34 (require 'w3-widget)
|
|
|
35 (require 'widget)
|
|
|
36 (require 'cl)
|
|
|
37
|
|
|
38 (if (featurep 'mule) (fset 'string-width 'length))
|
|
|
39
|
|
|
40 (defmacro w3-get-state (tag)
|
|
|
41 (or (symbolp tag)
|
|
|
42 (error "Bad argument: %s" tag))
|
|
|
43 (let ((index (length (memq tag w3-state-locator-variable))))
|
|
|
44 (` (aref w3-state-vector (, index)))))
|
|
|
45 (put 'w3-get-state 'edebug-form-spec '(symbolp))
|
|
|
46
|
|
|
47 (defmacro w3-put-state (tag val)
|
|
|
48 (or (symbolp tag)
|
|
|
49 (error "Bad argument: %s" tag))
|
|
|
50 (let ((index (length (memq tag w3-state-locator-variable))))
|
|
|
51 (` (aset w3-state-vector (, index) (, val)))))
|
|
|
52 (put 'w3-put-state 'edebug-form-spec '(symbolp form))
|
|
|
53
|
|
|
54 (defsubst w3-push-alignment (align)
|
|
|
55 (if align
|
|
|
56 (w3-put-state :align (cons (cons tag align) (w3-get-state :align)))))
|
|
|
57
|
|
|
58 (defsubst w3-pop-alignment ()
|
|
|
59 (let ((flubber (memq (assq tag (w3-get-state :align))
|
|
|
60 (w3-get-state :align))))
|
|
|
61 (cond
|
|
|
62 ((null flubber) nil)
|
|
|
63 ((cdr flubber)
|
|
|
64 (w3-put-state :align (cdr flubber)))
|
|
|
65 (t (w3-put-state :align nil)))))
|
|
|
66
|
|
|
67 (defsubst w3-current-alignment ()
|
|
|
68 (cdr-safe (car-safe (w3-get-state :align))))
|
|
|
69
|
|
|
70 (defconst w3-fill-prefixes-vector
|
|
|
71 (let ((len 0)
|
|
|
72 (prefix-vector (make-vector 80 nil)))
|
|
|
73 (while (< len 80)
|
|
|
74 (aset prefix-vector len (make-string len ? ))
|
|
|
75 (setq len (1+ len)))
|
|
|
76 prefix-vector))
|
|
|
77
|
|
|
78 (defsubst w3-set-fill-prefix-length (len)
|
|
2
|
79 (setq fill-prefix (if (< len (- (or w3-strict-width (window-width)) 4))
|
|
|
80 (if (< len 80)
|
|
|
81 (aref w3-fill-prefixes-vector len)
|
|
|
82 (make-string len ? ))
|
|
|
83 (url-warn
|
|
|
84 'html
|
|
|
85 "Runaway indentation! Too deep for window width!")
|
|
|
86 fill-prefix)))
|
|
0
|
87
|
|
|
88 (defsubst w3-get-default-style-info (info)
|
|
|
89 (and w3-current-stylesheet
|
|
|
90 (or
|
|
2
|
91 ;; Check for tag/id|name first!
|
|
|
92 (cdr-safe (assq info
|
|
|
93 (cdr-safe
|
|
|
94 (assoc (or (cdr-safe (assq 'id args))
|
|
|
95 (cdr-safe (assq 'name args)))
|
|
|
96 (cdr-safe
|
|
|
97 (assq tag w3-current-stylesheet))))))
|
|
|
98
|
|
|
99 ;; Check for tag/class next
|
|
0
|
100 (cdr-safe (assq info
|
|
|
101 (cdr-safe
|
|
|
102 (assoc (cdr-safe (assq 'class args))
|
|
|
103 (cdr-safe
|
|
|
104 (assq tag w3-current-stylesheet))))))
|
|
|
105
|
|
|
106 ;; Then for global stuff with 'class'
|
|
|
107 (cdr-safe (assq info
|
|
|
108 (cdr-safe
|
|
|
109 (assoc (cdr-safe (assq 'class args))
|
|
|
110 (cdr-safe
|
|
|
111 (assq 'doc w3-current-stylesheet))))))
|
|
|
112
|
|
|
113 ;; Fall back on the default styles for just this tag.
|
|
|
114 (cdr-safe (assq info
|
|
|
115 (cdr-safe
|
|
|
116 (assq 'internal
|
|
|
117 (cdr-safe
|
|
|
118 (assq tag w3-current-stylesheet)))))))))
|
|
|
119
|
|
2
|
120 (defsubst w3-normalize-color (color)
|
|
0
|
121 (cond
|
|
|
122 ((valid-color-name-p color)
|
|
|
123 color)
|
|
|
124 ((valid-color-name-p (concat "#" color))
|
|
|
125 (concat "#" color))
|
|
|
126 ((string-match "[ \t\r\n]" color)
|
|
|
127 (w3-normalize-color
|
|
|
128 (mapconcat (function (lambda (x) (if (memq x '(?\t ?\r ?\n ? )) ""
|
|
|
129 (char-to-string x)))) color "")))
|
|
2
|
130 ((valid-color-name-p (font-normalize-color color))
|
|
|
131 (font-normalize-color color))
|
|
|
132 (t
|
|
0
|
133 (w3-warn 'html (format "Bad color specification: %s" color))
|
|
|
134 nil)))
|
|
|
135
|
|
|
136 (defun w3-pause ()
|
|
|
137 (cond
|
|
|
138 (w3-running-FSF19 (sit-for 0))
|
|
|
139 (w3-running-xemacs
|
|
|
140 (if (and (not (sit-for 0)) (input-pending-p))
|
|
|
141 (condition-case ()
|
|
|
142 (dispatch-event (next-command-event))
|
|
|
143 (error nil))))
|
|
|
144 (t (sit-for 0))))
|
|
|
145
|
|
|
146 (defvar w3-end-tags
|
|
|
147 '((/ul . ul)
|
|
|
148 (/lit . lit)
|
|
|
149 (/li . li)
|
|
|
150 (/h1 . h1)
|
|
|
151 (/h2 . h2)
|
|
|
152 (/h3 . h3)
|
|
|
153 (/h4 . h4)
|
|
|
154 (/h5 . h5)
|
|
|
155 (/h6 . h6)
|
|
|
156 (/font0 . font0)
|
|
|
157 (/font1 . font1)
|
|
|
158 (/font2 . font2)
|
|
|
159 (/font3 . font3)
|
|
|
160 (/font4 . font4)
|
|
|
161 (/font5 . font5)
|
|
|
162 (/font6 . font6)
|
|
|
163 (/font7 . font7)
|
|
|
164 (/ol . ol)
|
|
|
165 (/dl . dl)
|
|
|
166 (/menu . menu)
|
|
|
167 (/dir . dir)
|
|
|
168 (/a . a)))
|
|
|
169
|
|
|
170 (defvar w3-face-cache nil
|
|
|
171 "Cache for w3-face-for-element")
|
|
|
172
|
|
|
173 (defsubst w3-voice-for-element ()
|
|
|
174 (let ((temporary-voice (w3-get-default-style-info 'voice-spec)))
|
|
2
|
175 (and temporary-voice (cons tag temporary-voice))))
|
|
0
|
176
|
|
|
177 (defsubst w3-face-for-element ()
|
|
|
178 (let* ((font-spec (w3-get-default-style-info 'font-spec))
|
|
|
179 (foreground (w3-get-default-style-info 'color))
|
|
|
180 (background (w3-get-default-style-info 'background))
|
|
|
181 ;;(pixmap (w3-get-default-style-info 'pixmap))
|
|
|
182 (descr (list font-spec foreground background))
|
|
|
183 (face (cdr-safe (assoc descr w3-face-cache))))
|
|
|
184 (if (or face (not (or foreground background font-spec)))
|
|
|
185 nil ; Do nothing, we got it already
|
|
|
186 (setq face (intern (format "%s" descr)))
|
|
|
187 (cond
|
|
|
188 ((not (fboundp 'make-face)) nil) ; Do nothing
|
|
|
189 ((and (fboundp 'face-property) ; XEmacs 19.14
|
|
|
190 (not (get 'face-property 'sysdep-defined-this)))
|
|
|
191 (setq face (make-face face
|
|
|
192 "An Emacs-W3 face... don't edit by hand." t)))
|
|
|
193 (t (make-face face)))
|
|
|
194
|
|
|
195 (and font-spec (set-face-font face font-spec))
|
|
|
196 (and foreground (set-face-foreground face foreground))
|
|
|
197 (and background (set-face-background face background))
|
|
|
198 ;(set-face-background-pixmap face pixmap)
|
|
|
199 (setq w3-face-cache (cons (cons descr face) w3-face-cache)))
|
|
|
200 (cons tag face)))
|
|
|
201
|
|
|
202 (defun w3-handle-single-tag (tag &optional args)
|
|
|
203 (save-excursion
|
|
|
204 (and w3-draw-buffer (set-buffer w3-draw-buffer))
|
|
|
205 (let ((opos (point))
|
|
|
206 (id (and (listp args)
|
|
|
207 (or (cdr-safe (assq 'name args))
|
|
|
208 (cdr-safe (assq 'id args))))))
|
|
2
|
209
|
|
0
|
210 ;; This allows _ANY_ tag, whether it is known or not, to be
|
|
|
211 ;; the target of a # reference in a URL
|
|
|
212 (if id
|
|
|
213 (progn
|
|
|
214 (setq w3-id-positions (cons
|
|
|
215 (cons (intern id)
|
|
|
216 (set-marker (make-marker)
|
|
|
217 (point-max)))
|
|
|
218 w3-id-positions))))
|
|
2
|
219
|
|
|
220 (if (and (listp args) (cdr-safe (assq 'style args)))
|
|
|
221 (let ((unique-id (or id (url-create-unique-id)))
|
|
|
222 (sheet ""))
|
|
|
223 (setq sheet (format "%s.%s { %s }\n" tag unique-id
|
|
|
224 (cdr-safe (assq 'style args)))
|
|
|
225 args (cons (cons 'id unique-id) args))
|
|
|
226
|
|
|
227 (w3-handle-style (list (cons 'data sheet)
|
|
|
228 (cons 'notation "css")))))
|
|
0
|
229 (goto-char (point-max))
|
|
|
230 (if (and (w3-get-state :next-break)
|
|
|
231 (not (memq tag
|
|
|
232 '(p h1 h2 h3 h4 h5 h6 ol ul dl menu dir pre))))
|
|
|
233 (w3-handle-p))
|
|
|
234 (w3-put-state :next-break nil)
|
|
|
235 (setq w3-current-formatter (get tag 'w3-formatter))
|
|
|
236 (cond
|
|
|
237 ((eq 'w3-handle-text w3-current-formatter)
|
|
|
238 (w3-handle-text args))
|
|
|
239 (t
|
|
|
240 (let ((data-before nil)
|
|
|
241 (data-after nil))
|
|
|
242 (if (and (not (eq tag 'text)) w3-current-stylesheet)
|
|
|
243 (progn
|
|
|
244 (setq data-before (w3-get-default-style-info
|
|
|
245 'insert.before))
|
|
|
246 (let ((tag (cdr-safe (assq tag w3-end-tags))))
|
|
|
247 (setq data-after (and tag
|
|
|
248 (w3-get-default-style-info
|
|
|
249 'insert.after))))))
|
|
2
|
250 (if data-before (w3-handle-text data-before))
|
|
0
|
251 (setq w3-current-formatter (get tag 'w3-formatter))
|
|
|
252 (cond
|
|
|
253 ((eq w3-current-formatter 'ack) nil)
|
|
|
254 ((null w3-current-formatter) (w3-handle-unknown-tag tag args))
|
|
|
255 (t (funcall w3-current-formatter args)))
|
|
2
|
256 (if data-after (w3-handle-text data-after)))))
|
|
0
|
257 (if (not (eq tag 'text))
|
|
|
258 (setq w3-last-tag tag))
|
|
|
259 (goto-char opos))))
|
|
|
260
|
|
|
261
|
|
|
262 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
263 ;;; Set up basic fonts/stuff
|
|
|
264 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
265
|
|
|
266 (defun w3-init-state ()
|
|
|
267 ;; Reset the state of an HTML drawing buffer
|
|
|
268 (setq w3-state-vector (copy-sequence w3-state-vector))
|
|
|
269 (setq w3-current-stylesheet (copy-tree w3-user-stylesheet))
|
|
|
270 (let* ((tag 'html)
|
|
|
271 (args nil)
|
|
|
272 (face (cdr (w3-face-for-element))))
|
|
2
|
273 (if (not face)
|
|
|
274 (setq tag 'body
|
|
|
275 face (cdr (w3-face-for-element))))
|
|
0
|
276 (and face
|
|
|
277 (if (not (fboundp 'valid-specifier-locale-p))
|
|
|
278 nil
|
|
|
279 (w3-my-safe-copy-face face 'default (current-buffer)))))
|
|
|
280 (setq w3-form-labels nil)
|
|
|
281 (make-local-variable 'w3-image-widgets-waiting)
|
|
|
282 (make-local-variable 'w3-active-voices)
|
|
|
283 (make-local-variable 'inhibit-read-only)
|
|
|
284 (setq w3-image-widgets-waiting nil
|
|
|
285 inhibit-read-only t)
|
|
|
286 (if (not (get 'w3-state 'init)) (w3-draw-setup))
|
|
|
287 (fillarray w3-state-vector 0)
|
|
|
288 (w3-put-state :bogus nil) ; Make all fake ones return nil
|
|
|
289 (w3-put-state :text-mangler nil) ; Any text mangling routine
|
|
|
290 (w3-put-state :next-break nil) ; Next item needs a paragraph break
|
|
|
291 (w3-put-state :background nil) ; Netscapism - gag
|
|
|
292 (w3-put-state :table nil) ; Table args
|
|
|
293 (w3-put-state :figdata nil) ; Data for <fig> tag
|
|
|
294 (w3-put-state :figalt nil) ; Alt data for <fig> tag
|
|
|
295 (w3-put-state :pre-start nil) ; Where current <pre> seg starts
|
|
|
296 (w3-put-state :zone nil) ; Zone of current href?
|
|
|
297 (w3-put-state :center nil) ; netscape tag
|
|
|
298 (w3-put-state :select nil) ; Data for current select field
|
|
|
299 (w3-put-state :options nil) ; Options in current select field
|
|
|
300 (w3-put-state :nofill nil) ; non-nil if in pre or xmp
|
|
|
301 (w3-put-state :nowrap nil) ; non-nil if in <p nowrap>
|
|
|
302 (w3-put-state :href nil) ; Current link destination
|
|
|
303 (w3-put-state :name nil) ; Current link ID tag
|
|
|
304 (w3-put-state :image nil) ; Current image destination
|
|
|
305 (w3-put-state :form nil) ; Current form information
|
|
|
306 (w3-put-state :optarg nil) ; Option arguments
|
|
|
307 (w3-put-state :w3-graphic nil) ; Image stuff for non-xemacs
|
|
|
308 (w3-put-state :lists '()) ; Types of list currently in.
|
|
|
309 (w3-put-state :align nil) ; Current alignment of paragraphs
|
|
|
310 (w3-put-state :title nil) ; Whether we can have a title or not
|
|
|
311 (w3-put-state :seen-this-url nil) ; whether we have seen this url or not
|
|
|
312 (w3-put-state :needspace 'never) ; Spacing info
|
|
|
313 (setq w3-active-faces nil) ; Face attributes to use
|
|
|
314 (setq w3-active-voices nil) ; voice attributes to use
|
|
|
315 )
|
|
|
316
|
|
|
317 (defun w3-draw-setup ()
|
|
|
318 (put 'w3-state 'init t)
|
|
|
319 (w3-init-state))
|
|
|
320
|
|
|
321
|
|
|
322 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
323 ;;; Mapping HTML tags to functions
|
|
|
324 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
325 (put 'lit 'w3-formatter 'w3-handle-pre)
|
|
|
326 (put '/lit 'w3-formatter 'w3-handle-/pre)
|
|
|
327 (put 'li 'w3-formatter 'w3-handle-list-item)
|
|
|
328 (put 'ul 'w3-formatter 'w3-handle-list-opening)
|
|
|
329 (put 'ol 'w3-formatter 'w3-handle-list-opening)
|
|
|
330 (put 'dl 'w3-formatter 'w3-handle-list-opening)
|
|
|
331 (put '/dl 'w3-formatter 'w3-handle-list-ending)
|
|
|
332 (put '/ul 'w3-formatter 'w3-handle-list-ending)
|
|
|
333 (put '/ol 'w3-formatter 'w3-handle-list-ending)
|
|
|
334 (put 'menu 'w3-formatter 'w3-handle-list-opening)
|
|
|
335 (put '/menu 'w3-formatter 'w3-handle-list-ending)
|
|
|
336 (put 'dir 'w3-formatter 'w3-handle-list-opening)
|
|
|
337 (put '/dir 'w3-formatter 'w3-handle-list-ending)
|
|
|
338 (put 'dt 'w3-formatter 'w3-handle-table-term)
|
|
|
339 (put 'dd 'w3-formatter 'w3-handle-table-definition)
|
|
|
340 (put 'a 'w3-formatter 'w3-handle-hyperlink)
|
|
|
341 (put '/a 'w3-formatter 'w3-handle-hyperlink-end)
|
|
|
342 (put 'h1 'w3-formatter 'w3-handle-header)
|
|
|
343 (put 'h2 'w3-formatter 'w3-handle-header)
|
|
|
344 (put 'h3 'w3-formatter 'w3-handle-header)
|
|
|
345 (put 'h4 'w3-formatter 'w3-handle-header)
|
|
|
346 (put 'h5 'w3-formatter 'w3-handle-header)
|
|
|
347 (put 'h6 'w3-formatter 'w3-handle-header)
|
|
|
348 (put '/h1 'w3-formatter 'w3-handle-header-end)
|
|
|
349 (put '/h2 'w3-formatter 'w3-handle-header-end)
|
|
|
350 (put '/h3 'w3-formatter 'w3-handle-header-end)
|
|
|
351 (put '/h4 'w3-formatter 'w3-handle-header-end)
|
|
|
352 (put '/h5 'w3-formatter 'w3-handle-header-end)
|
|
|
353 (put '/h6 'w3-formatter 'w3-handle-header-end)
|
|
|
354 (put 'img 'w3-formatter 'w3-handle-image)
|
|
|
355 (put 'kill_sgml 'w3-formatter 'w3-handle-kill-sgml)
|
|
|
356
|
|
|
357 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
358 ;;; The main drawing routines
|
|
|
359 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
360 (defun w3-handle-unknown-tag (tag args)
|
|
|
361 ;; A generic formatter for an unkown HTML tag. This will only be
|
|
|
362 ;; called if a formatter was not found in TAGs property list.
|
|
|
363 ;; If a function named `w3-handle-TAG' is defined, then it will be
|
|
|
364 ;; stored in TAGs property list, so it will be found next time
|
|
|
365 ;; the tag is run across.
|
|
|
366
|
|
|
367 (let ((handler (intern-soft (concat "w3-handle-" (symbol-name tag))))
|
|
|
368 (end-tag-p (= (string-to-char (symbol-name tag)) ?/)))
|
|
|
369
|
|
|
370 ;; This stores the info in w3-end-tags for future use by the display
|
|
|
371 ;; engine.
|
|
|
372 (if end-tag-p
|
|
|
373 (setq w3-end-tags (cons (cons tag
|
|
|
374 (intern (substring (symbol-name tag)
|
|
|
375 1)))
|
|
|
376 w3-end-tags)))
|
|
|
377
|
|
|
378 ;; For proper use of stylesheets, if no tag is found, then we should
|
|
|
379 ;; at least call w3-handle-emphasis
|
|
|
380 (cond
|
|
|
381 ((and handler (fboundp handler))
|
|
|
382 (put tag 'w3-formatter handler)
|
|
|
383 (funcall handler args))
|
|
|
384 (end-tag-p
|
|
2
|
385 (put tag 'w3-formatter 'w3-handle-emphasis-end)
|
|
|
386 (w3-handle-emphasis-end args))
|
|
0
|
387 (t
|
|
2
|
388 (put tag 'w3-formatter 'w3-handle-emphasis)
|
|
|
389 (w3-handle-emphasis args)))))
|
|
0
|
390
|
|
|
391 (defun w3-handle-text (&optional args)
|
|
|
392 ;; This is the main workhorse of the display engine.
|
|
|
393 ;; It will figure out how a chunk of text should be displayed and
|
|
|
394 ;; put all the necessary extents/overlays/regions around it."
|
|
|
395 (or args (error "Impossible"))
|
|
|
396 (if (string= args "")
|
|
|
397 (w3-put-state :needspace nil)
|
|
|
398 (let ((st (point))
|
|
|
399 (mangler (w3-get-state :text-mangler))
|
|
|
400 (sym nil))
|
|
|
401 (insert args)
|
|
|
402 ;;(goto-char st)
|
|
|
403 (cond ((w3-get-state :nofill)
|
|
|
404 (goto-char st)
|
|
|
405 (if (not (search-forward "\n" nil t))
|
|
|
406 (subst-char-in-region st (point-max) ?\r ?\n)
|
|
|
407 (subst-char-in-region st (point-max) ?\r ? ))
|
|
|
408 (goto-char (point-max)))
|
|
|
409 (t
|
|
|
410 (goto-char st)
|
|
|
411 (while (re-search-forward
|
|
|
412 " [ \t\n\r]+\\|[\t\n\r][ \t\n\r]*"
|
|
|
413 nil 'move)
|
|
|
414 (replace-match " "))
|
|
|
415 (goto-char st)
|
|
|
416 (if (and (= ? (following-char))
|
|
|
417 (or (bolp)
|
|
|
418 (eq 'never (w3-get-state :needspace))))
|
|
|
419 (delete-char 1))
|
|
|
420 (goto-char (point-max))))
|
|
|
421 (and mangler w3-delimit-emphasis
|
|
|
422 (fboundp mangler) (funcall mangler st (point)))
|
|
|
423 (let ((faces nil)
|
|
|
424 (todo w3-active-faces)
|
|
|
425 (voices w3-active-voices)
|
|
|
426 (val nil)
|
|
|
427 (cur nil))
|
|
|
428 (while todo
|
|
|
429 (setq cur (car todo)
|
|
|
430 todo (cdr todo))
|
|
|
431 (cond
|
|
|
432 ((symbolp cur)
|
|
|
433 nil)
|
|
|
434 ((listp (cdr-safe cur))
|
|
|
435 (let ((x (cdr cur)))
|
|
|
436 (while x
|
|
|
437 (if (not (memq (car x) faces))
|
|
|
438 (setq faces (cons (car x) faces)))
|
|
|
439 (setq x (cdr x)))))
|
|
|
440 ((and (consp cur) (not (memq (cdr cur) faces)))
|
|
|
441 (setq faces (cons (cdr cur) faces)))
|
|
|
442 (t nil)))
|
|
|
443 (add-text-properties st (point) (list 'face faces))
|
|
|
444 (if (car voices)
|
|
2
|
445 (add-text-properties st (point) (list 'personality (cdar voices))))
|
|
0
|
446 )
|
|
|
447 (if (not (memq (char-after (1- (point))) '(? ?.)))
|
|
|
448 (w3-put-state :needspace t))
|
|
|
449 )))
|
|
|
450
|
|
|
451 (defun w3-handle-plaintext (&optional args)
|
|
|
452 (let ((x (w3-get-state :nofill)))
|
|
|
453 (w3-put-state :nofill t)
|
|
|
454 (and args (cdr-safe (assq 'data args))
|
|
|
455 (w3-handle-text (cdr-safe (assq 'data args))))
|
|
|
456 (setq w3-last-fill-pos (point))))
|
|
|
457
|
|
|
458 (defun w3-handle-/plaintext (&optional args)
|
|
|
459 (w3-put-state :nofill nil))
|
|
|
460
|
|
|
461
|
|
|
462 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
463 ;;; Paragraph breaks, and other things that can cause linebreaks and
|
|
|
464 ;;; alignment changes.
|
|
|
465 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
466 (defun w3-handle-header (&optional args)
|
|
|
467 ;; Handle the creation of a header (of any level). Causes a full
|
|
|
468 ;; paragraph break.
|
|
|
469 (w3-handle-emphasis args)
|
|
|
470 (let ((name (or (cdr-safe (assq 'name args))
|
|
|
471 (cdr-safe (assq 'id args))))
|
|
|
472 (align (cdr-safe (assq 'align args)))
|
|
|
473 (mangler (nth 2 (cdr-safe (assq tag w3-header-chars-assoc)))))
|
|
|
474 (w3-handle-p)
|
|
|
475 (if align
|
|
|
476 (setq align (intern (downcase align)))
|
|
|
477 (setq align (w3-get-default-style-info 'align)))
|
|
|
478 (let ((tag 'p))
|
|
|
479 (w3-pop-alignment))
|
|
|
480 (w3-push-alignment align)
|
|
|
481 (w3-put-state :text-mangler mangler)
|
|
|
482 (if name (w3-put-state :name name))))
|
|
|
483
|
|
|
484 (defun w3-handle-header-end (&optional args)
|
|
|
485 ;; Handle the closing of a header (of any level). Causes a full
|
|
|
486 ;; paragraph break.
|
|
|
487 (w3-handle-emphasis-end)
|
|
|
488 (let ((mangler (w3-get-state :text-mangler)))
|
|
|
489 (and mangler (funcall mangler nil nil t)))
|
|
|
490 (w3-put-state :text-mangler nil)
|
|
|
491 (goto-char (point-max))
|
|
|
492 (w3-handle-p)
|
|
|
493 (let* ((info (car-safe (w3-get-state :lists)))
|
|
|
494 (type (and info (car-safe info))))
|
|
|
495 (if (and type fill-prefix)
|
|
|
496 (insert fill-prefix (cond
|
|
|
497 ((memq type '(ol dl)) " ")
|
|
|
498 (t " ")))))
|
|
|
499 (let ((tag (cdr-safe (assoc tag w3-end-tags))))
|
|
|
500 (w3-pop-alignment)))
|
|
|
501
|
|
|
502 (defun w3-handle-pre (&optional args)
|
|
|
503 ;; Marks the start of a preformatted section of text. No paragraph
|
|
|
504 ;; filling should be done from this point until a matching /pre has
|
|
|
505 ;; been encountered.
|
|
|
506 (w3-handle-p)
|
|
|
507 (w3-put-state :nofill t)
|
|
|
508 (w3-put-state :needspace t)
|
|
|
509 (w3-put-state :pre-start (set-marker (make-marker) (point)))
|
|
|
510 )
|
|
|
511
|
|
|
512 (defun w3-handle-xmp (&optional args)
|
|
|
513 ;; Marks the start of a preformatted section of text. No paragraph
|
|
|
514 ;; filling should be done from this point until a matching /pre has
|
|
|
515 ;; been encountered.
|
|
|
516 (w3-handle-p)
|
|
|
517 (w3-put-state :nofill t)
|
|
|
518 (w3-put-state :needspace t)
|
|
|
519 (w3-put-state :pre-start (set-marker (make-marker) (point)))
|
|
|
520 (if (and args (cdr-safe (assq 'data args)))
|
|
|
521 (progn
|
|
|
522 (w3-handle-text (cdr-safe (assq 'data args)))
|
|
|
523 (w3-handle-/xmp))))
|
|
|
524
|
|
|
525 (defun w3-handle-/pre (&optional args)
|
|
|
526 (if (not (w3-get-state :nofill))
|
|
|
527 (w3-handle-p)
|
|
|
528 (w3-put-state :nofill nil)
|
|
|
529 (let* ((info (car-safe (w3-get-state :lists)))
|
|
|
530 (type (and info (car-safe info)))
|
|
|
531 (st (w3-get-state :pre-start)))
|
|
|
532 (if (not (bolp)) (insert "\n"))
|
|
|
533 (if (and type fill-prefix st)
|
|
|
534 (progn
|
|
|
535 (save-excursion
|
|
|
536 (goto-char st)
|
|
|
537 (while (re-search-forward "^" nil t)
|
|
|
538 (insert fill-prefix (cond
|
|
|
539 ((memq type '(ol dl)) " ")
|
|
|
540 (t " ")))))
|
|
|
541 (setq w3-last-fill-pos (point))
|
|
|
542 (insert fill-prefix (cond
|
|
|
543 ((memq type '(ol dl)) " ")
|
|
|
544 (t " "))))
|
|
|
545 (setq w3-last-fill-pos (point))))
|
|
|
546 (let ((tag 'p))
|
|
|
547 (w3-handle-p))
|
|
|
548 (setq w3-active-faces nil)
|
|
|
549 (w3-put-state :pre-start nil)))
|
|
|
550
|
|
|
551 (fset 'w3-handle-/xmp 'w3-handle-/pre)
|
|
|
552
|
|
|
553 (defun w3-handle-blockquote (&optional args)
|
|
|
554 ;; Start a section of quoted text. This is done by causing the text
|
|
|
555 ;; to be indented from the right and left margins. Nested
|
|
|
556 ;; blockquotes will cause further indentation.
|
|
|
557 (let ((align (or (w3-get-default-style-info 'align) 'indent)))
|
|
|
558 (w3-handle-p)
|
|
|
559 (w3-push-alignment align))
|
|
|
560 (w3-put-state :fillcol fill-column)
|
|
|
561 (setq fill-column (max (- (or fill-column
|
|
|
562 (1- (or w3-strict-width (window-width)))) 8)
|
|
|
563 10)))
|
|
|
564
|
|
|
565 (defun w3-handle-/blockquote (&optional args)
|
|
|
566 (w3-handle-paragraph)
|
|
|
567 (let ((tag (cdr-safe (assoc tag w3-end-tags))))
|
|
|
568 (w3-pop-alignment))
|
|
|
569 (setq fill-column (or (w3-get-state :fillcol) (1- (or w3-strict-width
|
|
|
570 (window-width)))))
|
|
|
571 (w3-put-state :fillcol nil))
|
|
|
572
|
|
|
573 (defun w3-handle-align (&optional args)
|
|
|
574 ;; Cause a single line break (like <BR>) and replace the current
|
|
|
575 ;; alignment.
|
|
|
576 (let ((align (intern (or (cdr-safe (assq 'role args))
|
|
|
577 (cdr-safe (assq 'align args))
|
|
|
578 (cdr-safe (assq 'style args))))))
|
|
|
579 (w3-handle-paragraph)
|
|
|
580 (w3-push-alignment align)))
|
|
|
581
|
|
|
582 (defun w3-handle-/align (&optional args)
|
|
|
583 (w3-handle-paragraph)
|
|
|
584 (w3-pop-alignment))
|
|
|
585
|
|
|
586 (defun w3-handle-hr (&optional args)
|
|
|
587 ;; Cause a line break and insert a horizontal rule across the page.
|
|
|
588 (w3-handle-paragraph)
|
|
|
589 (let* ((perc (or (cdr-safe (assq 'width args))
|
|
|
590 (w3-get-default-style-info 'width)
|
|
|
591 "100%"))
|
|
|
592 (old-align (w3-current-alignment))
|
|
|
593 (talign (or (cdr-safe (assq 'textalign args))
|
|
|
594 (cdr-safe (assq 'text-align args))
|
|
|
595 (w3-get-default-style-info 'textalign)
|
|
|
596 (w3-get-default-style-info 'text-align)
|
|
|
597 (and old-align (symbol-name old-align))
|
|
|
598 "center"))
|
|
|
599 (text (cdr-safe (assq 'label args)))
|
|
|
600 (align (or (cdr-safe (assq 'align args))
|
|
|
601 (w3-get-default-style-info 'align)
|
|
|
602 old-align
|
|
|
603 'center))
|
|
|
604 (rule nil)
|
|
|
605 (width nil))
|
|
|
606 (if (stringp talign)
|
|
|
607 (setq talign (intern (downcase talign))))
|
|
|
608 (if (stringp align)
|
|
|
609 (setq align (intern (downcase align))))
|
|
|
610 (w3-push-alignment align)
|
|
|
611
|
|
|
612 (setq perc (min (string-to-int perc) 100)
|
|
|
613 width (/ (* (- (or w3-strict-width
|
|
|
614 (window-width))
|
|
|
615 w3-right-border) perc) 100))
|
|
|
616 (if text
|
|
|
617 (cond
|
|
|
618 ((>= (length text) width)
|
|
|
619 (setq rule (concat "-" text "-")))
|
|
|
620 ((eq talign 'right)
|
|
|
621 (setq rule (concat (make-string (- width 1 (length text))
|
|
|
622 w3-horizontal-rule-char)
|
|
|
623 text "-")))
|
|
|
624 ((eq talign 'center)
|
|
|
625 (let ((half (make-string (/ (- width (length text)) 2)
|
|
|
626 w3-horizontal-rule-char)))
|
|
|
627 (setq rule (concat half text half))))
|
|
|
628 ((eq talign 'left)
|
|
|
629 (setq rule (concat "-" text (make-string (- width 1
|
|
|
630 (length text))
|
|
|
631 w3-horizontal-rule-char)))))
|
|
|
632 (setq rule (make-string width w3-horizontal-rule-char)))
|
|
|
633 (w3-handle-text rule)
|
|
|
634 (condition-case ()
|
|
|
635 (w3-handle-paragraph)
|
|
|
636 (error nil))
|
|
|
637 (w3-pop-alignment)
|
|
|
638 (setq w3-last-fill-pos (point))
|
|
|
639 (let* ((info (car-safe (w3-get-state :lists)))
|
|
|
640 (type (and info (car-safe info)))
|
|
|
641 (cur (w3-current-alignment)))
|
|
|
642 (cond
|
|
|
643 ;;((eq cur 'indent)
|
|
|
644 ;;(insert (make-string w3-indent-level ? )))
|
|
|
645 ((and type fill-prefix (eq w3-last-tag 'dt))
|
|
|
646 (insert fill-prefix))
|
|
|
647 ((and type fill-prefix)
|
|
|
648 (insert fill-prefix (if (eq type 'ol) " " " ")))
|
|
|
649 (t nil)))))
|
|
|
650
|
|
|
651 (defun w3-handle-/p (&optional args)
|
|
|
652 ;; Marks the end of a paragraph. Only causes a paragraph break if
|
|
|
653 ;; it is not followed by another paragraph or similar markup
|
|
|
654 ;; (headers, list openings, etc) that will already cause a new
|
|
|
655 ;; paragraph to be started.
|
|
|
656 (w3-handle-emphasis-end)
|
|
|
657 (let ((tag (cdr-safe (assoc tag w3-end-tags))))
|
|
|
658 (w3-handle-p)
|
|
|
659 (w3-pop-alignment)))
|
|
|
660
|
|
|
661 (defun w3-handle-p (&optional args)
|
|
2
|
662 (if (or (not (memq w3-last-tag '(li tr td th dt dd)))
|
|
0
|
663 (memq tag '(ol ul dl menu dir)))
|
|
|
664 (let ((name (or (cdr-safe (assq 'name args))
|
|
|
665 (cdr-safe (assq 'id args))))
|
|
|
666 (align (cdr-safe (assoc 'align args))))
|
|
|
667 (w3-handle-emphasis-end)
|
|
|
668 (w3-handle-emphasis args)
|
|
|
669 (w3-handle-paragraph)
|
|
|
670 (w3-put-state :nowrap (assq 'nowrap args))
|
|
|
671 (setq align (if align
|
|
|
672 (intern (downcase align))
|
|
|
673 (w3-get-default-style-info 'align)))
|
|
|
674 (and (eq tag 'p) (progn
|
|
|
675 (w3-pop-alignment)
|
|
|
676 (w3-push-alignment align)))
|
|
|
677 (if (not (bobp))
|
|
|
678 (progn
|
|
|
679 (insert (cond
|
|
|
680 ((and (eolp) (bolp)) "\n")
|
|
|
681 ((eolp) "\n\n")
|
|
|
682 (t "\n")))
|
|
|
683 (setq w3-last-fill-pos (point))
|
|
|
684 (cond
|
|
|
685 ((null fill-prefix))
|
|
|
686 ((string= fill-prefix ""))
|
|
|
687 ((eq (car (car (w3-get-state :lists))) 'ol)
|
|
|
688 (insert fill-prefix " "))
|
|
|
689 (t (insert fill-prefix " ")))))
|
|
|
690 (if name (w3-put-state :name name)))))
|
|
|
691
|
|
|
692 (defun w3-handle-br (&optional args)
|
|
|
693 ;; Cause a single line break.
|
|
|
694 ;; The alignment will only effect the chunk of text (generally to
|
|
|
695 ;; the last <br> or <p> tag) immediately before the <br>. After
|
|
|
696 ;; that, the alignment will revert to the containers alignment.
|
|
|
697 (w3-handle-paragraph)
|
|
|
698 (let* ((info (car-safe (w3-get-state :lists)))
|
|
|
699 (type (and info (car-safe info)))
|
|
|
700 (cur (w3-current-alignment)))
|
|
|
701 (cond
|
|
|
702 ;;((eq cur 'indent)
|
|
|
703 ;;(insert (make-string w3-indent-level ? )))
|
|
|
704 ((and type fill-prefix (eq w3-last-tag 'dt))
|
|
|
705 (insert fill-prefix))
|
|
|
706 ((and type fill-prefix)
|
|
|
707 (insert fill-prefix (if (eq type 'ol) " " " ")))
|
|
|
708 (t nil))))
|
|
|
709
|
|
|
710 (defun w3-handle-paragraph (&optional args)
|
|
|
711 (if (not (bobp))
|
|
|
712 (let ((align (w3-current-alignment))
|
|
|
713 (fill-prefix fill-prefix))
|
|
|
714 (cond
|
|
|
715 ((eq align 'indent)
|
|
|
716 (w3-set-fill-prefix-length
|
|
|
717 (+ (length fill-prefix);; works even if fill-prefix is nil
|
|
|
718 w3-indent-level)))
|
|
|
719 ((null fill-prefix)
|
|
|
720 (setq fill-prefix ""))
|
|
|
721 ((string= fill-prefix ""))
|
|
|
722 ((eq (car (car (w3-get-state :lists))) 'ol)
|
|
|
723 (w3-set-fill-prefix-length (+ 4 (length fill-prefix))))
|
|
|
724 (t
|
|
|
725 (w3-set-fill-prefix-length (+ 2 (length fill-prefix)))))
|
|
|
726 (if (eq align 'indent)
|
|
|
727 (progn
|
|
|
728 (goto-char w3-last-fill-pos)
|
|
|
729 (insert fill-prefix)
|
|
|
730 (goto-char (point-max))))
|
|
|
731 (if (and (> (current-column) fill-column)
|
|
|
732 (not (w3-get-state :nowrap))
|
|
|
733 (not (w3-get-state :nofill)))
|
|
|
734 (fill-region-as-paragraph w3-last-fill-pos (point)
|
|
|
735 (eq align 'justify)))
|
|
|
736 (if (not w3-last-fill-pos)
|
|
|
737 (setq w3-last-fill-pos (point-min)))
|
|
|
738 (goto-char (point-max))
|
|
|
739 (skip-chars-backward " \t\n")
|
|
|
740 (delete-region (point) (point-max))
|
|
|
741 (if (< w3-last-fill-pos (point))
|
|
|
742 (cond
|
|
|
743 ((or (eq align 'center) (w3-get-state :center))
|
|
|
744 (center-region w3-last-fill-pos (point)))
|
|
|
745 ((eq align 'right)
|
|
|
746 (let ((x (point)))
|
|
|
747 (catch 'fill-exit
|
|
|
748 (save-excursion
|
|
|
749 (goto-char w3-last-fill-pos)
|
|
|
750 (while (re-search-forward "$" x t)
|
|
|
751 (if (/= (current-column) fill-column)
|
|
|
752 (let ((buff (- fill-column (current-column))))
|
|
|
753 (beginning-of-line)
|
|
|
754 (setq x (+ x buff))
|
|
|
755 (if (> buff 0)
|
|
|
756 (insert (make-string buff ? )))
|
|
|
757 (end-of-line))
|
|
|
758 (end-of-line))
|
|
|
759 (if (eobp) (throw 'fill-exit t))
|
|
|
760 (condition-case ()
|
|
|
761 (forward-char 1)
|
|
|
762 (error (throw 'fill-exit t))))))))))
|
|
|
763 (insert "\n")
|
|
|
764 (setq w3-last-fill-pos (point))
|
|
|
765 (w3-put-state :needspace 'never))))
|
|
|
766
|
|
|
767 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
768 ;;; List handling code
|
|
|
769 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
770 (defun w3-handle-list-ending (&optional args)
|
|
|
771 ;; Handles all the list terminators (/ol /ul /dl).
|
|
|
772 ;; This just fills the last paragrpah, then reduces the depth in
|
|
|
773 ;; `w3-state' and truncates `fill-prefix'"
|
|
|
774 (w3-handle-paragraph)
|
|
|
775 (w3-put-state :depth (max 0 (1- (w3-get-state :depth))))
|
|
|
776 (w3-put-state :next-break t)
|
|
|
777 (w3-set-fill-prefix-length (* (w3-get-state :depth) w3-indent-level))
|
|
|
778 (w3-put-state :lists (cdr (w3-get-state :lists)))
|
|
|
779 (if (/= 0 (length fill-prefix))
|
|
|
780 (insert fill-prefix " ")))
|
|
|
781
|
|
|
782 (defun w3-handle-list-opening (&optional args)
|
|
|
783 ;; Handles all the list openers (ol ul dl).
|
|
|
784 ;; This just fills the last paragraph, then increases the depth in
|
|
|
785 ;; `w3-state' and adds to `fill-prefix'
|
|
|
786 (w3-handle-p)
|
|
|
787 (let ((style (and (not (assq 'style args))
|
|
|
788 (w3-get-default-style-info 'style))))
|
|
|
789 (if style
|
|
|
790 (setq args (cons (cons 'style style) args))))
|
|
|
791 ;; Default VALUE attribute for OL is 1.
|
|
|
792 (if (eq tag 'ol)
|
|
|
793 (or (assq 'value args)
|
|
|
794 (setq args (cons (cons 'value 1) args))))
|
|
|
795 (w3-put-state :depth (1+ (w3-get-state :depth)))
|
|
|
796 (w3-set-fill-prefix-length (* (w3-get-state :depth) w3-indent-level))
|
|
|
797 (insert "\n\n" fill-prefix " ")
|
|
|
798 (w3-put-state :lists (cons (cons tag (copy-alist args))
|
|
|
799 (w3-get-state :lists))))
|
|
|
800
|
|
|
801 (defun w3-handle-table-definition (&optional args)
|
|
|
802 (w3-handle-paragraph)
|
|
|
803 (insert fill-prefix " "))
|
|
|
804
|
|
|
805 (defun w3-handle-table-term (&optional args)
|
|
|
806 (w3-handle-paragraph)
|
|
|
807 (insert "\n" fill-prefix))
|
|
|
808
|
|
|
809 (defun w3-handle-list-item (&optional args)
|
|
|
810 (w3-handle-paragraph)
|
|
|
811 (let* ((info (car (w3-get-state :lists)))
|
|
|
812 (type (car info))
|
|
|
813 (endr (or (nth (1- (or (w3-get-state :depth) 1))
|
|
|
814 (cdr (or (assoc type w3-list-chars-assoc)
|
|
|
815 (car w3-list-chars-assoc))))
|
|
|
816 "*")))
|
|
|
817 (setq info (cdr info))
|
|
|
818 (cond
|
|
|
819 ((assq 'plain info)
|
|
|
820 ;; We still need to indent from the left margin for lists without
|
|
|
821 ;; bullets. This is especially important with nested lists.
|
|
|
822 ;; Question: Do we want this to be equivalent to replacing the
|
|
|
823 ;; bullet by a space (" ") or by indenting so that the text starts
|
|
|
824 ;; where the bullet would have been? I've chosen the latter after
|
|
|
825 ;; looking at both kinds of output.
|
|
|
826 (insert fill-prefix))
|
|
|
827 ((eq type 'ol)
|
|
|
828 (let ((next (or (assq 'seqnum info) (assq 'value info)))
|
|
|
829 (type (cdr-safe (assq 'style info)))
|
|
|
830 (uppr (assq 'upper info))
|
|
|
831 (tokn nil))
|
|
|
832 (if (stringp (cdr next)) (setcdr next (string-to-int (cdr next))))
|
|
|
833 (cond
|
|
|
834 ((or (assq 'roman info)
|
|
|
835 (member type '("i" "I")))
|
|
|
836 (setq tokn (concat
|
|
|
837 (w3-pad-string (w3-decimal-to-roman (cdr next)) 3 ?
|
|
|
838 'left)
|
|
|
839 endr)))
|
|
|
840 ((or (assq 'arabic info)
|
|
|
841 (member type '("a" "A")))
|
|
|
842 (setq tokn (concat (w3-pad-string
|
|
|
843 (w3-decimal-to-alpha (cdr next)) 3 ? 'left)
|
|
|
844 endr)))
|
|
|
845 (t
|
|
|
846 (setq tokn (concat (w3-pad-string (int-to-string (cdr next))
|
|
|
847 2 ? 'left)
|
|
|
848 endr))))
|
|
|
849 (if (assq 'uppercase info)
|
|
|
850 (setq tokn (upcase tokn)))
|
|
|
851 (insert fill-prefix tokn " ")
|
|
|
852 (setcdr next (1+ (cdr next)))
|
|
|
853 (w3-put-state :needspace 'never)))
|
|
|
854 (t
|
|
|
855 (insert fill-prefix endr " ")))))
|
|
|
856
|
|
|
857 (defun w3-pad-string (str len pad side)
|
|
|
858 ;; Pads a string STR to a certain length LEN, using fill character
|
|
|
859 ;; PAD by concatenating PAD to SIDE of the string.
|
|
|
860 (let ((strlen (length str)))
|
|
|
861 (cond
|
|
|
862 ((>= strlen len) str)
|
|
|
863 ((eq side 'right) (concat str (make-string (- len strlen) pad)))
|
|
|
864 ((eq side 'left) (concat (make-string (- len strlen) pad) str)))))
|
|
|
865
|
|
|
866 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
867 ;;; Routines to handle character-level formatting
|
|
|
868 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
869 (defun w3-handle-q (&optional args)
|
|
|
870 (w3-handle-emphasis)
|
|
|
871 (w3-handle-text (or (w3-get-default-style-info 'startquote) "\"")))
|
|
|
872
|
|
|
873 (defun w3-handle-/q (&optional args)
|
|
|
874 (let ((tag (cdr-safe (assoc tag w3-end-tags))))
|
|
|
875 (w3-handle-text (or (w3-get-default-style-info 'endquote) "\"")))
|
|
|
876 (w3-handle-emphasis-end))
|
|
|
877
|
|
|
878 (defun w3-handle-emphasis (&optional args)
|
|
|
879 ;; Generic handler for character-based emphasis. Increments the state
|
|
|
880 ;; of TAG (which must be bound by the calling procedure). This
|
|
|
881 ;; checks all the various stylesheet mechanisms that may cause an
|
|
|
882 ;; alignment shift as well.
|
|
|
883 (let ((align (or (w3-get-default-style-info 'align)
|
|
|
884 (and (eq tag 'address) w3-right-justify-address 'right))))
|
|
|
885 (if (and align (not (memq tag '(h1 h2 h3 h4 h5 h6))))
|
|
|
886 (progn
|
|
|
887 (w3-handle-paragraph)
|
|
|
888 (w3-push-alignment align))))
|
|
|
889 (let* ((spec (and w3-delimit-emphasis (assoc tag w3-style-tags-assoc)))
|
|
|
890 (class (cdr-safe (assq 'class args)))
|
|
|
891 (face (w3-face-for-element))
|
|
|
892 (voice (w3-voice-for-element))
|
|
|
893 (beg (and spec (car (cdr spec)))))
|
|
|
894 (if spec
|
|
|
895 (insert beg))
|
|
|
896 (if voice
|
|
|
897 (setq w3-active-voices (cons voice w3-active-voices)))
|
|
|
898 (if face
|
|
|
899 (setq w3-active-faces (cons face w3-active-faces)))))
|
|
|
900
|
|
|
901 (defun w3-handle-emphasis-end (&optional args)
|
|
|
902 ;; Generic handler for ending character-based emphasis. Decrements
|
|
|
903 ;; the state of TAG (which must be bound by the calling procedure).
|
|
|
904 ;; Stylesheet mechanisms may cause arbitrary alignment changes.
|
|
|
905 (let* ((tag (cdr-safe (assq tag w3-end-tags)))
|
|
|
906 (spec (and w3-delimit-emphasis (assq tag w3-style-tags-assoc)))
|
|
|
907 (end (and spec (cdr (cdr spec)))))
|
|
|
908 (if (assq tag w3-active-voices)
|
|
|
909 (setq w3-active-voices (cdr (memq (assq tag w3-active-voices)
|
|
|
910 w3-active-voices)))
|
|
|
911 (setq w3-active-voices (delq tag w3-active-voices)))
|
|
|
912 (if (assq tag w3-active-faces)
|
|
|
913 (setq w3-active-faces (cdr (memq (assq tag w3-active-faces)
|
|
|
914 w3-active-faces)))
|
|
|
915 (setq w3-active-faces (delq tag w3-active-faces)))
|
|
|
916 (if spec (insert end))
|
|
|
917 (if (eq tag 'address)
|
|
|
918 (progn
|
|
|
919 (w3-handle-paragraph)
|
|
|
920 (w3-pop-alignment)))))
|
|
|
921
|
|
|
922 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
923 ;;; HTML 3.0 compliance
|
|
|
924 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
925 (defun w3-handle-math (&optional args)
|
|
|
926 (w3-handle-br)
|
|
|
927 (w3-handle-text "[START MATH - Not Implemented (Yet)]")
|
|
|
928 (w3-handle-br))
|
|
|
929
|
|
|
930 (defun w3-handle-/math (&optional args)
|
|
|
931 (w3-handle-br)
|
|
|
932 (w3-handle-text "[END MATH]")
|
|
|
933 (w3-handle-br))
|
|
|
934
|
|
2
|
935 (defun w3-handle-tr (&optional args)
|
|
|
936 (w3-handle-br))
|
|
|
937
|
|
|
938 (defun w3-handle-/tr (&optional args)
|
|
|
939 (w3-handle-br))
|
|
|
940
|
|
|
941 (defun w3-handle-td (&optional args)
|
|
|
942 (w3-handle-text " | "))
|
|
|
943
|
|
|
944 (defun w3-handle-/td (&optional args)
|
|
|
945 (w3-handle-text " | "))
|
|
|
946
|
|
|
947 (defun w3-handle-th (&optional args)
|
|
|
948 (w3-handle-text " | "))
|
|
|
949
|
|
|
950 (defun w3-handle-/th (&optional args)
|
|
|
951 (w3-handle-text " | "))
|
|
|
952
|
|
0
|
953 (defun w3-handle-table (&optional args)
|
|
|
954 (w3-handle-br))
|
|
|
955
|
|
|
956 (defun w3-handle-/table (&optional args)
|
|
|
957 (w3-handle-br))
|
|
|
958
|
|
|
959 (defun w3-handle-div (&optional args)
|
|
|
960 (let ((align (cdr-safe (assq 'align args))))
|
|
|
961 (w3-handle-emphasis args)
|
|
|
962 (w3-handle-paragraph)
|
|
|
963 (setq align (and align (intern (downcase align))))
|
|
|
964 (w3-push-alignment align)))
|
|
|
965
|
|
|
966 (defun w3-handle-/div (&optional args)
|
|
|
967 (w3-handle-emphasis-end)
|
|
|
968 (let ((tag (cdr-safe (assq tag w3-end-tags))))
|
|
|
969 (w3-handle-paragraph)
|
|
|
970 (w3-pop-alignment)))
|
|
|
971
|
|
|
972 (defun w3-handle-note (&optional args)
|
|
|
973 (w3-handle-emphasis)
|
|
|
974 (w3-handle-paragraph)
|
|
|
975 (let ((align (or (w3-get-default-style-info 'align) 'indent)))
|
|
|
976 (w3-push-alignment align))
|
|
|
977 (w3-handle-text (concat (or (cdr-safe (assq 'role args)) "CAUTION") ":")))
|
|
|
978
|
|
|
979 (defun w3-handle-/note (&optional args)
|
|
|
980 (w3-handle-paragraph)
|
|
|
981 (w3-handle-emphasis-end)
|
|
|
982 (let ((tag (cdr-safe (assoc tag w3-end-tags))))
|
|
|
983 (w3-pop-alignment)))
|
|
|
984
|
|
|
985 (defun w3-handle-fig (&optional args)
|
|
|
986 (w3-put-state :figdata args)
|
|
|
987 (w3-put-state :figalt (set-marker (make-marker) (point)))
|
|
|
988 )
|
|
|
989
|
|
|
990 (defun w3-handle-caption (&optional args)
|
|
|
991 )
|
|
|
992
|
|
|
993 (defun w3-handle-/caption (&optional args)
|
|
|
994 )
|
|
|
995
|
|
|
996 (defun w3-handle-/fig (&optional args)
|
|
|
997 (let* ((data (w3-get-state :figdata))
|
|
|
998 (src (cdr-safe (assq 'src data)))
|
|
|
999 (aln (cdr-safe (assq 'align data)))
|
|
|
1000 (alt (if (w3-get-state :figalt)
|
|
|
1001 (prog1
|
|
|
1002 (buffer-substring (w3-get-state :figalt) (point))
|
|
|
1003 (delete-region (w3-get-state :figalt) (point)))))
|
|
|
1004 (ack nil))
|
|
|
1005 (setq w3-last-fill-pos (point))
|
|
|
1006 (if (not src)
|
|
|
1007 (w3-warn 'html "Malformed <fig> tag.")
|
|
|
1008 (setq ack (list (cons 'src src)
|
|
|
1009 (cons 'alt alt)
|
|
|
1010 (cons 'align aln)))
|
|
|
1011 (w3-handle-pre nil)
|
|
|
1012 (w3-handle-image ack)
|
|
|
1013 (w3-handle-/pre nil))))
|
|
|
1014
|
|
|
1015 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1016 ;;; Netscape Compatibility
|
|
|
1017 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1018 ; For some reason netscape treats </br> like <br> - ugh.
|
|
|
1019 (fset 'w3-handle-/br 'w3-handle-br)
|
|
|
1020
|
|
2
|
1021 (defun w3-create-blank-pixmap (width height)
|
|
|
1022 (let ((retval
|
|
|
1023 (concat "/* XPM */\n"
|
|
|
1024 "static char *pixmap[] = {\n"
|
|
|
1025 ;;"/* width height num_colors chars_per_pixel */\n"
|
|
|
1026 (format "\" %d %d 2 1\",\n" width height)
|
|
|
1027 ;;"/* colors */\n"
|
|
|
1028 "\". c #000000 s background\",\n"
|
|
|
1029 "\"# c #FFFFFF s foreground\",\n"
|
|
|
1030 ;;"/* pixels /*\n"
|
|
|
1031 ))
|
|
|
1032 (line (concat "\"" (make-string width ?.) "\"")))
|
|
|
1033 (while (/= 1 height)
|
|
|
1034 (setq retval (concat retval line ",\n")
|
|
|
1035 height (1- height)))
|
|
|
1036 (concat retval line "\n};")))
|
|
|
1037
|
|
|
1038 (defun w3-handle-spacer (&optional args)
|
|
|
1039 (let ((type (cdr-safe (assq 'type args)))
|
|
|
1040 (size (cdr-safe (assq 'size args)))
|
|
|
1041 (w (or (cdr-safe (assq 'width args)) 1))
|
|
|
1042 (h (or (cdr-safe (assq 'height args)) 1))
|
|
|
1043 (align (cdr-safe (assq 'align args)))
|
|
|
1044 (glyph nil))
|
|
|
1045 (condition-case ()
|
|
|
1046 (setq glyph (make-glyph
|
|
|
1047 (vector 'xpm :data (w3-create-blank-pixmap w h))))
|
|
|
1048 (error nil))
|
|
|
1049 )
|
|
|
1050 )
|
|
|
1051
|
|
0
|
1052 (defun w3-handle-font (&optional args)
|
|
|
1053 (let* ((sizearg (cdr-safe (assq 'size args)))
|
|
|
1054 (sizenum (cond
|
|
|
1055 ((null sizearg) nil)
|
|
|
1056 ((= ?+ (string-to-char sizearg))
|
|
|
1057 (min (+ 3 (string-to-int (substring sizearg 1))) 7))
|
|
|
1058 ((= ?- (string-to-char sizearg))
|
|
|
1059 (max (- 3 (string-to-int (substring sizearg 1))) 0))
|
|
|
1060 ((string= sizearg (int-to-string (string-to-int sizearg)))
|
|
|
1061 (string-to-int sizearg))
|
|
|
1062 (t nil)))
|
|
2
|
1063 (family (cdr-safe (assq 'face args)))
|
|
0
|
1064 (color (cdr-safe (assq 'color args)))
|
|
|
1065 (normcolor (if color (w3-normalize-color color)))
|
|
2
|
1066 (w3-current-stylesheet (list
|
|
|
1067 (list 'font
|
|
|
1068 (list 'internal
|
|
|
1069 (cons 'font-family family)
|
|
|
1070 (cons 'font-size-index sizenum)
|
|
|
1071 (cons 'foreground normcolor))))))
|
|
|
1072 (w3-style-post-process-stylesheet w3-current-stylesheet)
|
|
0
|
1073 (w3-handle-emphasis args)))
|
|
|
1074
|
|
|
1075 (defun w3-handle-/font (&optional args)
|
|
|
1076 (w3-handle-emphasis-end))
|
|
|
1077
|
|
|
1078 (defun w3-handle-center (&optional args)
|
|
|
1079 (w3-handle-paragraph)
|
|
|
1080 (w3-push-alignment 'center))
|
|
|
1081
|
|
|
1082 (defun w3-handle-/center (&optional args)
|
|
|
1083 (w3-handle-paragraph)
|
|
|
1084 (let ((tag 'center))
|
|
|
1085 (w3-pop-alignment)))
|
|
|
1086
|
|
|
1087 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1088 ;;; Bonus HTML Tags just for fun :)
|
|
|
1089 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1090 (defun w3-handle-embed (&optional args)
|
|
2
|
1091 ;; This needs to be reimplemented!!!
|
|
|
1092 )
|
|
0
|
1093
|
|
|
1094 (defun w3-handle-blink (&optional args)
|
|
|
1095 ;; Keep track of all the buffers with blinking in them, and do GC
|
|
|
1096 ;; of this list whenever a new <blink> tag is encountered. The
|
|
|
1097 ;; timer checks this list to see if any of the buffers are visible,
|
|
|
1098 ;; and only blinks the face if there are any visible. This cuts
|
|
|
1099 ;; down tremendously on the amount of X traffic, and frame !@#!age
|
|
|
1100 ;; due to lots of face munging.
|
|
|
1101 (w3-handle-emphasis args)
|
|
|
1102 (let ((buffs w3-blinking-buffs)
|
|
|
1103 (name1 (buffer-name))
|
|
|
1104 (name2 nil)
|
|
|
1105 (add t))
|
|
|
1106 (setq w3-blinking-buffs nil)
|
|
|
1107 ;; Get rid of old buffers
|
|
|
1108 (while buffs
|
|
|
1109 (setq name2 (buffer-name (car buffs)))
|
|
|
1110 (if (null name2)
|
|
|
1111 nil
|
|
|
1112 (setq w3-blinking-buffs (cons (car buffs) w3-blinking-buffs))
|
|
|
1113 (if (string= name1 name2)
|
|
|
1114 (setq add nil)))
|
|
|
1115 (setq buffs (cdr buffs)))
|
|
|
1116 (if add
|
|
|
1117 (setq w3-blinking-buffs (cons (current-buffer) w3-blinking-buffs)))))
|
|
|
1118
|
|
|
1119 (defun w3-handle-/blink (&optional args)
|
|
|
1120 (w3-handle-emphasis-end args))
|
|
|
1121
|
|
|
1122 (defun w3-handle-peek (&optional args)
|
|
|
1123 ;; Handle the peek tag. Valid attributes are:
|
|
|
1124 ;; VARIABLE:: any valid lisp variable
|
|
|
1125 ;; If VARIABLE is bound and non-nil, then the value of the variable is
|
|
|
1126 ;; inserted at point. This can handle variables whos values are any
|
|
|
1127 ;; arbitrary lisp type.
|
|
|
1128 (let* ((var-name (cdr-safe (assq 'variable args)))
|
|
|
1129 (var-sym (and var-name (intern var-name)))
|
|
|
1130 (val (and var-sym (boundp var-sym) (symbol-value var-sym))))
|
|
|
1131 (cond
|
|
|
1132 ((null val) nil)
|
|
|
1133 ((stringp val) (w3-handle-text val))
|
|
|
1134 (t (w3-handle-text (format "%S" val))))))
|
|
|
1135
|
|
|
1136 (defun w3-rotate-region (st nd &optional rotation)
|
|
|
1137 "Ceasar rotate a region between ST and ND using ROTATION as the
|
|
|
1138 amount to rotate the text. Defaults to caesar (13)."
|
|
|
1139 (setq rotation (or rotation 13))
|
|
|
1140 (save-excursion
|
|
|
1141 (let (x)
|
|
|
1142 (while (< st nd)
|
|
|
1143 (setq x (char-after st))
|
|
|
1144 (cond
|
|
|
1145 ((and (>= x ?a) (<= x ?z))
|
|
|
1146 (setq x (- x ?a)
|
|
|
1147 x (char-to-string (+ (% (+ x rotation) 26) ?a))))
|
|
|
1148 ((and (>= x ?A) (<= x ?Z))
|
|
|
1149 (setq x (- x ?A)
|
|
|
1150 x (char-to-string (+ (% (+ x rotation) 26) ?A))))
|
|
|
1151 (t (setq x nil)))
|
|
|
1152 (if x (progn (goto-char st) (delete-char 1) (insert x)))
|
|
|
1153 (setq st (1+ st))))))
|
|
|
1154
|
|
|
1155 (defun w3-handle-kill-sgml (&optional args)
|
|
|
1156 (w3-handle-text "SGML is the spawn of evil! It must be stopped!"))
|
|
|
1157
|
|
|
1158 (defun w3-handle-secret (&optional args)
|
|
|
1159 (if (fboundp 'valid-specifier-locale-p)
|
|
|
1160 (let ((tag 'rot13))
|
|
|
1161 (w3-handle-emphasis))
|
|
|
1162 (w3-put-state :secret (set-marker (make-marker) (point)))))
|
|
|
1163
|
|
|
1164 (defun w3-handle-/secret (&optional args)
|
|
|
1165 "Close a secret region of text."
|
|
|
1166 (if (fboundp 'valid-specifier-locale-p)
|
|
|
1167 (let ((tag '/rot13))
|
|
|
1168 (w3-handle-emphasis-end))
|
|
|
1169 (if (integer-or-marker-p (w3-get-state :secret))
|
|
|
1170 (progn
|
|
|
1171 (w3-rotate-region (w3-get-state :secret) (point))
|
|
|
1172 (w3-put-state :secret nil)))))
|
|
|
1173
|
|
|
1174 (defun w3-handle-hype (&optional args)
|
|
|
1175 (if (and (or (featurep 'nas-sound) (featurep 'native-sound))
|
|
|
1176 (assoc 'hype sound-alist))
|
|
|
1177 (play-sound 'hype 100)
|
|
|
1178 (w3-handle-text "Hey, has Marca A. told you how cool he is?")))
|
|
|
1179
|
|
|
1180 (defun w3-handle-yogsothoth (&optional args)
|
|
|
1181 (w3-handle-image (list (cons 'src "href-to-yogsothoth-pic")
|
|
|
1182 (cons 'alt "YOGSOTHOTH LIVES!!!"))))
|
|
|
1183
|
|
|
1184 (defun w3-handle-roach (&optional args)
|
|
|
1185 (w3-handle-text "Man, I am so wasted..."))
|
|
|
1186
|
|
|
1187 (defun w3-handle-/roach (&optional args)
|
|
|
1188 (w3-handle-text (concat "So, you wanna get some "
|
|
|
1189 (or (cdr-safe (assq 'munchy args))
|
|
|
1190 "nachos") "? ")))
|
|
|
1191
|
|
|
1192 (defun w3-invert-face (face)
|
|
|
1193 (let ((buffs w3-blinking-buffs)
|
|
|
1194 (blink nil)
|
|
|
1195 (buff nil))
|
|
|
1196 (if buffs
|
|
|
1197 (while buffs
|
|
|
1198 (setq buff (car buffs))
|
|
|
1199 (cond
|
|
|
1200 ((bufferp buff)
|
|
|
1201 (if (buffer-name buff)
|
|
|
1202 (setq buff (car buffs))
|
|
|
1203 (setq buff nil)))
|
|
|
1204 ((stringp buff)
|
|
|
1205 (setq buff (get-buffer buff)))
|
|
|
1206 (t
|
|
|
1207 (setq buff nil)))
|
|
|
1208 (setq buffs (cdr buffs)
|
|
|
1209 buff (and buff (get-buffer-window buff 'visible))
|
|
|
1210 buff (and buff (window-live-p buff)))
|
|
|
1211 (if buff (setq buffs nil
|
|
|
1212 blink t))))
|
|
|
1213 (if blink (invert-face face))))
|
|
|
1214
|
|
|
1215 (autoload 'sentence-ify "flame")
|
|
|
1216 (autoload 'string-ify "flame")
|
|
|
1217 (autoload '*flame "flame")
|
|
|
1218 (if (not (fboundp 'flatten)) (autoload 'flatten "flame"))
|
|
|
1219
|
|
|
1220 (defvar w3-cookie-cache nil)
|
|
|
1221
|
|
|
1222 (defun w3-handle-cookie (&optional args)
|
|
|
1223 (if (not (fboundp 'cookie))
|
|
|
1224 (w3-handle-text "Sorry, no cookies today.")
|
|
|
1225 (let* ((url-working-buffer (url-generate-new-buffer-name " *cookie*"))
|
|
|
1226 (href (url-expand-file-name
|
|
|
1227 (or (cdr-safe (assq 'src args))
|
|
|
1228 (cdr-safe (assq 'href args)))
|
|
|
1229 (cdr-safe (assoc (cdr-safe (assq 'base args))
|
|
|
1230 w3-base-alist))))
|
|
|
1231 (fname (or (cdr-safe (assoc href w3-cookie-cache))
|
|
|
1232 (url-generate-unique-filename "%s.cki")))
|
|
|
1233 (st (or (cdr-safe (assq 'start args)) "Loading cookies..."))
|
|
|
1234 (nd (or (cdr-safe (assq 'end args))
|
|
|
1235 "Loading cookies... done.")))
|
|
|
1236 (if (not (assoc href w3-cookie-cache))
|
|
|
1237 (save-excursion
|
|
|
1238 (url-clear-tmp-buffer)
|
|
|
1239 (setq url-be-asynchronous nil)
|
|
|
1240 (url-retrieve href)
|
|
|
1241 (url-uncompress)
|
|
|
1242 (write-region (point-min) (point-max) fname 5)
|
|
|
1243 (setq w3-cookie-cache (cons (cons href fname) w3-cookie-cache))))
|
|
|
1244 (w3-handle-text (cookie fname st nd)))))
|
|
|
1245
|
|
|
1246 (defun w3-handle-flame (&optional args)
|
|
|
1247 (condition-case ()
|
|
|
1248 (w3-handle-text
|
|
|
1249 (concat
|
|
|
1250 (sentence-ify
|
|
|
1251 (string-ify
|
|
|
1252 (append-suffixes-hack (flatten (*flame)))))))
|
|
|
1253 (error nil)))
|
|
|
1254
|
|
|
1255 (defun w3-handle-pinhead (&optional args)
|
|
|
1256 (if (fboundp 'yow)
|
|
|
1257 (w3-handle-text (yow))))
|
|
|
1258
|
|
|
1259 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1260 ;;; Client-side Imagemaps
|
|
|
1261 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1262 (defun w3-handle-map (&optional args)
|
|
|
1263 (w3-put-state :map (cons (or (cdr-safe (assq 'name args))
|
|
|
1264 (cdr-safe (assq 'id args))
|
|
|
1265 "unnamed") nil)))
|
|
|
1266
|
|
|
1267 (defun w3-handle-/map (&optional args)
|
|
|
1268 (and (w3-get-state :map)
|
|
|
1269 (setq w3-imagemaps (cons (w3-get-state :map) w3-imagemaps)))
|
|
|
1270 (w3-put-state :map nil))
|
|
|
1271
|
|
|
1272 (defun w3-decode-area-coords (str)
|
|
|
1273 (let (retval)
|
|
|
1274 (while (string-match "\\([ \t0-9]+\\),\\([ \t0-9]+\\)" str)
|
|
|
1275 (setq retval (cons (vector (string-to-int (match-string 1 str))
|
|
|
1276 (string-to-int (match-string 2 str))) retval)
|
|
|
1277 str (substring str (match-end 0) nil)))
|
|
|
1278 (if (string-match "\\([0-9]+\\)" str)
|
|
|
1279 (setq retval (cons (vector (+ (aref (car retval) 0)
|
|
|
1280 (string-to-int (match-string 1 str)))
|
|
|
1281 (aref (car retval) 1)) retval)))
|
|
|
1282 (nreverse retval)))
|
|
|
1283
|
|
|
1284 (defun w3-handle-area (&optional args)
|
|
|
1285 (let ((type (downcase (or (cdr-safe (assq 'shape args)) "rect")))
|
|
|
1286 (coords (w3-decode-area-coords (or (cdr-safe (assq 'coords args)) "")))
|
|
|
1287 (alt (cdr-safe (assq 'alt args)))
|
|
|
1288 (href (if (assq 'nohref args)
|
|
|
1289 t
|
|
|
1290 (url-expand-file-name
|
|
|
1291 (or (cdr-safe (assq 'src args))
|
|
|
1292 (cdr-safe (assq 'href args)))
|
|
|
1293 (cdr-safe (assoc (cdr-safe (assq 'base args))
|
|
|
1294 w3-base-alist)))))
|
|
|
1295 (map (w3-get-state :map)))
|
|
|
1296 ;; data structure in storage is a vector
|
|
|
1297 ;; if (href == t) then no action should be taken
|
|
|
1298 ;; [ type coordinates href (hopefully)descriptive-text]
|
|
|
1299 (setcdr map (cons (vector type coords href alt) (cdr map)))))
|
|
|
1300
|
|
|
1301 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1302 ;;; Tags that don't really get drawn, etc.
|
|
|
1303 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2
|
1304 (defun w3-handle-/html (&optional args)
|
|
|
1305 ;; Technically, we are not supposed to have any text outside the
|
|
|
1306 ;; html element, so start ignoring everything.
|
|
|
1307 (put 'text 'w3-formatter 'ack))
|
|
|
1308
|
|
0
|
1309 (defun w3-handle-body (&optional args)
|
|
|
1310 (if (not w3-user-colors-take-precedence)
|
|
|
1311 (let* ((vlink (cdr-safe (assq 'vlink args)))
|
|
|
1312 (alink (cdr-safe (assq 'alink args)))
|
|
|
1313 (link (cdr-safe (assq 'link args)))
|
|
|
1314 (text (cdr-safe (assq 'text args)))
|
|
|
1315 (backg (cdr-safe (assq 'background args)))
|
|
|
1316 (rgb (or (cdr-safe (assq 'bgcolor args))
|
|
|
1317 (cdr-safe (assq 'rgb args))))
|
|
|
1318 (temp-face nil)
|
|
|
1319 (sheet ""))
|
|
|
1320 (setq backg (url-expand-file-name
|
|
|
1321 backg
|
|
|
1322 (cdr-safe (assoc (cdr-safe (assq 'base args))
|
|
|
1323 w3-base-alist))))
|
|
|
1324 (if (or text rgb backg)
|
|
|
1325 (progn
|
|
|
1326 (setq sheet "html {")
|
|
|
1327 (if text (setq sheet (format "%scolor: %s; " sheet
|
|
|
1328 (w3-normalize-color text))))
|
|
|
1329 (if rgb (setq sheet (format "%sbackground: %s; "
|
|
|
1330 sheet (w3-normalize-color rgb))))
|
|
|
1331 (if backg (setq sheet (format "%sbackdrop: %s; "
|
|
|
1332 sheet backg)))
|
|
|
1333 (setq sheet (concat sheet " }\n"))))
|
|
|
1334 (if link
|
|
|
1335 (setq sheet (format "%sa.link { color: %s }\n" sheet
|
|
|
1336 (w3-normalize-color link))))
|
|
|
1337 (if vlink
|
|
|
1338 (setq sheet (format "%sa.visited { color: %s }\n" sheet
|
|
|
1339 (w3-normalize-color vlink))))
|
|
|
1340 (if alink
|
|
|
1341 (setq sheet (format "%sa.active { color: %s }\n" sheet
|
|
|
1342 (w3-normalize-color alink))))
|
|
|
1343 (if (/= (length sheet) 0)
|
|
|
1344 (w3-handle-style (list (cons 'data sheet)
|
|
|
1345 (cons 'notation "css")))))))
|
|
|
1346
|
|
|
1347 (defun w3-handle-cryptopts (&optional args)
|
|
|
1348 (put 'text 'w3-formatter 'ack))
|
|
|
1349
|
|
|
1350 (defun w3-handle-/cryptopts (&optional args)
|
|
|
1351 (put 'text 'w3-formatter nil))
|
|
|
1352
|
|
|
1353 (defun w3-handle-certs (&optional args)
|
|
|
1354 (put 'text 'w3-formatter 'ack))
|
|
|
1355
|
|
|
1356 (defun w3-handle-/certs (&optional args)
|
|
|
1357 (put 'text 'w3-formatter nil))
|
|
|
1358
|
|
|
1359 (defun w3-handle-base (&optional args)
|
|
|
1360 (setq w3-base-alist (cons
|
|
|
1361 (cons (or (cdr-safe (assq 'name args))
|
|
|
1362 (cdr-safe (assq 'id args)))
|
|
|
1363 (or (cdr-safe (assq 'href args))
|
|
|
1364 (cdr-safe (assq 'src args))
|
|
|
1365 (url-view-url t)))
|
|
|
1366 w3-base-alist)))
|
|
|
1367
|
|
|
1368 (defun w3-handle-isindex (&optional args)
|
|
|
1369 (let ((prompt (or (cdr-safe (assq 'prompt args))
|
|
|
1370 "Search on (+ separates keywords): "))
|
|
|
1371 action)
|
|
|
1372 (setq action (url-expand-file-name
|
|
|
1373 (or (cdr-safe (assq 'src args))
|
|
|
1374 (cdr-safe (assq 'href args))
|
|
|
1375 (url-view-url t))
|
|
|
1376 (cdr-safe (assoc (cdr-safe (assq 'base args))
|
|
|
1377 w3-base-alist))))
|
|
|
1378 (if (and prompt (string-match "[^: \t-]+$" prompt))
|
|
|
1379 (setq prompt (concat prompt ": ")))
|
|
|
1380 (if w3-use-forms-index
|
|
|
1381 (progn
|
|
|
1382 (w3-handle-hr)
|
|
|
1383 (w3-handle-form (list (cons 'action action)
|
|
|
1384 (cons 'enctype "application/x-w3-isindex")
|
|
|
1385 (cons 'method "get")))
|
|
|
1386 (w3-handle-text (concat prompt " "))
|
|
|
1387 (w3-handle-input (list (cons 'type "text")
|
|
|
1388 (cons 'name "isindex")))))
|
|
|
1389 (setq w3-current-isindex (cons action prompt))))
|
|
|
1390
|
|
|
1391 (defun w3-handle-meta (&optional args)
|
|
|
1392 (let* ((equiv (cdr-safe (assq 'http-equiv args)))
|
|
|
1393 (value (cdr-safe (assq 'content args)))
|
|
|
1394 (node (and equiv (assoc (setq equiv (downcase equiv))
|
|
|
1395 url-current-mime-headers))))
|
|
|
1396 (if equiv
|
|
|
1397 (setq url-current-mime-headers (cons (cons equiv value)
|
|
|
1398 url-current-mime-headers)))
|
|
|
1399 ;; Special-case the Set-Cookie header
|
|
|
1400 (if (and equiv (string= (downcase equiv) "set-cookie"))
|
|
|
1401 (url-cookie-handle-set-cookie value))
|
|
|
1402 ;; Special-case the refresh header
|
|
|
1403 (if (and equiv (string= (downcase equiv) "refresh"))
|
|
|
1404 (url-handle-refresh-header value))))
|
|
|
1405
|
|
|
1406 (defun w3-handle-link (&optional args)
|
|
|
1407 (let* ((dest (cdr-safe (assq 'href args)))
|
|
|
1408 (type (if (assq 'rel args) "Parent of" "Child of"))
|
|
|
1409 (desc (or (cdr-safe (assq 'rel args))
|
|
|
1410 (cdr-safe (assq 'rev args))))
|
|
|
1411 (node-1 (assoc type w3-current-links))
|
|
|
1412 (node-2 (and node-1 desc (assoc desc (cdr node-1))))
|
|
|
1413 (base (cdr-safe (assq 'base args))))
|
|
|
1414 (if dest
|
|
|
1415 (progn
|
|
|
1416 (setq dest (url-expand-file-name
|
|
|
1417 dest
|
|
|
1418 (cdr-safe (assoc base w3-base-alist))))
|
|
|
1419 (cond
|
|
|
1420 (node-2 ; Add to old value
|
|
|
1421 (setcdr node-2 (cons dest (cdr node-2))))
|
|
|
1422 (node-1 ; first rel/rev
|
|
|
1423 (setcdr node-1 (cons (cons desc (list dest)) (cdr node-1))))
|
|
|
1424 (t (setq w3-current-links
|
|
|
1425 (cons (cons type (list (cons desc (list dest))))
|
|
|
1426 w3-current-links))))
|
|
|
1427 (if (and dest desc (member (downcase desc)
|
|
|
1428 '("style" "stylesheet")))
|
|
|
1429 (w3-handle-style (list (cons 'src dest))))))))
|
|
|
1430
|
|
|
1431 (defun w3-maybe-start-image-download (widget)
|
|
|
1432 (let* ((src (widget-get widget 'src))
|
|
|
1433 (cached-glyph (w3-image-cached-p src)))
|
|
|
1434 (if (and cached-glyph (w3-glyphp cached-glyph))
|
|
2
|
1435 (setq w3-image-widgets-waiting (cons widget w3-image-widgets-waiting))
|
|
0
|
1436 (cond
|
|
|
1437 ((or w3-delay-image-loads (not (fboundp 'valid-specifier-domain-p)))
|
|
2
|
1438 (w3-add-delayed-graphic widget))
|
|
0
|
1439 ((not (w3-image-loadable-p src nil)) ; Hey, we can't load it!
|
|
2
|
1440 (w3-warn 'images (format "Skipping image %s" (url-basepath src t)))
|
|
|
1441 (w3-add-delayed-graphic widget))
|
|
0
|
1442 (t ; Grab the images
|
|
|
1443 (let (
|
|
|
1444 (url-request-method "GET")
|
|
|
1445 (old-asynch url-be-asynchronous)
|
|
|
1446 (url-request-data nil)
|
|
|
1447 (url-request-extra-headers nil)
|
|
|
1448 (url-source t)
|
|
|
1449 (url-mime-accept-string (substring
|
|
|
1450 (mapconcat
|
|
|
1451 (function
|
|
|
1452 (lambda (x)
|
|
|
1453 (if x
|
|
|
1454 (concat (car x) ",")
|
|
|
1455 "")))
|
|
|
1456 w3-allowed-image-types "")
|
|
|
1457 0 -1))
|
|
|
1458 (url-working-buffer (generate-new-buffer-name " *W3GRAPH*")))
|
|
|
1459 (setq-default url-be-asynchronous t)
|
|
|
1460 (setq w3-graphics-list (cons (cons src (make-glyph))
|
|
|
1461 w3-graphics-list))
|
|
|
1462 (save-excursion
|
|
|
1463 (set-buffer (get-buffer-create url-working-buffer))
|
|
|
1464 (setq url-current-callback-data (list widget)
|
|
|
1465 url-be-asynchronous t
|
|
|
1466 url-current-callback-func 'w3-finalize-image-download)
|
|
|
1467 (url-retrieve src))
|
|
|
1468 (setq-default url-be-asynchronous old-asynch)))))))
|
|
|
1469
|
|
|
1470 (defun w3-finalize-image-download (widget)
|
|
|
1471 (let ((glyph nil)
|
|
|
1472 (url (widget-get widget 'src))
|
|
|
1473 (node nil)
|
|
|
1474 (buffer (widget-get widget 'buffer)))
|
|
|
1475 (message "Enhancing image...")
|
|
|
1476 (setq glyph (image-normalize (cdr-safe (assoc url-current-mime-type
|
|
|
1477 w3-image-mappings))
|
|
|
1478 (buffer-string)))
|
|
|
1479 (message "Enhancing image... done")
|
|
|
1480 (kill-buffer (current-buffer))
|
|
|
1481 (cond
|
|
|
1482 ((w3-image-invalid-glyph-p glyph)
|
|
|
1483 (w3-warn 'image (format "Reading of %s failed." url)))
|
|
|
1484 ((eq (aref glyph 0) 'xbm)
|
|
|
1485 (let ((temp-fname (url-generate-unique-filename "%s.xbm")))
|
|
|
1486 (save-excursion
|
|
|
1487 (set-buffer (generate-new-buffer " *xbm-garbage*"))
|
|
|
1488 (erase-buffer)
|
|
|
1489 (insert (aref glyph 2))
|
|
|
1490 (setq glyph temp-fname)
|
|
|
1491 (write-region (point-min) (point-max) temp-fname)
|
|
|
1492 (kill-buffer (current-buffer)))
|
|
|
1493 (setq glyph (make-glyph (list (cons 'x glyph))))
|
|
|
1494 (condition-case ()
|
|
|
1495 (delete-file temp-fname)
|
|
|
1496 (error nil))))
|
|
|
1497 (t
|
|
|
1498 (setq glyph (make-glyph glyph))))
|
|
|
1499 (setq node (assoc url w3-graphics-list))
|
|
|
1500 (if node
|
|
|
1501 (set-glyph-image (cdr node) (glyph-image glyph))
|
|
|
1502 (setq w3-graphics-list (cons (cons url glyph) w3-graphics-list)))
|
|
|
1503
|
|
|
1504 (if (and (buffer-name buffer) ; Dest. buffer exists
|
|
|
1505 (w3-glyphp glyph)) ; got a valid glyph
|
|
|
1506 (save-excursion
|
|
|
1507 (set-buffer buffer)
|
|
|
1508 (if (eq major-mode 'w3-mode)
|
|
|
1509 (widget-value-set widget glyph)
|
|
|
1510 (setq w3-image-widgets-waiting
|
|
|
1511 (cons widget w3-image-widgets-waiting)))))))
|
|
|
1512
|
|
|
1513 (defun w3-handle-image (&optional args)
|
|
|
1514 (let* ((parms args)
|
|
|
1515 (height (cdr-safe (assq 'height parms)))
|
|
|
1516 (width (cdr-safe (assq 'width parms)))
|
|
|
1517 (src (or (cdr-safe (assq 'src parms))
|
|
|
1518 "Error Image"))
|
|
|
1519 (our-alt (cond
|
|
|
1520 ((null w3-auto-image-alt) "")
|
|
|
1521 ((eq t w3-auto-image-alt)
|
|
|
1522 (concat "[IMAGE(" (url-basepath src t) ")] "))
|
|
|
1523 ((stringp w3-auto-image-alt)
|
|
|
1524 (format w3-auto-image-alt (url-basepath src t)))))
|
|
|
1525 (alt (or (cdr-safe (assq 'alt parms))
|
|
|
1526 our-alt))
|
|
|
1527 (ismap (and (assq 'ismap args) 'ismap))
|
|
|
1528 (usemap (cdr-safe (assq 'usemap args)))
|
|
|
1529 (dest (w3-get-state :href))
|
|
|
1530 (base (cdr-safe (assq 'base args)))
|
|
|
1531 (widget nil)
|
|
|
1532 (zone (w3-get-state :zone))
|
|
|
1533 (align (intern (or (cdr-safe (assq 'align parms)) "middle"))))
|
|
|
1534 (setq src (url-expand-file-name src
|
|
|
1535 (cdr-safe (assoc base w3-base-alist))))
|
|
|
1536 (if dest
|
|
|
1537 (w3-handle-hyperlink-end))
|
|
|
1538 (setq widget
|
|
|
1539 (widget-create 'image
|
|
|
1540 'src src ; Where to load the image from
|
|
|
1541 'alt alt ; Textual replacement
|
|
|
1542 'ismap ismap ; Is it a server-side map?
|
|
|
1543 'usemap usemap ; Is it a client-side map?
|
|
|
1544 'href dest ; Hyperlink destination
|
|
|
1545 ))
|
|
|
1546 (widget-put widget 'buffer (current-buffer))
|
|
|
1547 (w3-maybe-start-image-download widget)
|
|
|
1548 (goto-char (point-max))
|
|
|
1549 (if dest
|
|
|
1550 (w3-handle-hyperlink (list (cons 'href dest))))))
|
|
|
1551
|
|
|
1552 (defun w3-handle-title (&optional args)
|
|
|
1553 (if (w3-get-state :title)
|
|
|
1554 (w3-put-state :title nil))
|
|
|
1555 (put 'text 'w3-formatter 'w3-handle-title-text))
|
|
|
1556
|
|
|
1557 (defun w3-handle-title-text (&optional args)
|
|
|
1558 (w3-put-state :title
|
|
|
1559 (concat (w3-get-state :title) args)))
|
|
|
1560
|
|
|
1561 (defun w3-handle-/title (&optional args)
|
|
|
1562 (put 'text 'w3-formatter nil)
|
|
|
1563 (let ((ttl (w3-get-state :title)))
|
|
2
|
1564 (if (not (stringp ttl))
|
|
|
1565 nil
|
|
0
|
1566 (setq ttl (w3-fix-spaces ttl))
|
|
|
1567 (if (and ttl (string= ttl ""))
|
|
|
1568 (setq ttl (w3-fix-spaces (url-view-url t))))
|
|
|
1569 (rename-buffer (url-generate-new-buffer-name ttl))
|
|
|
1570 ;; Make the URL show in list-buffers output
|
|
|
1571 (make-local-variable 'list-buffers-directory)
|
|
|
1572 (setq list-buffers-directory (url-view-url t))
|
|
2
|
1573 (w3-put-state :title t))))
|
|
0
|
1574
|
|
|
1575 (fset 'w3-handle-/head 'w3-handle-/title)
|
|
|
1576
|
|
|
1577 (defun w3-handle-hyperlink (&optional args)
|
|
|
1578 (let* ((href-node (assq 'href args))
|
|
|
1579 (href (cdr href-node))
|
|
|
1580 (title (cdr-safe (assq 'title args)))
|
|
|
1581 (base (cdr-safe (assq 'base args)))
|
|
|
1582 (name (or (cdr-safe (assq 'id args))
|
|
|
1583 (cdr-safe (assq 'name args)))))
|
|
|
1584 (if href
|
|
|
1585 (progn
|
|
|
1586 (setq href (url-expand-file-name href (cdr-safe
|
|
|
1587 (assoc base w3-base-alist))))
|
|
|
1588 (setcdr href-node href)))
|
|
|
1589 (w3-put-state :seen-this-url (url-have-visited-url href))
|
|
|
1590 (w3-put-state :zone (point))
|
|
|
1591 (w3-put-state :link-args args)
|
|
|
1592 (if title (w3-put-state :link-title title))
|
|
|
1593 (if href (w3-put-state :href href))
|
|
|
1594 (if name (w3-put-state :name name))))
|
|
|
1595
|
|
|
1596 (defun w3-follow-hyperlink (widget &rest ignore)
|
|
2
|
1597 (let* ((target (widget-get widget 'target))
|
|
|
1598 (href (widget-get widget 'href))
|
|
|
1599 (tag 'a)
|
|
|
1600 (args '((class . "visited")))
|
|
|
1601 (face (cdr (w3-face-for-element)))
|
|
|
1602 (old-face (and (widget-get widget :from)
|
|
|
1603 (get-text-property (widget-get widget :from) 'face)))
|
|
|
1604 (faces (cond
|
|
|
1605 ((and old-face (consp old-face)) (cons face old-face))
|
|
|
1606 (old-face (cons face (list old-face)))
|
|
|
1607 (t (list face)))))
|
|
0
|
1608 (if target (setq target (intern (downcase target))))
|
|
2
|
1609 (put-text-property (widget-get widget :from) (widget-get widget :to)
|
|
|
1610 'face faces)
|
|
0
|
1611 (case target
|
|
|
1612 ((_blank external)
|
|
|
1613 (w3-fetch-other-frame href))
|
|
|
1614 (_top
|
|
|
1615 (delete-other-windows)
|
|
|
1616 (w3-fetch href))
|
|
|
1617 (otherwise
|
|
|
1618 (w3-fetch href)))))
|
|
|
1619
|
|
2
|
1620 (defun w3-balloon-help-callback (object &optional event)
|
|
|
1621 (let* ((widget (widget-at (extent-start-position object)))
|
|
|
1622 (href (and widget (widget-get widget 'href))))
|
|
|
1623 (if href
|
|
|
1624 (url-truncate-url-for-viewing href)
|
|
|
1625 nil)))
|
|
|
1626
|
|
0
|
1627 (defun w3-handle-hyperlink-end (&optional args)
|
|
|
1628 (let* ((href (w3-get-state :href))
|
|
|
1629 (old-args (w3-get-state :link-args))
|
|
|
1630 (name (w3-get-state :name))
|
|
|
1631 (zone (w3-get-state :zone))
|
|
|
1632 (btdt (and href (w3-get-state :seen-this-url)))
|
|
|
1633 (tag 'a)
|
|
|
1634 (args (list (cons 'class (if btdt "visited" "link"))))
|
|
|
1635 (face (cdr (w3-face-for-element)))
|
|
|
1636 (old-face (and zone (get-text-property zone 'face)))
|
|
|
1637 (faces (cond
|
|
|
1638 ((and old-face (consp old-face)) (cons face old-face))
|
|
|
1639 (old-face (cons face (list old-face)))
|
|
|
1640 (t (list face)))))
|
|
|
1641 (if (not href)
|
|
|
1642 nil
|
|
|
1643 (add-text-properties zone (point)
|
|
|
1644 (list 'mouse-face 'highlight
|
|
|
1645 'button
|
|
|
1646 (append
|
|
|
1647 (list 'push :args nil :value "" :tag ""
|
|
|
1648 :notify 'w3-follow-hyperlink
|
|
|
1649 :from (set-marker (make-marker) zone)
|
|
|
1650 :to (set-marker (make-marker) (point))
|
|
2
|
1651 )
|
|
0
|
1652 (alist-to-plist old-args))
|
|
|
1653 'face faces
|
|
2
|
1654 'balloon-help 'w3-balloon-help-callback
|
|
0
|
1655 'title (cons
|
|
|
1656 (set-marker (make-marker) zone)
|
|
|
1657 (set-marker (make-marker) (point)))
|
|
|
1658 'help-echo href))
|
|
|
1659 (w3-put-state :zone nil)
|
|
|
1660 (w3-put-state :href nil)
|
|
|
1661 (w3-put-state :name nil)
|
|
|
1662 (if (and w3-link-info-display-function
|
|
|
1663 (fboundp w3-link-info-display-function))
|
|
|
1664 (let ((info (condition-case ()
|
|
|
1665 (funcall w3-link-info-display-function href)
|
|
|
1666 (error nil))))
|
|
|
1667 (if (and info (stringp info))
|
|
|
1668 (w3-handle-text info)))))))
|
|
|
1669
|
|
|
1670 (defvar w3-tab-alist nil
|
|
|
1671 "An assoc list of tab stops and their respective IDs")
|
|
|
1672 (make-variable-buffer-local 'w3-tab-alist)
|
|
|
1673
|
|
|
1674 (defun w3-handle-tab (&optional args)
|
|
|
1675 (let* ((id (cdr-safe (assq 'id args)))
|
|
|
1676 (to (cdr-safe (assq 'to args)))
|
|
|
1677 (pos (cdr-safe (assoc to w3-tab-alist))))
|
|
|
1678 (cond
|
|
|
1679 (id ; Define a new tab stop
|
|
|
1680 (setq w3-tab-alist (cons (cons id (current-column)) w3-tab-alist)))
|
|
|
1681 ((and to pos) ; Go to a currently defined tabstop
|
|
|
1682 (while (<= (current-column) pos)
|
|
|
1683 (insert " ")))
|
|
|
1684 (to ; Tabstop 'to' is no defined yet
|
|
|
1685 (w3-warn 'html (format "Unkown tab stop -- `%s'" to)))
|
|
|
1686 (t ; Just do a tab
|
|
|
1687 (insert (make-string w3-indent-level ? ))))))
|
|
|
1688
|
|
|
1689 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1690 ;;; Some bogus shit for pythia
|
|
|
1691 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1692 (defun w3-handle-margin (&optional args)
|
|
|
1693 (if (assq 'reset args)
|
|
|
1694 (w3-handle-/blockquote nil)
|
|
|
1695 (w3-handle-blockquote nil)))
|
|
|
1696
|
|
|
1697 (fset 'w3-handle-l 'w3-handle-br)
|
|
|
1698
|
|
|
1699 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1700 ;;; Guts of the forms interface for the new display engine
|
|
|
1701 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1702 (defun w3-handle-form (&optional args)
|
|
|
1703 (let ((actn (cdr-safe (assq 'action args)))
|
|
|
1704 (enct (cdr-safe (assq 'enctype args)))
|
|
|
1705 (meth (cdr-safe (assq 'method args))))
|
|
|
1706 (if (not meth) (setq args (cons (cons 'method "GET") args)))
|
|
|
1707 (if (not actn)
|
|
|
1708 (setq args (cons (cons 'action
|
|
|
1709 (or
|
|
|
1710 (cdr-safe (assoc (cdr-safe (assq 'base args))
|
|
|
1711 w3-base-alist))
|
|
|
1712 (url-view-url t))) args))
|
|
|
1713 (setcdr (assq 'action args)
|
|
|
1714 (url-expand-file-name
|
|
|
1715 actn
|
|
|
1716 (cdr-safe (assoc (cdr-safe (assq 'base args))
|
|
|
1717 w3-base-alist)))))
|
|
|
1718 (if (not enct)
|
|
|
1719 (setq args
|
|
|
1720 (cons (cons 'enctype "application/x-www-form-urlencoded")
|
|
|
1721 args)))
|
|
|
1722 (w3-put-state :form args)))
|
|
|
1723
|
|
|
1724 (defun w3-handle-/form (&optional args)
|
|
|
1725 (w3-handle-paragraph)
|
|
|
1726 (w3-put-state :form nil)
|
|
|
1727 (w3-put-state :formnum (1+ (w3-get-state :formnum)))
|
|
|
1728 )
|
|
|
1729
|
|
|
1730 (defun w3-handle-keygen (&optional args)
|
|
|
1731 (w3-form-add-element 'keygen
|
|
|
1732 (or (cdr-safe (assq 'name args)) "")
|
|
|
1733 nil
|
|
|
1734 nil
|
|
|
1735 1000
|
|
|
1736 nil
|
|
|
1737 (w3-get-state :form)
|
|
|
1738 nil
|
|
|
1739 (w3-get-state :formnum)
|
|
|
1740 nil
|
|
|
1741 (w3-face-for-element)))
|
|
|
1742
|
|
|
1743 (defun w3-handle-input (&optional args)
|
|
|
1744 (if (or (not (w3-get-state :form))
|
|
|
1745 (w3-get-state :select))
|
|
|
1746 (w3-warn
|
|
|
1747 'html
|
|
|
1748 "<input> outside of a <form> or inside <select> construct - ERROR!!")
|
|
|
1749 (let* ((type (intern (downcase (or (cdr-safe (assq 'type args)) "text"))))
|
|
|
1750 (name (cdr-safe (assq 'name args)))
|
|
|
1751 (value (or (cdr-safe (assq 'value args)) ""))
|
|
|
1752 (size (string-to-int (or (cdr-safe (assq 'size args)) "20")))
|
|
|
1753 (maxlength (cdr (assoc 'maxlength args)))
|
|
|
1754 (default value)
|
|
|
1755 (action (w3-get-state :form))
|
|
|
1756 (options)
|
|
|
1757 (num (w3-get-state :formnum))
|
|
|
1758 (id (cdr-safe (assq 'id args)))
|
|
|
1759 (checked (assq 'checked args))
|
|
|
1760 (face (w3-face-for-element)))
|
|
|
1761 (if (and (string-match "^[ \t\n\r]+$" value)
|
|
|
1762 (not (eq type 'hidden)))
|
|
|
1763 (setq value ""))
|
|
|
1764 (if maxlength (setq maxlength (string-to-int maxlength)))
|
|
|
1765 (if (and name (string-match "[\r\n]" name))
|
|
|
1766 (setq name (mapconcat (function
|
|
|
1767 (lambda (x)
|
|
|
1768 (if (memq x '(?\r ?\n))
|
|
|
1769 ""
|
|
|
1770 (char-to-string x))))
|
|
|
1771 name "")))
|
|
|
1772 (if (memq type '(checkbox radio)) (setq default checked))
|
|
|
1773 (if (and (eq type 'checkbox) (string= value ""))
|
|
|
1774 (setq value "on"))
|
|
|
1775 (w3-form-add-element type name value size maxlength default action
|
|
|
1776 options num id checked face))))
|
|
|
1777
|
|
|
1778 (defun w3-handle-/select (&optional args)
|
|
|
1779 (if (not (and (w3-get-state :form)
|
|
|
1780 (w3-get-state :select)))
|
|
|
1781 (w3-warn 'html
|
|
|
1782 "</select> outside of a <form> or <select> construct - ERROR!!")
|
|
|
1783 (put 'text 'w3-formatter 'w3-handle-text)
|
|
|
1784 (let* ((args (w3-get-state :select))
|
|
|
1785 (tag 'input)
|
|
|
1786 (face (w3-face-for-element))
|
|
|
1787 (opts (w3-get-state :options))
|
|
|
1788 (form (w3-get-state :form))
|
|
|
1789 (max-size nil)
|
|
|
1790 (type "OPTION")
|
|
|
1791 (default nil)
|
|
|
1792 (tmp nil)
|
|
|
1793 (id (cdr-safe (assq 'id args)))
|
|
|
1794 (checked nil)
|
|
|
1795 )
|
|
|
1796 (setq tmp (reverse opts))
|
|
|
1797 (if (assq 'multiple args)
|
|
|
1798 (let ((tag 'ul) ; Convert to a list of checkboxes
|
|
|
1799 (nam (or (cdr-safe (assq 'name args)) "option"))
|
|
|
1800 (old (w3-get-state :align))
|
|
|
1801 (first nil))
|
|
|
1802 (w3-put-state :options nil)
|
|
|
1803 (w3-put-state :select nil)
|
|
|
1804 (w3-handle-list-opening)
|
|
|
1805 (w3-put-state :align nil)
|
|
|
1806 (while tmp
|
|
|
1807 (w3-handle-list-item)
|
|
|
1808 (w3-handle-input (list (cons 'type "checkbox")
|
|
|
1809 (cons 'name nam)
|
|
|
1810 (cons 'value
|
|
|
1811 (or (cdr-safe
|
|
|
1812 (assq 'value (car tmp)))
|
|
|
1813 (cdr-safe
|
|
|
1814 (assoc 'ack (car tmp)))
|
|
|
1815 "unknown"))
|
|
|
1816 (if (or (assq 'checked (car tmp))
|
|
|
1817 (assq 'selected (car tmp)))
|
|
|
1818 (cons 'checked "checked"))))
|
|
|
1819 (w3-handle-text (concat " " (or
|
|
|
1820 (cdr-safe (assq 'ack (car tmp)))
|
|
|
1821 "unknown")))
|
|
|
1822 (setq tmp (cdr tmp)))
|
|
|
1823 (w3-handle-list-ending)
|
|
|
1824 (w3-put-state :align old))
|
|
|
1825 (while (and (not default) tmp)
|
|
|
1826 (if (or (assq 'checked (car tmp))
|
|
|
1827 (assq 'selected (car tmp)))
|
|
|
1828 (setq default (car tmp)))
|
|
|
1829 (setq tmp (cdr tmp)))
|
|
|
1830 (setq default (cdr (assq 'ack (or default
|
|
|
1831 (nth (1- (length opts)) opts))))
|
|
|
1832 checked (mapcar
|
|
|
1833 (function
|
|
|
1834 (lambda (x)
|
|
|
1835 (cons (cdr-safe (assq 'ack x))
|
|
|
1836 (or (cdr-safe (assq 'value x))
|
|
|
1837 (cdr-safe (assq 'ack x))))))
|
|
|
1838 opts)
|
|
|
1839 max-size (car (sort (mapcar
|
|
|
1840 (function
|
|
|
1841 (lambda (x)
|
|
|
1842 (length (cdr-safe (assq 'ack x)))))
|
|
|
1843 opts)
|
|
|
1844 '>)))
|
|
|
1845 (if (and form args opts)
|
|
|
1846 (let ((pos (point))
|
|
|
1847 (siz (max max-size
|
|
|
1848 (string-to-int
|
|
|
1849 (or (cdr-safe (assq 'size args)) "0")))))
|
|
|
1850 (w3-form-add-element 'option
|
|
|
1851 (or (cdr-safe (assq 'name args)) "option")
|
|
|
1852 default
|
|
|
1853 siz
|
|
|
1854 (string-to-int
|
|
|
1855 (or (cdr-safe (assq 'maxlength args))
|
|
|
1856 "1000"))
|
|
|
1857 default
|
|
|
1858 (w3-get-state :form)
|
|
|
1859 checked
|
|
|
1860 (w3-get-state :formnum)
|
|
|
1861 nil checked face)))))
|
|
|
1862 (w3-put-state :options nil)
|
|
|
1863 (w3-put-state :select nil)))
|
|
|
1864
|
|
|
1865 (defun w3-handle-option-data (&optional args)
|
|
|
1866 (let ((text (cond
|
|
|
1867 ((null args) nil)
|
|
|
1868 ((stringp args) args)
|
|
|
1869 ((listp args) (mapconcat 'identity args " ")))))
|
|
|
1870 (if text
|
|
|
1871 (progn
|
|
|
1872 (setq text (url-strip-leading-spaces
|
|
|
1873 (url-eat-trailing-space text)))
|
|
|
1874 (w3-put-state :options (cons (cons (cons 'ack text)
|
|
|
1875 (w3-get-state :optargs))
|
|
|
1876 (w3-get-state :options))))))
|
|
|
1877 (put 'text 'w3-formatter 'w3-handle-text))
|
|
|
1878
|
|
|
1879 (defun w3-handle-option (&optional args)
|
|
|
1880 (if (not (and (w3-get-state :form)
|
|
|
1881 (w3-get-state :select)))
|
|
|
1882 (w3-warn 'html
|
|
|
1883 "<option> outside of a <form> or <select> construct - ERROR!!")
|
|
|
1884 (w3-put-state :optargs args)
|
|
|
1885 (put 'text 'w3-formatter 'w3-handle-option-data)))
|
|
|
1886
|
|
|
1887 (defun w3-handle-select (&optional args)
|
|
|
1888 (if (not (w3-get-state :form))
|
|
|
1889 (w3-warn 'html "<select> outside of a <FORM> construct - ERROR!!")
|
|
|
1890 (w3-put-state :select args))
|
|
|
1891 )
|
|
|
1892
|
|
|
1893 (defun w3-handle-textarea (&optional args)
|
|
|
1894 (if (not (w3-get-state :form))
|
|
|
1895 (w3-warn 'html "<textarea> outside of a <FORM> construct - ERROR!!")
|
|
|
1896 (let ((node (assq 'maxlength args)))
|
|
|
1897 (cond
|
|
|
1898 ((null node)
|
|
|
1899 (setq args (cons (cons 'maxlength nil) args)))
|
|
|
1900 ((null (cdr-safe node))
|
|
|
1901 nil)
|
|
|
1902 ((string= (downcase (cdr-safe node)) "unlimited")
|
|
|
1903 (setcdr node nil))))
|
|
|
1904 (let* (
|
|
|
1905 (face (let ((tag 'input)
|
|
|
1906 (args nil))
|
|
|
1907 (w3-face-for-element)))
|
|
|
1908 (value (cdr-safe (assq 'data args)))
|
|
|
1909 (type "TEXTAREA")
|
|
|
1910 (name (cdr-safe (assq 'name args)))
|
|
|
1911 (size (string-to-int (or (cdr-safe (assq 'size args)) "20")))
|
|
|
1912 (maxlength (string-to-int
|
|
|
1913 (or (cdr (assq 'maxlength args)) "10000")))
|
|
|
1914 (default nil)
|
|
|
1915 (action (w3-get-state :form))
|
|
|
1916 (options)
|
|
|
1917 (pos)
|
|
|
1918 (num (w3-get-state :formnum))
|
|
|
1919 (id (cdr-safe (assq 'id args)))
|
|
|
1920 (checked (assq 'checked args)))
|
|
|
1921 (setq default value
|
|
|
1922 pos (point))
|
|
|
1923 (put 'text 'w3-formatter 'w3-handle-text)
|
|
|
1924 (w3-form-add-element 'multiline name value size maxlength default
|
|
|
1925 action options num id checked face))))
|
|
|
1926
|
|
|
1927 (defun w3-handle-label-text (&optional args)
|
|
|
1928 (setcdr (w3-get-state :label-text)
|
|
|
1929 (concat (cdr (w3-get-state :label-text)) args))
|
|
|
1930 (w3-handle-text args))
|
|
|
1931
|
|
|
1932 (defun w3-handle-/label (&optional args)
|
|
|
1933 (let ((num (w3-get-state :formnum))
|
|
|
1934 (dat (w3-get-state :label-text)))
|
|
|
1935 (setq w3-form-labels (cons (cons (format "%d:%s" num (car dat))
|
|
|
1936 (cdr dat))
|
|
|
1937 w3-form-labels))
|
|
|
1938 (put 'text 'w3-formatter 'w3-handle-text)))
|
|
|
1939
|
|
|
1940 (defun w3-handle-label (&optional args)
|
|
|
1941 (if (not (w3-get-state :form))
|
|
|
1942 (w3-warn 'html "<label> outside of a <FORM> construct - ERROR!!")
|
|
|
1943 (put 'text 'w3-formatter 'w3-handle-label-text)
|
|
|
1944 (w3-put-state :label-text (cons (or (cdr-safe (assq 'for args))
|
|
|
1945 "Unknown label") ""))))
|
|
|
1946
|
|
|
1947 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1948 ;;; For displaying the buffer
|
|
|
1949 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1950 (defun w3-show-buffer ()
|
|
|
1951 (let ((potential-title
|
|
|
1952 (and (not (w3-get-state :title))
|
|
|
1953 (url-generate-new-buffer-name
|
|
|
1954 (url-basepath url-current-file t)))))
|
|
|
1955 (if (and potential-title (string= potential-title ""))
|
|
|
1956 (setq potential-title
|
|
|
1957 (url-generate-new-buffer-name url-current-file)))
|
|
|
1958 (if (and potential-title (not (string= potential-title "")))
|
|
|
1959 (rename-buffer potential-title)))
|
|
|
1960 (setq inhibit-read-only nil)
|
|
|
1961 (if url-find-this-link
|
|
|
1962 (w3-find-specific-link url-find-this-link))
|
|
|
1963 (let* ((tag 'html)
|
|
|
1964 (args nil)
|
|
|
1965 (face (cdr (w3-face-for-element))))
|
|
2
|
1966 (if (not face)
|
|
|
1967 (setq tag 'body
|
|
|
1968 face (cdr (w3-face-for-element))))
|
|
0
|
1969 (and face
|
|
|
1970 (if (not (fboundp 'valid-specifier-locale-p))
|
|
|
1971 nil
|
|
|
1972 (w3-my-safe-copy-face face 'default (current-buffer))))))
|
|
|
1973
|
|
|
1974 (defun w3-parse-header-link-items ()
|
|
|
1975 ;; Parse `url-current-mime-headers' and look for any <link> items
|
|
|
1976 (let ((items url-current-mime-headers)
|
|
|
1977 (node nil)
|
|
|
1978 (url nil)
|
|
|
1979 (type nil)
|
|
|
1980 (args nil)
|
|
|
1981 (title nil)
|
|
|
1982 (label nil))
|
|
|
1983 (while items
|
|
|
1984 (setq node (car items)
|
|
|
1985 items (cdr items))
|
|
|
1986 (if (string= (car node) "link")
|
|
|
1987 (progn
|
|
|
1988 (setq args (mm-parse-args (cdr node))
|
|
|
1989 type (if (assoc "rel" args) "rel" "rev")
|
|
|
1990 label (cdr-safe (assoc type args))
|
|
|
1991 title (cdr-safe (assoc "title" args))
|
|
|
1992 url (car-safe (rassoc nil args)))
|
|
|
1993 (if (string-match "^<.*>$" url)
|
|
|
1994 (setq url (substring url 1 -1)))
|
|
|
1995 (and url label type
|
|
|
1996 (w3-handle-link (list (cons "href" url)
|
|
|
1997 (cons type label)
|
|
|
1998 (cons "title" title)))))))))
|
|
|
1999
|
|
|
2000 (defun w3-refresh-buffer (&rest args)
|
|
|
2001 "Redraw the current buffer - this does not refetch or reparse the current
|
|
|
2002 document, but uses the stored parse data."
|
|
|
2003 (interactive)
|
|
|
2004 (let ((buffer-read-only nil))
|
|
|
2005 (if (get-buffer url-working-buffer)
|
|
|
2006 (kill-buffer url-working-buffer))
|
|
|
2007 (error "Not yet reimplemented... sorry.")))
|
|
|
2008
|
|
|
2009 (defun w3-prepare-buffer (&rest args)
|
|
|
2010 ;; The text/html viewer - does all the drawing and displaying of the buffer
|
|
|
2011 ;; that is necessary to go from raw HTML to a good presentation.
|
|
|
2012 (let ((active-minibuffer-window
|
|
|
2013 (if (minibuffer-window-active-p (minibuffer-window))
|
|
|
2014 (minibuffer-window))))
|
|
|
2015 (let ((pop-up-windows nil))
|
|
|
2016 (if active-minibuffer-window
|
|
|
2017 (let* ((current-buffer (current-buffer))
|
|
|
2018 (window (get-buffer-window current-buffer t)))
|
|
|
2019 (cond (window
|
|
|
2020 (and (fboundp 'select-frame)
|
|
|
2021 (fboundp 'window-frame)
|
|
|
2022 (select-frame (window-frame window)))
|
|
|
2023 (select-window window))
|
|
|
2024 ((and (fboundp 'selected-frame)
|
|
|
2025 (fboundp 'window-frame)
|
|
|
2026 (eq (selected-frame)
|
|
|
2027 (window-frame (minibuffer-window))))
|
|
|
2028 ;; on minibuffer-only-frame
|
|
|
2029 (select-frame (previous-frame))
|
|
|
2030 (select-window (frame-first-window (selected-frame))))
|
|
|
2031 ((fboundp 'frame-first-window)
|
|
|
2032 (select-window (frame-first-window))))
|
|
|
2033 (set-buffer current-buffer))))
|
|
|
2034 (let* ((source (buffer-string))
|
|
|
2035 (parse (w3-preparse-buffer (current-buffer)))
|
|
|
2036 (buff (car parse)))
|
|
|
2037 (set-buffer-modified-p nil)
|
|
|
2038 (kill-buffer (current-buffer))
|
|
|
2039 (set-buffer buff)
|
|
|
2040 (setq w3-current-source source
|
|
|
2041 w3-current-parse w3-last-parse-tree)
|
|
|
2042 (w3-parse-header-link-items)
|
|
|
2043 (save-excursion
|
|
|
2044 (goto-char (point-max))
|
|
|
2045 (w3-handle-paragraph)
|
|
|
2046 (if (and (boundp 'w3-image-widgets-waiting) w3-image-widgets-waiting)
|
|
|
2047 (let (url glyph widget)
|
|
|
2048 (while w3-image-widgets-waiting
|
|
|
2049 (setq widget (car w3-image-widgets-waiting)
|
|
|
2050 w3-image-widgets-waiting (cdr w3-image-widgets-waiting)
|
|
|
2051 url (widget-get widget 'src)
|
|
|
2052 glyph (cdr-safe (assoc url w3-graphics-list)))
|
|
|
2053 (widget-value-set widget glyph))))
|
|
|
2054 (w3-mode)
|
|
|
2055 (w3-handle-annotations)
|
|
|
2056 (w3-handle-headers)
|
|
|
2057 (set-buffer-modified-p nil)
|
|
|
2058 )
|
|
|
2059 (switch-to-buffer (current-buffer))
|
|
|
2060 (or active-minibuffer-window
|
|
|
2061 (let ((window nil)
|
|
|
2062 (pop-up-windows nil))
|
|
|
2063 (display-buffer (current-buffer))
|
|
|
2064 (if (or w3-running-FSF19 w3-running-xemacs)
|
|
|
2065 (setq window (get-buffer-window (current-buffer) t))
|
|
|
2066 (setq window (get-buffer-window (current-buffer))))
|
|
|
2067 (select-window window)
|
|
|
2068 (if (and (fboundp 'select-frame)
|
|
|
2069 (fboundp 'window-frame))
|
|
|
2070 (select-frame (window-frame window)))))
|
|
|
2071 (goto-char (point-min))
|
|
|
2072 (w3-show-buffer)
|
|
|
2073 (if url-keep-history
|
|
|
2074 (let ((url (url-view-url t)))
|
|
|
2075 (if (not (url-hashtablep url-history-list))
|
|
|
2076 (setq url-history-list (url-make-hashtable 131)))
|
|
|
2077 (url-puthash url (buffer-name) url-history-list)
|
|
|
2078 (if (fboundp 'w3-shuffle-history-menu)
|
|
|
2079 (w3-shuffle-history-menu)))))
|
|
|
2080 (cond (active-minibuffer-window
|
|
|
2081 (select-window active-minibuffer-window)
|
|
|
2082 (sit-for 0)))))
|
|
|
2083
|
|
|
2084 (defun w3-handle-headers ()
|
|
|
2085 ;; Insert any headers the user wants to see into the current buffer.
|
|
|
2086 (let ((show w3-show-headers)
|
|
|
2087 (cur nil)
|
|
|
2088 (hdrs nil)
|
|
|
2089 (tag 'ol)
|
|
|
2090 (header nil)
|
|
|
2091 (w3-last-fill-pos (point-max))
|
|
|
2092 (val nil)
|
|
|
2093 (first t))
|
|
|
2094 (goto-char (point-max))
|
|
|
2095 (if (eq show t) (setq show '(".*")))
|
|
|
2096 (while show
|
|
|
2097 (setq cur (car show)
|
|
|
2098 show (cdr show)
|
|
|
2099 hdrs url-current-mime-headers)
|
|
|
2100 (while hdrs
|
|
|
2101 (setq header (car (car hdrs))
|
|
|
2102 val (cdr (car hdrs))
|
|
|
2103 hdrs (cdr hdrs))
|
|
|
2104 (if (numberp val) (setq val (int-to-string val)))
|
|
|
2105 (if (and (/= 0 (length header))
|
|
|
2106 (string-match cur header))
|
|
|
2107 (progn
|
|
|
2108 (if first
|
|
|
2109 (progn
|
|
|
2110 (w3-handle-hr)
|
|
|
2111 (w3-handle-list-opening '(("value" . 1)))
|
|
|
2112 (setq tag 'li
|
|
|
2113 first nil)))
|
|
|
2114 (w3-handle-list-item)
|
|
|
2115 (w3-handle-text (concat (capitalize header)
|
|
|
2116 ": " val))))))
|
|
|
2117 (if (not first) ; We showed some headers
|
|
|
2118 (setq tag '/ol
|
|
|
2119 tag (w3-handle-list-ending)))))
|
|
|
2120
|
|
|
2121 (defun w3-handle-annotations ()
|
|
|
2122 ;; Insert personal annotations into the current buffer
|
|
|
2123 (let ((annos (w3-fetch-personal-annotations))
|
|
|
2124 (tag nil))
|
|
|
2125 (if (not annos)
|
|
|
2126 nil ; No annotations
|
|
|
2127 (goto-char (cond
|
|
|
2128 ((eq w3-annotation-position 'bottom) (point-max))
|
|
|
2129 ((eq w3-annotation-position 'top) (point-min))
|
|
|
2130 (t (message "Bad value for w3-annotation-position")
|
|
|
2131 (point-max))))
|
|
|
2132 (w3-handle-div '((class . "annotations")))
|
|
|
2133 (w3-handle-hr '((width . "75%")
|
|
|
2134 (label . " Personal Annotations ")
|
|
|
2135 (align . "center")))
|
|
|
2136 (setq tag 'ol)
|
|
|
2137 (w3-handle-list-opening)
|
|
|
2138 (while annos
|
|
|
2139 (w3-handle-list-item)
|
|
|
2140 (w3-handle-hyperlink (list (cons 'href (car (car annos)))))
|
|
|
2141 (w3-handle-text (cdr (car annos)))
|
|
|
2142 (w3-handle-hyperlink-end)
|
|
|
2143 (setq annos (cdr annos)))
|
|
|
2144 (w3-handle-list-ending)
|
|
|
2145 (w3-handle-hr '((width . "75%")
|
|
|
2146 (align . "center")))
|
|
|
2147 (w3-handle-/div)
|
|
|
2148 )))
|
|
|
2149
|
|
|
2150 (defun w3-fetch-personal-annotations ()
|
|
|
2151 ;; Grab any personal annotations for the current url
|
|
|
2152 (let ((url (url-view-url t))
|
|
|
2153 (anno w3-personal-annotations)
|
|
|
2154 (annolist nil))
|
|
|
2155 (if (assoc url anno)
|
|
|
2156 (while anno
|
|
|
2157 (if (equal (car (car anno)) url)
|
|
|
2158 (setq annolist
|
|
|
2159 (cons
|
|
|
2160 (cons
|
|
|
2161 (format "file:%s%s/PAN-%s.html"
|
|
|
2162 (if (= ?/ (string-to-char
|
|
|
2163 w3-personal-annotation-directory)) ""
|
|
|
2164 "/")
|
|
|
2165 w3-personal-annotation-directory
|
|
|
2166 (car (car (cdr (car anno)))))
|
|
|
2167 (car (cdr (car (cdr (car anno))))))
|
|
|
2168 annolist)))
|
|
|
2169 (setq anno (cdr anno))))
|
|
|
2170 annolist))
|
|
|
2171
|
|
|
2172 (defun w3-normalize-spaces (string)
|
|
|
2173 ;; nuke spaces at the beginning
|
|
|
2174 (if (string-match "^[ \t\r\n]+" string)
|
|
|
2175 (setq string (substring string (match-end 0))))
|
|
|
2176
|
|
|
2177 ;; nuke spaces in the middle
|
|
|
2178 (while (string-match "[ \t\r\n][ \r\t\n]+" string)
|
|
|
2179 (setq string (concat (substring string 0 (1+ (match-beginning 0)))
|
|
|
2180 (substring string (match-end 0)))))
|
|
|
2181
|
|
|
2182 ;; nuke spaces at the end
|
|
|
2183 (if (string-match "[ \t\n\r]+$" string)
|
|
|
2184 (setq string (substring string 0 (match-beginning 0))))
|
|
|
2185 string)
|
|
|
2186
|
|
|
2187 (defun w3-upcase-region (st nd &optional end)
|
|
|
2188 (and st nd (upcase-region st nd)))
|
|
|
2189
|
|
|
2190 (provide 'w3-draw)
|
|
|
2191
|
