1;;; url-privacy.el --- Global history tracking for URL package 2 3;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Keywords: comm, data, processes, hypermedia 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 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 21;; along with GNU Emacs; see the file COPYING. If not, write to the 22;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 23;; Boston, MA 02110-1301, USA. 24 25;;; Code: 26 27(eval-when-compile (require 'cl)) 28(require 'url-vars) 29 30(if (fboundp 'device-type) 31 (defalias 'url-device-type 'device-type) 32 (defun url-device-type (&optional device) (or window-system 'tty))) 33 34;;;###autoload 35(defun url-setup-privacy-info () 36 "Setup variables that expose info about you and your system." 37 (interactive) 38 (setq url-system-type 39 (cond 40 ((or (eq url-privacy-level 'paranoid) 41 (and (listp url-privacy-level) 42 (memq 'os url-privacy-level))) 43 nil) 44 ;; First, we handle the inseparable OS/Windowing system 45 ;; combinations 46 ((eq system-type 'Apple-Macintosh) "Macintosh") 47 ((eq system-type 'next-mach) "NeXT") 48 ((eq system-type 'windows-nt) "Windows-NT; 32bit") 49 ((eq system-type 'ms-windows) "Windows; 16bit") 50 ((eq system-type 'ms-dos) "MS-DOS; 32bit") 51 ((memq (url-device-type) '(win32 w32)) "Windows; 32bit") 52 ((eq (url-device-type) 'pm) "OS/2; 32bit") 53 (t 54 (case (url-device-type) 55 (x "X11") 56 (ns "OpenStep") 57 (tty "TTY") 58 (otherwise nil))))) 59 60 (setq url-personal-mail-address (or url-personal-mail-address 61 user-mail-address 62 (format "%s@%s" (user-real-login-name) 63 (system-name)))) 64 65 (if (or (memq url-privacy-level '(paranoid high)) 66 (and (listp url-privacy-level) 67 (memq 'email url-privacy-level))) 68 (setq url-personal-mail-address nil)) 69 70 (setq url-os-type 71 (cond 72 ((or (eq url-privacy-level 'paranoid) 73 (and (listp url-privacy-level) 74 (memq 'os url-privacy-level))) 75 nil) 76 ((boundp 'system-configuration) system-configuration) 77 ((boundp 'system-type) (symbol-name system-type)) 78 (t nil)))) 79 80(provide 'url-privacy) 81 82;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d 83;;; url-privacy.el ends here 84