Commit | Line | Data |
---|---|---|
8c8b8430 | 1 | ;;; url-privacy.el --- Global history tracking for URL package |
00eef4de | 2 | |
3f12e3f4 | 3 | ;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, |
5df4f04c | 4 | ;; 2009, 2010, 2011 Free Software Foundation, Inc. |
00eef4de | 5 | |
8c8b8430 SM |
6 | ;; Keywords: comm, data, processes, hypermedia |
7 | ||
00eef4de LH |
8 | ;; This file is part of GNU Emacs. |
9 | ||
4936186e | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
00eef4de | 11 | ;; it under the terms of the GNU General Public License as published by |
4936186e GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
00eef4de LH |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
4936186e | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
00eef4de LH |
22 | |
23 | ;;; Code: | |
8c8b8430 SM |
24 | |
25 | (eval-when-compile (require 'cl)) | |
26 | (require 'url-vars) | |
27 | ||
153ef845 DN |
28 | (defun url-device-type (&optional device) |
29 | (if (fboundp 'device-type) | |
bb78f352 | 30 | (device-type device) ; XEmacs |
153ef845 | 31 | (or window-system 'tty))) |
8c8b8430 SM |
32 | |
33 | ;;;###autoload | |
34 | (defun url-setup-privacy-info () | |
59425106 | 35 | "Setup variables that expose info about you and your system." |
8c8b8430 SM |
36 | (interactive) |
37 | (setq url-system-type | |
38 | (cond | |
39 | ((or (eq url-privacy-level 'paranoid) | |
40 | (and (listp url-privacy-level) | |
41 | (memq 'os url-privacy-level))) | |
42 | nil) | |
43 | ;; First, we handle the inseparable OS/Windowing system | |
44 | ;; combinations | |
8c8b8430 | 45 | ((eq system-type 'windows-nt) "Windows-NT; 32bit") |
8c8b8430 SM |
46 | ((eq system-type 'ms-dos) "MS-DOS; 32bit") |
47 | ((memq (url-device-type) '(win32 w32)) "Windows; 32bit") | |
48 | ((eq (url-device-type) 'pm) "OS/2; 32bit") | |
49 | (t | |
50 | (case (url-device-type) | |
51 | (x "X11") | |
52 | (ns "OpenStep") | |
53 | (tty "TTY") | |
54 | (otherwise nil))))) | |
55 | ||
56 | (setq url-personal-mail-address (or url-personal-mail-address | |
57 | user-mail-address | |
58 | (format "%s@%s" (user-real-login-name) | |
59 | (system-name)))) | |
60 | ||
61 | (if (or (memq url-privacy-level '(paranoid high)) | |
62 | (and (listp url-privacy-level) | |
63 | (memq 'email url-privacy-level))) | |
64 | (setq url-personal-mail-address nil)) | |
65 | ||
66 | (setq url-os-type | |
67 | (cond | |
68 | ((or (eq url-privacy-level 'paranoid) | |
69 | (and (listp url-privacy-level) | |
70 | (memq 'os url-privacy-level))) | |
71 | nil) | |
59425106 SM |
72 | ((boundp 'system-configuration) system-configuration) |
73 | ((boundp 'system-type) (symbol-name system-type)) | |
8c8b8430 SM |
74 | (t nil)))) |
75 | ||
76 | (provide 'url-privacy) | |
e5566bd5 | 77 | |
59425106 | 78 | ;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d |
00eef4de | 79 | ;;; url-privacy.el ends here |