|
2
|
1 ;;; w3-prefs.el --- Preferences panels for Emacs-W3
|
|
0
|
2 ;; Author: wmperry
|
|
138
|
3 ;; Created: 1997/04/24 15:41:27
|
|
|
4 ;; Version: 1.24
|
|
0
|
5 ;; Keywords: hypermedia, preferences
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2
|
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
82
|
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
|
|
0
|
10 ;;;
|
|
80
|
11 ;;; This file is part of GNU Emacs.
|
|
0
|
12 ;;;
|
|
|
13 ;;; 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
|
|
|
15 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;;; any later version.
|
|
|
17 ;;;
|
|
|
18 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
21 ;;; GNU General Public License for more details.
|
|
|
22 ;;;
|
|
|
23 ;;; You should have received a copy of the GNU General Public License
|
|
80
|
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
26 ;;; Boston, MA 02111-1307, USA.
|
|
0
|
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
28
|
|
|
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
30 ;;; Preferences panels for Emacs-W3
|
|
|
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
32 (require 'w3-vars)
|
|
|
33 (require 'w3-keyword)
|
|
2
|
34 (require 'w3-toolbar)
|
|
80
|
35 (eval-and-compile
|
|
|
36 (require 'w3-widget))
|
|
0
|
37
|
|
|
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")
|
|
110
|
46 (proxy . "Proxy")
|
|
|
47 (privacy . "Privacy")))
|
|
70
|
48
|
|
0
|
49 (defun w3-preferences-generic-variable-callback (widget &rest ignore)
|
|
|
50 (condition-case ()
|
|
|
51 (set (widget-get widget 'variable) (widget-value widget))
|
|
|
52 (error (message "Invalid or incomplete data..."))))
|
|
|
53
|
|
|
54 (defun w3-preferences-restore-variables (vars)
|
|
|
55 (let ((temp nil))
|
|
|
56 (while vars
|
|
|
57 (setq temp (intern (format "w3-preferences-temp-%s" (car vars))))
|
|
|
58 (set (car vars) (symbol-value temp))
|
|
138
|
59 (if (fboundp 'custom-set-variables)
|
|
|
60 (eval (` (custom-set-variables '((, (car vars)) (quote (, (symbol-value temp))) t)))))
|
|
0
|
61 (setq vars (cdr vars)))))
|
|
|
62
|
|
|
63 (defun w3-preferences-create-temp-variables (vars)
|
|
|
64 (let ((temp nil))
|
|
|
65 (while vars
|
|
|
66 (setq temp (intern (format "w3-preferences-temp-%s" (car vars))))
|
|
|
67 (set (make-local-variable temp) (symbol-value (car vars)))
|
|
|
68 (setq vars (cdr vars)))))
|
|
|
69
|
|
|
70
|
|
|
71 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
72 ;;; Appearance of the frame / pages
|
|
|
73 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
74 (defun w3-preferences-init-appearance-panel ()
|
|
|
75 (let ((vars '(w3-toolbar-orientation
|
|
|
76 w3-use-menus
|
|
|
77 w3-honor-stylesheets
|
|
|
78 w3-default-stylesheet
|
|
|
79 w3-default-homepage
|
|
|
80 w3-toolbar-type))
|
|
|
81 (temp nil))
|
|
|
82 (set (make-local-variable 'w3-preferences-temp-use-home-page)
|
|
|
83 (and w3-default-homepage t))
|
|
|
84 (w3-preferences-create-temp-variables vars)))
|
|
|
85
|
|
|
86 (defun w3-preferences-create-appearance-panel ()
|
|
|
87 ;; First the toolbars
|
|
|
88 (widget-insert "\nToolbars\n--------\n")
|
|
|
89 (widget-insert "\tShow Toolbars as:\t")
|
|
|
90 (widget-put
|
|
|
91 (widget-create 'radio
|
|
|
92 :value (symbol-value 'w3-preferences-temp-w3-toolbar-type)
|
|
|
93 :notify 'w3-preferences-generic-variable-callback
|
|
80
|
94 :format "%v"
|
|
0
|
95 (list 'item :format "%t\t" :tag "Pictures" :value 'pictures)
|
|
|
96 (list 'item :format "%t\t" :tag "Text" :value 'text)
|
|
|
97 (list 'item :format "%t" :tag "Both" :value 'both))
|
|
|
98 'variable 'w3-preferences-temp-w3-toolbar-type)
|
|
|
99 (widget-insert "\n\tToolbars appear on ")
|
|
|
100 (widget-put
|
|
|
101 (widget-create 'choice
|
|
|
102 :value (symbol-value 'w3-preferences-temp-w3-toolbar-orientation)
|
|
|
103 :notify 'w3-preferences-generic-variable-callback
|
|
|
104 :format "%v"
|
|
|
105 :tag "Toolbar Position"
|
|
|
106 (list 'choice-item :format "%[%t%]" :tag "XEmacs Default" :value 'default)
|
|
|
107 (list 'choice-item :format "%[%t%]" :tag "Top" :value 'top)
|
|
|
108 (list 'choice-item :format "%[%t%]" :tag "Bottom" :value 'bottom)
|
|
|
109 (list 'choice-item :format "%[%t%]" :tag "Right" :value 'right)
|
|
|
110 (list 'choice-item :format "%[%t%]" :tag "Left" :value 'left)
|
|
|
111 (list 'choice-item :format "%[%t%]" :tag "No Toolbar" :value 'none))
|
|
|
112 'variable 'w3-preferences-temp-w3-toolbar-orientation)
|
|
|
113 (widget-insert " side of window.\n")
|
|
|
114
|
|
|
115 ;; Home page
|
|
|
116 (widget-insert "\nStartup\n--------\n\tBrowser starts with:\t")
|
|
|
117 (widget-put
|
|
|
118 (widget-create
|
|
|
119 'radio
|
|
80
|
120 :format "%v"
|
|
0
|
121 :value (symbol-value 'w3-preferences-temp-use-home-page)
|
|
|
122 :notify 'w3-preferences-generic-variable-callback
|
|
|
123 (list 'item :format "%t\t" :tag "Blank Page" :value nil)
|
|
|
124 (list 'item :format "%t" :tag "Home Page Location" :value t))
|
|
|
125 'variable 'w3-preferences-temp-use-home-page)
|
|
|
126 (widget-insert "\n\t\tURL: ")
|
|
|
127 (widget-put
|
|
|
128 (widget-create
|
|
80
|
129 'editable-field
|
|
0
|
130 :value (or (symbol-value 'w3-preferences-temp-w3-default-homepage) "None")
|
|
|
131 :notify 'w3-preferences-generic-variable-callback)
|
|
|
132 'variable 'w3-preferences-temp-w3-default-homepage)
|
|
|
133
|
|
|
134 ;; Stylesheet
|
|
|
135 (widget-insert "\nStyle\n--------\n\tDefault stylesheet:\t")
|
|
|
136 (widget-put
|
|
|
137 (widget-create
|
|
|
138 'file
|
|
|
139 :value (or (symbol-value 'w3-preferences-temp-w3-default-stylesheet) "")
|
|
|
140 :must-match t
|
|
|
141 :notify 'w3-preferences-generic-variable-callback)
|
|
|
142 'variable 'w3-preferences-temp-w3-default-stylesheet)
|
|
|
143 (widget-setup)
|
|
|
144 )
|
|
|
145
|
|
|
146 (defun w3-preferences-save-appearance-panel ()
|
|
|
147 (let ((vars '(w3-toolbar-orientation
|
|
|
148 w3-use-menus
|
|
|
149 w3-honor-stylesheets
|
|
|
150 w3-default-stylesheet
|
|
|
151 w3-toolbar-type))
|
|
|
152 (temp nil))
|
|
|
153 (if (symbol-value 'w3-preferences-temp-use-home-page)
|
|
|
154 (setq vars (cons 'w3-default-homepage vars))
|
|
|
155 (setq w3-default-homepage nil))
|
|
|
156 (w3-preferences-restore-variables vars)
|
|
|
157 (w3-toolbar-make-buttons)))
|
|
|
158
|
|
|
159
|
|
|
160 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
161 ;;; The images panel
|
|
|
162 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
163 (defun w3-preferences-init-images-panel ()
|
|
|
164 (let ((vars '(w3-delay-image-loads
|
|
|
165 w3-image-mappings)))
|
|
|
166 (w3-preferences-create-temp-variables vars)))
|
|
|
167
|
|
|
168 (defun w3-preferences-create-images-panel ()
|
|
|
169 (widget-insert "\n")
|
|
|
170 (widget-put
|
|
|
171 (widget-create
|
|
|
172 'checkbox
|
|
|
173 :notify 'w3-preferences-generic-variable-callback
|
|
|
174 :value (symbol-value 'w3-preferences-temp-w3-delay-image-loads))
|
|
|
175 'variable 'w3-preferences-temp-w3-delay-image-loads)
|
|
|
176 (widget-insert " Delay Image Loads\n"
|
|
|
177 ))
|
|
|
178
|
|
|
179 (defun w3-preferences-save-images-panel ()
|
|
|
180 (let ((vars '(w3-delay-image-loads
|
|
|
181 w3-image-mappings)))
|
|
|
182 (w3-preferences-restore-variables vars)))
|
|
|
183
|
|
|
184 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
185 ;;; The cookies panel
|
|
|
186 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
187 (defun w3-preferences-init-cookies-panel ()
|
|
|
188 (let ((cookies url-cookie-storage)
|
|
|
189 (secure-cookies url-cookie-secure-storage))
|
|
|
190 )
|
|
|
191 )
|
|
|
192
|
|
|
193 (defun w3-preferences-create-cookies-panel ()
|
|
|
194 (widget-insert "\n\t\tSorry, not yet implemented.\n\n"))
|
|
|
195
|
|
|
196 (defun w3-preferences-save-cookies-panel ()
|
|
|
197 )
|
|
|
198
|
|
|
199
|
|
|
200 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
201 ;;; The hooks panel
|
|
|
202 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
203 (defvar w3-preferences-hooks-variables
|
|
108
|
204 '(w3-load-hook
|
|
0
|
205 w3-mode-hook
|
|
|
206 w3-preferences-cancel-hook
|
|
|
207 w3-preferences-default-hook
|
|
|
208 w3-preferences-ok-hook
|
|
|
209 w3-preferences-setup-hook
|
|
|
210 w3-source-file-hook))
|
|
|
211
|
|
|
212 (defun w3-preferences-init-hooks-panel ()
|
|
|
213 (w3-preferences-create-temp-variables w3-preferences-hooks-variables))
|
|
|
214
|
|
|
215 (defun w3-preferences-create-hooks-panel ()
|
|
|
216 (let ((todo w3-preferences-hooks-variables)
|
|
|
217 (cur nil)
|
|
|
218 (pt nil)
|
|
|
219 (doc nil))
|
|
|
220 (widget-insert "\n")
|
|
|
221 (while todo
|
|
|
222 (setq cur (car todo)
|
|
|
223 todo (cdr todo)
|
|
114
|
224 doc (documentation-property cur 'variable-documentation))
|
|
0
|
225 (if (string-match "^\\*" doc)
|
|
|
226 (setq doc (substring doc 1 nil)))
|
|
|
227 (setq pt (point))
|
|
|
228 (widget-insert "\n" (symbol-name cur) " - " doc)
|
|
|
229 (fill-region-as-paragraph pt (point))
|
|
|
230 (setq cur (intern (format "w3-preferences-temp-%s" cur)))
|
|
|
231 (widget-put
|
|
|
232 (widget-create
|
|
|
233 'sexp
|
|
|
234 :notify 'w3-preferences-generic-variable-callback
|
|
|
235 :value (or (symbol-value cur) "nil"))
|
|
|
236 'variable cur))
|
|
|
237 (widget-setup)))
|
|
|
238
|
|
|
239 (defun w3-preferences-save-hooks-panel ()
|
|
|
240 (w3-preferences-restore-variables w3-preferences-hooks-variables))
|
|
|
241
|
|
|
242
|
|
|
243 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
244 ;;; The compatibility panel
|
|
|
245 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
246 (defvar w3-preferences-compatibility-variables
|
|
|
247 '(
|
|
|
248 (w3-netscape-compatible-comments
|
|
|
249 . "Allow Netscape compatible comments")
|
|
|
250 (w3-user-colors-take-precedence
|
|
|
251 . "Ignore netscape document color control")
|
|
|
252 (url-honor-refresh-requests
|
|
|
253 . "Allow Netscape `Client Pull'"))
|
|
|
254 "A list of variables that the preferences compability pane knows about.")
|
|
|
255
|
|
|
256 (defun w3-preferences-init-compatibility-panel ()
|
|
|
257 (let ((compat w3-preferences-compatibility-variables)
|
|
|
258 (cur nil)
|
|
|
259 (var nil))
|
|
|
260 (w3-preferences-create-temp-variables
|
|
|
261 (mapcar 'car w3-preferences-compatibility-variables))))
|
|
|
262
|
|
|
263 (defun w3-preferences-create-compatibility-panel ()
|
|
|
264 (let ((compat w3-preferences-compatibility-variables)
|
|
|
265 (cur nil)
|
|
|
266 (var nil))
|
|
|
267 (widget-insert "\n")
|
|
|
268 (while compat
|
|
|
269 (setq cur (car compat)
|
|
|
270 compat (cdr compat)
|
|
|
271 var (intern (format "w3-preferences-temp-%s" (car cur))))
|
|
|
272 (widget-put
|
|
|
273 (widget-create 'checkbox
|
|
|
274 :notify 'w3-preferences-generic-variable-callback
|
|
|
275 :value (symbol-value var))
|
|
|
276 'variable var)
|
|
|
277 (widget-insert " " (cdr cur) "\n\n"))
|
|
|
278 (widget-setup)))
|
|
|
279
|
|
|
280 (defun w3-preferences-save-compatibility-panel ()
|
|
|
281 (w3-preferences-restore-variables
|
|
|
282 (mapcar 'car w3-preferences-compatibility-variables)))
|
|
|
283
|
|
|
284
|
|
|
285 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
286 ;;; The proxy configuration panel
|
|
|
287 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
288 (defun w3-preferences-init-proxy-panel ()
|
|
|
289 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
|
|
|
290 (proxy nil)
|
|
|
291 (host-var nil)
|
|
|
292 (port-var nil)
|
|
110
|
293 (host nil)
|
|
|
294 (port nil)
|
|
|
295 (proxy-entry nil))
|
|
0
|
296 (widget-insert "\n")
|
|
|
297 (while proxies
|
|
|
298 (setq proxy (car proxies)
|
|
|
299 proxies (cdr proxies)
|
|
|
300 host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
|
|
|
301 port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))
|
|
110
|
302 proxy-entry (cdr-safe (assoc (downcase proxy) url-proxy-services)))
|
|
|
303 (if (and proxy-entry (string-match "\\(.*\\):\\([0-9]+\\)" proxy-entry))
|
|
|
304 (setq host (match-string 1 proxy-entry)
|
|
|
305 port (match-string 2 proxy-entry))
|
|
|
306 (setq host proxy-entry
|
|
|
307 port nil))
|
|
|
308 (set (make-local-variable host-var) (or host ""))
|
|
116
|
309 (set (make-local-variable port-var) (or port ""))))
|
|
|
310 (set (make-local-variable 'w3-preferences-temp-no-proxy)
|
|
|
311 (cdr-safe (assoc "no_proxy" url-proxy-services))))
|
|
0
|
312
|
|
|
313 (defun w3-preferences-create-proxy-panel ()
|
|
|
314 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
|
|
|
315 (proxy nil)
|
|
|
316 (host-var nil)
|
|
|
317 (port-var nil)
|
|
|
318 (urlobj nil))
|
|
|
319 (widget-insert "\n")
|
|
|
320 (while proxies
|
|
|
321 (setq proxy (car proxies)
|
|
|
322 proxies (cdr proxies)
|
|
|
323 host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
|
|
|
324 port-var (intern (format "w3-%s-proxy-port" (downcase proxy))))
|
|
|
325 (widget-insert (format "%10s Proxy: " proxy))
|
|
|
326 (widget-put
|
|
80
|
327 (widget-create 'editable-field
|
|
0
|
328 :size 20
|
|
|
329 :value-face 'underline
|
|
|
330 :notify 'w3-preferences-generic-variable-callback
|
|
|
331 :value (format "%-20s" (symbol-value host-var)))
|
|
|
332 'variable host-var)
|
|
|
333 (widget-insert " Port: ")
|
|
|
334 (widget-put
|
|
80
|
335 (widget-create 'editable-field
|
|
0
|
336 :size 5
|
|
|
337 :value-face 'underline
|
|
|
338 :notify 'w3-preferences-generic-variable-callback
|
|
|
339 :value (format "%5s" (symbol-value port-var)))
|
|
|
340 'variable port-var)
|
|
|
341 (widget-insert "\n\n"))
|
|
116
|
342 (widget-insert " No proxy: ")
|
|
|
343 (widget-put
|
|
|
344 (widget-create 'editable-field
|
|
|
345 :size 40
|
|
|
346 :value-face 'underline
|
|
|
347 :notify 'w3-preferences-generic-variable-callback
|
|
|
348 :value (or (symbol-value 'w3-preferences-temp-no-proxy) ""))
|
|
|
349 'variable 'w3-preferences-temp-no-proxy)
|
|
0
|
350 (widget-setup)))
|
|
|
351
|
|
|
352 (defun w3-preferences-save-proxy-panel ()
|
|
|
353 (let ((proxies '("FTP" "Gopher" "HTTP" "Security" "WAIS" "SHTTP" "News"))
|
|
|
354 (proxy nil)
|
|
|
355 (host-var nil)
|
|
|
356 (port-var nil)
|
|
|
357 (urlobj nil)
|
|
|
358 (host nil)
|
|
|
359 (port nil)
|
|
|
360 (new-proxy-services nil))
|
|
116
|
361 (if (/= 0 (length (symbol-value 'w3-preferences-temp-no-proxy)))
|
|
|
362 (setq new-proxy-services (cons
|
|
|
363 (cons
|
|
|
364 "no_proxy"
|
|
|
365 (symbol-value 'w3-preferences-temp-no-proxy))
|
|
|
366 new-proxy-services)))
|
|
0
|
367 (while proxies
|
|
|
368 (setq proxy (car proxies)
|
|
|
369 proxies (cdr proxies)
|
|
|
370 host-var (intern (format "w3-%s-proxy-host" (downcase proxy)))
|
|
|
371 port-var (intern (format "w3-%s-proxy-port" (downcase proxy)))
|
|
|
372 urlobj (url-generic-parse-url
|
|
|
373 (cdr-safe
|
|
|
374 (assoc (downcase proxy) url-proxy-services)))
|
|
|
375 host (symbol-value host-var)
|
|
|
376 port (symbol-value port-var))
|
|
|
377 (if (and host (/= 0 (length host)))
|
|
|
378 (setq new-proxy-services (cons (cons (downcase proxy)
|
|
110
|
379 (format "%s:%s" host
|
|
0
|
380 (or port "80")))
|
|
|
381 new-proxy-services))))
|
|
|
382 (setq url-proxy-services new-proxy-services)))
|
|
|
383
|
|
|
384 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
110
|
385 ;;; Privacy panel
|
|
|
386 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
387
|
|
|
388 (defsubst w3-preferences-privacy-bits-sort (bits)
|
|
|
389 (sort bits (function (lambda (a b)
|
|
|
390 (memq b (memq a '(email os lastloc agent cookie)))))))
|
|
|
391
|
|
|
392 (defvar url-valid-privacy-levels
|
|
|
393 '((paranoid . (email os lastloc agent cookie))
|
|
|
394 (high . (email lastloc))
|
|
|
395 (low . (lastloc))
|
|
|
396 (none . nil)))
|
|
|
397
|
|
|
398 (defvar w3-preferences-privacy-bit-widgets nil)
|
|
|
399 (defvar w3-preferences-privacy-level-widget nil)
|
|
|
400 (defvar w3-preferences-temp-url-privacy-level nil)
|
|
|
401 ;; darnit i just noticed the checklist widget, this should probably be
|
|
|
402 ;; reimplemented with that instead of checkboxes, but i've almost finished.
|
|
|
403 (defun w3-preferences-privacy-bit-callback (widget &rest ignore)
|
|
|
404 (let ((privacy-bits (if (listp w3-preferences-temp-url-privacy-level)
|
|
|
405 w3-preferences-temp-url-privacy-level
|
|
|
406 (copy-list (cdr-safe (assq w3-preferences-temp-url-privacy-level url-valid-privacy-levels)))))
|
|
|
407 (bit (widget-get widget 'bit))
|
|
|
408 (val (widget-value widget)))
|
|
|
409 (if val
|
|
|
410 (setq privacy-bits (delq bit privacy-bits))
|
|
|
411 (setq privacy-bits (w3-preferences-privacy-bits-sort (cons bit (delq bit privacy-bits)))))
|
|
|
412 (setq w3-preferences-temp-url-privacy-level
|
|
|
413 (or (car (rassoc privacy-bits url-valid-privacy-levels))
|
|
|
414 privacy-bits))
|
|
|
415 (widget-value-set w3-preferences-privacy-level-widget
|
|
|
416 (if (listp w3-preferences-temp-url-privacy-level)
|
|
|
417 'custom
|
|
|
418 w3-preferences-temp-url-privacy-level))
|
|
|
419 ))
|
|
|
420
|
|
|
421
|
|
|
422 (defun w3-preferences-privacy-level-callback (widget &rest ignore)
|
|
|
423 (let* ((val (widget-value widget))
|
|
|
424 (privacy-bits (cdr-safe (assq val url-valid-privacy-levels))))
|
|
|
425 (if (eq val 'custom) nil
|
|
|
426 (setq w3-preferences-temp-url-privacy-level val)
|
|
|
427 (mapcar (function (lambda (bit)
|
|
|
428 (widget-value-set (cdr bit)
|
|
|
429 (not (memq (car bit)
|
|
|
430 privacy-bits)))))
|
|
|
431 w3-preferences-privacy-bit-widgets))
|
|
|
432 ))
|
|
|
433
|
|
|
434 (defun w3-preferences-init-privacy-panel ()
|
|
|
435 (w3-preferences-create-temp-variables '(url-privacy-level
|
|
|
436 url-cookie-confirmation))
|
|
|
437 (setq w3-preferences-privacy-bit-widgets nil)
|
|
|
438 (setq w3-preferences-privacy-level-widget nil))
|
|
|
439
|
|
|
440 (defsubst w3-preferences-create-privacy-bit-widget (bit bit-text current-bits)
|
|
|
441 (let ((bit-widget (widget-create
|
|
|
442 'checkbox
|
|
|
443 :value (not (memq bit current-bits))
|
|
|
444 :notify 'w3-preferences-privacy-bit-callback
|
|
|
445 )))
|
|
|
446 (widget-put bit-widget 'bit bit)
|
|
|
447 (setq w3-preferences-privacy-bit-widgets (cons (cons bit bit-widget)
|
|
|
448 w3-preferences-privacy-bit-widgets))
|
|
|
449 (widget-insert " " bit-text "\n")))
|
|
|
450
|
|
|
451
|
|
|
452 (defun w3-preferences-create-privacy-panel ()
|
|
|
453 (let ((privacy-bits (if (listp url-privacy-level)
|
|
|
454 url-privacy-level
|
|
|
455 (cdr-safe (assq url-privacy-level url-valid-privacy-levels)))))
|
|
|
456 (widget-insert "\n")
|
|
|
457 (widget-insert "General Privacy Level: ")
|
|
|
458 ;;; XXX something is weird with case folding in the following widget if you
|
|
|
459 ;;; type an option in lower case it accepts it but doesn't do anything
|
|
|
460 (setq w3-preferences-privacy-level-widget
|
|
|
461 (widget-create
|
|
|
462 'choice
|
|
|
463 :value (if (listp w3-preferences-temp-url-privacy-level)
|
|
|
464 'custom
|
|
|
465 w3-preferences-temp-url-privacy-level)
|
|
|
466 :notify 'w3-preferences-privacy-level-callback
|
|
|
467 :format "%v"
|
|
|
468 :tag "Privacy Level"
|
|
|
469 (list 'choice-item :format "%[%t%]" :tag "Paranoid" :value 'paranoid)
|
|
|
470 (list 'choice-item :format "%[%t%]" :tag "High" :value 'high)
|
|
|
471 (list 'choice-item :format "%[%t%]" :tag "Low" :value 'low)
|
|
|
472 (list 'choice-item :format "%[%t%]" :tag "None" :value 'none)
|
|
|
473 (list 'choice-item :format "%[%t%]" :tag "Custom" :value 'custom)))
|
|
|
474 (widget-put w3-preferences-privacy-level-widget 'variable 'w3-preferences-temp-url-privacy-level)
|
|
|
475
|
|
|
476 (widget-insert "\n(controls the options below)\n\nSend the following information with each request:\n")
|
|
|
477 (setq w3-preferences-privacy-bit-widgets nil)
|
|
|
478 (w3-preferences-create-privacy-bit-widget 'email "E-mail address" privacy-bits)
|
|
|
479 (w3-preferences-create-privacy-bit-widget 'lastloc "Last location visited" privacy-bits)
|
|
|
480 (w3-preferences-create-privacy-bit-widget 'os "Operating system information" privacy-bits)
|
|
|
481 (w3-preferences-create-privacy-bit-widget 'agent "User agent information" privacy-bits)
|
|
|
482 (w3-preferences-create-privacy-bit-widget 'cookie "Accept cookies" privacy-bits)
|
|
|
483 (widget-insert " ")
|
|
|
484 (widget-put
|
|
|
485 (widget-create
|
|
|
486 'checkbox
|
|
|
487 :value (symbol-value 'w3-preferences-temp-url-cookie-confirmation)
|
|
|
488 :notify 'w3-preferences-generic-variable-callback)
|
|
|
489 'variable 'w3-preferences-temp-url-cookie-confirmation)
|
|
|
490 (widget-insert " Ask before accepting cookies\n"))
|
|
|
491 (widget-setup))
|
|
|
492
|
|
|
493 (defun w3-preferences-save-privacy-panel ()
|
|
|
494 (w3-preferences-restore-variables '(url-privacy-level
|
|
|
495 url-cookie-confirmation))
|
|
|
496 (url-setup-privacy-info))
|
|
|
497
|
|
|
498 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
0
|
499 ;;;
|
|
|
500 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
501 (defun w3-preferences-create-panel (panel)
|
|
|
502 (let ((func (intern (format "w3-preferences-create-%s-panel" panel)))
|
|
|
503 (inhibit-read-only t))
|
|
|
504 (goto-char w3-preferences-panel-begin-marker)
|
|
|
505 (delete-region w3-preferences-panel-begin-marker
|
|
|
506 w3-preferences-panel-end-marker)
|
|
|
507 (set-marker-insertion-type w3-preferences-panel-end-marker t)
|
|
|
508 (if (fboundp func)
|
|
|
509 (funcall func)
|
|
|
510 (insert (format "You should be seeing %s right now.\n" panel))))
|
|
|
511 (set-marker-insertion-type w3-preferences-panel-end-marker nil)
|
|
|
512 (set-marker w3-preferences-panel-end-marker (point))
|
|
|
513 (goto-char w3-preferences-panel-begin-marker)
|
|
|
514 (condition-case ()
|
|
|
515 (widget-forward 1)
|
|
|
516 (error nil)))
|
|
|
517
|
|
|
518 (defun w3-preferences-notify (widget widget-ignore &optional event)
|
|
|
519 (let* ((glyph (and event w3-running-xemacs (event-glyph event)))
|
|
80
|
520 (x (and glyph (widget-glyphp glyph) (event-glyph-x-pixel event)))
|
|
|
521 (y (and glyph (widget-glyphp glyph) (event-glyph-y-pixel event)))
|
|
0
|
522 (map (widget-get widget 'usemap))
|
|
|
523 (value (widget-value widget)))
|
|
|
524 (if (and map x y)
|
|
|
525 (setq value (w3-point-in-map (vector x y) map)))
|
|
|
526 (if value
|
|
|
527 (w3-preferences-create-panel value))))
|
|
|
528
|
|
|
529 (defun w3-preferences-save-options ()
|
|
|
530 (w3-menu-save-options))
|
|
|
531
|
|
|
532 (defun w3-preferences-ok-callback (widget &rest ignore)
|
|
|
533 (let ((panels w3-preferences-panels)
|
|
|
534 (buffer (current-buffer))
|
|
|
535 (func nil))
|
|
|
536 (run-hooks 'w3-preferences-ok-hook)
|
|
|
537 (while panels
|
|
|
538 (setq func (intern
|
|
|
539 (format "w3-preferences-save-%s-panel" (caar panels)))
|
|
|
540 panels (cdr panels))
|
|
|
541 (if (fboundp func)
|
|
|
542 (funcall func)))
|
|
138
|
543 (if (fboundp 'custom-save-variables)
|
|
|
544 (custom-save-variables))
|
|
0
|
545 (w3-preferences-save-options)
|
|
|
546 (message "Options saved")
|
|
|
547 (sit-for 1)
|
|
|
548 (kill-buffer (current-buffer))))
|
|
|
549
|
|
|
550 (defun w3-preferences-reset-all-panels ()
|
|
|
551 (let ((panels w3-preferences-panels)
|
|
|
552 (func nil))
|
|
|
553 (while panels
|
|
|
554 (setq func (intern (format "w3-preferences-init-%s-panel"
|
|
|
555 (caar panels)))
|
|
|
556 panels (cdr panels))
|
|
|
557 (if (and func (fboundp func))
|
|
|
558 (funcall func)))))
|
|
|
559
|
|
|
560 (defun w3-preferences-cancel-callback (widget &rest ignore)
|
|
|
561 (if (not (funcall url-confirmation-func "Cancel and lose all changes? "))
|
|
|
562 (error "Not cancelled!"))
|
|
|
563 (w3-preferences-reset-all-panels)
|
|
|
564 (kill-buffer (current-buffer))
|
|
|
565 (run-hooks 'w3-preferences-cancel-hook))
|
|
|
566
|
|
|
567 (defun w3-preferences-reset-callback (widget &rest ignore)
|
|
|
568 (w3-preferences-reset-all-panels)
|
|
|
569 (run-hooks 'w3-preferences-default-hook)
|
|
|
570 (w3-preferences-create-panel (caar w3-preferences-panels)))
|
|
|
571
|
|
|
572 (defvar w3-preferences-setup-hook nil
|
|
|
573 "*Hooks to be run before setting up the preferences buffer.")
|
|
|
574
|
|
|
575 (defvar w3-preferences-cancel-hook nil
|
|
|
576 "*Hooks to be run when cancelling the preferences (Cancel was chosen).")
|
|
|
577
|
|
|
578 (defvar w3-preferences-default-hook nil
|
|
|
579 "*Hooks to be run when resetting preference defaults (Defaults was chosen).")
|
|
|
580
|
|
|
581 (defvar w3-preferences-ok-hook nil
|
|
|
582 "*Hooks to be run before saving the preferences (OK was chosen).")
|
|
|
583
|
|
|
584 (defun w3-preferences-init-all-panels ()
|
|
|
585 (let ((todo w3-preferences-panels)
|
|
|
586 (func nil))
|
|
|
587 (while todo
|
|
|
588 (setq func (intern (format "w3-preferences-init-%s-panel" (caar todo)))
|
|
|
589 todo (cdr todo))
|
|
|
590 (and (fboundp func) (funcall func)))))
|
|
|
591
|
|
82
|
592 ;;###autoload
|
|
0
|
593 (defun w3-preferences-edit ()
|
|
|
594 (interactive)
|
|
|
595 (let* ((prefs-buffer (get-buffer-create "W3 Preferences"))
|
|
|
596 (widget nil)
|
|
|
597 (inhibit-read-only t)
|
|
|
598 (window-conf (current-window-configuration)))
|
|
|
599 (delete-other-windows)
|
|
|
600 (set-buffer prefs-buffer)
|
|
110
|
601 (set (make-local-variable 'widget-push-button-gui) nil)
|
|
0
|
602 (w3-preferences-init-all-panels)
|
|
|
603 (set-window-buffer (selected-window) prefs-buffer)
|
|
|
604 (make-local-variable 'widget-field-face)
|
|
|
605 (setq w3-preferences-panel-begin-marker (make-marker)
|
|
|
606 w3-preferences-panel-end-marker (make-marker))
|
|
|
607 (set-marker-insertion-type w3-preferences-panel-begin-marker nil)
|
|
|
608 (set-marker-insertion-type w3-preferences-panel-end-marker t)
|
|
|
609 (use-local-map widget-keymap)
|
|
|
610 (erase-buffer)
|
|
|
611 (run-hooks 'w3-preferences-setup-hook)
|
|
108
|
612 (setq widget (apply 'widget-create 'menu-choice
|
|
|
613 :tag "Panel"
|
|
|
614 :notify 'w3-preferences-notify
|
|
|
615 :value 'appearance
|
|
|
616 (mapcar
|
|
|
617 (function
|
|
|
618 (lambda (x)
|
|
|
619 (list 'choice-item
|
|
|
620 :format "%[%t%]"
|
|
|
621 :tag (cdr x)
|
|
|
622 :value (car x))))
|
|
|
623 w3-preferences-panels)))
|
|
0
|
624 (goto-char (point-max))
|
|
|
625 (insert "\n\n")
|
|
|
626 (set-marker w3-preferences-panel-begin-marker (point))
|
|
|
627 (set-marker w3-preferences-panel-end-marker (point))
|
|
|
628 (w3-preferences-create-panel (caar w3-preferences-panels))
|
|
|
629 (goto-char (point-max))
|
|
|
630 (widget-insert "\n\n")
|
|
80
|
631 (widget-create 'push-button
|
|
0
|
632 :notify 'w3-preferences-ok-callback
|
|
|
633 :value "Ok")
|
|
|
634 (widget-insert " ")
|
|
80
|
635 (widget-create 'push-button
|
|
0
|
636 :notify 'w3-preferences-cancel-callback
|
|
|
637 :value "Cancel")
|
|
|
638 (widget-insert " ")
|
|
80
|
639 (widget-create 'push-button
|
|
0
|
640 :notify 'w3-preferences-reset-callback
|
|
|
641 :value "Reset")
|
|
|
642 (center-region (point-min) w3-preferences-panel-begin-marker)
|
|
|
643 (center-region w3-preferences-panel-end-marker (point-max))))
|
|
|
644
|
|
|
645 (provide 'w3-prefs)
|
