lisp/url/url-privacy.el

   1 ;;; url-privacy.el --- Global history tracking for URL package
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
   4 ;;   2005, 2006, 2007, 2008 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 3 of the License, or
  13 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Code:
  24
  25 (eval-when-compile (require 'cl))
  26 (require 'url-vars)
  27
  28 (defun url-device-type (&optional device)
  29   (if (fboundp 'device-type)
  30       (device-type device)              ; XEmacs
  31     (or window-system 'tty)))
  32
  33 ;;;###autoload
  34 (defun url-setup-privacy-info ()
  35   "Setup variables that expose info about you and your system."
  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
  45          ((eq system-type 'Apple-Macintosh) "Macintosh")
  46          ((eq system-type 'next-mach) "NeXT")
  47          ((eq system-type 'windows-nt) "Windows-NT; 32bit")
  48          ((eq system-type 'ms-windows) "Windows; 16bit")
  49          ((eq system-type 'ms-dos) "MS-DOS; 32bit")
  50          ((memq (url-device-type) '(win32 w32)) "Windows; 32bit")
  51          ((eq (url-device-type) 'pm) "OS/2; 32bit")
  52          (t
  53           (case (url-device-type)
  54             (x "X11")
  55             (ns "OpenStep")
  56             (tty "TTY")
  57             (otherwise nil)))))
  58
  59   (setq url-personal-mail-address (or url-personal-mail-address
  60                                       user-mail-address
  61                                       (format "%s@%s"  (user-real-login-name)
  62                                               (system-name))))
  63
  64   (if (or (memq url-privacy-level '(paranoid high))
  65           (and (listp url-privacy-level)
  66                (memq 'email url-privacy-level)))
  67       (setq url-personal-mail-address nil))
  68
  69   (setq url-os-type
  70         (cond
  71          ((or (eq url-privacy-level 'paranoid)
  72               (and (listp url-privacy-level)
  73                    (memq 'os url-privacy-level)))
  74           nil)
  75          ((boundp 'system-configuration) system-configuration)
  76          ((boundp 'system-type) (symbol-name system-type))
  77          (t nil))))
  78
  79 (provide 'url-privacy)
  80
  81 ;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d
  82 ;;; url-privacy.el ends here