home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / edb / db-interfa.el < prev    next >
Encoding:
Text File  |  1993-06-14  |  66.7 KB  |  1,774 lines
  1. ;;; db-interfa.el --- part of EDB, the Emacs database
  2.  
  3. ;; See database.el for copyright notice, distribution conditions, etc.
  4.  
  5. ;; Author: Michael Ernst <mernst@theory.lcs.mit.edu>
  6. ;; Keywords: EDB
  7.  
  8. ;;; Commentary:
  9.  
  10. ;; Commands for operating on the current database.
  11.  
  12. ;;; Code:
  13.  
  14.  
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16. ;;; Variables
  17. ;;;
  18.  
  19. (deflocalvar dbc-database nil
  20.   "The database associated with this format.
  21. This variable is also set in the summary format.")
  22.  
  23. ;;; Database modification
  24.  
  25. (deflocalvar dbc-database-modified-p nil
  26.   "T if the database has been modified, nil otherwise.
  27. Mirrors the value of the modified-p slot of the database.
  28. This has to be a real variable so it can go in mode-line-format.
  29. Set it using `dbc-set-database-modified-p'.")
  30. ;; Usually dbc-set-database-modified-p is used instead.
  31. (defun dbc-update-database-modified-p ()
  32.   (setq dbc-database-modified-p (database-modified-p dbc-database)))
  33. (proclaim-inline dbc-update-database-modified-p)
  34. (defun dbc-set-database-modified-p (value)
  35.   (database-set-modified-p dbc-database value)
  36.   (setq dbc-database-modified-p value))
  37. (proclaim-inline dbc-set-database-modified-p)
  38.  
  39. ;;; Omitting
  40.  
  41. ;; Making this default to t affects all buffers, even non-EDB ones,
  42. ;; resulting in an ugly "Omit" in their mode lines.
  43. (deflocalvar dbc-omit-p nil
  44.   "Non-nil if omitting is in effect, nil otherwise.
  45. Use function `dbc-set-omit-p', which works in either a data display buffer or
  46. a summary buffer and sets the variable's value in both, instead of setting
  47. this directly.
  48. Setting this to nil is cheaper than changing the omit function to the empty
  49. one, since no omit bits are recomputed.  
  50. This variable is automatically set by the omitting functions.")
  51. ;; Beware, however, that if records have changed, then whether they should
  52. ;; still be omitted may change too.  Perhaps set the omit bit to 'recompute
  53. ;; or something like that if dbf-omit-function is set but this is nil.
  54. ;; Nah, I don't like that: just pay the price to recompute the bit.  This
  55. ;; should be set in the format, not the summary, buffer.
  56.  
  57. ;; At present this is only called from the data display buffer, so some of
  58. ;; this is extraneous, but it needs to be callable from anywhere.
  59. ;; Other necessary work includes updating the mode line, calling
  60. ;; dbf-update-summary-marks, etc.
  61. (defun dbc-set-omit-p (value)
  62.   "Set `dbc-omit-p' to VALUE in both data display buffer and summary buffer.
  63. Does no other housekeeping."
  64.   (db-in-data-display-buffer
  65.     (setq dbc-omit-p value)
  66.     (dbf-in-summary-buffer
  67.       (setq dbc-omit-p value))))
  68. ;; (proclaim-inline dbc-set-omit-p)
  69.  
  70. ;;; Location in the database
  71.  
  72. ;; The current link and its index.
  73. (deflocalvar dbc-link nil
  74.   "The link of the record currently being displayed, or nil.")
  75. (deflocalvar dbc-index nil
  76.   "The index of the record currently being displayed (and of its link), or nil.
  77. Use `dbc-set-index' to set this value unless you know what you are doing.")
  78.  
  79. (deflocalvar dbc-index-fraction nil
  80.   "A string of the form dbc-index/database-no-of-records.
  81. Variables with numeric values aren't allowed in mode-line-format.
  82. An asterisk (*) precedes dbc-index if the current record is marked.
  83. The fraction is surrounded by square brackets if the current record is omitted.
  84. This variable should only be set by calling `dbc-set-index'.")
  85.  
  86. ;;; Movement behavior
  87.  
  88. (deflocalvar dbc-wraparound-p 'delay
  89.   "Value t, nil, or 'delay determines whether going forward from the last
  90. record (or backward from the first) wraps, is prohibited, or denies on the
  91. first attempt only and then wraps.")
  92.  
  93. (deflocalvar dbf-stay-in-edit-mode-p t
  94.   "*Whether edit mode is preserved when switching records in EDB.
  95. Automatically becomes local to the current buffer when set in any fashion.
  96. Only has an effect when set in an EDB data display buffer.")
  97.  
  98. ;;; Etc.
  99.  
  100. (deflocalvar db-new-record-function nil
  101.   "Function called on empty records before they're inserted in the database.
  102. Takes two arguments, the record and the database.")
  103.  
  104. ;;   "Non-nil if `db-kill-buffer-hook' shouldn't do anything."
  105. (defvar db-kill-buffer-hook-inhibit-p nil)
  106.  
  107.  
  108. (defvar db-delete-record-modifies-database-p t
  109.   "Non-nil if deleting a record should mark the database as modified.")
  110.  
  111. ;;   "Non-nil if a database's print-name or filename should be mentioned when
  112. ;; it is saved to disk."
  113. (defvar db-mention-filename-on-save-p t)
  114.  
  115.  
  116. (defvar db-auto-edit-mode t
  117.   "nil if movement around the data display buffer is permitted in view mode.
  118. When this variable is non-nil \(it defaults to t\), mousing and most
  119. movement commands cause edit mode to be entered on the appropriate field.
  120. Don't set this variable directly; use command `db-toggle-auto-edit-mode'.")
  121.  
  122.  
  123. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  124. ;;; Keymaps
  125. ;;;
  126.  
  127. ;; Probably this shouldn't be a sparse keymap after all.
  128. ;;   "Keymap for database data display buffer in view mode."
  129. (defvar database-view-mode-map (make-keymap))
  130.  
  131. (suppress-keymap database-view-mode-map)
  132.  
  133. ;; Moving around in the database
  134. (define-key database-view-mode-map "n" 'db-next-record)
  135. (define-key database-view-mode-map "p" 'db-previous-record)
  136. (define-key database-view-mode-map "<" 'db-first-record)
  137. (define-key database-view-mode-map ">" 'db-last-record)
  138. (define-key database-view-mode-map (db-meta-prefix-ify "<") 'db-first-record)
  139. (define-key database-view-mode-map (db-meta-prefix-ify ">") 'db-last-record)
  140. (define-key database-view-mode-map "j" 'db-jump-to-record)
  141. (define-key database-view-mode-map " " 'db-next-screen-or-record)
  142. (define-key database-view-mode-map "\177" 'db-previous-screen-or-record)
  143. (define-key database-view-mode-map (db-meta-prefix-ify "n") 'db-next-record-ignore-omitting)
  144. (define-key database-view-mode-map (db-meta-prefix-ify "p") 'db-previous-record-ignore-omitting)
  145. (define-key database-view-mode-map (db-meta-prefix-ify "\C-n") 'db-next-marked-record)
  146. (define-key database-view-mode-map (db-meta-prefix-ify "\C-p") 'db-previous-marked-record)
  147.  
  148. ;; Changing to edit mode
  149. (define-key database-view-mode-map "\t" 'db-first-field)
  150. (define-key database-view-mode-map (db-meta-prefix-ify "\t") 'db-last-field)
  151. (define-key database-view-mode-map "\C-n" 'db-first-field)
  152. (define-key database-view-mode-map "\C-p" 'db-last-field)
  153. (define-key database-view-mode-map "e" 'db-first-field)
  154. ;; These could be db-first-field and db-last-field, but that wouldn't fit in:
  155. ;; nowhere else are these keystrokes inter-field-movement keystrokes.
  156. (define-key database-view-mode-map "\C-f" 'undefined)
  157. (define-key database-view-mode-map "\C-b" 'undefined)
  158. (define-key database-view-mode-map "\C-a" 'undefined)
  159. (define-key database-view-mode-map "\C-e" 'undefined)
  160. ;; What's the point of this?
  161. ;; (define-key database-view-mode-map "v" 'db-view-mode)
  162. (define-key database-view-mode-map "\C-v" 'db-scroll-up)
  163. ;; In view-mode, we're at the top of the buffer (not after db-next-screen).
  164. (define-key database-view-mode-map (db-meta-prefix-ify "v") 'db-scroll-down)
  165.  
  166. ;; Undoing changes
  167. (define-key database-view-mode-map "\C-xu" 'db-revert-record)
  168. ;; (define-key database-view-mode-map "u" 'db-revert-record)
  169. (define-key database-view-mode-map "\C-xr" 'db-revert-database)
  170.  
  171. ;; Adding and removing records
  172. (define-key database-view-mode-map "a" 'db-add-record)
  173. (define-key database-view-mode-map "i" 'db-add-record)
  174. (define-key database-view-mode-map "d" 'db-delete-record)
  175. (define-key database-view-mode-map "k" 'db-delete-record)
  176. (define-key database-view-mode-map "o" 'db-output-record-to-db)
  177. (define-key database-view-mode-map "c" 'db-copy-record)
  178.  
  179. ;; Searching commands
  180. (define-key database-view-mode-map (db-meta-prefix-ify "S") 'db-search)
  181. (define-key database-view-mode-map (db-meta-prefix-ify "s") 'db-search)
  182. (define-key database-view-mode-map "s" 'db-search)
  183. (define-key database-view-mode-map "S" 'db-incremental-search)
  184. (define-key database-view-mode-map "\C-s" 'db-isearch-forward)
  185. (define-key database-view-mode-map "\C-r" 'db-isearch-backward)
  186.  
  187. ;; Exiting database mode
  188. (define-key database-view-mode-map "q" 'db-quit)
  189. (define-key database-view-mode-map "x" 'db-exit)
  190.  
  191.  
  192. (define-key database-view-mode-map "m" 'db-mark-record)
  193.  
  194.  
  195.  
  196. (define-key database-view-mode-map "?" 'describe-mode)
  197.  
  198. ;; Gross key bindings.
  199. (define-key database-view-mode-map "O" 'db-omit-record)
  200. (define-key database-view-mode-map (db-meta-prefix-ify "o") 'db-omitting-toggle)
  201. (define-key database-view-mode-map (db-meta-prefix-ify "O") 'db-omitting-set)
  202. (define-key database-view-mode-map (db-meta-prefix-ify "\C-o") 'db-toggle-show-omitted-records)
  203.  
  204.  
  205. (define-key database-view-mode-map "D" 'db-summary) ; mnemonic for Directory
  206. (define-key database-view-mode-map "h" 'db-summary) ; mnemonic for Headers
  207. (define-key database-view-mode-map "H" 'db-summary) ; mnemonic for Headers
  208.  
  209. (define-key database-view-mode-map "r" 'db-report)
  210. (define-key database-view-mode-map "\r" 'db-accept-record)
  211.  
  212. (define-key database-view-mode-map "b" 'undefined)
  213. (define-key database-view-mode-map "f" 'undefined)
  214. (define-key database-view-mode-map "g" 'undefined)
  215. (define-key database-view-mode-map "l" 'undefined)
  216. (define-key database-view-mode-map "t" 'undefined)
  217. (define-key database-view-mode-map "w" 'undefined)
  218. (define-key database-view-mode-map "y" 'undefined)
  219. (define-key database-view-mode-map "z" 'undefined)
  220.  
  221.  
  222. ;;   "Keymap for database data display buffer in edit mode."
  223. (defvar database-edit-mode-map (make-keymap))
  224.  
  225. ;; Obviously don't do suppress-keymap on this one; we want to be able to edit.
  226. ;; The view-mode commands should be available via C-c and many (such as
  227. ;; next-record) available via M- commands as well, espcially those not
  228. ;; ordinarily bound in text mode (eg M-n and M-p).
  229.  
  230. ;; Lucid Emacs's mouse-handling is completely different from version 18's.
  231. (if (not db-running-lucid-emacs)
  232.     ;; This needs to be global because we might mouse in the data display
  233.     ;; buffer while point is in some other buffer (which has its own binding
  234.     ;; for \C-x\C-@).  \C-x\C-@ is what mouse clicks send to the buffer.
  235.     (global-set-key "\C-x\C-@" 'db-x-jump-to-point))
  236.  
  237. ;; Exiting edit mode
  238. (define-key database-edit-mode-map "\C-c\C-c" 'db-view-mode)
  239.  
  240. ;; Undoing changes
  241. (define-key database-edit-mode-map "\C-xU" 'db-revert-field)
  242.  
  243. ;; Moving from record to record
  244. (define-key database-edit-mode-map (db-meta-prefix-ify "n") 'db-next-record)
  245. (define-key database-edit-mode-map (db-meta-prefix-ify "p") 'db-previous-record)
  246.  
  247. ;; Moving from field to field
  248. (define-key database-edit-mode-map "\t" 'db-next-field)
  249. (define-key database-edit-mode-map (db-meta-prefix-ify "\t") 'db-previous-field)
  250. (define-key database-edit-mode-map (db-meta-prefix-ify "<") 'db-first-field)
  251. (define-key database-edit-mode-map (db-meta-prefix-ify ">") 'db-last-field)
  252. (define-key database-edit-mode-map "\C-v" 'db-scroll-up)
  253. (define-key database-edit-mode-map (db-meta-prefix-ify "v") 'db-scroll-down)
  254.  
  255.  
  256. ;; Movement within a field
  257. (define-key database-edit-mode-map "\C-n" 'db-next-line-or-field)
  258. (define-key database-edit-mode-map "\C-p" 'db-previous-line-or-field)
  259. ;; almost-the-same-as-before commands
  260. (define-key database-edit-mode-map "\C-f" 'db-forward-char)
  261. (define-key database-edit-mode-map "\C-b" 'db-backward-char)
  262. (define-key database-edit-mode-map (db-meta-prefix-ify "f") 'db-forward-word)
  263. (define-key database-edit-mode-map (db-meta-prefix-ify "b") 'db-backward-word)
  264. (define-key database-edit-mode-map "\C-a" 'db-beginning-of-line-or-field)
  265. (define-key database-edit-mode-map "\C-e" 'db-end-of-line-or-field)
  266.  
  267. ;; Editing a field
  268. ;;insertion
  269. (define-key database-edit-mode-map "\r" 'db-newline)
  270. (define-key database-edit-mode-map "\n" 'db-newline)
  271. (define-key database-edit-mode-map "\C-o" 'db-open-line)
  272. ;;deletion
  273. (define-key database-edit-mode-map "\C-d" 'db-delete-char)
  274. (define-key database-edit-mode-map "\177" 'db-backward-delete-char)
  275. (define-key database-edit-mode-map (db-meta-prefix-ify "d") 'db-kill-word)
  276. (define-key database-edit-mode-map (db-meta-prefix-ify "\177") 'db-backward-kill-word)
  277. (define-key database-edit-mode-map "\C-k" 'db-kill-line)
  278. (define-key database-edit-mode-map (db-meta-prefix-ify "k") 'db-kill-to-end)
  279. (define-key database-edit-mode-map "\C-w" 'db-kill-region)
  280. (define-key database-edit-mode-map (db-meta-prefix-ify "w") 'db-copy-region-as-kill)
  281.  
  282. ;; Other commands
  283. (define-key database-edit-mode-map (db-meta-prefix-ify "s") 'db-search-field)
  284. ;; (define-key database-edit-mode-map (db-meta-prefix-ify "S") 'db-search-field)
  285.  
  286.  
  287. (define-key database-edit-mode-map "\C-s" 'db-isearch-forward)
  288. (define-key database-edit-mode-map "\C-r" 'db-isearch-backward)
  289.  
  290. (define-key database-edit-mode-map (db-meta-prefix-ify "?") 'db-field-help)
  291.  
  292.  
  293. ;;; Bindings for both keymaps
  294.  
  295. ;; Saving the database
  296. (define-key database-view-mode-map "\C-x\C-s" 'db-save-database)
  297. (define-key database-edit-mode-map "\C-x\C-s" 'db-save-database)
  298. (define-key database-view-mode-map "\C-x\C-w" 'db-write-database-file)
  299. (define-key database-edit-mode-map "\C-x\C-w" 'db-write-database-file)
  300.  
  301. ;; Toggling modifiable-p
  302. (define-key database-view-mode-map "\C-x\C-q" 'db-toggle-modifiable-p)
  303. (define-key database-edit-mode-map "\C-x\C-q" 'db-toggle-modifiable-p)
  304.  
  305. ;; Wipe out dangerous commands
  306. (define-key database-view-mode-map "\C-xn" 'undefined)
  307. (define-key database-edit-mode-map "\C-xn" 'undefined)
  308.  
  309.  
  310. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  311. ;;; Help
  312. ;;;
  313.  
  314. (defun db-field-help ()
  315.   "Display help for current field using the recordfieldspec help-info field.
  316. If this is a string, display it.  If it is a form, eval it and display the
  317. result."
  318.   (interactive)
  319.   (if (not dbf-this-displayspec)
  320.       (error "Not on a field."))
  321.   (let* ((field-index (displayspec-record-index dbf-this-displayspec))
  322.      (help-text (recordfieldspec-help-info
  323.              (database-recordfieldspec dbc-database field-index))))
  324.     (best-fit-message
  325.      (if help-text
  326.      (if (stringp help-text)
  327.          help-text
  328.        (condition-case err
  329.            (eval help-text)
  330.          (error
  331.           (format
  332.            "This help form:\n\n  %s\n\nfailed with this error:\n\n%s"
  333.            help-text err))))
  334.        (format "No help available for `%s'."
  335.            (fieldnumber->fieldname field-index dbc-database)))
  336.      " *DB Help*")))
  337.  
  338.  
  339. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  340. ;;; Quitting
  341. ;;;
  342.  
  343. ;; I have made these work in both the data display buffer and the summary
  344. ;; buffer, for folks who enjoy spending most of their time in the summary
  345. ;; who will rebind its keystrokes to call these functions instead of
  346. ;; dbs-exit (for instance).
  347.  
  348. (defun db-quit ()
  349.   "Quit editing the database for now; bury its buffers."
  350.   (interactive)
  351.   (db-bury))
  352.  
  353. (defun db-exit (&optional kill)
  354.   "Be done with the database; like `db-quit', but offers to save any changes.
  355. With prefix arg, kills the data display buffer, and the database, if that was
  356. its only data display buffer."
  357.   (interactive "P")
  358.   (db-save-database t)
  359.   (if kill
  360.       (db-kill-buffers)
  361.     (db-quit)))
  362.  
  363. (defun db-kill-buffers ()
  364.   "Kill this buffer, and the associated summary or data display buffer, if any.
  365. If its last data display buffer is killed, the database is killed too.
  366. Does not offer to save changes to the database or to this record; use `db-exit'
  367. with optional argument to do so."
  368.   (db-in-data-display-buffer
  369.     ;; I don't call database-clean-data-display-buffers here; should I?
  370.     (dbf-kill-summary)
  371.     (let ((remaining-buffers (delq (current-buffer)
  372.                    (database-data-display-buffers dbc-database))))
  373.       (if remaining-buffers
  374.       (database-set-data-display-buffers dbc-database remaining-buffers)
  375.     (setq db-databases (delq dbc-database db-databases))))
  376.     (let ((db-kill-buffer-hook-inhibit-p t))
  377.       (kill-buffer (current-buffer)))))
  378.  
  379. ;;   "Kill this data display buffer's associated database summary buffer."
  380. (defun dbf-kill-summary ()
  381.   (dbf-in-summary-buffer
  382.     (delete-windows-on (current-buffer))
  383.     (let ((db-kill-buffer-hook-inhibit-p t))
  384.       (kill-buffer (current-buffer)))))
  385.  
  386. ;; Does nothing if db-kill-buffer-hook-inhibit-p is non-nil.
  387. (defun db-kill-buffer-hook ()
  388.   (cond ((and (not db-kill-buffer-hook-inhibit-p)
  389.           (or (db-data-display-buffer-p)
  390.           (db-summary-buffer-p)))
  391.      (if (or dbf-this-record-modified-p
  392.          (dbf-this-field-modified-p))
  393.          (if (y-or-n-p (concat "Commit the current record before killing "
  394.                    (database-print-name dbc-database)
  395.                    "? "))
  396.          (progn
  397.            (dbf-process-current-record-maybe t)
  398.            ;; Ask whether to save the database.
  399.            (db-save-database t)))
  400.        ;; Ask whether to save the database.
  401.        (db-save-database t))
  402.      ;; We have asked whether to save the database unless this record was
  403.      ;; modified and the user didn't want to commit it.
  404.      (db-kill-buffers))))
  405.  
  406. ;;   "Bury the data display and summary buffers.
  407. ;; Spare either or both of these buffers by specifying optional arguments
  408. ;; NOT-DATA-DISPLAY and NOT-SUMMARY."
  409. (defun db-bury (&optional not-data-display not-summary)
  410.   (let (data-display-buffer
  411.     summary-buffer)
  412.     (db-in-data-display-buffer
  413.       (setq data-display-buffer (and (not not-data-display) (current-buffer))
  414.         summary-buffer (and (not not-summary) (dbf-summary-buffer))))
  415.     (if data-display-buffer
  416.     (progn
  417.       (delete-windows-on data-display-buffer)
  418.       (bury-buffer data-display-buffer)))
  419.     (if summary-buffer
  420.     (progn
  421.       (delete-windows-on summary-buffer)
  422.       (bury-buffer summary-buffer)))))
  423.  
  424. (if (not (fboundp 'db-old-save-some-buffers))
  425.     (progn
  426.       (fset 'db-old-save-some-buffers (symbol-function 'save-some-buffers))
  427.       (fset 'save-some-buffers 'db-save-some-buffers)))
  428.  
  429. (defun db-save-some-buffers (&optional quietly exiting)
  430.   "Save some modified databases and file-visiting buffers.
  431. Asks user about each one.  With argument, saves all with no questions."
  432.   (interactive "P")
  433.   (db-save-some-databases quietly)
  434.   (db-old-save-some-buffers quietly exiting))
  435.  
  436. ;; This isn't quite right because it should modify the ???.
  437. (defun db-save-some-databases (&optional quietly)
  438.   "Save some modified databases.  Asks user about each one.
  439. With argument, saves all with no questions."
  440.   (interactive "P")
  441.   (let ((databases db-databases)
  442.     this-database
  443.     buffers
  444.     buffers-remaining)
  445.     (while databases
  446.       (setq this-database (car databases)
  447.         databases (cdr databases)
  448.         buffers (database-clean-data-display-buffers this-database))
  449.       ;; Could use map-data-display-buffers here.
  450.       (if buffers
  451.       (progn
  452.         (setq buffers-remaining buffers)
  453.         (while buffers-remaining
  454.           (in-buffer (car buffers-remaining)
  455.         (dbf-process-current-record-maybe t))
  456.           (setq buffers-remaining (cdr buffers-remaining)))
  457.  
  458.         (in-buffer (car buffers)
  459.           (db-save-database (not quietly)))
  460.  
  461.         (setq buffers-remaining buffers)
  462.         (while buffers-remaining
  463.           (in-buffer (car buffers-remaining)
  464.         (force-mode-line-update))
  465.           (setq buffers-remaining (cdr buffers-remaining))))))))
  466.  
  467.  
  468. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  469. ;;; File I/O
  470. ;;;
  471.  
  472. ;; This should check whether the file is currently read in.
  473.  
  474. (defun db-find-file (database-file &optional prompt-for-format)
  475.   "Read a database from DATABASE-FILE; prompts when called interactively.
  476. If the database file doesn't specify a format and the format file can't be
  477. inferred from DATABASE-FILE, the user is prompted for it too.
  478. The user is always prompted for the format if prefix arg PROMPT-FOR-FORMAT
  479. is non-nil.
  480. If the database is already read in and PROMPT-FOR-FORMAT is nil, the existing
  481. database buffer is merely selected.
  482. When called non-interactively, argument PROMPT-FOR-FORMAT may be a string, the
  483. name of a format file to use."
  484.   (interactive "fDatabase file: \nP")
  485.   (setq database-file (expand-file-name database-file))
  486.   (let ((format-file (if (stringp prompt-for-format) prompt-for-format))
  487.     database data-display-buffer)
  488.     (if (stringp prompt-for-format)
  489.     (setq prompt-for-format nil))
  490.  
  491.     (if (not prompt-for-format)
  492.     (progn
  493.       (setq database (db-find-read-in-database database-file))
  494.       (or (null database)
  495.           (if (not (database-clean-data-display-buffers database))
  496.           (setq database nil)))
  497.       ;; Find an appropriate data display buffer
  498.       (if (and database format-file)
  499.           (let ((ddbs (database-data-display-buffers database))
  500.             ddb-format-file)
  501.         (while ddbs
  502.           (if (same-file-p format-file
  503.                    (in-buffer (car ddbs) dbf-format-file))
  504.               (setq data-display-buffer (car ddbs)
  505.                 ddbs nil)
  506.             (setq ddbs (cdr ddbs))))))))
  507.     (if (not database)
  508.     ;; Either prompt-for-format is non-nil, or we couldn't find an
  509.     ;; appropriate read-in-database.
  510.     (setq database (read-database-file
  511.             database-file format-file prompt-for-format)))
  512.     (if (not data-display-buffer)
  513.     (setq data-display-buffer
  514.           (car (database-clean-data-display-buffers database))))
  515.     (switch-to-buffer data-display-buffer)
  516.     (setq dbc-database database))
  517.   (db-first-record))
  518.  
  519. (defun db-this-buffer ()
  520.   "Run EDB on the file corresponding to the current buffer.
  521. The current buffer is killed first."
  522.   (interactive)
  523.   (let ((file (buffer-file-name (current-buffer))))
  524.     (kill-buffer (current-buffer))
  525.     (db-find-file file)))
  526.  
  527. ;; This is too simplistic:  I'd like to check to see if it has another
  528. ;; non-killed data display buffer, and if not, I'd like to remove it from
  529. ;; db-databases altogether.
  530. ;; Plus, it could be the same database even if the filenames aren't the
  531. ;; same, if one had /u/mernst and the other had ~.  (Is this possible?)
  532. ;;   "Return the database most recently read in from DATABASE-FILE, or nil."
  533. (defun db-find-read-in-database (database-filename)
  534.   (let ((databases db-databases)
  535.     result)
  536.     (while (and (not result) databases)
  537.       (setq result (if (and (same-file-p database-filename
  538.                      (database-file (car databases)))
  539.                 (car (database-clean-data-display-buffers (car databases))))
  540.                (car databases))
  541.         databases (cdr databases)))
  542.     result))
  543.  
  544. ;; Perhaps instead I want a for-each-data-display-buffer primitive which
  545. ;; also updates the database slot as it goes.  Actually, there is a
  546. ;; map-data-display-buffers function.
  547. ;;   "Remove killed buffers from DATABASE's data-display-buffers slot.
  548. ;; Returns a list of the remaining data display buffers.
  549. ;; If there are none, kills DATABASE as well."
  550. (defun database-clean-data-display-buffers (database)
  551.   (let* ((ddbs (database-data-display-buffers database))
  552.      (remaining ddbs))
  553.     (while remaining
  554.       (if (not (buffer-name (car remaining)))
  555.       (setq ddbs (delq (car remaining) ddbs)))
  556.       (setq remaining (cdr remaining)))
  557.     ;; Kill the database
  558.     (if (null ddbs)
  559.     (progn
  560.       (db-save-database-no-buffer database t nil)
  561.       (setq db-databases (delq database db-databases)))
  562.       (database-set-data-display-buffers database ddbs))
  563.     ddbs))
  564.  
  565. (defun db-revert-database ()
  566.   "Replace the database with the data on disk.
  567. This undoes all changes since the database was last saved."
  568.   (interactive)
  569.   (if (yes-or-no-p (format "Revert database from file %s? "
  570.                (database-file dbc-database)))
  571.       (let ((database dbc-database)
  572.         (data-display-buffer (current-buffer))
  573.         (db-buffer (generate-new-buffer "read-database-file")))
  574.  
  575.     (set-buffer db-buffer)
  576.     (insert-file-contents (database-file database) nil)
  577.     (setq database (read-database-internal-file-layout-maybe))
  578.     (read-database-file-helper db-buffer database)
  579.  
  580.     (mapcar (function (lambda (data-display-buffer)
  581.           (set-buffer data-display-buffer)
  582.           (dbc-update-database-modified-p)
  583.  
  584.           ;; abandon any changes
  585.           (dbf-set-this-field-modified-p nil)
  586.           (setq dbf-this-record-modified-p nil)
  587.           (db-jump-to-record dbc-index nil)))
  588.         (database-clean-data-display-buffers database))
  589.  
  590.     (db-message "Reverted database from disk.")
  591.     )))
  592.  
  593.  
  594. ;; I'd like to complain if file write time is more current than it was when
  595. ;; the database was read; but all that is done in C and I don't feel like
  596. ;; reimplementing it yet.
  597.  
  598. ;; I'd like a way to avoid saying "No changes..." without suppressing the
  599. ;; messages when the database does need to be saved.
  600. (defun db-save-database (&optional query quietly)
  601.   "Save the database to disk in the default save file.
  602. Any changes to the current record are processed first.
  603. The default save file is the file it was last saved to or read from.
  604. If optional arg QUERY is specified, the user is asked first.
  605. Optional second arg QUIETLY suppresses messages regarding the filename."
  606.   (interactive)
  607.   (db-in-data-display-buffer
  608.     ;; This is also done by db-write-database-file, but dbc-database-modified-p
  609.     ;; won't be set if only the current record has changed,
  610.     (db-debug-message "Current record about to be processed.")
  611.     (dbf-process-current-record-maybe t)
  612.     (db-debug-message "Current record processed.")
  613.     (db-save-database-helper query quietly)))
  614.  
  615. (defun db-save-database-helper (query quietly)
  616.   (if dbc-database-modified-p
  617.       (if (or (not query) (y-or-n-p (concat "Save database "
  618.                         (database-print-name dbc-database)
  619.                         "? ")))
  620.       (db-write-database-file (database-file dbc-database) quietly))
  621.     (if (not quietly)
  622.     (db-message "No changes need to be saved%s."
  623.             (if (and db-mention-filename-on-save-p
  624.                  (not (database-unnamed-p dbc-database)))
  625.             (format " in %s" (database-print-name dbc-database))
  626.               "")))))
  627.  
  628. (defun db-save-database-no-buffer (database query quietly)
  629.   ;; This is a hack.  Avoid calling dbf-process-current-record-maybe.
  630.   (let ((dbc-index nil)
  631.     (dbc-database database))
  632.     (db-save-database-helper query quietly)))
  633.  
  634. (defun db-write-database-file (&optional filename quietly)
  635.   "Save the database to disk in file FILENAME; it becomes the default save file.
  636. Any changes to the current record are processed first.
  637. If FILENAME is not specified, the user is prompted for it.
  638. Optional second arg QUIETLY suppresses messages regarding the filename."
  639.   (interactive)
  640.   ;; Do this before asking for the filename.
  641.   (dbf-process-current-record-maybe t)
  642.   ;; Save even if the database is not modified.
  643.   (if (not filename)
  644.       (setq filename (read-file-name
  645.               (format "Save database %s into file: "
  646.                   (database-print-name dbc-database)))))
  647.   (if (not (equal filename (database-file dbc-database)))
  648.       (progn
  649.     (database-set-file dbc-database filename)
  650.     ;; Rename the buffer
  651.     (rename-buffer (generate-new-buffer-name
  652.             (file-name-nondirectory filename)))))
  653.   (let ((message-filename (if db-mention-filename-on-save-p
  654.                   (concat " to file " filename)
  655.                 "")))
  656.     (db-debug-message "Saving database to file %s..." filename)
  657.     (if (not quietly) (db-message "Saving database%s..." message-filename))
  658.     (write-database-file dbc-database filename)
  659.     ;; (dbc-update-database-modified-p)
  660.     ;; (force-mode-line-update)
  661.     (if (not (or quietly db-io-error-p))
  662.     (db-message "Saving database%s...done" message-filename))))
  663.  
  664. (defun db-toggle-internal-file-layout (&optional arg)
  665.   "Toggle whether the database will be saved in EDB's internal file layout.
  666. With a nonzero prefix argument, set it to use internal file layout.
  667. With a zero prefix argument, set it not to use internal file layout."
  668.   (interactive "P")
  669.   (database-set-internal-file-layout-p
  670.    dbc-database
  671.    (if arg
  672.        (not (zerop (prefix-numeric-value arg)))
  673.      (not (database-internal-file-layout-p dbc-database)))))
  674.  
  675. (defun db-toggle-modifiable-p (&optional arg)
  676.   "Toggle whether the database may be modified by the user.
  677. With a nonzero prefix argument, set it modifiable.
  678. With a zero prefix argument, set it non-modifiable."
  679.   (interactive "P")
  680.   (let ((modifiable-p (if arg
  681.               (not (zerop (prefix-numeric-value arg)))
  682.             (not (database-modifiable-p dbc-database)))))
  683.     (database-set-modifiable-p dbc-database modifiable-p)
  684.  
  685.     ;; Suppose the record or field is modified and modifiable-p is nil.
  686.     ;; Should I dbf-process-current-record-maybe, or throw away the
  687.     ;; changes, or leave them to be dealt with later?
  688.     (db-in-data-display-buffer
  689.       (if (eq dbf-minor-mode 'edit)
  690.       (setq buffer-read-only (not modifiable-p))))))
  691.  
  692.  
  693. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  694. ;;; Record selection
  695. ;;;
  696.  
  697. ;; This comes before its usages so it can be compiled as a macro
  698. ;; properly even when EDB not already loaded.
  699.  
  700. ;; This is the common body of db-next-record and db-jump-to-record.
  701. ;; I shouldn't do the stuff in the setq if I end up at the same record
  702. ;; as I was at before.  Actually it doesn't hurt since I just did
  703. ;; dbf-process-current-record-maybe.
  704. (defmacro dbf-goto-record-internal (&rest record-selector-body)
  705.   (` (progn
  706.        ;; This used to be at the end; I moved it forward and commented out
  707.        ;; a whole lot of code.  Does this hurt anything?  I don't think so...
  708.        ;; In some cases I will be going right back to edit mode, in which
  709.        ;; case I don't want to change the local map and so forth -- then
  710.        ;; I should really be using something closer to the original, and
  711.        ;; worrying about the mode later on.  Maybe have an arg saying which
  712.        ;; mode I want to end up in (or whether I want to change modes).
  713.        ;; *** This line will cause problems if some hook function
  714.        ;; *** deliberately raises an error (like Joe Wells' do).
  715.        (db-view-mode)
  716.        (dbf-process-current-record-maybe nil)
  717.        (,@ record-selector-body)
  718.        ;; (setq dbf-this-record-modified-p nil)
  719.        ;; (setq dbf-this-field-index nil)
  720.        ;; (setq dbf-this-displayspec nil)
  721.        (setq dbf-this-record-original (link-record dbc-link))
  722.        ;; jbw: commented this out
  723.        ;; (setq buffer-read-only nil)
  724.        (display-record (dbf-displayed-record) t)
  725.        ;; (db-view-mode)
  726.        )))
  727. (put 'dbf-goto-record-internal 'lisp-indent-hook 0)
  728. (put 'dbf-goto-record-internal 'edebug-form-spec '(&rest form))
  729.  
  730. ;; Take note!  This opional argument has the opposite effect from all the other
  731. ;; optional arguments, which are called IGNORE-OMITTING.
  732. ;; Perhaps optionally go directly into edit mode (ie, add another argument
  733. ;; for that).
  734. (defun db-jump-to-record (arg &optional respect-omitting)
  735.   "Show the database's ARGth record.
  736. Omitting is ignored unless optional argument RESPECT-OMITTING is specified."
  737.   (interactive "NJump to record number: ")
  738.   (db-in-data-display-buffer
  739.     (dbf-goto-record-internal
  740.       (db-select-record arg (not respect-omitting))))
  741.   (if (db-summary-buffer-p)
  742.       (dbs-synch-summary-with-format)))
  743.  
  744. (defun db-first-record (&optional ignore-omitting)
  745.   "Show the database's first record.
  746. With optional prefix argument, ignores omitting."
  747.   (interactive "P")
  748.   (cond ((db-data-display-buffer-p)
  749.      (db-jump-to-record 1 (not ignore-omitting)))
  750.     ((db-summary-buffer-p)
  751.      ;; Is this right wrt omitting?
  752.      (goto-char (point-min))
  753.      (db-jump-to-point))
  754.     (t
  755.      (error "db-first-record called in wrong context."))))
  756.  
  757. (defun db-last-record (&optional ignore-omitting)
  758.   "Show the database's last record.
  759. With optional prefix argument, ignores omitting."
  760.   (interactive "P")
  761.   (cond ((db-data-display-buffer-p)
  762.      (db-jump-to-record (database-no-of-records dbc-database) (not ignore-omitting)))
  763.     ((db-summary-buffer-p)
  764.      (goto-char (point-max))
  765.      (db-jump-to-point))
  766.     (t
  767.      (error "db-last-record called in wrong context"))))
  768.  
  769. (defun db-next-record (arg &optional ignore-omitting markedp)
  770.   "Go to the ARGth next record.
  771. In that record, go to the current field, if any."
  772.   (interactive "p")
  773.   (if (db-summary-buffer-p)
  774.       (dbs-synch-format-with-summary))
  775.   (db-in-data-display-buffer
  776.     (let ((this-field-index dbf-this-field-index))
  777.       (dbf-goto-record-internal
  778.     (db-select-next-record arg ignore-omitting markedp))
  779.       ;; If in edit mode, stay in edit mode in the same field.
  780.       (if (and this-field-index
  781.            dbf-stay-in-edit-mode-p)
  782.       (db-move-to-field-exact this-field-index))))
  783.   (if (db-summary-buffer-p)
  784.       (let ((index (dbs-in-data-display-buffer dbc-index)))
  785.     ;; This might not be right, depending on what records are summarized.
  786.     (dbs-forward-record (- index dbs-index))
  787.     (dbs-set-index index))))
  788.  
  789. (defun db-previous-record (arg &optional ignore-omitting markedp)
  790.   "Go to the ARGth previous record.
  791. In that record, go to the current field, if any."
  792.   (interactive "p")
  793.   (db-next-record (- arg) ignore-omitting markedp))
  794. (proclaim-inline db-previous-record)
  795.  
  796. (defun db-next-record-ignore-omitting (arg)
  797.   "Go to the ARGth next record, ignoring omissions.
  798. That is, all records, even those which are omitted, are counted."
  799.   (interactive "p")
  800.   (db-next-record arg t))
  801. (proclaim-inline db-next-record-ignore-omitting)
  802.  
  803. (defun db-previous-record-ignore-omitting (arg)
  804.   "Go to the ARGth previous record, ignoring omissions.
  805. That is, all records, even those which are omitted, are counted."
  806.   (interactive "p")
  807.   (db-next-record-ignore-omitting (- arg)))
  808. (proclaim-inline db-previous-record-ignore-omitting)
  809.  
  810. (defun db-next-marked-record (arg)
  811.   "Go to the ARGth next marked record.
  812. Omitted records are treated according to db-omit-p."
  813.   (interactive "p")
  814.   (db-next-record arg nil t))
  815. (proclaim-inline db-next-marked-record)
  816.  
  817. (defun db-previous-marked-record (arg)
  818.   "Go to the ARGth previous marked record.
  819. Omitted records are treated according to db-omit-p."
  820.   (interactive "p")
  821.   (db-next-marked-record (- arg)))
  822. (proclaim-inline db-previous-marked-record)
  823.  
  824.  
  825. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  826. ;;; Moving from record to record (setting dbc-link)
  827. ;;;
  828.  
  829. ;; Finish this.
  830. (defun db-set-auto-edit-mode (arg)
  831.   "Set `db-auto-edit-mode' to ARG."
  832.   (setq db-auto-edit-mode arg)
  833.   (if db-auto-edit-mode
  834.       ))
  835.  
  836.  
  837. (defun db-toggle-auto-edit-mode (&optional arg)
  838.   "Change whether cursor movement in view mode causes edit mode to be entered.
  839. See variable `db-auto-edit-mode'.
  840. With a nonzero prefix argument, set  db-auto-edit-mode to t.
  841. With a zero prefix argument, set  db-auto-edit-mode to nil."
  842.   (interactive "P")
  843.   (db-set-auto-edit-mode (if arg
  844.                  (not (zerop (prefix-numeric-value arg)))
  845.                (not db-auto-edit-mode))))
  846.  
  847.  
  848. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  849. ;;; Moving from record to record (setting dbc-link)
  850. ;;;
  851.  
  852. ;; These don't display, but they do set dbc-link and dbc-index.
  853.  
  854. ;; Don't forget that when moving off a record, must check whether it has
  855. ;; been modified and, if so, call an update function.
  856.  
  857. ;; I think this a bit too big to inline; though I'd like to.
  858. (defun dbc-set-index (index)
  859.   (setq dbc-index index
  860.     dbc-index-fraction
  861.     (let ((frac (format "%s%d/%d"
  862.                 (if (link-markedp dbc-link) "+" "")
  863.                 dbc-index
  864.                 (database-no-of-records dbc-database))))
  865.       (if (and dbc-omit-p (link-omittedp dbc-link))
  866.           (concat "[" frac "]")
  867.         frac))))
  868.  
  869. ;; This has no checks about whether there are any unomitted records
  870. ;; (ie, it can infinite-loop).  I should probably keep a record of the
  871. ;; number of unomitted records, for use here and being clever
  872. ;; elsewhere.  It would allow me to run short distances backwards instead
  873. ;; of far forwards as well.
  874.  
  875. ;;   "Advance to the ARGth following record.  Does no display."
  876. (defun db-select-next-record (arg &optional ignore-omitting markedp)
  877.   (interactive "p")
  878.  
  879.   (let ((link-index-list
  880.      (next-link-and-index dbc-database dbc-link dbc-index
  881.                   arg (and dbc-omit-p (not ignore-omitting))
  882.                   markedp
  883.                   (or (eq dbc-wraparound-p t)
  884.                   (and (eq dbc-wraparound-p 'delay)
  885.                        (eq last-command 'db-next-record-failed))))))
  886.     (setq dbc-link (car link-index-list))
  887.     (dbc-set-index (car (cdr link-index-list)))
  888.     (if (cdr (cdr link-index-list))
  889.     (progn
  890.       (setq this-command 'db-next-record-failed)
  891.       ;; (beep)
  892.       (if (< (car (cdr (cdr link-index-list))) 0)
  893.           (db-message "First record.")
  894.         (db-message "Last record."))))))
  895.  
  896. ;;   "Advance to the ARGth previous record.  Does no display."
  897. (defun db-select-prev-record (arg &optional ignore-omitting)
  898.   (interactive "p")
  899.   (db-select-next-record (- arg) ignore-omitting))
  900. (proclaim-inline db-select-prev-record)
  901.  
  902. ;;   "Select first record.  Does no display.
  903. ;; If omitting is in effect, select the first unomitted record, unless
  904. ;; optional argument IGNORE-OMITTING is non-nil."
  905. (defun db-select-first-record (&optional ignore-omitting)
  906.   (interactive)
  907.   (setq dbc-link (database-first-link dbc-database))
  908.   (if (and dbc-omit-p (link-omittedp dbc-link) (not ignore-omitting))
  909.       (progn
  910.     (setq dbc-index 1)
  911.     (db-select-next-record 1))
  912.     (progn
  913.       (dbc-set-index 1))))
  914.  
  915. ;;   "Select last record.  Does no display.
  916. ;; If omitting is in effect, select the last unomitted record, unless
  917. ;; optional argument IGNORE-OMITTING is non-nil."
  918. (defun db-select-last-record (&optional ignore-omitting)
  919.   (interactive)
  920.   (setq dbc-link (database-first-link dbc-database)
  921.     dbc-index 1)
  922.   (let ((dbc-wraparound t))
  923.     (db-select-next-record -1 ignore-omitting)))
  924. (proclaim-inline db-select-last-record)
  925.  
  926. ;;   "Select record ARG.  Does no display.
  927. ;; If record ARG is omitted, selects the first following non-omitted record,
  928. ;; unless optional argument IGNORE-OMITTING is non-nil."
  929. (defun db-select-record (arg &optional ignore-omitting)
  930.   (interactive "nRecord number: ")
  931.  
  932.   (if (database-index-in-range arg dbc-database)
  933.       (progn
  934.     (db-select-first-record ignore-omitting)
  935.     (db-select-next-record (1- arg) ignore-omitting))
  936.     (progn
  937.       (db-debug-message "db-select-record:  %s out of range" arg)
  938.       (beep)
  939.       ;; This should test on the number of unomitted records, if
  940.       ;; omitting is on and IGNORE-OMITTING is non-nil.
  941.       (db-message "Record number %d out of range 1..%d"
  942.            arg (database-no-of-records dbc-database)))))
  943.  
  944. ;; Overall this isn't worth it:  it doesn't take that long to get somewhere, and we don't know how many records are omitted, etc.
  945.  
  946. ;; For very large databases, of course, it certainly pays to do a bit of
  947. ;; thinking before acting.  So probably keep this here if not in the above
  948. ;; section.
  949.  
  950. ;; This could be even cleverer and possibly search from the current record
  951. ;; as well.  I'm not sure that would be worth it for an average speedup of
  952. ;; half.  The current scheme, however, doesn't hurt performance much on
  953. ;; small databases but helps plenty for going to last record.  Then again,
  954. ;; I could just special-case that argument.  The cost of this hack is:
  955. ;; floor, division (for computing fraction; I could do this when
  956. ;; adding/deleting records, but that would be a pain); addition, mod,
  957. ;; subtraction.  Where is the break-even point?
  958.  
  959. ;; (defun db-select-record (arg)
  960. ;;   "Select record ARG.  Does no display"
  961. ;;   (interactive "nRecord number: ")
  962. ;;  
  963. ;;   (if (record-no-out-of-range arg)
  964. ;;       (progn
  965. ;;     (beep)
  966. ;;     (db-message "Record number %d out of range 1..%d"
  967. ;;          arg (database-no-of-records dbc-database)))
  968. ;;     (progn
  969. ;;       (db-first-record)
  970. ;;       (setq record-no arg)
  971. ;;      
  972. ;;       ;; For this many records we'll go backward toward them; for the
  973. ;;       ;; others, go forwards toward them.  (I'm assuming that going forward
  974. ;;       ;; is 1/3 as costly as going backward.)
  975. ;;       ;; Don't need floor because / always returns an integer.
  976. ;;       (let ((db-backward-fraction (/ records 4)))
  977. ;; 
  978. ;;     (setq offset (- (mod (+ (1- arg) db-backward-fraction) records)
  979. ;;             db-backward-fraction))
  980. ;; 
  981. ;;     ;; Actually we probably don't want to skip over omitted records.
  982. ;;     ;; If it's omitted, permit it to be selected, but warn the user.
  983. ;;     (db-next-record-internal offset t)))))
  984.  
  985.  
  986. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  987. ;;; Hybrid field/record movement commands
  988. ;;;
  989.  
  990. (defun db-next-screen-or-record (arg)
  991.   "Go to the ARGth next screenful of this display, or to the ARGth
  992. next record, if this is the last screenful of this display.
  993. If point is in the summary buffer and the data display buffer is not visible,
  994. then move to the next record."
  995.   (interactive "p")
  996.   (cond ((db-data-display-buffer-p)
  997.      (dbf-next-screen-or-record arg))
  998.     ((db-summary-buffer-p)
  999.      (let ((ddb-window (get-buffer-window dbs-data-display-buffer)))
  1000.        (if ddb-window
  1001.            (progn
  1002.          (in-window ddb-window
  1003.            (dbf-next-screen-or-record arg))
  1004.          (dbs-synch-summary-with-format))
  1005.          (db-next-record arg))))))
  1006.  
  1007. (defun dbf-next-screen-or-record (arg)
  1008.   (if (eob-visible-p)
  1009.       (db-next-record arg)
  1010.     (while (and (> arg 0) (not (eob-visible-p)))
  1011.       (scroll-up nil)
  1012.       (setq arg (1- arg)))))
  1013.  
  1014. ;; (defun db-next-screen-or-record (arg)
  1015. ;;   "Go to the ARGth next screenful of this display, or to the ARGth
  1016. ;; next record, if this is the last screenful of this display.
  1017. ;; If point is in the summary buffer and the data display buffer is not visible,
  1018. ;; then move to the next record."
  1019. ;;   (interactive "p")
  1020. ;;   (if (buffer-visible-p (db-data-display-buffer))
  1021. ;;       (db-in-data-display-buffer
  1022. ;;        (if (eob-visible-p)
  1023. ;;        (db-next-record arg)
  1024. ;;      (while (and (> arg 0) (not (eob-visible-p)))
  1025. ;;        (scroll-up nil)
  1026. ;;        (setq arg (1- arg)))))
  1027. ;;     (db-next-record arg)))
  1028.  
  1029.  
  1030. (defun db-previous-screen-or-record (arg)
  1031.   "Go to the ARGth previous screenful of this display, or to the ARGth
  1032. previous record, if this is the first screenful of this display.
  1033. If point is in the summary buffer and the data display buffer is not visible,
  1034. then move to the previous record."
  1035.   (interactive "p")
  1036.   (cond ((db-data-display-buffer-p)
  1037.      (dbf-previous-screen-or-record arg))
  1038.     ((db-summary-buffer-p)
  1039.      (let ((ddb-window (get-buffer-window dbs-data-display-buffer)))
  1040.        (if ddb-window
  1041.            (progn
  1042.          (in-window ddb-window
  1043.            (dbf-previous-screen-or-record arg))
  1044.          (dbs-synch-summary-with-format))
  1045.          (db-previous-record arg))))))
  1046.  
  1047. (defun dbf-previous-screen-or-record (arg)
  1048.   (if (bob-visible-p)
  1049.       (db-previous-record arg)
  1050.     (progn
  1051.       (while (and (> arg 0) (not (bob-visible-p)))
  1052.     (scroll-down nil)
  1053.     (setq arg (1- arg)))
  1054.       (if (bob-visible-p)
  1055.       (goto-char (point-min))))))
  1056.  
  1057.  
  1058. ;; (defun db-previous-screen-or-record (arg)
  1059. ;;   "Go to the ARGth previous screenful of this display, or to the ARGth
  1060. ;; previous record, if this is the first screenful of this display.
  1061. ;; If point is in the summary buffer and the data display buffer is not visible,
  1062. ;; then move to the previous record."
  1063. ;;   (interactive "p")
  1064. ;;   (if (buffer-visible-p (db-data-display-buffer))
  1065. ;;       (db-in-data-display-buffer
  1066. ;;        (if (bob-visible-p)
  1067. ;;        (db-previous-record arg)
  1068. ;;      (progn
  1069. ;;        (while (and (> arg 0) (not (bob-visible-p)))
  1070. ;;          (scroll-down nil)
  1071. ;;          (setq arg (1- arg)))
  1072. ;;        (if (bob-visible-p)
  1073. ;;            (goto-char (point-min))))))
  1074. ;;     (db-previous-record arg)))
  1075.  
  1076. ;; These are still too annoying.  Perhaps they should go to the first/last
  1077. ;; field if they're on the first/last line of the current field rather than
  1078. ;; forcing point to be at an extremum of the current field.
  1079.  
  1080. (defun db-beginning-of-field-or-record ()
  1081.   "Move to the beginning of this field; if at its beginning, to the first field."
  1082.   (interactive)
  1083.   (if (= (point) dbf-this-field-beginning-pos)
  1084.       (db-first-field)
  1085.     (db-beginning-of-field)))
  1086.  
  1087. (defun db-end-of-field-or-record ()
  1088.   "Move to the end of this field; if at its end, to the last field."
  1089.   (interactive)
  1090.   (if (= (point) (dbf-this-field-end-pos))
  1091.       (db-last-field)
  1092.     (db-end-of-field)))
  1093.  
  1094.  
  1095. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1096. ;;; Adding and deleting records
  1097. ;;;
  1098.  
  1099. (defun db-add-record ()
  1100.   "Add a new record to the database immediately before the current record."
  1101.   (interactive)
  1102.   (if (db-summary-buffer-p)
  1103.       ;; (switch-to-buffer dbs-data-display-buffer)
  1104.       (pop-to-buffer dbs-data-display-buffer)
  1105.       )
  1106.   (let ((new-record (make-default-record dbc-database)))
  1107.     (maybe-funcall db-new-record-function new-record dbc-database)
  1108.     (database-add-record new-record dbc-database dbc-index))
  1109.   (setq dbc-index (1+ dbc-index))
  1110.   ;; Why doesn't this need to be (dbc-set-modified-p t)?
  1111.   (database-set-modified-p dbc-database t)
  1112.   ;; Probably unnecessary, as database-add-record has done the trick.
  1113.   (dbf-set-summary-out-of-date-p)
  1114.   ;; Actually I only want to add one summary line rather than fully synching.
  1115.   ;; And I don't ordinarily update this buffer unless I was in it to begin
  1116.   ;; with.  (That is, at present changes made in the data display buffer
  1117.   ;; aren't automatically reflected in the summary buffer.)
  1118.   (if (and dbf-summary-buffer (get-buffer-window dbf-summary-buffer))
  1119.       (dbf-in-summary-buffer
  1120.     (dbs-synch-summary-with-format)))
  1121.   (db-message "Added a new record.")
  1122.   (db-previous-record 1)
  1123.   ;; Begin editing the new record.  (db-edit-mode) is the wrong way to do this.
  1124.   (db-first-field)
  1125.   )
  1126.  
  1127. (defun db-delete-record (&optional force)
  1128.   "Remove the current record from the database.
  1129. With a prefix arg, doesn't verify."
  1130.   (interactive "P")
  1131.  
  1132.   (if (or force (y-or-n-p "Delete this record? "))
  1133.       (progn
  1134.     (database-delete-link dbc-database dbc-link)
  1135.     ;; set some links-changed variable, or update the summary directly
  1136.     (setq dbc-index (1- dbc-index))
  1137.     (if db-delete-record-modifies-database-p
  1138.         (dbc-set-database-modified-p t))
  1139.     (db-message "Record deleted.")
  1140.     (db-next-record 1))))
  1141.  
  1142. (defun db-copy-record (&optional arg)
  1143.   "Insert a copy of the current record in the database immediately after it.
  1144. The second of the two records is made the current record.
  1145. With a prefix arg, inserts that many copies."
  1146.   (interactive "p")
  1147.   (db-in-data-display-buffer
  1148.     (dbf-process-current-record-maybe t)
  1149.     (while (> arg 0)
  1150.       (database-add-record (copy-record (link-record dbc-link))
  1151.                dbc-database dbc-index)
  1152.       (dbc-set-index (1+ dbc-index))
  1153.       (setq arg (1- arg))))
  1154.   (if (db-summary-buffer-p)
  1155.       (dbs-synch-summary-with-format))
  1156.   (force-mode-line-update)
  1157.   (db-message "Record copied."))
  1158.  
  1159. (deflocalvar db-for-output nil
  1160.   "Default database to which to output records.")
  1161.  
  1162. (defun db-output-record-to-db (database)
  1163.   "Copy the current record to DATABASE.
  1164. DATABASE must be read in and compatible with the current database."
  1165.   ;; Make a list of databases compatible with this one.
  1166.   (interactive
  1167.    (list
  1168.     (let ((db-alist (delq nil (mapcar
  1169.                    (function (lambda (database)
  1170.                   (if (and (not (eq database dbc-database))
  1171.                        (databases-compatible database
  1172.                                  dbc-database))
  1173.                       (cons
  1174.                        (or (database-print-name database)
  1175.                        (database-file database))
  1176.                        database))))
  1177.                    db-databases))))
  1178.       (if db-alist
  1179.       (cdr (assoc (completing-read
  1180.                "Output record to which database (? for choices): "
  1181.                db-alist nil t db-for-output)
  1182.               db-alist))
  1183.     (progn
  1184.       (error "No compatible databases are currently read in!")
  1185.       nil)))))
  1186.   (if database
  1187.       (progn
  1188.     (if (db-summary-buffer-p)
  1189.         (dbs-synch-format-with-summary))
  1190.     (db-in-data-display-buffer
  1191.       (database-add-record (link-record dbc-link) database)))))
  1192.                     
  1193.  
  1194. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1195. ;;; Sorting
  1196. ;;;
  1197.  
  1198. ;;; How to deal with:
  1199. ;; With a prefix arg, put omitted records at the end; otherwise they are
  1200. ;; sorted like all other records.
  1201. ;;; How to get a default from the database?  Maybe only permit the
  1202. ;;; database's value to be used.  (That souds good.)
  1203.  
  1204. (defun db-sort (&optional dont-confirm)
  1205.   "Sort the database.  With a prefix arg, don't confirm the sort order."
  1206.   (interactive "P")
  1207.  
  1208.   (db-in-data-display-buffer
  1209.     (dbf-process-current-record-maybe t)
  1210.     (if dont-confirm
  1211.     (progn
  1212.       (database-sort dbc-database)
  1213.       (dbf-finished-sorting))
  1214.       (database-sort-interface dbc-database))))
  1215.  
  1216. ;; Call this after sorting the database.
  1217. (defun dbf-finished-sorting ()
  1218.  
  1219.   ;; Need to recompute the current record's index.
  1220.   ;; [This is the sort of thing that perhaps should be done for each format
  1221.   ;; that accesses the database.]
  1222.   (dbc-compute-index)
  1223.  
  1224.   (delete-windows-on (dbf-summary-buffer))
  1225.  
  1226.   ;; Force summary refresh.
  1227.   ;; Set the summary buffer out of order but don't set the
  1228.   ;; must-recompute-something bit.  There ought to be special variables
  1229.   ;; for this rather than using dbs-no-of-records.
  1230.   (dbf-in-summary-buffer (setq dbs-no-of-records -1))
  1231.  
  1232.   ;; The index shown in the mode line is correct, but the database may have
  1233.   ;; been marked as modified, and that change hasn't made it to the mode line.
  1234.   (dbc-update-database-modified-p)
  1235.   (force-mode-line-update)
  1236.   )
  1237.  
  1238. ;; With the macro expanded, this is too big to inline.
  1239. (defun dbc-compute-index ()
  1240.   (let (this-index)
  1241.     (maplinks-macro
  1242.       (if (eq maplinks-link dbc-link)
  1243.       (progn
  1244.         (setq this-index maplinks-index)
  1245.         (maplinks-break)))
  1246.       dbc-database)
  1247.     (dbc-set-index this-index)))
  1248.  
  1249.  
  1250. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1251. ;;; Editing
  1252. ;;;
  1253.  
  1254. ;; Should have a better way of adding a field.
  1255.  
  1256. (defun db-field-query-replace ()
  1257.   "Replace some instances of a value in this field with some other value.
  1258. Confirms before each replacement."
  1259.   (interactive)
  1260.   (if (not dbf-this-field-index)
  1261.       (error "Call this when on a field."))
  1262.   (let* ((old-dbc-index dbc-index)
  1263.      (displayspec dbf-this-displayspec)
  1264.      (fsno dbf-this-field-index)
  1265.      (record-index (displayspec-record-index dbf-this-displayspec))
  1266.      (fieldname (fieldnumber->fieldname record-index dbc-database))
  1267.      (order-function (recordfieldspec-order-function
  1268.               (database-recordfieldspec dbc-database record-index)))
  1269.      original-value
  1270.      ov-printed
  1271.      replacement-value
  1272.      rv-printed)
  1273.     (dbf-process-current-record-maybe nil)
  1274.     (setq original-value (display->actual-call
  1275.               (displayspec-display->actual displayspec)
  1276.               (read-string "Query replace: ")
  1277.               ;; No previous value or record.
  1278.               nil nil
  1279.               record-index))
  1280.     (record-check-constraint original-value nil record-index dbc-database)
  1281.     ;; Must keep in mind that this is not necessarily what the user typed.
  1282.     (setq ov-printed (actual->display-call
  1283.               (displayspec-actual->display displayspec)
  1284.               original-value
  1285.               nil
  1286.               record-index))
  1287.  
  1288.     (setq replacement-value (display->actual-call
  1289.                  (displayspec-display->actual displayspec)
  1290.                  (read-string (format "Query replace %s with: "
  1291.                           ov-printed))
  1292.                  nil nil record-index))
  1293.     (record-check-constraint replacement-value nil record-index dbc-database)
  1294.     (setq rv-printed (actual->display-call
  1295.               (displayspec-actual->display displayspec)
  1296.               replacement-value
  1297.               nil
  1298.               record-index))
  1299.  
  1300.     (maprecords (function
  1301.          (lambda (record)
  1302.            (if (= 0 (funcall order-function
  1303.                      original-value
  1304.                      (aref record record-index)))
  1305.                (progn
  1306.              (display-record record t)
  1307.              ;; I should put the cursor on the field in question
  1308.              ;; and not name it in the question.
  1309.              (skip-string-forward (aref dbf-inter-field-text 0))
  1310.              (setq dbf-this-field-index 0)
  1311.              (db-next-field-internal fsno)
  1312.              ;; *** must handle case where replace strings
  1313.              ;; *** don't fit in minibuffer.
  1314.              ;; *** Maybe use best-fit-message somehow?
  1315.              (if (y-or-n-p (format "Replace `%s' with `%s'? "
  1316.                            fieldname ov-printed rv-printed))
  1317.                  ;; It's a bit extreme that this errs if the value
  1318.                  ;; fails to meet the constraint.
  1319.                  (record-set-field-from-index
  1320.                   record record-index replacement-value
  1321.                   dbc-database))))))
  1322.         dbc-database)
  1323.     (db-message "Replacement done.")
  1324.     (db-jump-to-record old-dbc-index t)))
  1325.  
  1326. (defun db-accept-record ()
  1327.   "Install the current record in the database; make any changes permanent."
  1328.   (interactive)
  1329.   (dbf-process-current-record-maybe t))
  1330. (fset 'db-commit-record 'db-accept-record)
  1331.  
  1332.  
  1333. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1334. ;;; Searching
  1335. ;;;
  1336.  
  1337. ;; This must get significantly faster; right now it's awful.
  1338.  
  1339. (defun db-search-field (pattern &optional mark)
  1340.   "Search for occurrences of PATTERN in the current field of any record.
  1341. Finds the first match after the current record; wraps around automatically.
  1342. With prefix arg, marks all matches in addition to going to the first one.
  1343. If omitting is in effect, omitted records are ignored."
  1344. ;;   (interactive (list (read-string "Pattern to search for in current field: "
  1345. ;;                   (aref dbf-field-search-defaults
  1346. ;;                     dbf-this-field-index))
  1347. ;;              current-prefix-arg))
  1348.   (interactive
  1349.    (list (let ((fieldname (dbf-this-field-name)))
  1350.        (read-string
  1351. ;;; Which type of defaulting is better is a matter of debate.
  1352. ;;         (if (if dbf-this-field-index
  1353. ;;             (aref dbf-field-search-defaults dbf-this-field-index)
  1354. ;;           (error "Only call db-search-field when on a field in a data display buffer."))
  1355. ;;         (format "Search in %s for [%s]: "
  1356. ;;             fieldname
  1357. ;;             (aref dbf-field-search-defaults dbf-this-field-index))
  1358. ;;           (format "Search in %s for: " fieldname))
  1359.         (format "Search in %s for: " fieldname)
  1360.         (if dbf-this-field-index
  1361.         (aref dbf-field-search-defaults dbf-this-field-index)
  1362.           (error "Only call db-search-field when on a field in a data display buffer."))))
  1363.      current-prefix-arg))
  1364. ;;   (if (equal "" pattern)
  1365. ;;       (if (aref dbf-field-search-defaults dbf-this-field-index)
  1366. ;;       (setq pattern (aref dbf-field-search-defaults dbf-this-field-index))
  1367. ;;     (error "You didn't enter a pattern, and there was no default.")))   
  1368.   (if (equal "" pattern)
  1369.       (error "You didn't enter a pattern for which to search."))
  1370.  
  1371.   (let* ((pat (db-parse-match-pattern pattern dbf-this-displayspec))
  1372.      (pat-display-rep (db-print-match-pattern pat dbf-this-displayspec))
  1373.      (this-record-index (displayspec-record-index dbf-this-displayspec))
  1374.      (recordfieldspec (database-recordfieldspec dbc-database this-record-index))
  1375.      (this-field-index dbf-this-field-index)
  1376.      this-field
  1377.      (fieldname (dbf-this-field-name))
  1378.      ;; success is t if we've already found some match.
  1379.      ;; The idea is that we'll move to success-link when we're done with
  1380.      ;; the search; if success is nil then we're looking for such a link.
  1381.      ;; This is either because we haven't found one or because we have
  1382.      ;; only found one before dbc-link in the database.
  1383.      success success-link success-index
  1384.      (matches 0))
  1385.     (aset dbf-field-search-defaults dbf-this-field-index pat-display-rep)
  1386.     (if mark
  1387.     (db-message "Marking all %s in %s..." pat-display-rep fieldname)
  1388.       (db-message "Searching in %s for %s..." fieldname pat-display-rep))
  1389.     (maplinks-macro
  1390.       (progn
  1391.     (if (or mark (not success))
  1392.         (progn
  1393.           (setq this-field (aref (link-record maplinks-link)
  1394.                      this-record-index))
  1395.           (db-debug-message "db-search-field:  this-field = %s" this-field)
  1396.           ;; When the pattern isn't a combination, this is slower than
  1397.           ;; a hard-coded "just use recordfieldspec-match-function"; but
  1398.           ;; I'm not sure that speed would be worth the extra complexity.
  1399.           (if (db-match pat this-field recordfieldspec)
  1400.           (progn
  1401.             (if (not success)
  1402.             (setq success-link maplinks-link
  1403.                   success-index maplinks-index
  1404.                   success t))
  1405.             (if mark
  1406.             (progn (setq matches (1+ matches))
  1407.                    (link-set-markedp maplinks-link t)))))))
  1408.     ;; We're looking for a match in some record besides the displayed
  1409.     ;; one and, preferrably, after it.  This permits the first success
  1410.     ;; succeeding the current record to overwrite the first success
  1411.     ;; preceding the current record.  This means that searches can't
  1412.     ;; abort after a success, since that success might be before the
  1413.     ;; current record.  Perhaps I should have a version of maplinks
  1414.     ;; that starts from the current record, for efficiency in
  1415.     ;; searching.
  1416.     (if (eq maplinks-link dbc-link)
  1417.         (setq success nil)))
  1418.       dbc-database
  1419.       dbc-omit-p)
  1420.     (if success-index
  1421.     (if (eq dbc-link success-link)
  1422.         (db-message "This record has the only match for %s." pat-display-rep)
  1423.       (progn
  1424.         ;; This takes care of committing any changes to the current record.
  1425.         (dbf-goto-record-internal
  1426.           (setq dbc-link success-link)
  1427.           (dbc-set-index success-index))
  1428.         (db-move-to-field-exact this-field-index)
  1429.         (if mark
  1430.         ;; *** update each summary item as it is marked???
  1431.         (progn (dbf-set-summary-out-of-date-p)
  1432.                (db-message "Searching for %s...marked %s matches."
  1433.                 pat-display-rep matches))
  1434.           (db-message "Searching for %s...found." pat-display-rep))))
  1435.       (db-message "Couldn't find a match in %s for %s."
  1436.            fieldname pat-display-rep))))
  1437.  
  1438.  
  1439. (if nil
  1440. ;; This has lots of problems.  I may want to rethink a lot of the search
  1441. ;; mechanism before doing this in earnest.
  1442. (defun db-search (pattern &optional mark)
  1443.   "Search for occurrences of PATTERN in any field of any record.
  1444. Finds the first match after the current record; wraps around automatically.
  1445. With prefix arg, marks all matches in addition to going to the first one.
  1446. If omitting is in effect, omitted records are ignored."
  1447.   (interactive
  1448.    (list (read-string "Search in all fields for: "
  1449.               (aref dbf-field-search-defaults dbf-displayspecs-length))
  1450.      current-prefix-arg))
  1451.   (if (equal "" pattern)
  1452.       (error "You didn't enter a pattern for which to search."))
  1453.  
  1454.   
  1455.   ;; This was lifted from db-search-field.  See there for comments.
  1456.   (let* ((pats (vconcat
  1457.         (mapcar (function (lambda (displayspec)
  1458.                     (db-parse-match-pattern pattern displayspec)))
  1459.             dbf-displayspecs)))
  1460.      (pat-display-rep pattern)
  1461.      (record-indexes (vconcat
  1462.               (mapcar (function (lambda (displayspec)
  1463.                           (displayspec-record-index displayspec)))
  1464.                   dbf-displayspecs)))
  1465.      (recordfieldspecs (vconcat
  1466.                 (mapcar (function (lambda (record-index)
  1467.                         (database-recordfieldspec
  1468.                          dbc-database record-index)))
  1469.                     record-indexes)))
  1470.      this-record
  1471.      this-field
  1472.      success success-link success-index success-field-index
  1473.      (matches 0))
  1474.     (aset dbf-field-search-defaults dbf-displayspecs-length pat-display-rep)
  1475.     (if mark
  1476.     (db-message "Marking all %s..." pat-display-rep)
  1477.       (db-message "Searching for %s..." pat-display-rep))
  1478.     (maplinks-macro
  1479.       (progn
  1480.     (if (or mark (not success))
  1481.         (progn
  1482.           (setq this-record (link-record maplinks-link))
  1483.           (db-debug-message "db-search:  this-record = #%d, %s"
  1484.                 maplinks-index this-record)
  1485.           
  1486.           (mapfields-macro
  1487.            (progn
  1488.          (db-debug-message "db-search:  this-field = #%d, %s" this-field-index this-field)
  1489.          (if (db-match (aref pats this-field-index)
  1490.                    this-field
  1491.                    (aref recordfieldspecs this-field-index))
  1492.              (progn
  1493.                (if (not success)
  1494.                (setq success-link maplinks-link
  1495.                  success-index maplinks-index
  1496.                  success t
  1497.                  success-field-index this-field-index
  1498.                  this-field-index field-index-max))
  1499.                (if mark
  1500.                (progn (setq matches (1+ matches))
  1501.                   (link-set-markedp maplinks-link t))))))
  1502.            this-record dbc-database)))
  1503.     (if (eq maplinks-link dbc-link)
  1504.         (setq success nil)))
  1505.       dbc-database
  1506.       dbc-omit-p)
  1507.     (if success-index
  1508.     (if (eq dbc-link success-link)
  1509.         (db-message "This record has the only match for %s." pat-display-rep)
  1510.       (progn
  1511.         ;; This takes care of committing any changes to the current record.
  1512.         (dbf-goto-record-internal
  1513.           (setq dbc-link success-link)
  1514.           (dbc-set-index success-index))
  1515.         (db-move-to-field-exact success-field-index)
  1516.         (if mark
  1517.         ;; *** update each summary item as it is marked???
  1518.         (progn (dbf-set-summary-out-of-date-p)
  1519.                (db-message "Searching for %s...marked %s matches."
  1520.                 pat-display-rep matches))
  1521.           (db-message "Searching for %s...found." pat-display-rep))))
  1522.       (db-message "Couldn't find any match for %s."
  1523.           pat-display-rep))))
  1524. )
  1525.  
  1526. (defun db-search ()
  1527.   "Please do not use `db-search', which is unimplemented; use `db-search-field'.
  1528. In a future version of EDB, `db-search' will permit searching on all fields
  1529. of a record simultaneously."
  1530.   (interactive)
  1531.   (error "db-search is unimplemented; use db-search-field instead (M-s from Edit mode).")
  1532.   )
  1533.  
  1534.  
  1535. ;; These should perhaps just be wrappers of some sort.
  1536. (defun db-isearch-forward ()
  1537.   "Like isearch-forward, but maintains the correspondence between the format
  1538. and summary buffers."
  1539.   (interactive)
  1540.   (isearch-forward)
  1541.   (db-jump-to-point))
  1542.  
  1543. (defun db-isearch-backward ()
  1544.   "Like isearch-backward, but maintains the correspondence between the format
  1545. and summary buffers."
  1546.   (interactive)
  1547.   (isearch-backward)
  1548.   (db-jump-to-point))
  1549.  
  1550.  
  1551. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1552. ;;; Omitting
  1553. ;;;
  1554.  
  1555. ;; These first two aren't very convenient for calling non-interactively.
  1556.  
  1557. ;; Should update the summary.
  1558. (defun db-mark-record (&optional arg)
  1559.   "Toggle whether the current record is marked.
  1560. With a nonzero prefix argument, set it to be marked.
  1561. With a zero prefix argument, set it to be unmarked."
  1562.   (interactive "P")
  1563.   (db-in-data-display-buffer
  1564.     (link-set-markedp dbc-link (if arg
  1565.                    (not (zerop (prefix-numeric-value arg)))
  1566.                  (not (link-markedp dbc-link))))
  1567.     ;; (dbf-set-summary-out-of-date-p)
  1568.     (dbf-update-summary-item dbc-index dbc-link)
  1569.     (dbc-set-index dbc-index)        ; sets dbc-index-fraction
  1570.     (force-mode-line-update)))
  1571.  
  1572. (defun db-omit-record (&optional arg)
  1573.   "Change whether the current record is omitted.
  1574. With a nonzero prefix argument, set it to be omitted.
  1575. With a zero prefix argument, set it to be unomitted."
  1576.   (interactive "P")
  1577.   (db-in-data-display-buffer
  1578.     (link-set-omittedp dbc-link (if arg
  1579.                     (not (zerop (prefix-numeric-value arg)))
  1580.                   (not (link-omittedp dbc-link))))
  1581.     ;; (dbf-set-summary-out-of-date-p)
  1582.     (if dbc-omit-p
  1583.     (dbf-update-summary-item dbc-index dbc-link)
  1584.       ;; Automatically turn on the effect of omitting.  I think this is
  1585.       ;; most intuitive for the user.  And now the user doesn't have to
  1586.       ;; remember what the command for enabling omitting is.
  1587.       (dbc-set-omit-p t)
  1588.       ;; Update all marks, since potentially all have to be displayed now.
  1589.       (dbf-update-summary-marks))
  1590.     (dbc-set-index dbc-index)        ; sets dbc-index-fraction
  1591.     (force-mode-line-update)))
  1592.  
  1593. ;; These could remember what the marks used to be...  That would require
  1594. ;; another slot in the link, or much more complicated manipulation of the
  1595. ;; current omittedp slot, and it doesn't sound entirely feasible, or
  1596. ;; worthwhile for that matter.  But I could get back the old value of
  1597. ;; db-omit-p.
  1598.  
  1599. (defun db-omit-unmarked-records ()
  1600.   "Omit all unmarked records.  Also clears all mark bits and sets `dbc-omit-p'."
  1601.   (interactive)
  1602.   (db-in-data-display-buffer
  1603.     (maplinks-macro
  1604.      (if (link-markedp maplinks-link)
  1605.      (link-set-markedp maplinks-link nil)
  1606.        (link-set-omittedp maplinks-link t))
  1607.      dbc-database
  1608.      t)
  1609.     (dbc-set-omit-p t)
  1610.     ;; (dbf-set-summary-out-of-date-p)
  1611.     (dbf-update-summary-marks)
  1612.     ;; *** Do some redisplay here as well, especially of the summary buffer.
  1613.     ))
  1614.  
  1615. (defun db-mark-unomitted-records ()
  1616.   "Mark all unomitted records.  Also clears all omit bits."
  1617.   (interactive)
  1618.   (db-in-data-display-buffer
  1619.     (maplinks-macro
  1620.      (if (link-omittedp maplinks-link)
  1621.      (link-set-omittedp maplinks-link nil)
  1622.        (link-set-markedp maplinks-link t))
  1623.      dbc-database)
  1624.     (dbc-set-omit-p t)
  1625.     ;; (dbf-set-summary-out-of-date-p)
  1626.     (dbf-update-summary-marks)
  1627.     ;; *** Do some redisplay here as well.
  1628.     ))
  1629.  
  1630. (defun db-unomit-all ()
  1631.   "Clear the omit bit of every record."
  1632.   (interactive)
  1633.   (db-in-data-display-buffer
  1634.     (maplinks-macro
  1635.      (link-set-omittedp maplinks-link nil)
  1636.      dbc-database)
  1637.     (dbc-set-index dbc-index)        ; sets dbc-index-fraction
  1638.     (force-mode-line-update)
  1639.     (dbf-update-summary-marks)))
  1640.  
  1641. (defun db-unmark-all ()
  1642.   "Clear the mark bit of every record."
  1643.   (interactive)
  1644.   (db-in-data-display-buffer
  1645.     (maplinks-macro
  1646.      (link-set-markedp maplinks-link nil)
  1647.      dbc-database)
  1648.     (dbc-set-index dbc-index)        ; sets dbc-index-fraction
  1649.     (force-mode-line-update)
  1650.     (dbf-update-summary-marks)))
  1651.  
  1652. (defun db-omitting-toggle (&optional arg)
  1653.   "Change whether omitting is in effect.
  1654. With a nonzero prefix argument, turn omitting on.
  1655. With a zero prefix argument, turn omitting off.
  1656.  
  1657. This does not change the current omit-function, and an omit bit is always
  1658. computed for each record, but omit bits have no effect on any operations
  1659. if omitting is not in effect."
  1660.   (interactive "P")
  1661.   (db-in-data-display-buffer
  1662.     (dbc-set-omit-p (if arg
  1663.             (not (zerop (prefix-numeric-value arg)))
  1664.               (not dbc-omit-p)))
  1665.     ;; Must refill summary buffer whenever displayed set of records
  1666.     ;; changes, including when switching to no omitting and showing omitted
  1667.     ;; records.
  1668.     (cond
  1669.      ((not dbf-summary-show-omitted-records-p)
  1670.       ;; If the omitted records weren't being shown, the records that
  1671.       ;; should be displayed in the summary buffer just changed.  We need
  1672.       ;; to refill the summary.
  1673.       (dbf-fill-summary-buffer-and-move-to-proper-record))
  1674.      (t
  1675.       (dbf-update-summary-marks)
  1676.       ;;(if dbc-omit-p
  1677.       ;;    (dbf-update-summary-marks)
  1678.       ;;  ;; Is there any real speed advantage to this:
  1679.       ;;  (dbf-in-summary-buffer
  1680.       ;;   (let ((buffer-read-only nil))
  1681.       ;;     (goto-char (point-min))
  1682.       ;;     (replace-regexp-noninteractive "^\\(.\\)\\[" "\\1 ")
  1683.       ;;     (dbs-move-to-proper-record)
  1684.       ;;     (set-buffer-modified-p nil))))
  1685.       ))
  1686.     (force-mode-line-update)
  1687.     (db-message "Omitting is now %sin effect." (if dbc-omit-p "" "not "))))
  1688.  
  1689. ;; Perhaps rename this db-omitting-set-criteria.
  1690. (defun db-omitting-set ()
  1691.   "Set the criteria for automatically determining whether to omit a record.
  1692. This isn't implemented yet."
  1693.   (interactive)
  1694.   (error "db-omitting-set is not yet implemented.")
  1695.   )
  1696.  
  1697. (defun db-toggle-show-omitted-records (&optional arg)
  1698.   "Toggle whether omitted records are shown in the summary.
  1699. With a nonzero prefix argument, show omitted records in the summary.
  1700. With a zero prefix argument, don't show omitted records in the summary."
  1701.   (interactive "P")
  1702.   (db-in-data-display-buffer
  1703.     (setq dbf-summary-show-omitted-records-p
  1704.       (if arg
  1705.           (not (zerop (prefix-numeric-value arg)))
  1706.         (not dbf-summary-show-omitted-records-p)))
  1707.     (if dbf-summary-show-omitted-records-p
  1708.     ;; If we weren't showing omitted records, we might as well start from
  1709.     ;; scratch in filling the summary buffer.
  1710.     (dbf-fill-summary-buffer-and-move-to-proper-record)
  1711.       (dbf-in-summary-buffer
  1712.     (let ((buffer-read-only nil))
  1713.       (goto-char (point-min))
  1714.       (delete-matching-lines "^.\\[")
  1715.       (dbs-move-to-proper-record))))
  1716.     (if dbf-summary-show-omitted-records-p
  1717.     (db-message "Omitted records will now be shown.")
  1718.       (db-message "Omitted records will not now be shown."))))
  1719.  
  1720.  
  1721. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1722. ;;; Reporting
  1723. ;;;
  1724.  
  1725. ;; Could make an alist so I don't have to read in the report name every time.
  1726. (defun db-report (report-filename &optional markedp)
  1727.   "Create a report according to REPORT-FILENAME.
  1728. Prefix argument MARKEDP, if non-nil, means report on only marked records.
  1729. If omitting is in effect, omitted records are not reported upon.
  1730. When called interactively, prompts for REPORT-FILENAME."
  1731.   (interactive "fReport format file: \nP")
  1732.   (dbf-process-current-record-maybe t)
  1733.   (let ((database dbc-database)
  1734.     report-format report-function)
  1735.     (save-window-excursion
  1736.       (set-buffer (get-buffer-create " *Database work buffer*"))
  1737.       (setq buffer-read-only nil)
  1738.       (erase-buffer)
  1739.       (insert-file-contents report-filename)
  1740.       (setq report-format (buffer-substring (point-min) (point-max))))
  1741.     (let ((lasfl (format->lines-and-stringform-list
  1742.           report-format dbc-database nil nil t)))
  1743.       (setq report-function
  1744.         (` (lambda (formatted-record)
  1745.          (insert (,@ (cdr lasfl)))))))
  1746.     (let ((omit-p dbc-omit-p))
  1747.       (switch-to-buffer (get-buffer-create "*Database Report*"))
  1748.       (setq buffer-read-only nil)
  1749.       (erase-buffer)
  1750.       (maplinks-macro
  1751.        (if (or (not markedp) (link-markedp maplinks-link))
  1752.        (funcall report-function (link-record maplinks-link)))
  1753.        database
  1754.        omit-p)
  1755.     (goto-char (point-min)))))
  1756.  
  1757.  
  1758. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1759. ;;; Etc.
  1760. ;;;
  1761.  
  1762. ;; Probably get rid of these.
  1763.  
  1764. (defun data-display-buffer-database (data-display-buffer)
  1765.   (in-buffer data-display-buffer
  1766.      dbc-database))
  1767. (proclaim-inline data-display-buffer-database)
  1768.  
  1769. (defun display-current-record (recompute)
  1770.   (display-record (dbf-displayed-record) recompute))
  1771. (proclaim-inline display-current-record)
  1772.  
  1773. ;;; db-interfa.el ends here
  1774.