Mercurial > hg > xemacs-beta
diff lisp/url/url-hash.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | ac2d302a0011 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-hash.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,146 @@ +;;; url-hash.el,v --- Hashtable functions +;; Author: wmperry +;; Created: 1995/11/17 16:43:12 +;; Version: 1.3 +;; Keywords: lisp + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Copyright (c) 1995 by William M. Perry (wmperry@spry.com) +;;; +;;; This file is not part of GNU Emacs, but the same permissions apply. +;;; +;;; GNU Emacs is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; GNU Emacs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Emacs; see the file COPYING. If not, write to +;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Hash tables +(cond + ((and (fboundp 'maphash) (subrp (symbol-function 'maphash))) + ;; Builtins! + (defun url-puthash (key val table) + (let ((sym (if (stringp key) (intern key) key))) + (puthash sym val table))) + + (defun url-gethash (key table &optional default) + (let ((sym (if (stringp key) (intern-soft key) key))) + (if (not sym) + default + (gethash sym table)))) + + (mapcar (function + (lambda (sym) + (let ((new-sym (intern (format "url-%s" sym)))) + (defalias new-sym sym)))) + '(make-hashtable + make-key-weak-hashtable + make-value-weak-hashtable + make-weak-hashtable + hashtablep + clrhash + maphash + copy-hashtable))) + ((fboundp 'w3-maphash) + (mapcar (function + (lambda (sym) + (let ((new-sym (intern (format "url-%s" sym))) + (old-sym (intern (format "w3-%s" sym)))) + (defalias new-sym old-sym)))) + '(make-hashtable + make-key-weak-hashtable + make-value-weak-hashtable + make-weak-hashtable + hashtablep + puthash + gethash + clrhash + maphash + copy-hashtable))) + (t + (defconst url-hashtable-primes + '(13 29 37 47 59 71 89 107 131 163 197 239 293 353 431 521 631 761 919 + 1103 1327 1597 1931 2333 2801 3371 4049 4861 5839 7013 8419 10103 + 12143 14591 17519 21023 25229 30293 36353 43627 52361 62851 75431 + 90523 108631 130363 156437 187751 225307 270371 324449 389357 467237 + 560689 672827 807403 968897 1162687 1395263 1674319 2009191 2411033 + 2893249) + "A list of some good prime #s to use as sizes for hashtables.") + + (defun url-make-hashtable (size) + "Make a hashtable of initial size SIZE" + (if (not size) (setq size 37)) + (if (not (memq size url-hashtable-primes)) + ;; Find a suitable prime # to use as the hashtable size + (let ((primes url-hashtable-primes)) + (while (<= (car primes) size) + (setq primes (cdr primes))) + (setq size (car primes)))) + (make-vector (or size 2893249) 0)) + + (fset 'url-make-key-weak-hashtable 'url-make-hashtable) + (fset 'url-make-value-weak-hashtable 'url-make-hashtable) + (fset 'url-make-weak-hashtable 'url-make-hashtable) + + (defun url-hashtablep (obj) + "Return t if OBJ is a hashtable, else nil." + (vectorp obj)) + + (defun url-puthash (key val table) + "Hash KEY to VAL in TABLE." + (let ((sym (intern (if (stringp key) key (prin1-to-string key)) table))) + (put sym 'val val) + (put sym 'key key))) + + (defun url-gethash (key table &optional default) + "Find hash value for KEY in TABLE. +If there is no corresponding value, return DEFAULT (defaults to nil)." + (let ((sym (intern-soft (if (stringp key) key (prin1-to-string key)) table))) + (and sym (get sym 'val)))) + + (put 'url-gethash 'sysdep-defined-this t) + + (defun url-clrhash (table) + "Flush TABLE" + (fillarray table 0)) + + (defun url-maphash (function table) + "Map FUNCTION over entries in TABLE, calling it with two args, +each key and value in the table." + (mapatoms + (function + (lambda (sym) + (funcall function (get sym 'key) (get sym 'val)))) table)) + + (defun url-copy-hashtable (old-table) + "Make a new hashtable which contains the same keys and values +as the given table. The keys and values will not themselves be copied." + (copy-sequence old-table)) + (mapcar (function + (lambda (sym) + (let ((new-sym (intern (format "w3-%s" sym))) + (old-sym (intern (format "url-%s" sym)))) + (fset new-sym old-sym)))) + '(make-hashtable + make-key-weak-hashtable + make-value-weak-hashtable + make-weak-hashtable + hashtablep + puthash + gethash + clrhash + maphash + copy-hashtable)) + )) + +(provide 'url-hash) +(provide 'w3-hash)