home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / edb / database.el < prev    next >
Encoding:
Text File  |  1993-06-14  |  14.3 KB  |  409 lines
  1. ;;; database.el --- EDB, the Emacs database; replaces forms editing modes
  2.  
  3. ;; Copyright (C) 1991-1993 Michael D. Ernst <mernst@theory.lcs.mit.edu>
  4.  
  5. ;; Author: Michael Ernst <mernst@theory.lcs.mit.edu>
  6. ;; Keywords: EDB, database, forms
  7. ;; Version: 1.17
  8. ;; Release-Date: June 14, 1993
  9.  
  10. ;;; Commentary:
  11.  
  12. ;; EDB is a flexible, customizable database program for Emacs.
  13. ;; See the texinfo documentation database.texi for complete installation
  14. ;; and usage instructions for EDB, the Emacs database.  The README file
  15. ;; also contains installation instructions.
  16.  
  17. ;; LCD Archive Entry:
  18. ;; edb|Michael Ernst|mernst@theory.lcs.mit.edu
  19. ;; |Customizable database program for Emacs; replaces forms editing modes
  20. ;; |June 14, 1993|1.17|~/packages/edb.tar.Z|
  21.  
  22. ;; When changing these, change the LCD Archive Entry and header too.
  23. (defconst edb-version "1.17")
  24. (defconst edb-date "June 14, 1993")    ; release date
  25.  
  26. ;; EDB is distributed under the same conditions as GNU Emacs.
  27.  
  28. ;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT
  29. ;; ANY WARRANTY.  No author or distributor accepts responsibility to anyone
  30. ;; for the consequences of using it or for whether it serves any particular
  31. ;; purpose or works at all, unless he says so in writing.  Refer to the GNU
  32. ;; Emacs General Public License for full details.
  33.  
  34. ;; Everyone is granted permission to copy, modify and redistribute GNU
  35. ;; Emacs, but only under the conditions described in the GNU Emacs General
  36. ;; Public License.  A copy of this license is supposed to have been given
  37. ;; to you along with GNU Emacs so you can know your rights and
  38. ;; responsibilities.  It should be in a file named COPYING.  If not, write
  39. ;; to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  40. ;; 02139, USA for a copy.  Among other things, the copyright notice and
  41. ;; this notice must be preserved on all copies.
  42.  
  43. ;;; Code:
  44.  
  45.  
  46. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47. ;;; User-visible variables
  48. ;;;
  49.  
  50. (defvar db-load-hooks nil
  51.   "Function or list of functions run after loading EDB.
  52. You can use this to customize key bindings or load extensions.")
  53.  
  54.  
  55. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  56. ;;; Global variables
  57. ;;;
  58.  
  59. (defvar db-databases nil
  60.   "Assoc list of database names and databases.")
  61.  
  62. ;; Alist of typenames and displayspecs.
  63. (defvar db-displaytypes nil)
  64.  
  65. (defvar db-recordfieldtypes nil
  66.   "Alist of typenames and recordfieldspecs.")
  67.  
  68. (defvar db-inform-interval 10
  69.   "When doing a lengthy computation, inform the user of progress every this
  70. many records.  If nil, don't inform.")
  71.  
  72.  
  73. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74. ;;; Database messages
  75. ;;;
  76.  
  77. ;; T if logging has been done recently (since the user was last shown the log).
  78. (defvar db-logged nil)
  79.  
  80. ;; Postpend STRING to buffer *Database-Log*.
  81. (defun db-log (string)
  82.   (in-buffer "*Database-Log*"
  83.     (save-excursion
  84.       (goto-char (point-max))
  85.       (insert string "\n")))
  86.   (setq db-logged t))
  87.  
  88. ;; Format message, display it, and log it in buffer *Database-Log*.
  89. (defun db-message (format-string &rest args)
  90.   (let ((formatted (apply 'format format-string args)))
  91.     (db-log formatted)
  92.     (best-fit-message formatted)))
  93.  
  94. ;; Like `db-message', but prepends \"Warning: \".
  95. (defmacro db-warning (format-string &rest args)
  96.   (` (db-message (concat "Warning: " (, format-string)) (,@ args))))
  97. (fset 'db-warn 'db-warning)
  98.  
  99.  
  100. ;;;
  101. ;;; Debugging messages
  102. ;;;
  103.  
  104. (defvar db-disable-debugging-support t
  105.   "If non-nil, then debugging calls will be compiled out of the source and the
  106. variable  db-debug-p  will have no effect.  Setting this variable at run-time
  107. has no effect if you are running EDB compiled; you must set it when you compile
  108. EDB, or run EDB interpreted.  Defaults to t.")
  109.  
  110. (defvar db-debug-p nil
  111.   "*T if database debugging is enabled.  Defaults to nil.
  112. Has no effect on code compiled with `db-disable-debugging-support' set.")
  113.  
  114. (defmacro db-debug (&rest body)
  115.   "Execute BODY if `db-debug-p' is non-nil.
  116. See also variable `db-disable-debugging-support'."
  117.   (if (and (boundp 'db-disable-debugging-support)
  118.        (not db-disable-debugging-support))
  119.       (` (if db-debug-p
  120.          (progn
  121.            (,@ body))))))
  122. (put 'db-debug 'edebug-form-spec '(&rest form))
  123.  
  124. (defmacro db-debug-log (string)
  125.   (` (db-debug (db-log (, string)))))
  126. ;; (defun db-debug-log (string)
  127. ;;   (db-debug (db-log string)))
  128.  
  129. (defmacro db-debug-message (format-string &rest args)
  130.   (` (db-debug (db-message (, format-string) (,@ args)))))
  131. (put 'db-debug-message 'edebug-form-spec '(&rest form))
  132. ;; (defun db-debug-message (format-string &rest args)
  133. ;;   (db-debug-log (apply 'format format-string args)))
  134.  
  135. ;;; Debugging proper
  136.  
  137. (defun db-prepare-to-debug ()
  138.   "Prepare to debug EDB.
  139. Set variables `debug-on-error', `db-disable-debugging-support',  and db-debug-p.
  140. Also load uncompiled EDB source."
  141.   (interactive)
  142.   (setq debug-on-error t
  143.     db-disable-debugging-support nil
  144.     db-debug-p t)
  145.   (load-database 'uncompiled))
  146.  
  147. (defun edb-version ()
  148.   "Return a string describing the version of EDB that is running."
  149.   (interactive)
  150.   (if (interactive-p)
  151.       (message "%s" (emacs-version))
  152.     (format "EDB %s of %s"
  153.         edb-version
  154.         edb-date)))
  155.  
  156.  
  157. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  158. ;;; Loading
  159. ;;;
  160.  
  161. (defvar edb-directory nil
  162.   "A string, the name of the directory containing the EDB source files.")
  163.  
  164. (defvar db-running-lucid-emacs (string-match "Lucid" emacs-version))
  165.  
  166. ;; How to add a file to EDB:
  167. ;; * add its name to one of these lists
  168. ;; * add autoloads below, if necessary
  169. ;; * add a one-line description to the README file
  170. ;; * add it to the edbtoftp script
  171.  
  172. ;;; Files comprising EDB.
  173. ;; List of EDB source files loaded by `load', sans extensions.
  174. (defconst edb-essential-file-names
  175.   (append '("db-rep" "db-format" "db-file-io" "db-summary" "db-interfa"
  176.         "db-types" "db-time")
  177.       (if db-running-lucid-emacs '("db-lucid"))))
  178. ;; List of EDB source files loaded by `require', sans extensions.
  179. (defconst edb-required-file-names
  180.   ;; backtracef probably hasn't changed since EDB was first loaded, and
  181.   ;; there's no sense in loading an uncompiled version.  Still, include it.
  182.   '("db-util" "backtracef"))
  183. ;; List of EDB source files loaded by `autoload', sans extensions.
  184. (defconst edb-autoloaded-file-names
  185.   '("db-convert" "db-rdb" "db-search" "db-sort" "db-tagged" "db-two-dbs"))
  186. ;; List of all EDB source files, sans extensions.
  187. ;; Does not include \"database\", the top-level file.
  188. (defconst edb-file-names
  189.   (append edb-required-file-names
  190.       edb-essential-file-names
  191.       edb-autoloaded-file-names))
  192.  
  193. (defconst edb-source-file-names
  194.   (mapcar (function (lambda (file-name) (concat file-name ".el")))
  195.       edb-file-names))
  196.  
  197. (defun load-database (&optional uncompiled)
  198.   "Load all the files of EDB, the Emacs database.
  199. With prefix arg, load source, not compiled, code; EDB will run interpreted.
  200. This function is a good candidate for autoloading."
  201.   (interactive "P")
  202.   (mapcar (function load)
  203.       (if uncompiled
  204.           edb-source-file-names
  205.         edb-file-names)))
  206.  
  207. ;; ;; Useful during debugging.
  208. ;; (defun db-reset ()
  209. ;;   "Reset global database variables."
  210. ;;   (interactive)
  211. ;;   ;; I need to think about whether this should set any other variables.
  212. ;;   ;; If db-databases is set to nil, then any data display or summary buffers
  213. ;;   ;; should be killed.
  214. ;;   (setq db-databases nil
  215. ;;     db-recordfieldtypes nil
  216. ;;     db-displaytypes nil
  217. ;;     ))
  218.  
  219.  
  220. (defun edb-update (&optional directory)
  221.   "Install the EDB update found in the current buffer after point.
  222. EDB is assumed to be in the directory specified by `edb-directory'.
  223. If you have trouble with this command, it is likely that your version of EDB
  224. is not exactly the same as the last release.  You might have an old
  225. release, or you might have a pre-release.  (When users request features or
  226. report bugs, I sometimes place a pre-release of the next version of EDB
  227. on theory.lcs.mit.edu so that their problems are corrected right away.)"
  228.   (interactive)
  229.   (setq directory (file-name-as-directory
  230.            (expand-file-name
  231.             (or directory
  232.             edb-directory
  233.             (read-file-name "What directory contains EDB? "
  234.                     nil default-directory t)))))
  235.   (if (not (file-directory-p directory))
  236.       (error "%s is not a directory." directory))
  237.  
  238.   (write-region (progn (re-search-forward "^begin 644 ")
  239.                (beginning-of-line)
  240.                (point))
  241.         (progn (re-search-forward "^end\n")
  242.                (point))
  243.         (concat directory "edb-diff.Z.UUE"))
  244.  
  245.   (message "uudecoding, uncompressing, and applying patch...")
  246.   (shell-command (concat
  247.           "cd " directory "; "
  248.           "uudecode edb-diff.Z.UUE; "
  249.           "zcat edb-diff.Z | patch"))
  250.   (message "uudecoding, uncompressing, and applying patch...done")
  251.  
  252.   (load-database t)
  253.   ;; This ought to know about dependencies on macros, so that if they
  254.   ;; change, then all the dependent files are recompiled, too.
  255.   (byte-recompile-directory directory)
  256.   ;; Call db-reset here only if you're brave and believe you will never
  257.   ;; have any unsaved changes when you call edb-update.
  258.   (load-database)
  259.   )
  260.  
  261.  
  262. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  263. ;;; Autoloads
  264. ;;;
  265.  
  266. ;; I must declare some variables to be buffer-local here, so that they can
  267. ;; be set differently in different data display buffers even though the
  268. ;; packages that use them have not been loaded yet.  I would prefer to
  269. ;; have the variables' default values and documentation strings be
  270. ;; available as well, but I want the definitions to be near where the
  271. ;; variables are used, and I don't want to have to keep two copies
  272. ;; up-to-date.
  273. ;; Luckily, many of the interactively-called functions are in db-interfa
  274. ;; instead of one of the autoloaded files.
  275.  
  276. ;;; db-convert.el
  277. (autoload 'db-convert "db-convert"
  278.   "Convert DATABASE's field structure.  To be autoloaded." t)
  279.  
  280. ;;; db-rdb.el
  281. (autoload 'db-rdb-setup "db-rdb"
  282.   "Prepare EDB to read files in RDB format.  To be autoloaded." t)
  283.  
  284. ;;; db-sort.el
  285. (autoload 'database-sort "db-sort"
  286.  "Sort and return DATABASE, which is also side-effected.  To be autoloaded." t)
  287. (autoload 'database-sort-interface "db-sort")
  288. (make-variable-buffer-local 'dbf-field-priorities)
  289. (make-variable-buffer-local 'dbf-omitted-to-end-p)
  290.  
  291. ;;; db-two-dbs.el
  292. (autoload 'db-process-two-databases "db-two-dbs")
  293. (autoload 'db-merge "db-two-dbs"
  294.   "Merge two read-in databases.  To be autoloaded." t)
  295. (autoload 'databases-compatible "db-two-dbs")
  296.  
  297. ;;; db-search.el
  298. (autoload 'db-parse-match-pattern "db-search") ; should be called first
  299. (autoload 'db-print-match-pattern "db-search")
  300. (autoload 'db-match "db-search")
  301. (make-variable-buffer-local 'dbf-field-search-defaults)
  302.  
  303. ;;; db-tagged.el
  304. (autoload 'db-tagged-setup "db-tagged"
  305.   "Prepare EDB to read files in tagged format.  To be autoloaded." t)
  306.  
  307.  
  308. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  309. ;;; Compiling
  310. ;;;
  311.  
  312. (defun byte-compile-database-all (&optional directory)
  313.   "Compile all source (.el) files in EDB, the Emacs database, unconditionally.
  314. Calls `byte-compile-database'."
  315.   (interactive)
  316.   (byte-compile-database directory t))
  317.  
  318. ;; Cannibalized in part from byte-recompile-directory.
  319. (defun byte-compile-database (&optional directory all)
  320.   "Compile source (.el) files in EDB, the Emacs database, which need it.
  321. If optional prefix argument ALL is non-nil, every source file is recompiled."
  322.   ;; This nonsense is just to get access to current-prefix-arg.
  323.   (interactive (list 
  324.         (or edb-directory
  325.             (read-file-name "What directory contains EDB? "
  326.                     nil default-directory t))
  327.         current-prefix-arg))
  328.  
  329.   (setq directory (file-name-as-directory
  330.            (expand-file-name
  331.             (or directory
  332.             edb-directory
  333.             (read-file-name "What directory contains EDB? "
  334.                     nil default-directory t)))))
  335.  
  336.   (if (not (file-directory-p directory))
  337.       (error "%s is not a directory." directory))
  338.  
  339.   ;; Load EDB, in source form, to get proper definitions for macros, etc.
  340.   ;; EDB is already loaded if this function is defined, but the source
  341.   ;; might be different than the .elc files (a good reason for compiling),
  342.   ;; or some files might have changed since database.el was loaded.
  343.   ;; Because of this call, all EDB files should be written so as to be
  344.   ;; loadable multiple times, even though in the ordinary course of things
  345.   ;; they will only be loaded once.
  346.   (load-database t)
  347.  
  348.   (let ((files edb-source-file-names)
  349.     (count 0)
  350.     source dest)
  351.     (while files
  352.       (setq source (expand-file-name (car files) directory))
  353.       (setq dest (concat (file-name-sans-versions source) "c"))
  354.  
  355.       ;; Compile unless a newer .elc file exists.
  356.       (if (or all (not (file-newer-than-file-p dest source)))
  357.       (progn (byte-compile-file source)
  358.          (setq count (1+ count))))
  359.       (setq files (cdr files)))
  360.     (message "Done (Total of %d file%s compiled)"
  361.          count (if (= count 1) "" "s")))
  362.  
  363.   ;; Hide uninteresting errors
  364.   (in-buffer "*Compile-Log*"
  365.     (save-excursion
  366.       (goto-char (point-min))
  367.       (delete-matching-lines "with-electric-help is not known to be defined")
  368.       (delete-matching-lines "x-flush-mouse-queue is not known to be defined")
  369.       (delete-matching-lines "mouse-track is not known to be defined")
  370.       (delete-matching-lines "function link-set-record being redefined")
  371.       (delete-matching-lines "link-set-record defined multiple times")
  372.       ;; (delete-matching-lines "free variable mode-motion-hook")
  373.       ;; Lucid support
  374.       (delete-matching-lines "db-lucid")
  375.       (delete-matching-lines "map-extent")
  376.       (delete-matching-lines "delete-extent")
  377.       (delete-matching-lines "db-fontify")
  378.       ;; Get rid of references to functions/files that no longer have errors.
  379.       (goto-char (point-min)) 
  380.       (replace-string
  381.        "  ** The following functions are not known to be defined: \n\n"
  382.        "\n")
  383.       (goto-char (point-min))
  384.       (replace-string "While compiling the end of the data:\n\n" "\n")
  385.       (goto-char (point-min))
  386.       (delete-matching-lines "199.\nWhile compiling .*:\n\\(\\'\\|\n\f\\)")))
  387.   )
  388.  
  389.  
  390. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  391. ;;; One-time setup
  392. ;;;
  393.  
  394. ;;; Actually load the database.
  395. (require 'backtracef)
  396. (require 'db-util)
  397. (mapcar (function load)    edb-essential-file-names)
  398.  
  399. (if (not (assoc 'dbc-omit-p minor-mode-alist))
  400.     (setq minor-mode-alist (cons '(dbc-omit-p " Omit") minor-mode-alist)))
  401. (db-add-to-hook 'kill-buffer-hooks 'db-kill-buffer-hook)
  402.  
  403. ;; At the end of the file in case this load aborts.
  404. (provide 'database)            ; provide before running hooks
  405.  
  406. (run-hooks 'db-load-hooks)
  407.  
  408. ;;; database.el ends here
  409.