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