annotate lisp/url/url-hash.el @ 7:c153ca296910

Added tag r19-15b4 for changeset 27bc7f280385
author cvs
date Mon, 13 Aug 2007 08:47:16 +0200
parents ac2d302a0011
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 ;;; url-hash.el,v --- Hashtable functions
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2 ;; Author: wmperry
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3 ;; Created: 1995/11/17 16:43:12
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4 ;; Version: 1.3
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5 ;; Keywords: lisp
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 ;;; Copyright (c) 1995 by William M. Perry (wmperry@spry.com)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 ;;; This file is not part of GNU Emacs, but the same permissions apply.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13 ;;; it under the terms of the GNU General Public License as published by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 ;;; the Free Software Foundation; either version 2, or (at your option)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 ;;; any later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 ;;; GNU General Public License for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21 ;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22 ;;; You should have received a copy of the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27 ;; Hash tables
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 (cond
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29 ((and (fboundp 'maphash) (subrp (symbol-function 'maphash)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30 ;; Builtins!
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31 (defun url-puthash (key val table)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 (let ((sym (if (stringp key) (intern key) key)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33 (puthash sym val table)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 (defun url-gethash (key table &optional default)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36 (let ((sym (if (stringp key) (intern-soft key) key)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
37 (if (not sym)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
38 default
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 (gethash sym table))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41 (mapcar (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42 (lambda (sym)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43 (let ((new-sym (intern (format "url-%s" sym))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44 (defalias new-sym sym))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
45 '(make-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 make-key-weak-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47 make-value-weak-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48 make-weak-hashtable
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49 hashtablep
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
50 clrhash
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51 maphash
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
52 copy-hashtable)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 (t
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54 (defconst url-hashtable-primes
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
55 '(13 29 37 47 59 71 89 107 131 163 197 239 293 353 431 521 631 761 919
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 1103 1327 1597 1931 2333 2801 3371 4049 4861 5839 7013 8419 10103
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 12143 14591 17519 21023 25229 30293 36353 43627 52361 62851 75431
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 90523 108631 130363 156437 187751 225307 270371 324449 389357 467237
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 560689 672827 807403 968897 1162687 1395263 1674319 2009191 2411033
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 2893249)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 "A list of some good prime #s to use as sizes for hashtables.")
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63 (defun url-make-hashtable (size)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64 "Make a hashtable of initial size SIZE"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 (if (not size) (setq size 37))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 (if (not (memq size url-hashtable-primes))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 ;; Find a suitable prime # to use as the hashtable size
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 (let ((primes url-hashtable-primes))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69 (while (<= (car primes) size)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70 (setq primes (cdr primes)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 (setq size (car primes))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 (make-vector (or size 2893249) 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 (fset 'url-make-key-weak-hashtable 'url-make-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 (fset 'url-make-value-weak-hashtable 'url-make-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 (fset 'url-make-weak-hashtable 'url-make-hashtable)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78 (defun url-hashtablep (obj)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79 "Return t if OBJ is a hashtable, else nil."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80 (vectorp obj))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
82 (defun url-puthash (key val table)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 "Hash KEY to VAL in TABLE."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 (let ((sym (intern (if (stringp key) key (prin1-to-string key)) table)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 (put sym 'val val)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86 (put sym 'key key)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 (defun url-gethash (key table &optional default)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 "Find hash value for KEY in TABLE.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90 If there is no corresponding value, return DEFAULT (defaults to nil)."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 (let ((sym (intern-soft (if (stringp key) key (prin1-to-string key)) table)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 (and sym (get sym 'val))))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 (put 'url-gethash 'sysdep-defined-this t)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96 (defun url-clrhash (table)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 "Flush TABLE"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98 (fillarray table 0))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 (defun url-maphash (function table)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101 "Map FUNCTION over entries in TABLE, calling it with two args,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102 each key and value in the table."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 (mapatoms
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104 (function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 (lambda (sym)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106 (funcall function (get sym 'key) (get sym 'val)))) table))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 (defun url-copy-hashtable (old-table)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109 "Make a new hashtable which contains the same keys and values
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
110 as the given table. The keys and values will not themselves be copied."
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111 (copy-sequence old-table))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112 ))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114 (provide 'url-hash)