lisp/url/url-privacy.el

   1 ;;; url-privacy.el --- Global history tracking for URL package
   2
   3 ;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc.
   4
   5 ;; Keywords: comm, data, processes, hypermedia
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  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
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Code:
  23
  24 (require 'url-vars)
  25
  26 (defun url-device-type (&optional device)
  27   (if (fboundp 'device-type)
  28       (device-type device)              ; XEmacs
  29     (or window-system 'tty)))
  30
  31 ;;;###autoload
  32 (defun url-setup-privacy-info ()
  33   "Setup variables that expose info about you and your system."
  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
  43          ((eq system-type 'windows-nt) "Windows-NT; 32bit")
  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
  48           (pcase (url-device-type)
  49             (`x "X11")
  50             (`ns "OpenStep")
  51             (`tty "TTY")
  52             (_ nil)))))
  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)
  70          ((boundp 'system-configuration) system-configuration)
  71          ((boundp 'system-type) (symbol-name system-type))
  72          (t nil))))
  73
  74 (provide 'url-privacy)
  75
  76 ;;; url-privacy.el ends here