Mercurial > hg > xemacs-beta

comparison lisp/url/url-hash.el @ 0:376386a54a3c r19-14

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