Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-prefs.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 8d2a9b52c682
children 1ce6082ce73f
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; w3-prefs.el --- Preferences panels for Emacs-W3 1 ;;; w3-prefs.el --- Preferences panels for Emacs-W3
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/21 15:52:22 3 ;; Created: 1996/06/30 18:10:45
4 ;; Version: 1.23 4 ;; Version: 1.5
5 ;; Keywords: hypermedia, preferences 5 ;; Keywords: hypermedia, preferences
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
10 ;;; 9 ;;;
11 ;;; This file is part of GNU Emacs. 10 ;;; This file is not part of GNU Emacs, but the same permissions apply.
12 ;;; 11 ;;;
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;;; it under the terms of the GNU General Public License as published by 13 ;;; it under the terms of the GNU General Public License as published by
15 ;;; the Free Software Foundation; either version 2, or (at your option) 14 ;;; the Free Software Foundation; either version 2, or (at your option)
16 ;;; any later version. 15 ;;; any later version.
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;;; GNU General Public License for more details. 20 ;;; GNU General Public License for more details.
22 ;;; 21 ;;;
23 ;;; You should have received a copy of the GNU General Public License 22 ;;; You should have received a copy of the GNU General Public License
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the 23 ;;; along with GNU Emacs; see the file COPYING. If not, write to
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;;; Boston, MA 02111-1307, USA.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 26
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;;; Preferences panels for Emacs-W3 28 ;;; Preferences panels for Emacs-W3
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 (require 'widget)
31 (require 'widget-edit)
32 (require 'w3-vars) 32 (require 'w3-vars)
33 (require 'w3-keyword) 33 (require 'w3-keyword)
34 (require 'w3-widget)
34 (require 'w3-toolbar) 35 (require 'w3-toolbar)
35 (eval-and-compile 36
36 (require 'w3-widget)) 37 (defvar w3-preferences-glyph nil)
37 38 (defvar w3-preferences-map nil)
38 (defvar w3-preferences-panel-begin-marker nil) 39 (defvar w3-preferences-panel-begin-marker nil)
39 (defvar w3-preferences-panel-end-marker nil) 40 (defvar w3-preferences-panel-end-marker nil)
40 (defvar w3-preferences-panels '( 41 (defvar w3-preferences-panels '(
41 (appearance . "Appearance") 42 (appearance . "Appearance")
42 (images . "Images") 43 (images . "Images")
43 (cookies . "HTTP Cookies") 44 (cookies . "HTTP Cookies")
44 (hooks . "Various Hooks") 45 (hooks . "Various Hooks")
45 (compatibility . "Compatibility") 46 (compatibility . "Compatibility")
46 (proxy . "Proxy") 47 (proxy . "Proxy")))
47 (privacy . "Privacy"))) 48
49 (defun w3-preferences-setup-glyph-map ()
50 (let* ((x 0)
51 (height (and w3-preferences-glyph
52 (glyph-height w3-preferences-glyph)))
53 (width (and height (/ (glyph-width w3-preferences-glyph)
54 (length w3-preferences-panels)))))
55 (mapcar
56 (function
57 (lambda (region)
58 (vector "rect" (list (vector (if width (* x width) 0) 0)
59 (vector (if width (* (setq x (1+ x)) width) 0)
60 (or height 0)))
61 (car region) (cdr region))))
62 w3-preferences-panels)))
48 63
49 (defun w3-preferences-generic-variable-callback (widget &rest ignore) 64 (defun w3-preferences-generic-variable-callback (widget &rest ignore)
50 (condition-case () 65 (condition-case ()
51 (set (widget-get widget 'variable) (widget-value widget)) 66 (set (widget-get widget 'variable) (widget-value widget))
52 (error (message "Invalid or incomplete data...")))) 67 (error (message "Invalid or incomplete data..."))))
87 (widget-insert "\tShow Toolbars as:\t") 102 (widget-insert "\tShow Toolbars as:\t")
88 (widget-put 103 (widget-put
89 (widget-create 'radio 104 (widget-create 'radio
90 :value (symbol-value 'w3-preferences-temp-w3-toolbar-type) 105 :value (symbol-value 'w3-preferences-temp-w3-toolbar-type)
91 :notify 'w3-preferences-generic-variable-callback 106 :notify 'w3-preferences-generic-variable-callback
92 :format "%v"
93 (list 'item :format "%t\t" :tag "Pictures" :value 'pictures) 107 (list 'item :format "%t\t" :tag "Pictures" :value 'pictures)
94 (list 'item :format "%t\t" :tag "Text" :value 'text) 108 (list 'item :format "%t\t" :tag "Text" :value 'text)
95 (list 'item :format "%t" :tag "Both" :value 'both)) 109 (list 'item :format "%t" :tag "Both" :value 'both))
96 'variable 'w3-preferences-temp-w3-toolbar-type) 110 'variable 'w3-preferences-temp-w3-toolbar-type)
97 (widget-insert "\n\tToolbars appear on ") 111 (widget-insert "\n\tToolbars appear on ")
113 ;; Home page 127 ;; Home page
114 (widget-insert "\nStartup\n--------\n\tBrowser starts with:\t") 128 (widget-insert "\nStartup\n--------\n\tBrowser starts with:\t")
115 (widget-put 129 (widget-put
116 (widget-create 130 (widget-create
117 'radio 131 'radio
118 :format "%v"
119 :value (symbol-value 'w3-preferences-temp-use-home-page) 132 :value (symbol-value 'w3-preferences-temp-use-home-page)
120 :notify 'w3-preferences-generic-variable-callback 133 :notify 'w3-preferences-generic-variable-callback
121 (list 'item :format "%t\t" :tag "Blank Page" :value nil) 134 (list 'item :format "%t\t" :tag "Blank Page" :value nil)
122 (list 'item :format "%t" :tag "Home Page Location" :value t)) 135 (list 'item :format "%t" :tag "Home Page Location" :value t))
123 'variable 'w3-preferences-temp-use-home-page) 136 'variable 'w3-preferences-temp-use-home-page)
124 (widget-insert "\n\t\tURL: ") 137 (widget-insert "\n\t\tURL: ")
125 (widget-put 138 (widget-put
126 (widget-create 139 (widget-create
127 'editable-field 140 'field
128 :value (or (symbol-value 'w3-preferences-temp-w3-default-homepage) "None") 141 :value (or (symbol-value 'w3-preferences-temp-w3-default-homepage) "None")
129 :notify 'w3-preferences-generic-variable-callback) 142 :notify 'w3-preferences-generic-variable-callback)
130 'variable 'w3-preferences-temp-w3-default-homepage) 143 'variable 'w3-preferences-temp-w3-default-homepage)
131 144
132 ;; Stylesheet 145 ;; Stylesheet
170 'checkbox 183 'checkbox
171 :notify 'w3-preferences-generic-variable-callback 184 :notify 'w3-preferences-generic-variable-callback
172 :value (symbol-value 'w3-preferences-temp-w3-delay-image-loads)) 185 :value (symbol-value 'w3-preferences-temp-w3-delay-image-loads))
173 'variable 'w3-preferences-temp-w3-delay-image-loads) 186 'variable 'w3-preferences-temp-w3-delay-image-loads)
174 (widget-insert " Delay Image Loads\n" 187 (widget-insert " Delay Image Loads\n"
188 ;;; "\nAllowed Image Types\n"
189 ;;; "-------------------\n")
190 ;;; (set
191 ;;; (make-local-variable 'w3-preferences-image-type-widget)
192 ;;; (widget-create
193 ;;; 'repeat
194 ;;; :entry-format "%i %d %v"
195 ;;; :value (mapcar
196 ;;; (function
197 ;;; (lambda (x)
198 ;;; (list 'item :format "%t" :tag (car x) :value (cdr x))))
199 ;;; w3-image-mappings)
200 ;;; '(item :tag "*/*" :value 'unknown)))
175 )) 201 ))
176 202
177 (defun w3-preferences-save-images-panel () 203 (defun w3-preferences-save-images-panel ()
178 (let ((vars '(w3-delay-image-loads 204 (let ((vars '(w3-delay-image-loads
179 w3-image-mappings))) 205 w3-image-mappings)))
197 223
198 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 224 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
199 ;;; The hooks panel 225 ;;; The hooks panel
200 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 226 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
201 (defvar w3-preferences-hooks-variables 227 (defvar w3-preferences-hooks-variables
202 '(w3-load-hook 228 '(w3-file-done-hook
229 w3-file-prepare-hook
230 w3-load-hook
203 w3-mode-hook 231 w3-mode-hook
204 w3-preferences-cancel-hook 232 w3-preferences-cancel-hook
205 w3-preferences-default-hook 233 w3-preferences-default-hook
206 w3-preferences-ok-hook 234 w3-preferences-ok-hook
207 w3-preferences-setup-hook 235 w3-preferences-setup-hook
217 (doc nil)) 245 (doc nil))
218 (widget-insert "\n") 246 (widget-insert "\n")
219 (while todo 247 (while todo
220 (setq cur (car todo) 248 (setq cur (car todo)
221 todo (cdr todo) 249 todo (cdr todo)
222 doc (documentation-property cur 'variable-documentation)) 250 doc (get cur 'variable-documentation))
223 (if (string-match "^\\*" doc) 251 (if (string-match "^\\*" doc)
224 (setq doc (substring doc 1 nil))) 252 (setq doc (substring doc 1 nil)))
225 (setq pt (point)) 253 (setq pt (point))
226 (widget-insert "\n" (symbol-name cur) " - " doc) 254 (widget-insert "\n" (symbol-name cur) " - " doc)
227 (fill-region-as-paragraph pt (point)) 255 (fill-region-as-paragraph pt (point))
241 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 269 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
242 ;;; The compatibility panel 270 ;;; The compatibility panel
243 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 271 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
244 (defvar w3-preferences-compatibility-variables 272 (defvar w3-preferences-compatibility-variables
245 '( 273 '(
274 (w3-style-ie-compatibility
275 . "Internet Explorer (tm) 3.0 compatible stylesheet parsing")
246 (w3-netscape-compatible-comments 276 (w3-netscape-compatible-comments
247 . "Allow Netscape compatible comments") 277 . "Allow Netscape compatible comments")
248 (w3-user-colors-take-precedence 278 (w3-user-colors-take-precedence
249 . "Ignore netscape document color control") 279 . "Ignore netscape document color control")
250 (url-honor-refresh-requests 280 (url-honor-refresh-requests
286 (defun w3-preferences-init-proxy-panel () 316 (defun w3-preferences-init-proxy-panel ()
287 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News")) 317 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
288 (proxy nil) 318 (proxy nil)
289 (host-var nil) 319 (host-var nil)
290 (port-var nil) 320 (port-var nil)
291 (host nil) 321 (urlobj nil))
292 (port nil)
293 (proxy-entry nil))
294 (widget-insert "\n") 322 (widget-insert "\n")
295 (while proxies 323 (while proxies
296 (setq proxy (car proxies) 324 (setq proxy (car proxies)
297 proxies (cdr proxies) 325 proxies (cdr proxies)
298 host-var (intern (format "w3-%s-proxy-host" (downcase proxy))) 326 host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
299 port-var (intern (format "w3-%s-proxy-port" (downcase proxy))) 327 port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))
300 proxy-entry (cdr-safe (assoc (downcase proxy) url-proxy-services))) 328 urlobj (url-generic-parse-url
301 (if (and proxy-entry (string-match "\\(.*\\):\\([0-9]+\\)" proxy-entry)) 329 (cdr-safe
302 (setq host (match-string 1 proxy-entry) 330 (assoc (downcase proxy) url-proxy-services))))
303 port (match-string 2 proxy-entry)) 331 (set (make-local-variable host-var) (or (url-host urlobj) ""))
304 (setq host proxy-entry 332 (set (make-local-variable port-var) (or (url-port urlobj) "")))))
305 port nil))
306 (set (make-local-variable host-var) (or host ""))
307 (set (make-local-variable port-var) (or port ""))))
308 (set (make-local-variable 'w3-preferences-temp-no-proxy)
309 (cdr-safe (assoc "no_proxy" url-proxy-services))))
310 333
311 (defun w3-preferences-create-proxy-panel () 334 (defun w3-preferences-create-proxy-panel ()
312 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News")) 335 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
313 (proxy nil) 336 (proxy nil)
314 (host-var nil) 337 (host-var nil)
320 proxies (cdr proxies) 343 proxies (cdr proxies)
321 host-var (intern (format "w3-%s-proxy-host" (downcase proxy))) 344 host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
322 port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))) 345 port-var (intern (format "w3-%s-proxy-port" (downcase proxy))))
323 (widget-insert (format "%10s Proxy: " proxy)) 346 (widget-insert (format "%10s Proxy: " proxy))
324 (widget-put 347 (widget-put
325 (widget-create 'editable-field 348 (widget-create 'field
326 :size 20 349 :size 20
327 :value-face 'underline 350 :value-face 'underline
328 :notify 'w3-preferences-generic-variable-callback 351 :notify 'w3-preferences-generic-variable-callback
329 :value (format "%-20s" (symbol-value host-var))) 352 :value (format "%-20s" (symbol-value host-var)))
330 'variable host-var) 353 'variable host-var)
331 (widget-insert " Port: ") 354 (widget-insert " Port: ")
332 (widget-put 355 (widget-put
333 (widget-create 'editable-field 356 (widget-create 'field
334 :size 5 357 :size 5
335 :value-face 'underline 358 :value-face 'underline
336 :notify 'w3-preferences-generic-variable-callback 359 :notify 'w3-preferences-generic-variable-callback
337 :value (format "%5s" (symbol-value port-var))) 360 :value (format "%5s" (symbol-value port-var)))
338 'variable port-var) 361 'variable port-var)
339 (widget-insert "\n\n")) 362 (widget-insert "\n\n"))
340 (widget-insert " No proxy: ")
341 (widget-put
342 (widget-create 'editable-field
343 :size 40
344 :value-face 'underline
345 :notify 'w3-preferences-generic-variable-callback
346 :value (or (symbol-value 'w3-preferences-temp-no-proxy) ""))
347 'variable 'w3-preferences-temp-no-proxy)
348 (widget-setup))) 363 (widget-setup)))
349 364
350 (defun w3-preferences-save-proxy-panel () 365 (defun w3-preferences-save-proxy-panel ()
351 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News")) 366 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
352 (proxy nil) 367 (proxy nil)
354 (port-var nil) 369 (port-var nil)
355 (urlobj nil) 370 (urlobj nil)
356 (host nil) 371 (host nil)
357 (port nil) 372 (port nil)
358 (new-proxy-services nil)) 373 (new-proxy-services nil))
359 (if (/= 0 (length (symbol-value 'w3-preferences-temp-no-proxy)))
360 (setq new-proxy-services (cons
361 (cons
362 "no_proxy"
363 (symbol-value 'w3-preferences-temp-no-proxy))
364 new-proxy-services)))
365 (while proxies 374 (while proxies
366 (setq proxy (car proxies) 375 (setq proxy (car proxies)
367 proxies (cdr proxies) 376 proxies (cdr proxies)
368 host-var (intern (format "w3-%s-proxy-host" (downcase proxy))) 377 host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
369 port-var (intern (format "w3-%s-proxy-port" (downcase proxy))) 378 port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))
372 (assoc (downcase proxy) url-proxy-services))) 381 (assoc (downcase proxy) url-proxy-services)))
373 host (symbol-value host-var) 382 host (symbol-value host-var)
374 port (symbol-value port-var)) 383 port (symbol-value port-var))
375 (if (and host (/= 0 (length host))) 384 (if (and host (/= 0 (length host)))
376 (setq new-proxy-services (cons (cons (downcase proxy) 385 (setq new-proxy-services (cons (cons (downcase proxy)
377 (format "%s:%s" host 386 (format "http://%s:%s/" host
378 (or port "80"))) 387 (or port "80")))
379 new-proxy-services)))) 388 new-proxy-services))))
380 (setq url-proxy-services new-proxy-services))) 389 (setq url-proxy-services new-proxy-services)))
381
382 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
383 ;;; Privacy panel
384 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
385
386 (defsubst w3-preferences-privacy-bits-sort (bits)
387 (sort bits (function (lambda (a b)
388 (memq b (memq a '(email os lastloc agent cookie)))))))
389
390 (defvar url-valid-privacy-levels
391 '((paranoid . (email os lastloc agent cookie))
392 (high . (email lastloc))
393 (low . (lastloc))
394 (none . nil)))
395
396 (defvar w3-preferences-privacy-bit-widgets nil)
397 (defvar w3-preferences-privacy-level-widget nil)
398 (defvar w3-preferences-temp-url-privacy-level nil)
399 ;; darnit i just noticed the checklist widget, this should probably be
400 ;; reimplemented with that instead of checkboxes, but i've almost finished.
401 (defun w3-preferences-privacy-bit-callback (widget &rest ignore)
402 (let ((privacy-bits (if (listp w3-preferences-temp-url-privacy-level)
403 w3-preferences-temp-url-privacy-level
404 (copy-list (cdr-safe (assq w3-preferences-temp-url-privacy-level url-valid-privacy-levels)))))
405 (bit (widget-get widget 'bit))
406 (val (widget-value widget)))
407 (if val
408 (setq privacy-bits (delq bit privacy-bits))
409 (setq privacy-bits (w3-preferences-privacy-bits-sort (cons bit (delq bit privacy-bits)))))
410 (setq w3-preferences-temp-url-privacy-level
411 (or (car (rassoc privacy-bits url-valid-privacy-levels))
412 privacy-bits))
413 (widget-value-set w3-preferences-privacy-level-widget
414 (if (listp w3-preferences-temp-url-privacy-level)
415 'custom
416 w3-preferences-temp-url-privacy-level))
417 ))
418
419
420 (defun w3-preferences-privacy-level-callback (widget &rest ignore)
421 (let* ((val (widget-value widget))
422 (privacy-bits (cdr-safe (assq val url-valid-privacy-levels))))
423 (if (eq val 'custom) nil
424 (setq w3-preferences-temp-url-privacy-level val)
425 (mapcar (function (lambda (bit)
426 (widget-value-set (cdr bit)
427 (not (memq (car bit)
428 privacy-bits)))))
429 w3-preferences-privacy-bit-widgets))
430 ))
431
432 (defun w3-preferences-init-privacy-panel ()
433 (w3-preferences-create-temp-variables '(url-privacy-level
434 url-cookie-confirmation))
435 (setq w3-preferences-privacy-bit-widgets nil)
436 (setq w3-preferences-privacy-level-widget nil))
437
438 (defsubst w3-preferences-create-privacy-bit-widget (bit bit-text current-bits)
439 (let ((bit-widget (widget-create
440 'checkbox
441 :value (not (memq bit current-bits))
442 :notify 'w3-preferences-privacy-bit-callback
443 )))
444 (widget-put bit-widget 'bit bit)
445 (setq w3-preferences-privacy-bit-widgets (cons (cons bit bit-widget)
446 w3-preferences-privacy-bit-widgets))
447 (widget-insert " " bit-text "\n")))
448
449
450 (defun w3-preferences-create-privacy-panel ()
451 (let ((privacy-bits (if (listp url-privacy-level)
452 url-privacy-level
453 (cdr-safe (assq url-privacy-level url-valid-privacy-levels)))))
454 (widget-insert "\n")
455 (widget-insert "General Privacy Level: ")
456 ;;; XXX something is weird with case folding in the following widget if you
457 ;;; type an option in lower case it accepts it but doesn't do anything
458 (setq w3-preferences-privacy-level-widget
459 (widget-create
460 'choice
461 :value (if (listp w3-preferences-temp-url-privacy-level)
462 'custom
463 w3-preferences-temp-url-privacy-level)
464 :notify 'w3-preferences-privacy-level-callback
465 :format "%v"
466 :tag "Privacy Level"
467 (list 'choice-item :format "%[%t%]" :tag "Paranoid" :value 'paranoid)
468 (list 'choice-item :format "%[%t%]" :tag "High" :value 'high)
469 (list 'choice-item :format "%[%t%]" :tag "Low" :value 'low)
470 (list 'choice-item :format "%[%t%]" :tag "None" :value 'none)
471 (list 'choice-item :format "%[%t%]" :tag "Custom" :value 'custom)))
472 (widget-put w3-preferences-privacy-level-widget 'variable 'w3-preferences-temp-url-privacy-level)
473
474 (widget-insert "\n(controls the options below)\n\nSend the following information with each request:\n")
475 (setq w3-preferences-privacy-bit-widgets nil)
476 (w3-preferences-create-privacy-bit-widget 'email "E-mail address" privacy-bits)
477 (w3-preferences-create-privacy-bit-widget 'lastloc "Last location visited" privacy-bits)
478 (w3-preferences-create-privacy-bit-widget 'os "Operating system information" privacy-bits)
479 (w3-preferences-create-privacy-bit-widget 'agent "User agent information" privacy-bits)
480 (w3-preferences-create-privacy-bit-widget 'cookie "Accept cookies" privacy-bits)
481 (widget-insert " ")
482 (widget-put
483 (widget-create
484 'checkbox
485 :value (symbol-value 'w3-preferences-temp-url-cookie-confirmation)
486 :notify 'w3-preferences-generic-variable-callback)
487 'variable 'w3-preferences-temp-url-cookie-confirmation)
488 (widget-insert " Ask before accepting cookies\n"))
489 (widget-setup))
490
491 (defun w3-preferences-save-privacy-panel ()
492 (w3-preferences-restore-variables '(url-privacy-level
493 url-cookie-confirmation))
494 (url-setup-privacy-info))
495 390
496 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 391 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
497 ;;; 392 ;;;
498 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 393 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
499 (defun w3-preferences-create-panel (panel) 394 (defun w3-preferences-create-panel (panel)
513 (widget-forward 1) 408 (widget-forward 1)
514 (error nil))) 409 (error nil)))
515 410
516 (defun w3-preferences-notify (widget widget-ignore &optional event) 411 (defun w3-preferences-notify (widget widget-ignore &optional event)
517 (let* ((glyph (and event w3-running-xemacs (event-glyph event))) 412 (let* ((glyph (and event w3-running-xemacs (event-glyph event)))
518 (x (and glyph (widget-glyphp glyph) (event-glyph-x-pixel event))) 413 (x (and glyph (w3-glyphp glyph) (event-glyph-x-pixel event)))
519 (y (and glyph (widget-glyphp glyph) (event-glyph-y-pixel event))) 414 (y (and glyph (w3-glyphp glyph) (event-glyph-y-pixel event)))
520 (map (widget-get widget 'usemap)) 415 (map (widget-get widget 'usemap))
521 (value (widget-value widget))) 416 (value (widget-value widget)))
522 (if (and map x y) 417 (if (and map x y)
523 (setq value (w3-point-in-map (vector x y) map))) 418 (setq value (w3-point-in-map (vector x y) map)))
524 (if value 419 (if value
583 (while todo 478 (while todo
584 (setq func (intern (format "w3-preferences-init-%s-panel" (caar todo))) 479 (setq func (intern (format "w3-preferences-init-%s-panel" (caar todo)))
585 todo (cdr todo)) 480 todo (cdr todo))
586 (and (fboundp func) (funcall func))))) 481 (and (fboundp func) (funcall func)))))
587 482
588 ;;###autoload
589 (defun w3-preferences-edit () 483 (defun w3-preferences-edit ()
590 (interactive) 484 (interactive)
485 (if (not w3-preferences-map)
486 (setq w3-preferences-map (w3-preferences-setup-glyph-map)))
591 (let* ((prefs-buffer (get-buffer-create "W3 Preferences")) 487 (let* ((prefs-buffer (get-buffer-create "W3 Preferences"))
592 (widget nil) 488 (widget nil)
593 (inhibit-read-only t) 489 (inhibit-read-only t)
594 (window-conf (current-window-configuration))) 490 (window-conf (current-window-configuration)))
595 (delete-other-windows) 491 (delete-other-windows)
596 (set-buffer prefs-buffer) 492 (set-buffer prefs-buffer)
597 (set (make-local-variable 'widget-push-button-gui) nil)
598 (w3-preferences-init-all-panels) 493 (w3-preferences-init-all-panels)
599 (set-window-buffer (selected-window) prefs-buffer) 494 (set-window-buffer (selected-window) prefs-buffer)
600 (make-local-variable 'widget-field-face) 495 (make-local-variable 'widget-field-face)
601 (setq w3-preferences-panel-begin-marker (make-marker) 496 (setq w3-preferences-panel-begin-marker (make-marker)
602 w3-preferences-panel-end-marker (make-marker)) 497 w3-preferences-panel-end-marker (make-marker))
603 (set-marker-insertion-type w3-preferences-panel-begin-marker nil) 498 (set-marker-insertion-type w3-preferences-panel-begin-marker nil)
604 (set-marker-insertion-type w3-preferences-panel-end-marker t) 499 (set-marker-insertion-type w3-preferences-panel-end-marker t)
605 (use-local-map widget-keymap) 500 (use-local-map widget-keymap)
606 (erase-buffer) 501 (erase-buffer)
607 (run-hooks 'w3-preferences-setup-hook) 502 (run-hooks 'w3-preferences-setup-hook)
608 (setq widget (apply 'widget-create 'menu-choice 503 (setq widget (widget-create 'image
609 :tag "Panel" 504 :notify 'w3-preferences-notify
610 :notify 'w3-preferences-notify 505 :value 'appearance
611 :value 'appearance 506 :tag "Panel"
612 (mapcar 507 'usemap w3-preferences-map))
613 (function
614 (lambda (x)
615 (list 'choice-item
616 :format "%[%t%]"
617 :tag (cdr x)
618 :value (car x))))
619 w3-preferences-panels)))
620 (goto-char (point-max)) 508 (goto-char (point-max))
621 (insert "\n\n") 509 (insert "\n\n")
622 (set-marker w3-preferences-panel-begin-marker (point)) 510 (set-marker w3-preferences-panel-begin-marker (point))
623 (set-marker w3-preferences-panel-end-marker (point)) 511 (set-marker w3-preferences-panel-end-marker (point))
624 (w3-preferences-create-panel (caar w3-preferences-panels)) 512 (w3-preferences-create-panel (caar w3-preferences-panels))
625 (goto-char (point-max)) 513 (goto-char (point-max))
626 (widget-insert "\n\n") 514 (widget-insert "\n\n")
627 (widget-create 'push-button 515 (widget-create 'push
628 :notify 'w3-preferences-ok-callback 516 :notify 'w3-preferences-ok-callback
629 :value "Ok") 517 :value "Ok")
630 (widget-insert " ") 518 (widget-insert " ")
631 (widget-create 'push-button 519 (widget-create 'push
632 :notify 'w3-preferences-cancel-callback 520 :notify 'w3-preferences-cancel-callback
633 :value "Cancel") 521 :value "Cancel")
634 (widget-insert " ") 522 (widget-insert " ")
635 (widget-create 'push-button 523 (widget-create 'push
636 :notify 'w3-preferences-reset-callback 524 :notify 'w3-preferences-reset-callback
637 :value "Reset") 525 :value "Reset")
638 (center-region (point-min) w3-preferences-panel-begin-marker) 526 (center-region (point-min) w3-preferences-panel-begin-marker)
639 (center-region w3-preferences-panel-end-marker (point-max)))) 527 (center-region w3-preferences-panel-end-marker (point-max))))
640 528