home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / zload / edbm.el next >
Encoding:
Text File  |  1993-03-24  |  4.3 KB  |  145 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Emacs-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;; 
  3. ;; edbm.el -- simple minded dbm-like facility for emacs
  4. ;; 
  5. ;; edbm.el,v 1.2 1993/02/19 00:46:53 krab Exp
  6. ;; 
  7. ;; Author          : Kresten Krab Thorup
  8. ;; Created On      : Thu Feb 18 23:27:07 1993
  9. ;; Last Modified By: Kresten Krab Thorup
  10. ;; Last Modified On: Fri Feb 19 01:46:00 1993
  11. ;; 
  12. ;; Update Count    : 33
  13. ;; Buffer Position : 4102
  14. ;; Minor Modes     : ( DEBUG Fill)
  15. ;; 
  16. ;; edbm.el,v
  17. ;; Revision 1.2  1993/02/19  00:46:53  krab
  18. ;; Changed to fast version of edbm::read which doesnt use load.
  19. ;;
  20. ;; Revision 1.1  1993/02/18  22:54:10  krab
  21. ;; Initial revision
  22. ;;
  23. ;; 
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. (provide 'edbm)
  27. (require 'zload)
  28.  
  29. (defconst edbm:version "1.2"
  30.   "The revision number of edbm.el -- Simple code to provide edbm like
  31. facilities for elisp.   Complete RCS identity is
  32.  
  33.     edbm.el,v 1.2 1993/02/19 00:46:53 krab Exp")
  34.  
  35.  
  36. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37. ;; PUBLIC FUNCTIONS
  38. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  39.  
  40. (defun edbm:init (file)
  41.   "Initialize a edbm table from FILE.  Returns a table data structure,
  42. which is passed as the first argument of the other functions"
  43.   (let ((edbm::date (and (file-exists-p file)
  44.              (nth 5 (file-attributes file)))))
  45.     
  46.     (if edbm::date
  47.     (cons (cons file edbm::date) (edbm::read file))
  48.       (cons (cons file edbm::date) nil))))
  49.  
  50. (defun edbm:get (table key)
  51.   "From TABLE get the value of KEY"
  52.   (if table
  53.       (let* ((edbm::file (car (car table)))
  54.          (edbm::date (cdr (car table)))
  55.          (file::date (and (file-exists-p (car (car table)))
  56.                   (nth 5 (file-attributes (car (car table)))))))
  57.  
  58.     (if (equal edbm::date file::date)
  59.         nil
  60.       (setcdr table (edbm::read edbm::file))
  61.       (setcar table (cons edbm::file file::date)))
  62.     
  63.     (assoc key (cdr table)))))
  64.  
  65. (defun edbm:set (table key value)
  66.   "In TABLE set the value of KEY to VALUE"
  67.   (edbm:remove table key)
  68.   (edbm::append table key value))
  69.  
  70. (defun edbm:remove (table key)
  71.   "In table, remove key"
  72.   (if (and table (edbm:get table key))
  73.   
  74.       (let ((removen-entry nil))
  75.     
  76.     ;; first, remove it from the table
  77.     (let ((edbm::table (cdr table))
  78.           (edbm::entry nil))
  79.       (setcdr table nil)
  80.       (while (setq edbm::entry (car edbm::table))
  81.         (setq edbm::table (cdr edbm::table))
  82.         (if (equal (car edbm::entry) key)
  83.         (setq removen-entry edbm::entry)
  84.           (setcdr table (cons edbm::entry (cdr table))))))
  85.     
  86.     ;;next, remove it from the file
  87.     (let ((table-buf (get-buffer-create "*edbm*"))
  88.           (this-buf (current-buffer)))
  89.       (set-buffer table-buf)
  90.       (kill-region (point-min) (point-max))
  91.       (if (file-exists-p (car (car table)))
  92.           (insert-file-contents (car (car table))))
  93.       (goto-char (point-min))
  94.       (delete-matching-lines 
  95.        (concat "^" (regexp-quote (edbm::entry-string removen-entry))))
  96.       (write-region (point-min) (point-max) (car (car table)) nil "glab")
  97.       (set-buffer this-buf)
  98.       (kill-buffer table-buf)))))
  99.     
  100.  
  101. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  102. ;; PRIVATE FUNCTIONS
  103. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  104.  
  105.  
  106. (defun edbm::append (table key value)
  107.   "To TABLE, append KEY as VALUE"
  108.   (setcdr table (cons (cons key value) (cdr table)))
  109.   (let ((table-buf (get-buffer-create "*edbm*"))
  110.     (this-buf (current-buffer)))
  111.     (set-buffer table-buf)
  112.     (kill-region (point-min) (point-max))
  113.     (if (file-exists-p (car (car table)))
  114.     (insert-file-contents (car (car table))))
  115.     (goto-char (point-max))
  116.     (insert (concat (edbm::entry-string (cons key value)) "\n"))
  117.     (write-region (point-min) (point-max) (car (car table)) nil "glab")
  118.     (set-buffer this-buf)
  119.     (kill-buffer table-buf)))
  120.  
  121. (defun edbm::read (file)
  122.   "This function is used to read a edbm file"
  123.   (let ((edbm:::list nil)
  124.     (table-buf (get-buffer-create "*edbm*"))
  125.     (this-buf (current-buffer)))
  126.     (set-buffer table-buf)
  127.     (kill-region (point-min) (point-max))
  128.     (insert-file-contents file)
  129.     (eval-current-buffer)
  130.     (set-buffer this-buf)
  131.     (kill-buffer table-buf)
  132.     edbm:::list))
  133.  
  134. (defun edbm::entry-string (cell)
  135.   "This function is used for printing edbm files"
  136.   (prin1-to-string (list 'edbm:::entry (list 'quote cell)))
  137. )
  138.  
  139. (defun edbm:::entry (cell)
  140.   "This function is used for scanning edbm files"
  141.   (setq edbm:::list (cons cell edbm:::list)))
  142.  
  143.  
  144.  
  145.