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