Mercurial > hg > xemacs-beta

comparison lisp/url/url-hash.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents
children
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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 (t
54 (defconst url-hashtable-primes
55 '(13 29 37 47 59 71 89 107 131 163 197 239 293 353 431 521 631 761 919
56 1103 1327 1597 1931 2333 2801 3371 4049 4861 5839 7013 8419 10103
57 12143 14591 17519 21023 25229 30293 36353 43627 52361 62851 75431
58 90523 108631 130363 156437 187751 225307 270371 324449 389357 467237
59 560689 672827 807403 968897 1162687 1395263 1674319 2009191 2411033
60 2893249)
61 "A list of some good prime #s to use as sizes for hashtables.")
62
63 (defun url-make-hashtable (size)
64 "Make a hashtable of initial size SIZE"
65 (if (not size) (setq size 37))
66 (if (not (memq size url-hashtable-primes))
67 ;; Find a suitable prime # to use as the hashtable size
68 (let ((primes url-hashtable-primes))
69 (while (<= (car primes) size)
70 (setq primes (cdr primes)))
71 (setq size (car primes))))
72 (make-vector (or size 2893249) 0))
73
74 (fset 'url-make-key-weak-hashtable 'url-make-hashtable)
75 (fset 'url-make-value-weak-hashtable 'url-make-hashtable)
76 (fset 'url-make-weak-hashtable 'url-make-hashtable)
77
78 (defun url-hashtablep (obj)
79 "Return t if OBJ is a hashtable, else nil."
80 (vectorp obj))
81
82 (defun url-puthash (key val table)
83 "Hash KEY to VAL in TABLE."
84 (let ((sym (intern (if (stringp key) key (prin1-to-string key)) table)))
85 (put sym 'val val)
86 (put sym 'key key)))
87
88 (defun url-gethash (key table &optional default)
89 "Find hash value for KEY in TABLE.
90 If there is no corresponding value, return DEFAULT (defaults to nil)."
91 (let ((sym (intern-soft (if (stringp key) key (prin1-to-string key)) table)))
92 (and sym (get sym 'val))))
93
94 (put 'url-gethash 'sysdep-defined-this t)
95
96 (defun url-clrhash (table)
97 "Flush TABLE"
98 (fillarray table 0))
99
100 (defun url-maphash (function table)
101 "Map FUNCTION over entries in TABLE, calling it with two args,
102 each key and value in the table."
103 (mapatoms
104 (function
105 (lambda (sym)
106 (funcall function (get sym 'key) (get sym 'val)))) table))
107
108 (defun url-copy-hashtable (old-table)
109 "Make a new hashtable which contains the same keys and values
110 as the given table. The keys and values will not themselves be copied."
111 (copy-sequence old-table))
112 ))
113
114 (provide 'url-hash)