cgit.sxemacs.org Git - packages/blob - xemacs-packages/w3/lisp/url-ns.el

   1 ;;; url-ns.el --- Various netscape-ish functions for proxy definitions
   2
   3 ;; Copyright (C) 1997-1999, 2004-2012 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-gw)
  25
  26 ;;;###autoload
  27 (defun isPlainHostName (host)
  28   (not (string-match "\\." host)))
  29
  30 ;;;###autoload
  31 (defun dnsDomainIs (host dom)
  32   (string-match (concat (regexp-quote dom) "$") host))
  33
  34 ;;;###autoload
  35 (defun dnsResolve (host)
  36   (url-gateway-nslookup-host host))
  37
  38 ;;;###autoload
  39 (defun isResolvable (host)
  40   (if (string-match "^[0-9.]+$" host)
  41       t
  42     (not (string= host (url-gateway-nslookup-host host)))))
  43
  44 ;;;###autoload
  45 (defun isInNet (ip net mask)
  46   (let ((netc (split-string ip "\\."))
  47         (ipc  (split-string net "\\."))
  48         (maskc (split-string mask "\\.")))
  49     (if (or (/= (length netc) (length ipc))
  50             (/= (length ipc) (length maskc)))
  51         nil
  52       (setq netc (mapcar 'string-to-number netc)
  53             ipc (mapcar 'string-to-number ipc)
  54             maskc (mapcar 'string-to-number maskc))
  55       (and
  56        (= (logand (nth 0 netc) (nth 0 maskc))
  57           (logand (nth 0 ipc)  (nth 0 maskc)))
  58        (= (logand (nth 1 netc) (nth 1 maskc))
  59           (logand (nth 1 ipc)  (nth 1 maskc)))
  60        (= (logand (nth 2 netc) (nth 2 maskc))
  61           (logand (nth 2 ipc)  (nth 2 maskc)))
  62        (= (logand (nth 3 netc) (nth 3 maskc))
  63           (logand (nth 3 ipc)  (nth 3 maskc)))))))
  64
  65 ;; Netscape configuration file parsing
  66 (defvar url-ns-user-prefs nil
  67   "Internal, do not use.")
  68
  69 ;;;###autoload
  70 (defun url-ns-prefs (&optional file)
  71   (if (not file)
  72       (setq file (expand-file-name "~/.netscape/preferences.js")))
  73   (if (not (and (file-exists-p file)
  74                 (file-readable-p file)))
  75       (message "Could not open %s for reading" file)
  76     (save-excursion
  77       (let ((false nil)
  78             (true t))
  79         (setq url-ns-user-prefs (make-hash-table :size 13 :test 'equal))
  80         (set-buffer (get-buffer-create " *ns-parse*"))
  81         (erase-buffer)
  82         (insert-file-contents file)
  83         (goto-char (point-min))
  84         (while (re-search-forward "^//" nil t)
  85           (replace-match ";;"))
  86         (goto-char (point-min))
  87         (while (re-search-forward "^user_pref(" nil t)
  88           (replace-match "(url-ns-set-user-pref "))
  89         (goto-char (point-min))
  90         (while (re-search-forward "\"," nil t)
  91           (replace-match "\""))
  92         (goto-char (point-min))
  93         (eval-buffer)))))
  94
  95 (defun url-ns-set-user-pref (key val)
  96   (puthash key val url-ns-user-prefs))
  97
  98 ;;;###autoload
  99 (defun url-ns-user-pref (key &optional default)
 100   (gethash key url-ns-user-prefs default))
 101
 102 (provide 'url-ns)
 103
 104 ;;; url-ns.el ends here