Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-prefs.el @ 32:e04119814345 r19-15b99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b99
author cvs
date Mon, 13 Aug 2007 08:52:56 +0200
parents ec9a17fef872
children c53a95d3c46d
comparison
equal deleted inserted replaced
31:b9328a10c56c 32:e04119814345
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/04 14:33:41 3 ;; Created: 1997/03/14 06:31:17
4 ;; Version: 1.16 4 ;; Version: 1.19
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. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
41 (appearance . "Appearance") 41 (appearance . "Appearance")
42 (images . "Images") 42 (images . "Images")
43 (cookies . "HTTP Cookies") 43 (cookies . "HTTP Cookies")
44 (hooks . "Various Hooks") 44 (hooks . "Various Hooks")
45 (compatibility . "Compatibility") 45 (compatibility . "Compatibility")
46 (proxy . "Proxy"))) 46 (proxy . "Proxy")
47 (privacy . "Privacy")))
47 48
48 (defun w3-preferences-generic-variable-callback (widget &rest ignore) 49 (defun w3-preferences-generic-variable-callback (widget &rest ignore)
49 (condition-case () 50 (condition-case ()
50 (set (widget-get widget 'variable) (widget-value widget)) 51 (set (widget-get widget 'variable) (widget-value widget))
51 (error (message "Invalid or incomplete data...")))) 52 (error (message "Invalid or incomplete data..."))))
216 (doc nil)) 217 (doc nil))
217 (widget-insert "\n") 218 (widget-insert "\n")
218 (while todo 219 (while todo
219 (setq cur (car todo) 220 (setq cur (car todo)
220 todo (cdr todo) 221 todo (cdr todo)
221 doc (get cur 'variable-documentation)) 222 doc (documentation-property cur 'variable-documentation)) ;; (get cur 'variable-documentation))
222 (if (string-match "^\\*" doc) 223 (if (string-match "^\\*" doc)
223 (setq doc (substring doc 1 nil))) 224 (setq doc (substring doc 1 nil)))
224 (setq pt (point)) 225 (setq pt (point))
225 (widget-insert "\n" (symbol-name cur) " - " doc) 226 (widget-insert "\n" (symbol-name cur) " - " doc)
226 (fill-region-as-paragraph pt (point)) 227 (fill-region-as-paragraph pt (point))
285 (defun w3-preferences-init-proxy-panel () 286 (defun w3-preferences-init-proxy-panel ()
286 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News")) 287 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
287 (proxy nil) 288 (proxy nil)
288 (host-var nil) 289 (host-var nil)
289 (port-var nil) 290 (port-var nil)
290 (urlobj nil)) 291 (host nil)
292 (port nil)
293 (proxy-entry nil))
291 (widget-insert "\n") 294 (widget-insert "\n")
292 (while proxies 295 (while proxies
293 (setq proxy (car proxies) 296 (setq proxy (car proxies)
294 proxies (cdr proxies) 297 proxies (cdr proxies)
295 host-var (intern (format "w3-%s-proxy-host" (downcase proxy))) 298 host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
296 port-var (intern (format "w3-%s-proxy-port" (downcase proxy))) 299 port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))
297 urlobj (url-generic-parse-url 300 proxy-entry (cdr-safe (assoc (downcase proxy) url-proxy-services)))
298 (cdr-safe 301 (if (and proxy-entry (string-match "\\(.*\\):\\([0-9]+\\)" proxy-entry))
299 (assoc (downcase proxy) url-proxy-services)))) 302 (setq host (match-string 1 proxy-entry)
300 (set (make-local-variable host-var) (or (url-host urlobj) "")) 303 port (match-string 2 proxy-entry))
301 (set (make-local-variable port-var) (or (url-port urlobj) ""))))) 304 (setq host proxy-entry
305 port nil))
306 (set (make-local-variable host-var) (or host ""))
307 (set (make-local-variable port-var) (or port "")))))
302 308
303 (defun w3-preferences-create-proxy-panel () 309 (defun w3-preferences-create-proxy-panel ()
304 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News")) 310 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
305 (proxy nil) 311 (proxy nil)
306 (host-var nil) 312 (host-var nil)
350 (assoc (downcase proxy) url-proxy-services))) 356 (assoc (downcase proxy) url-proxy-services)))
351 host (symbol-value host-var) 357 host (symbol-value host-var)
352 port (symbol-value port-var)) 358 port (symbol-value port-var))
353 (if (and host (/= 0 (length host))) 359 (if (and host (/= 0 (length host)))
354 (setq new-proxy-services (cons (cons (downcase proxy) 360 (setq new-proxy-services (cons (cons (downcase proxy)
355 (format "http://%s:%s/" host 361 (format "%s:%s" host
356 (or port "80"))) 362 (or port "80")))
357 new-proxy-services)))) 363 new-proxy-services))))
358 (setq url-proxy-services new-proxy-services))) 364 (setq url-proxy-services new-proxy-services)))
365
366 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
367 ;;; Privacy panel
368 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
369
370 (defsubst w3-preferences-privacy-bits-sort (bits)
371 (sort bits (function (lambda (a b)
372 (memq b (memq a '(email os lastloc agent cookie)))))))
373
374 (defvar url-valid-privacy-levels
375 '((paranoid . (email os lastloc agent cookie))
376 (high . (email lastloc))
377 (low . (lastloc))
378 (none . nil)))
379
380 (defvar w3-preferences-privacy-bit-widgets nil)
381 (defvar w3-preferences-privacy-level-widget nil)
382 (defvar w3-preferences-temp-url-privacy-level nil)
383 ;; darnit i just noticed the checklist widget, this should probably be
384 ;; reimplemented with that instead of checkboxes, but i've almost finished.
385 (defun w3-preferences-privacy-bit-callback (widget &rest ignore)
386 (let ((privacy-bits (if (listp w3-preferences-temp-url-privacy-level)
387 w3-preferences-temp-url-privacy-level
388 (copy-list (cdr-safe (assq w3-preferences-temp-url-privacy-level url-valid-privacy-levels)))))
389 (bit (widget-get widget 'bit))
390 (val (widget-value widget)))
391 (if val
392 (setq privacy-bits (delq bit privacy-bits))
393 (setq privacy-bits (w3-preferences-privacy-bits-sort (cons bit (delq bit privacy-bits)))))
394 (setq w3-preferences-temp-url-privacy-level
395 (or (car (rassoc privacy-bits url-valid-privacy-levels))
396 privacy-bits))
397 (widget-value-set w3-preferences-privacy-level-widget
398 (if (listp w3-preferences-temp-url-privacy-level)
399 'custom
400 w3-preferences-temp-url-privacy-level))
401 ))
402
403
404 (defun w3-preferences-privacy-level-callback (widget &rest ignore)
405 (let* ((val (widget-value widget))
406 (privacy-bits (cdr-safe (assq val url-valid-privacy-levels))))
407 (if (eq val 'custom) nil
408 (setq w3-preferences-temp-url-privacy-level val)
409 (mapcar (function (lambda (bit)
410 (widget-value-set (cdr bit)
411 (not (memq (car bit)
412 privacy-bits)))))
413 w3-preferences-privacy-bit-widgets))
414 ))
415
416 (defun w3-preferences-init-privacy-panel ()
417 (w3-preferences-create-temp-variables '(url-privacy-level
418 url-cookie-confirmation))
419 (setq w3-preferences-privacy-bit-widgets nil)
420 (setq w3-preferences-privacy-level-widget nil))
421
422 (defsubst w3-preferences-create-privacy-bit-widget (bit bit-text current-bits)
423 (let ((bit-widget (widget-create
424 'checkbox
425 :value (not (memq bit current-bits))
426 :notify 'w3-preferences-privacy-bit-callback
427 )))
428 (widget-put bit-widget 'bit bit)
429 (setq w3-preferences-privacy-bit-widgets (cons (cons bit bit-widget)
430 w3-preferences-privacy-bit-widgets))
431 (widget-insert " " bit-text "\n")))
432
433
434 (defun w3-preferences-create-privacy-panel ()
435 (let ((privacy-bits (if (listp url-privacy-level)
436 url-privacy-level
437 (cdr-safe (assq url-privacy-level url-valid-privacy-levels)))))
438 (widget-insert "\n")
439 (widget-insert "General Privacy Level: ")
440 ;;; XXX something is weird with case folding in the following widget if you
441 ;;; type an option in lower case it accepts it but doesn't do anything
442 (setq w3-preferences-privacy-level-widget
443 (widget-create
444 'choice
445 :value (if (listp w3-preferences-temp-url-privacy-level)
446 'custom
447 w3-preferences-temp-url-privacy-level)
448 :notify 'w3-preferences-privacy-level-callback
449 :format "%v"
450 :tag "Privacy Level"
451 (list 'choice-item :format "%[%t%]" :tag "Paranoid" :value 'paranoid)
452 (list 'choice-item :format "%[%t%]" :tag "High" :value 'high)
453 (list 'choice-item :format "%[%t%]" :tag "Low" :value 'low)
454 (list 'choice-item :format "%[%t%]" :tag "None" :value 'none)
455 (list 'choice-item :format "%[%t%]" :tag "Custom" :value 'custom)))
456 (widget-put w3-preferences-privacy-level-widget 'variable 'w3-preferences-temp-url-privacy-level)
457
458 (widget-insert "\n(controls the options below)\n\nSend the following information with each request:\n")
459 (setq w3-preferences-privacy-bit-widgets nil)
460 (w3-preferences-create-privacy-bit-widget 'email "E-mail address" privacy-bits)
461 (w3-preferences-create-privacy-bit-widget 'lastloc "Last location visited" privacy-bits)
462 (w3-preferences-create-privacy-bit-widget 'os "Operating system information" privacy-bits)
463 (w3-preferences-create-privacy-bit-widget 'agent "User agent information" privacy-bits)
464 (w3-preferences-create-privacy-bit-widget 'cookie "Accept cookies" privacy-bits)
465 (widget-insert " ")
466 (widget-put
467 (widget-create
468 'checkbox
469 :value (symbol-value 'w3-preferences-temp-url-cookie-confirmation)
470 :notify 'w3-preferences-generic-variable-callback)
471 'variable 'w3-preferences-temp-url-cookie-confirmation)
472 (widget-insert " Ask before accepting cookies\n"))
473 (widget-setup))
474
475 (defun w3-preferences-save-privacy-panel ()
476 (w3-preferences-restore-variables '(url-privacy-level
477 url-cookie-confirmation))
478 (url-setup-privacy-info))
359 479
360 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 480 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
361 ;;; 481 ;;;
362 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 482 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
363 (defun w3-preferences-create-panel (panel) 483 (defun w3-preferences-create-panel (panel)
456 (widget nil) 576 (widget nil)
457 (inhibit-read-only t) 577 (inhibit-read-only t)
458 (window-conf (current-window-configuration))) 578 (window-conf (current-window-configuration)))
459 (delete-other-windows) 579 (delete-other-windows)
460 (set-buffer prefs-buffer) 580 (set-buffer prefs-buffer)
581 (set (make-local-variable 'widget-push-button-gui) nil)
461 (w3-preferences-init-all-panels) 582 (w3-preferences-init-all-panels)
462 (set-window-buffer (selected-window) prefs-buffer) 583 (set-window-buffer (selected-window) prefs-buffer)
463 (make-local-variable 'widget-field-face) 584 (make-local-variable 'widget-field-face)
464 (setq w3-preferences-panel-begin-marker (make-marker) 585 (setq w3-preferences-panel-begin-marker (make-marker)
465 w3-preferences-panel-end-marker (make-marker)) 586 w3-preferences-panel-end-marker (make-marker))