1 ;;; url-privacy.el --- Global history tracking for URL package
2 ;; Author: $Author: fx $
3 ;; Created: $Date: 2001/10/05 17:10:26 $
4 ;; Version: $Revision: 1.4 $
5 ;; Keywords: comm, data, processes, hypermedia
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
9 ;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
11 ;;; This file is part of GNU Emacs.
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;;; it under the terms of the GNU General Public License as published by
15 ;;; the Free Software Foundation; either version 2, or (at your option)
16 ;;; any later version.
18 ;;; GNU Emacs is distributed in the hope that it will be useful,
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;;; GNU General Public License for more details.
23 ;;; You should have received a copy of the GNU General Public License
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;;; Boston, MA 02111-1307, USA.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 (eval-when-compile (require 'cl
))
32 (if (fboundp 'device-type
)
33 (defalias 'url-device-type
'device-type
)
34 (defun url-device-type (&optional device
) (or window-system
'tty
)))
37 (defun url-setup-privacy-info ()
41 ((or (eq url-privacy-level
'paranoid
)
42 (and (listp url-privacy-level
)
43 (memq 'os url-privacy-level
)))
45 ;; First, we handle the inseparable OS/Windowing system
47 ((eq system-type
'Apple-Macintosh
) "Macintosh")
48 ((eq system-type
'next-mach
) "NeXT")
49 ((eq system-type
'windows-nt
) "Windows-NT; 32bit")
50 ((eq system-type
'ms-windows
) "Windows; 16bit")
51 ((eq system-type
'ms-dos
) "MS-DOS; 32bit")
52 ((memq (url-device-type) '(win32 w32
)) "Windows; 32bit")
53 ((eq (url-device-type) 'pm
) "OS/2; 32bit")
55 (case (url-device-type)
61 (setq url-personal-mail-address
(or url-personal-mail-address
63 (format "%s@%s" (user-real-login-name)
66 (if (or (memq url-privacy-level
'(paranoid high
))
67 (and (listp url-privacy-level
)
68 (memq 'email url-privacy-level
)))
69 (setq url-personal-mail-address nil
))
73 ((or (eq url-privacy-level
'paranoid
)
74 (and (listp url-privacy-level
)
75 (memq 'os url-privacy-level
)))
77 ((boundp 'system-configuration
)
79 ((boundp 'system-type
)
80 (symbol-name system-type
))
83 (provide 'url-privacy
)