comparison lisp/w3/w3-prefs.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; w3-prefs.el,v --- Preferences panels for Emacs-W3
2 ;; Author: wmperry
3 ;; Created: 1996/06/06 14:14:34
4 ;; Version: 1.10
5 ;; Keywords: hypermedia, preferences
6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1996 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 ;;; Preferences panels for Emacs-W3
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 (require 'widget)
31 (require 'widget-edit)
32 (require 'w3-vars)
33 (require 'w3-keyword)
34 (require 'w3-widget)
35
36 (defvar w3-preferences-glyph nil)
37 (defvar w3-preferences-map nil)
38 (defvar w3-preferences-panel-begin-marker nil)
39 (defvar w3-preferences-panel-end-marker nil)
40 (defvar w3-preferences-panels '(
41 (appearance . "Appearance")
42 (images . "Images")
43 (cookies . "HTTP Cookies")
44 (hooks . "Various Hooks")
45 (compatibility . "Compatibility")
46 (proxy . "Proxy")))
47
48 (defun w3-preferences-setup-glyph-map ()
49 (let* ((x 0)
50 (height (and w3-preferences-glyph
51 (glyph-height w3-preferences-glyph)))
52 (width (and height (/ (glyph-width w3-preferences-glyph)
53 (length w3-preferences-panels)))))
54 (mapcar
55 (function
56 (lambda (region)
57 (vector "rect" (list (vector (if width (* x width) 0) 0)
58 (vector (if width (* (setq x (1+ x)) width) 0)
59 (or height 0)))
60 (car region) (cdr region))))
61 w3-preferences-panels)))
62
63 (defun w3-preferences-generic-variable-callback (widget &rest ignore)
64 (condition-case ()
65 (set (widget-get widget 'variable) (widget-value widget))
66 (error (message "Invalid or incomplete data..."))))
67
68 (defun w3-preferences-restore-variables (vars)
69 (let ((temp nil))
70 (while vars
71 (setq temp (intern (format "w3-preferences-temp-%s" (car vars))))
72 (set (car vars) (symbol-value temp))
73 (setq vars (cdr vars)))))
74
75 (defun w3-preferences-create-temp-variables (vars)
76 (let ((temp nil))
77 (while vars
78 (setq temp (intern (format "w3-preferences-temp-%s" (car vars))))
79 (set (make-local-variable temp) (symbol-value (car vars)))
80 (setq vars (cdr vars)))))
81
82
83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
84 ;;; Appearance of the frame / pages
85 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
86 (defun w3-preferences-init-appearance-panel ()
87 (let ((vars '(w3-toolbar-orientation
88 w3-use-menus
89 w3-honor-stylesheets
90 w3-default-stylesheet
91 w3-default-homepage
92 w3-toolbar-type))
93 (temp nil))
94 (set (make-local-variable 'w3-preferences-temp-use-home-page)
95 (and w3-default-homepage t))
96 (w3-preferences-create-temp-variables vars)))
97
98 (defun w3-preferences-create-appearance-panel ()
99 ;; First the toolbars
100 (widget-insert "\nToolbars\n--------\n")
101 (widget-insert "\tShow Toolbars as:\t")
102 (widget-put
103 (widget-create 'radio
104 :value (symbol-value 'w3-preferences-temp-w3-toolbar-type)
105 :notify 'w3-preferences-generic-variable-callback
106 (list 'item :format "%t\t" :tag "Pictures" :value 'pictures)
107 (list 'item :format "%t\t" :tag "Text" :value 'text)
108 (list 'item :format "%t" :tag "Both" :value 'both))
109 'variable 'w3-preferences-temp-w3-toolbar-type)
110 (widget-insert "\n\tToolbars appear on ")
111 (widget-put
112 (widget-create 'choice
113 :value (symbol-value 'w3-preferences-temp-w3-toolbar-orientation)
114 :notify 'w3-preferences-generic-variable-callback
115 :format "%v"
116 :tag "Toolbar Position"
117 (list 'choice-item :format "%[%t%]" :tag "XEmacs Default" :value 'default)
118 (list 'choice-item :format "%[%t%]" :tag "Top" :value 'top)
119 (list 'choice-item :format "%[%t%]" :tag "Bottom" :value 'bottom)
120 (list 'choice-item :format "%[%t%]" :tag "Right" :value 'right)
121 (list 'choice-item :format "%[%t%]" :tag "Left" :value 'left)
122 (list 'choice-item :format "%[%t%]" :tag "No Toolbar" :value 'none))
123 'variable 'w3-preferences-temp-w3-toolbar-orientation)
124 (widget-insert " side of window.\n")
125
126 ;; Home page
127 (widget-insert "\nStartup\n--------\n\tBrowser starts with:\t")
128 (widget-put
129 (widget-create
130 'radio
131 :value (symbol-value 'w3-preferences-temp-use-home-page)
132 :notify 'w3-preferences-generic-variable-callback
133 (list 'item :format "%t\t" :tag "Blank Page" :value nil)
134 (list 'item :format "%t" :tag "Home Page Location" :value t))
135 'variable 'w3-preferences-temp-use-home-page)
136 (widget-insert "\n\t\tURL: ")
137 (widget-put
138 (widget-create
139 'field
140 :value (or (symbol-value 'w3-preferences-temp-w3-default-homepage) "None")
141 :notify 'w3-preferences-generic-variable-callback)
142 'variable 'w3-preferences-temp-w3-default-homepage)
143
144 ;; Stylesheet
145 (widget-insert "\nStyle\n--------\n\tDefault stylesheet:\t")
146 (widget-put
147 (widget-create
148 'file
149 :value (or (symbol-value 'w3-preferences-temp-w3-default-stylesheet) "")
150 :must-match t
151 :notify 'w3-preferences-generic-variable-callback)
152 'variable 'w3-preferences-temp-w3-default-stylesheet)
153 (widget-setup)
154 )
155
156 (defun w3-preferences-save-appearance-panel ()
157 (let ((vars '(w3-toolbar-orientation
158 w3-use-menus
159 w3-honor-stylesheets
160 w3-default-stylesheet
161 w3-toolbar-type))
162 (temp nil))
163 (if (symbol-value 'w3-preferences-temp-use-home-page)
164 (setq vars (cons 'w3-default-homepage vars))
165 (setq w3-default-homepage nil))
166 (w3-preferences-restore-variables vars)
167 (w3-toolbar-make-buttons)))
168
169
170 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
171 ;;; The images panel
172 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
173 (defun w3-preferences-init-images-panel ()
174 (let ((vars '(w3-delay-image-loads
175 w3-image-mappings)))
176 (w3-preferences-create-temp-variables vars)))
177
178 (defun w3-preferences-create-images-panel ()
179 (widget-insert "\n")
180 (widget-put
181 (widget-create
182 'checkbox
183 :notify 'w3-preferences-generic-variable-callback
184 :value (symbol-value 'w3-preferences-temp-w3-delay-image-loads))
185 'variable 'w3-preferences-temp-w3-delay-image-loads)
186 (widget-insert " Delay Image Loads\n"
187 ;;; "\nAllowed Image Types\n"
188 ;;; "-------------------\n")
189 ;;; (set
190 ;;; (make-local-variable 'w3-preferences-image-type-widget)
191 ;;; (widget-create
192 ;;; 'repeat
193 ;;; :entry-format "%i %d %v"
194 ;;; :value (mapcar
195 ;;; (function
196 ;;; (lambda (x)
197 ;;; (list 'item :format "%t" :tag (car x) :value (cdr x))))
198 ;;; w3-image-mappings)
199 ;;; '(item :tag "*/*" :value 'unknown)))
200 ))
201
202 (defun w3-preferences-save-images-panel ()
203 (let ((vars '(w3-delay-image-loads
204 w3-image-mappings)))
205 (w3-preferences-restore-variables vars)))
206
207 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
208 ;;; The cookies panel
209 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
210 (defun w3-preferences-init-cookies-panel ()
211 (let ((cookies url-cookie-storage)
212 (secure-cookies url-cookie-secure-storage))
213 )
214 )
215
216 (defun w3-preferences-create-cookies-panel ()
217 (widget-insert "\n\t\tSorry, not yet implemented.\n\n"))
218
219 (defun w3-preferences-save-cookies-panel ()
220 )
221
222
223 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
224 ;;; The hooks panel
225 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
226 (defvar w3-preferences-hooks-variables
227 '(w3-file-done-hook
228 w3-file-prepare-hook
229 w3-load-hook
230 w3-mode-hook
231 w3-preferences-cancel-hook
232 w3-preferences-default-hook
233 w3-preferences-ok-hook
234 w3-preferences-setup-hook
235 w3-source-file-hook))
236
237 (defun w3-preferences-init-hooks-panel ()
238 (w3-preferences-create-temp-variables w3-preferences-hooks-variables))
239
240 (defun w3-preferences-create-hooks-panel ()
241 (let ((todo w3-preferences-hooks-variables)
242 (cur nil)
243 (pt nil)
244 (doc nil))
245 (widget-insert "\n")
246 (while todo
247 (setq cur (car todo)
248 todo (cdr todo)
249 doc (get cur 'variable-documentation))
250 (if (string-match "^\\*" doc)
251 (setq doc (substring doc 1 nil)))
252 (setq pt (point))
253 (widget-insert "\n" (symbol-name cur) " - " doc)
254 (fill-region-as-paragraph pt (point))
255 (setq cur (intern (format "w3-preferences-temp-%s" cur)))
256 (widget-put
257 (widget-create
258 'sexp
259 :notify 'w3-preferences-generic-variable-callback
260 :value (or (symbol-value cur) "nil"))
261 'variable cur))
262 (widget-setup)))
263
264 (defun w3-preferences-save-hooks-panel ()
265 (w3-preferences-restore-variables w3-preferences-hooks-variables))
266
267
268 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
269 ;;; The compatibility panel
270 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
271 (defvar w3-preferences-compatibility-variables
272 '(
273 (w3-style-ie-compatibility
274 . "Internet Explorer (tm) 3.0 compatible stylesheet parsing")
275 (w3-netscape-compatible-comments
276 . "Allow Netscape compatible comments")
277 (w3-user-colors-take-precedence
278 . "Ignore netscape document color control")
279 (url-honor-refresh-requests
280 . "Allow Netscape `Client Pull'"))
281 "A list of variables that the preferences compability pane knows about.")
282
283 (defun w3-preferences-init-compatibility-panel ()
284 (let ((compat w3-preferences-compatibility-variables)
285 (cur nil)
286 (var nil))
287 (w3-preferences-create-temp-variables
288 (mapcar 'car w3-preferences-compatibility-variables))))
289
290 (defun w3-preferences-create-compatibility-panel ()
291 (let ((compat w3-preferences-compatibility-variables)
292 (cur nil)
293 (var nil))
294 (widget-insert "\n")
295 (while compat
296 (setq cur (car compat)
297 compat (cdr compat)
298 var (intern (format "w3-preferences-temp-%s" (car cur))))
299 (widget-put
300 (widget-create 'checkbox
301 :notify 'w3-preferences-generic-variable-callback
302 :value (symbol-value var))
303 'variable var)
304 (widget-insert " " (cdr cur) "\n\n"))
305 (widget-setup)))
306
307 (defun w3-preferences-save-compatibility-panel ()
308 (w3-preferences-restore-variables
309 (mapcar 'car w3-preferences-compatibility-variables)))
310
311
312 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
313 ;;; The proxy configuration panel
314 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
315 (defun w3-preferences-init-proxy-panel ()
316 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
317 (proxy nil)
318 (host-var nil)
319 (port-var nil)
320 (urlobj nil))
321 (widget-insert "\n")
322 (while proxies
323 (setq proxy (car proxies)
324 proxies (cdr proxies)
325 host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
326 port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))
327 urlobj (url-generic-parse-url
328 (cdr-safe
329 (assoc (downcase proxy) url-proxy-services))))
330 (set (make-local-variable host-var) (or (url-host urlobj) ""))
331 (set (make-local-variable port-var) (or (url-port urlobj) "")))))
332
333 (defun w3-preferences-create-proxy-panel ()
334 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
335 (proxy nil)
336 (host-var nil)
337 (port-var nil)
338 (urlobj nil))
339 (widget-insert "\n")
340 (while proxies
341 (setq proxy (car proxies)
342 proxies (cdr proxies)
343 host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
344 port-var (intern (format "w3-%s-proxy-port" (downcase proxy))))
345 (widget-insert (format "%10s Proxy: " proxy))
346 (widget-put
347 (widget-create 'field
348 :size 20
349 :value-face 'underline
350 :notify 'w3-preferences-generic-variable-callback
351 :value (format "%-20s" (symbol-value host-var)))
352 'variable host-var)
353 (widget-insert " Port: ")
354 (widget-put
355 (widget-create 'field
356 :size 5
357 :value-face 'underline
358 :notify 'w3-preferences-generic-variable-callback
359 :value (format "%5s" (symbol-value port-var)))
360 'variable port-var)
361 (widget-insert "\n\n"))
362 (widget-setup)))
363
364 (defun w3-preferences-save-proxy-panel ()
365 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
366 (proxy nil)
367 (host-var nil)
368 (port-var nil)
369 (urlobj nil)
370 (host nil)
371 (port nil)
372 (new-proxy-services nil))
373 (while proxies
374 (setq proxy (car proxies)
375 proxies (cdr proxies)
376 host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
377 port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))
378 urlobj (url-generic-parse-url
379 (cdr-safe
380 (assoc (downcase proxy) url-proxy-services)))
381 host (symbol-value host-var)
382 port (symbol-value port-var))
383 (if (and host (/= 0 (length host)))
384 (setq new-proxy-services (cons (cons (downcase proxy)
385 (format "http://%s:%s/" host
386 (or port "80")))
387 new-proxy-services))))
388 (setq url-proxy-services new-proxy-services)))
389
390 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
391 ;;;
392 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
393 (defun w3-preferences-create-panel (panel)
394 (let ((func (intern (format "w3-preferences-create-%s-panel" panel)))
395 (inhibit-read-only t))
396 (goto-char w3-preferences-panel-begin-marker)
397 (delete-region w3-preferences-panel-begin-marker
398 w3-preferences-panel-end-marker)
399 (set-marker-insertion-type w3-preferences-panel-end-marker t)
400 (if (fboundp func)
401 (funcall func)
402 (insert (format "You should be seeing %s right now.\n" panel))))
403 (set-marker-insertion-type w3-preferences-panel-end-marker nil)
404 (set-marker w3-preferences-panel-end-marker (point))
405 (goto-char w3-preferences-panel-begin-marker)
406 (condition-case ()
407 (widget-forward 1)
408 (error nil)))
409
410 (defun w3-preferences-notify (widget widget-ignore &optional event)
411 (let* ((glyph (and event w3-running-xemacs (event-glyph event)))
412 (x (and glyph (w3-glyphp glyph) (event-glyph-x-pixel event)))
413 (y (and glyph (w3-glyphp glyph) (event-glyph-y-pixel event)))
414 (map (widget-get widget 'usemap))
415 (value (widget-value widget)))
416 (if (and map x y)
417 (setq value (w3-point-in-map (vector x y) map)))
418 (if value
419 (w3-preferences-create-panel value))))
420
421 (defun w3-preferences-save-options ()
422 (w3-menu-save-options))
423
424 (defun w3-preferences-ok-callback (widget &rest ignore)
425 (let ((panels w3-preferences-panels)
426 (buffer (current-buffer))
427 (func nil))
428 (run-hooks 'w3-preferences-ok-hook)
429 (while panels
430 (setq func (intern
431 (format "w3-preferences-save-%s-panel" (caar panels)))
432 panels (cdr panels))
433 (if (fboundp func)
434 (funcall func)))
435 (w3-preferences-save-options)
436 (message "Options saved")
437 (sit-for 1)
438 (kill-buffer (current-buffer))))
439
440 (defun w3-preferences-reset-all-panels ()
441 (let ((panels w3-preferences-panels)
442 (func nil))
443 (while panels
444 (setq func (intern (format "w3-preferences-init-%s-panel"
445 (caar panels)))
446 panels (cdr panels))
447 (if (and func (fboundp func))
448 (funcall func)))))
449
450 (defun w3-preferences-cancel-callback (widget &rest ignore)
451 (if (not (funcall url-confirmation-func "Cancel and lose all changes? "))
452 (error "Not cancelled!"))
453 (w3-preferences-reset-all-panels)
454 (kill-buffer (current-buffer))
455 (run-hooks 'w3-preferences-cancel-hook))
456
457 (defun w3-preferences-reset-callback (widget &rest ignore)
458 (w3-preferences-reset-all-panels)
459 (run-hooks 'w3-preferences-default-hook)
460 (w3-preferences-create-panel (caar w3-preferences-panels)))
461
462 (defvar w3-preferences-setup-hook nil
463 "*Hooks to be run before setting up the preferences buffer.")
464
465 (defvar w3-preferences-cancel-hook nil
466 "*Hooks to be run when cancelling the preferences (Cancel was chosen).")
467
468 (defvar w3-preferences-default-hook nil
469 "*Hooks to be run when resetting preference defaults (Defaults was chosen).")
470
471 (defvar w3-preferences-ok-hook nil
472 "*Hooks to be run before saving the preferences (OK was chosen).")
473
474 (defun w3-preferences-init-all-panels ()
475 (let ((todo w3-preferences-panels)
476 (func nil))
477 (while todo
478 (setq func (intern (format "w3-preferences-init-%s-panel" (caar todo)))
479 todo (cdr todo))
480 (and (fboundp func) (funcall func)))))
481
482 (defun w3-preferences-edit ()
483 (interactive)
484 (if (not w3-preferences-map)
485 (setq w3-preferences-map (w3-preferences-setup-glyph-map)))
486 (let* ((prefs-buffer (get-buffer-create "W3 Preferences"))
487 (widget nil)
488 (inhibit-read-only t)
489 (window-conf (current-window-configuration)))
490 (delete-other-windows)
491 (set-buffer prefs-buffer)
492 (w3-preferences-init-all-panels)
493 (set-window-buffer (selected-window) prefs-buffer)
494 (make-local-variable 'widget-field-face)
495 (setq w3-preferences-panel-begin-marker (make-marker)
496 w3-preferences-panel-end-marker (make-marker))
497 (set-marker-insertion-type w3-preferences-panel-begin-marker nil)
498 (set-marker-insertion-type w3-preferences-panel-end-marker t)
499 (use-local-map widget-keymap)
500 (erase-buffer)
501 (run-hooks 'w3-preferences-setup-hook)
502 (setq widget (widget-create 'image
503 :notify 'w3-preferences-notify
504 :value 'appearance
505 :tag "Panel"
506 'usemap w3-preferences-map))
507 (goto-char (point-max))
508 (insert "\n\n")
509 (set-marker w3-preferences-panel-begin-marker (point))
510 (set-marker w3-preferences-panel-end-marker (point))
511 (w3-preferences-create-panel (caar w3-preferences-panels))
512 (goto-char (point-max))
513 (widget-insert "\n\n")
514 (widget-create 'push
515 :notify 'w3-preferences-ok-callback
516 :value "Ok")
517 (widget-insert " ")
518 (widget-create 'push
519 :notify 'w3-preferences-cancel-callback
520 :value "Cancel")
521 (widget-insert " ")
522 (widget-create 'push
523 :notify 'w3-preferences-reset-callback
524 :value "Reset")
525 (center-region (point-min) w3-preferences-panel-begin-marker)
526 (center-region w3-preferences-panel-end-marker (point-max))))
527
528 (provide 'w3-prefs)