home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / edb / db-summary.el < prev    next >
Encoding:
Text File  |  1993-06-14  |  34.6 KB  |  980 lines
  1. ;;; db-summary.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. ;; Patterned in part after rmail-new-summary.
  11.  
  12. ;;; Code:
  13.  
  14.  
  15. (provide 'db-summary)
  16.  
  17.  
  18. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19. ;;; Variables
  20. ;;;
  21.  
  22. ;;;
  23. ;;; Hooks
  24. ;;;
  25.  
  26. (defvar database-summary-mode-hooks nil
  27.   "Function or list of functions run when switching to database summary mode.")
  28.  
  29.  
  30. ;;;
  31. ;;; Summary variables
  32. ;;;
  33.  
  34. ;; All of these are strictly auxiliary variables; no original information
  35. ;; is kept here.  Don't change this since the summary buffer may be
  36. ;; destroyed at any time.
  37.  
  38. ;; I could keep more information here (eg dbs-format-lines) for
  39. ;; convenience; that would mean I'd have to do more work when the summary
  40. ;; format changed and when the summary buffer was created.  Maybe later.
  41.  
  42. (deflocalvar dbs-data-display-buffer nil
  43.   "The buffer of the format for which this buffer is a summary.")
  44.  
  45. (deflocalvar dbs-index nil
  46.   "The index of the record summary at point.
  47. Used in determining whether the data display buffer and its summary are in synch.
  48. Don't set this variable directly; use `dbs-set-index' instead.")
  49.  
  50. ;;   "Set  dbs-index  to INDEX and  dbs-index-fraction  appropriately."
  51. (defun dbs-set-index (index)
  52.   (setq dbs-index index
  53.     dbs-index-fraction
  54.     (format "%d/%d" dbs-index dbs-no-of-records)))
  55. (proclaim-inline dbs-set-index)
  56.  
  57. (deflocalvar dbs-no-of-records nil
  58.   "The number of records in the database when this summary was made.")
  59.  
  60. (deflocalvar dbs-point nil
  61.   "The beginning of the current record.")
  62.  
  63. (deflocalvar dbs-index-fraction nil
  64.   "Like `dbc-index-fraction', for the benefit of the mode line.")
  65.  
  66. (deflocalvar dbs-recompute-p nil
  67.   "T if some summary information is out of date, nil otherwise.
  68. This is usually set to t when some link-summary is set to nil.")
  69.  
  70.  
  71.  
  72. ;;;
  73. ;;; Format variables related to the summary
  74. ;;;
  75.  
  76. ;; One might like to have several summaries of a database, so perhaps these
  77. ;; variables should be local to the summary rather than to the format.  How
  78. ;; often would one want multiple summaries, anyway?
  79. ;; Pro:
  80. ;;  * Less dbs-in-format-buffer to look up variable values.
  81. ;; Con:
  82. ;;  * If I update summaries I'd have to keep track of, and update, them all.
  83. ;;  * Summaries might be less sensitive to changes the format wants to make.
  84. ;;  * The format must maintain these anywa, in case summary buffer destroyed.
  85.  
  86.  
  87. (deflocalvar dbf-summary-format nil
  88.   "A string in the same format as the format-file.
  89. Use `dbf-set-summary-format' to set it.")
  90.  
  91. ;; Needn't be buffer-local.
  92. (defvar dbf-default-summary-format nil)
  93.  
  94. (deflocalvar dbf-summary-function nil
  95.   "Function which inserts summary information for a single record in
  96. the summary buffer; it takes the record as its argument.")
  97.  
  98. (deflocalvar dbf-summary-buffer nil
  99.   "The summary buffer associated with this format.")
  100.  
  101. (deflocalvar dbf-summary-show-omitted-records-p t
  102.   "Nil if omitted records should be omitted from the summary, t otherwise.")
  103.  
  104. (deflocalvar dbf-summary-recompute-all-p nil
  105.   "T if every record summary in this buffer should be recomputed.")
  106.  
  107.  
  108. ;;;
  109. ;;; Variables in both the format and summary buffers
  110. ;;;
  111.  
  112. ;; These variables are too important to be kept only in the summary buffer,
  113. ;; which may disappear at any time, but are often used by it and so should
  114. ;; be handy.
  115.  
  116. ;; This doesn't depend on the field values in the individual records
  117. ;; because format->lines-and-stringform-list errs if min-height is not
  118. ;; equal to max-height (unelss variable-height is set).  That makes
  119. ;; determining which summary point is in, and getting to a particular
  120. ;; summary, much easier.
  121. (deflocalvar dbfs-lines nil
  122.   "The (constant) number of screen lines occupied by each record summary.
  123. This variable is computed automatically from the summary format.
  124. It has a value in both the summary and data display buffers.")
  125.  
  126.  
  127. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  128. ;;; Musings
  129. ;;;
  130.  
  131. ;; How often should the summary buffer be updated?
  132. ;; * always, when it exists (This could be advantageous for large databases:
  133. ;;   incremental computation instead of all at once.  This proposal also has
  134. ;;   grassroots support, so I'll implement it.  Could have a variable to
  135. ;;   defer updates and get the other behavior.)
  136. ;; * on demand (Thus, experience no slowdown when marking, etc.)
  137. ;; * have some operations defer updating the summary until they
  138. ;;   are completed (eg, long operations that make a lot of changes or do a
  139. ;;   lot of marking and which we don't want to slow down).
  140. ;; * when visible in a window (no, too confusing, could surprise the user.
  141. ;;   But a lot of emacs stuff does work this way)
  142. ;; Just changing marks could be made efficient.
  143.  
  144. ;; Maybe don't bother to do as much work if the data display buffer isn't
  145. ;; visible.
  146.  
  147.  
  148. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  149. ;;; Macros for working in the correct buffer
  150. ;;;
  151.  
  152. ;; Assumes the current buffer is the data display buffer.
  153. (defmacro dbf-summary-buffer ()
  154.   (` (and (bufferp dbf-summary-buffer)
  155.       (buffer-name dbf-summary-buffer)
  156.       dbf-summary-buffer)))
  157.  
  158. ;; Assumes the current buffer is the data display buffer.
  159. ;;   "Execute the body in the summary buffer, if it exists."
  160. (defmacro dbf-in-summary-buffer (&rest body)
  161.   (` (if (dbf-summary-buffer)
  162.      (in-buffer dbf-summary-buffer
  163.        (progn
  164.          (,@ body))))))
  165. (put 'dbf-in-summary-buffer 'lisp-indent-hook 0)
  166. (put 'dbf-in-summary-buffer 'edebug-form-spec '(&rest form))
  167.  
  168. ;; Assumes the current buffer is the summary buffer.
  169. ;;   "Execute the body in the data display buffer (which always exists)."
  170. (defmacro dbs-in-data-display-buffer (&rest body)
  171.   (` (in-buffer dbs-data-display-buffer
  172.        (,@ body))))
  173. (put 'dbs-in-data-display-buffer 'lisp-indent-hook 0)
  174. (put 'dbs-in-data-display-buffer 'edebug-form-spec '(&rest form))
  175.  
  176. ;;; These assume the current buffer is a database buffer.
  177.  
  178. (defun db-data-display-buffer ()
  179.   "Return the database data display buffer associated with the current buffer,
  180. which must be either a summary buffer or a data display buffer."
  181.   (cond ((db-summary-buffer-p)
  182.      dbs-data-display-buffer)
  183.     ((db-data-display-buffer-p)
  184.      (current-buffer))
  185.     (t
  186.      (error "Neither in format nor summary buffer"))))
  187. (proclaim-inline db-data-display-buffer)
  188.  
  189. ;;   "Return the database summary buffer associated with the current buffer,
  190. ;; which must be either a summary buffer (which is returned) or a data display
  191. ;; buffer.  Return nil if there is no associated summary buffer."
  192. (defun db-summary-buffer ()
  193.   (cond ((db-summary-buffer-p)
  194.      (current-buffer))
  195.     ((db-data-display-buffer-p)
  196.      (dbf-summary-buffer))
  197.     (t
  198.      (error "Neither in format nor summary buffer"))))
  199. (proclaim-inline db-summary-buffer)
  200.  
  201.  
  202.  
  203. (defmacro db-in-data-display-buffer (&rest body)
  204.   (` (in-buffer (db-data-display-buffer)
  205.        (,@ body))))
  206. (put 'db-in-data-display-buffer 'lisp-indent-hook 0)
  207. (put 'db-in-data-display-buffer 'edebug-form-spec '(&rest form))
  208.  
  209.  
  210. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  211. ;;; Creating the summary
  212. ;;;
  213.  
  214. ;; Perhaps add a variable which permits, if no changes have been made, even
  215. ;; dbf-fill-summary-buffer to be bypassed.
  216.  
  217. (defun db-summary ()
  218.   "Display a summary (or directory) of all database records according to
  219. the variable `dbf-summary-function', which is set by `dbf-set-summary-format'.
  220. The summary appears in a separate buffer.
  221. When called from the summary buffer, this updates the summary."
  222.   (interactive)
  223.  
  224.   (db-in-data-display-buffer
  225.    
  226.     ;; I need to decide whether the buffer should be erased and refilled or
  227.     ;; just displayed without updating at this time.  Probably the former,
  228.     ;; but the latter would be much nicer and is doable.
  229.    
  230.     (cond ((database-empty-p dbc-database)
  231.        ;; Maybe give the message, but pop anyway, if the database is empty.
  232.        (delete-windows-on (dbf-summary-buffer))
  233.        (db-message "Database is empty."))
  234.       (t
  235.        (let ((data-display-buffer (current-buffer)))
  236.          (if (not dbf-summary-function)
  237.          (dbf-set-summary-format dbf-summary-format))
  238.          (if (not (dbf-summary-buffer))
  239.          (setq dbf-summary-buffer
  240.                (db-create-summary-buffer data-display-buffer)))
  241.          ;; Avoid a check by not using dbf-in-summary-buffer
  242.          (if (in-buffer dbf-summary-buffer (dbs-out-of-date-p))
  243.          (dbf-fill-summary-buffer))
  244.          (pop-to-buffer dbf-summary-buffer)
  245.          (setq dbs-data-display-buffer data-display-buffer)
  246.          ;; go to proper line
  247.          (dbs-move-to-proper-record))))))
  248.  
  249. ;; This shouldn't be called if a summary buffer already exists.
  250. (defun db-create-summary-buffer (data-display-buffer)
  251.   (let ((sbuf (generate-new-buffer (concat (buffer-name data-display-buffer)
  252.                        "-summary"))))
  253.     (in-buffer sbuf
  254.       (setq dbs-data-display-buffer data-display-buffer)
  255.       (setq dbc-database (in-buffer data-display-buffer dbc-database))
  256.       (database-summary-mode))
  257.  
  258.     ;; (make-local-variable 'minor-mode-alist)
  259.     ;; (setq minor-mode-alist (list ": " description))
  260.  
  261.     ;; return the buffer
  262.     sbuf))
  263.  
  264.  
  265. (defvar mode-motion-hook)        ; quiet the byte-compiler
  266. ;; This is spelled out instead of being db-summary-mode because it's a
  267. ;; major mode, while db-edit-mode and db-view-mode are minor modes.  This
  268. ;; is a weak rationale.
  269. (defun database-summary-mode ()
  270.   "Summary buffer for database mode.
  271. Most keystrokes perform the same function they do in the data display buffer.
  272.  
  273. Key bindings:
  274.  
  275. \\{database-summary-mode-map}"
  276.  
  277.   ;; Actually mode-line should be hacked the way the others are.
  278.   (setq major-mode 'database-summary-mode)
  279.   (setq mode-name "Database Summary")
  280.  
  281.   (set-buffer-modified-p nil)
  282.   (setq buffer-read-only t)
  283.  
  284.   (auto-save-mode 0)
  285.   (setq buffer-file-name nil)
  286.  
  287.   (use-local-map database-summary-mode-map)
  288.  
  289.   (setq mode-line-format
  290.     (dbs-in-data-display-buffer
  291.      (list
  292.       (format "-----Database: %17s   %%[(Summary" (buffer-name))
  293.       'minor-mode-alist
  294.       " "
  295.       'dbs-index-fraction
  296.       ")%]---"
  297.       '(-3 . "%p")
  298.       "-%-")))
  299.  
  300.   (if db-running-lucid-emacs
  301.       (progn
  302.     (require 'mode-motion)
  303.     (setq mode-motion-hook 'mode-motion-highlight-line)
  304.     (db-lucid-summary-mode-menubar)))
  305.  
  306.   (run-hooks 'database-summary-mode-hooks)
  307.  
  308.   ;; Force an update.
  309.   (setq dbs-no-of-records -1))
  310.  
  311. ;;   "T if this buffer is a database summary buffer."
  312. (defun db-summary-buffer-p ()
  313.   (eq major-mode 'database-summary-mode))
  314. (proclaim-inline db-summary-buffer-p)
  315.  
  316.  
  317. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  318. ;;; Filling the summary
  319. ;;;
  320.  
  321. (defun dbs-insert-link-summary (link mark-omitted-records-p)
  322.   ;; Instead of having start and end, I could just
  323.   ;; move by lines; which is more efficient?
  324.   (let ((start (point))
  325.     end)
  326.     (insert (link-summary link))
  327.     ;; (indent-rigidly start (point) 2)
  328.     (setq end (point))
  329.     (if (link-markedp link)
  330.     (progn
  331.       (goto-char start)
  332.       (delete-char 1)
  333.       (insert "+")
  334.       (goto-char end)))
  335.     (if (and mark-omitted-records-p (link-omittedp link))
  336.     (progn
  337.       (goto-char start)
  338.       (forward-char 2)
  339.       (while (< (point) end)
  340.         (backward-delete-char 1)
  341.         (insert "[")
  342.         (next-line 1))
  343.       (goto-char end)))))
  344. ;; This function is currently only called two places, so what the heck...
  345. (proclaim-inline dbs-insert-link-summary)
  346.  
  347. ;; Will I ever call this without pop-to-buffering immediately thereafter?
  348. ;; [Does that matter all that much?]
  349.  
  350. ;; The database won't be empty when this is called.
  351.  
  352. (defun dbf-fill-summary-buffer ()
  353.  
  354.   ;; (db-debug-message "dbf-f-s-b:  summary-buffer = %s." summary-buffer)
  355.  
  356.   (let ((summary-function dbf-summary-function)
  357.     (lines dbfs-lines)
  358.     (omit (and (not dbf-summary-show-omitted-records-p)
  359.            dbc-omit-p))
  360.     (mark-omitted-records-p dbc-omit-p)
  361.     (recompute-all-p dbf-summary-recompute-all-p))
  362.     (db-debug-message "dbf-fill-summary-buffer:  %s %s"
  363.               omit mark-omitted-records-p)
  364.     (dbf-in-summary-buffer
  365.       (let ((buffer-read-only nil))
  366.     (erase-buffer)
  367.     (db-message "Computing summary...")
  368.     ;; Should recompile this loop whenever summary-function changes.
  369.     ;; The funcall overhead makes it really slow.
  370.     (maplinks-macro
  371.       (progn
  372.         (if (or recompute-all-p (not (link-summary maplinks-link)))
  373.         (progn
  374.           (db-debug-message "Computing link summary for link %d." maplinks-index)
  375.           (link-set-summary maplinks-link
  376.             (funcall summary-function (link-record maplinks-link)))))
  377.         ;; A call to inline here was giving trouble to old-bytecomp users.
  378.         (dbs-insert-link-summary maplinks-link mark-omitted-records-p))
  379.       dbc-database omit "Computing summary...%d")
  380.     (db-message "Computing summary...done.")
  381.  
  382.     ;; get rid of last newline.
  383.     (backward-delete-char 1)
  384.     (set-buffer-modified-p nil)
  385.     (setq dbs-no-of-records (database-no-of-records dbc-database))
  386.     ;; What is this doing?  lines is bound to dbfs-lines above, and
  387.     ;; hasn't been changed (except perhaps dynamically??) since.
  388.     (setq dbfs-lines lines)
  389.  
  390.     (setq dbs-recompute-p nil)
  391.  
  392.     ;; *** Maybe we should call dbs-move-to-proper-record here.
  393.     (setq dbs-index 0)
  394.  
  395.         ;;; This is wrong because the first displayed record might not be
  396.         ;;; the first record due to omitting.
  397.     ;; (goto-char (point-min))
  398.     ;; (dbs-set-index 1)
  399.     ))
  400.     (setq dbf-summary-recompute-all-p nil)))
  401.  
  402. (defun dbf-fill-summary-buffer-and-move-to-proper-record ()
  403.   (if (dbf-summary-buffer)
  404.       (progn
  405.     (dbf-fill-summary-buffer)
  406.     (dbf-in-summary-buffer
  407.       (dbs-move-to-proper-record)))))
  408.  
  409. ;; Efficient way to update just the marked and omitted summary markings.
  410. (defun dbf-update-summary-marks ()
  411.   (let ((mark-omitted-records-p dbc-omit-p)
  412.     (omitted-records-shown-p (or dbf-summary-show-omitted-records-p
  413.                      (not dbc-omit-p))))
  414.     (dbf-in-summary-buffer
  415.       (let ((buffer-read-only nil)
  416.         (opoint (point))
  417.         line)
  418.     (unwind-protect
  419.         (progn
  420.           (goto-char (point-min))
  421.           (maplinks-macro
  422.         (progn
  423.           (delete-char 1)
  424.           (insert (if (link-markedp maplinks-link) "+" " "))
  425.           (backward-char 1)
  426.           (setq line 0)
  427.           ;; Each summary item spans exactly dbfs-lines screen lines.
  428.           (while (< line dbfs-lines)
  429.             (forward-char 1)
  430.             (delete-char 1)
  431.             (insert (if (and mark-omitted-records-p
  432.                      (link-omittedp maplinks-link))
  433.                 "["
  434.                   " "))
  435.             (forward-line 1)
  436.             (setq line (1+ line))))
  437.         dbc-database
  438.         (not omitted-records-shown-p)))
  439.       (goto-char opoint))))))
  440.  
  441. ;; Efficient way to update just changes to one record in the summary.
  442. (defun dbf-update-summary-item (index &optional link)
  443.   (setq link (or link (database-link dbc-database index)))
  444.   (let* ((mark-omitted-records-p dbc-omit-p)
  445.      (this-record-shown-p (or (not (link-omittedp link))
  446.                   dbf-summary-show-omitted-records-p
  447.                   (not dbc-omit-p)))
  448.      (summary-function dbf-summary-function))
  449.     (if this-record-shown-p
  450.     (dbf-in-summary-buffer
  451.       (let ((buffer-read-only nil)
  452.         (oindex dbs-index)
  453.         line)
  454.         (unwind-protect
  455.         (progn
  456.           (or (link-summary link)
  457.               (link-set-summary
  458.                link
  459.                (funcall summary-function (link-record link))))
  460.           (dbs-move-to-proper-record index)
  461.           ;; assuming at beginning of line
  462.           (delete-region (point)
  463.                  (progn
  464.                    (forward-line dbfs-lines)
  465.                    (point)))
  466.           (dbs-insert-link-summary link mark-omitted-records-p))
  467.           ;; save old line and column instead.
  468.           (dbs-move-to-proper-record oindex))))
  469.       ;; *** need to update cached summary, even though we're not going to
  470.       ;; *** display.
  471.       )))
  472.  
  473. ;; If we always show marked records, regardless of omitting, then
  474. ;; clearly we should have a similar policy in moving forward in the
  475. ;; database proper or everything will get all fouled up.  Maybe have a
  476. ;; link-ignored for use when moving forward and here as well; it would be
  477. ;; true only if unmarked and omitted and the appropriate variables
  478. ;; about how omitted records were treated were set.
  479.  
  480. ;; I think we really want the summary to end with a newline so that all
  481. ;; this works.
  482.  
  483. ;; This isn't used any more, and I'm afraid to abstract any more out of
  484. ;; dbf-fill-summary-buffer for fear of degraded performance.
  485. (defun dbf-summarize-link (link)
  486.   (if (or dbf-summary-recompute-all-p (not (link-summary link)))
  487.       (progn
  488.     (db-debug-message "Computing link summary.")
  489.     (link-set-summary link
  490.           (funcall dbf-summary-function (link-record link)))))
  491.   (if (or dbf-summary-show-omitted-records-p
  492.         (not (link-omittedp link))
  493.         ;; always show marked records, regardless of omitting
  494.         (link-markedp link))
  495.       (dbf-in-summary-buffer
  496.     (let ((start (point))
  497.           end)
  498.       (insert (link-summary link))
  499.       ;; instead of having start and end, I could just
  500.       ;; move by lines; which is more efficient?
  501.       (indent-rigidly start (point) 2)
  502.       (setq end (point))
  503.       (if (link-markedp link)
  504.           (progn
  505.         (goto-char start)
  506.         (delete-char 1)
  507.         (insert "*")
  508.         (goto-char end)))
  509.       (if (link-omittedp link)
  510.           (progn
  511.         (goto-char start)
  512.         (forward-char 2)
  513.         (while (< (point) end)
  514.           (backward-delete-char 1)
  515.           (insert "[")
  516.           (next-line 1))
  517.         (goto-char end)))))))
  518.  
  519.  
  520.  
  521.  
  522.  
  523.  
  524. ;;; May not need this, depending on how I work the summary buffer.
  525. ;;; Perhaps have how often it's updated be an option.
  526. ;;; Or maybe it will be fast enough that it won't matter.
  527. ;; For newly created records.
  528. ; (defun db-insert-summary-info (record)
  529. ;   "Insert summary info for the record in the current buffer."
  530. ;
  531. ;   ;; ...
  532. ;
  533. ;   )
  534.  
  535.  
  536.  
  537. ;; Plan:  make a list of separator strings and displayspecs from the
  538. ;; summary-info.  Then create a function that returns a list of the
  539. ;; strings and formatted strings.  Complain if, for instance, max-height <>
  540. ;; min-height, etc.
  541.  
  542. ;; Don't bother to remember what info is shown in the summary listing;
  543. ;; just update the entry when the database record changes.
  544.  
  545. ;; How to compute the number of lines in the summary-format?
  546.  
  547. ;; Sets dbf-summary-function and dbfs-lines.
  548. (defun dbf-make-summary-maker (summary-format database)
  549.  
  550.   ;; (db-debug-message "db-make-summary-maker: summary-format = %s" summary-format)
  551.  
  552.   (let ((lasfl (format->lines-and-stringform-list summary-format database 2 t nil)))
  553.     ;; (db-debug-message "db-make-summary-maker:  lasfl = %s" lasfl)
  554.  
  555.     (setq dbfs-lines (car lasfl))
  556.    
  557.     ;; I don't see how to fit a call to function around this lambda form.
  558.     (setq dbf-summary-function
  559.       (` (lambda (formatted-record)
  560.            (concat (,@ (cdr lasfl))))))))
  561.  
  562.  
  563. ;; Takes a format and returns a cons of two values:  a number and a list.
  564. ;; The list is list of forms which, when evaluated with variable
  565. ;; formatted-record bound, evaluate to strings; these can be used as
  566. ;; argumentes to concat, insert, etc.  The number is the number of lines
  567. ;; occupied by the items when inserted.
  568.  
  569. ;; Signals an error if any displayspec has nonequal min-height and
  570. ;; max-height, unless variable-height is non-nil, in which case the number
  571. ;; returned is a minimum.
  572.  
  573. ;; I can't decide whether to automatically add a newline at the end; or
  574. ;; maybe just check whether there's one there.  Maybe people who care about
  575. ;; that sort of thing (like summaries) should make sure for themselves.
  576.  
  577. (defun format->lines-and-stringform-list (format database indent add-newline variable-height)
  578.  
  579.   (let (results
  580.     beginning
  581.     end
  582.     this-displayspec
  583.     (backslash-placeholder (and (string-match "\\\\\\\\" format)
  584.                     (unused-char-in-string format)))
  585.     (lines 0))
  586.     ;; (db-debug-message "f->lasfl: format = %s" format)
  587.  
  588.     ;; Yes, it would be more efficient to do this to each literal as it's
  589.     ;; extracted.  I don't care.
  590.     (if (and indent (> indent 0))
  591.     (setq format (concat (make-string indent ? )
  592.                  (string-substitute-substring-general-case
  593.                   (concat "\n" (make-string indent ? ))
  594.                   "\n"
  595.                   format))))
  596.     (if backslash-placeholder
  597.     (string-substitute-substring-general-case
  598.      "\\\\" (char-to-string backslash-placeholder) format))
  599.  
  600.     (while (string-match displayspec-regexp format)
  601.       ;; (db-debug-message "f->lasfl: match = %s" (match-string 0 format))
  602.       (setq beginning (match-beginning displayspec-regexp-content-beginning)
  603.         end (or (match-end displayspec-regexp-content-end)
  604.             (match-end displayspec-regexp-content-end-alt))
  605.         this-displayspec (make-displayspec-from-string-internal
  606.                   format database))
  607.       (if (not (or variable-height (displayspec-max-height this-displayspec)))
  608.       (displayspec-set-max-height this-displayspec
  609.         (displayspec-min-height this-displayspec)))
  610.       (if (or variable-height
  611.           (= (displayspec-min-height this-displayspec)
  612.          (displayspec-max-height this-displayspec)))
  613.       (setq lines (+ lines (1- (displayspec-min-height this-displayspec))))
  614.     (error "Min-height %s must equal max-height %s in summary displayspec %s."
  615.            (displayspec-min-height this-displayspec)
  616.            (displayspec-max-height this-displayspec)
  617.            this-displayspec))
  618.       (if (not (zerop beginning))
  619.       (let ((literal (substring format 0 beginning)))
  620.         (if backslash-placeholder
  621.         (string-substitute ?\ backslash-placeholder literal))
  622.         (setq results (cons literal results)
  623.           lines (+ lines (count-array ?\n literal)))))
  624.       (setq results (cons (make-format-printer this-displayspec) results))
  625.       (setq format (substring format end)))
  626.     (if add-newline (setq format (concat format "\n")))
  627.     (if (not (equal "" format))
  628.     (progn
  629.       (if backslash-placeholder
  630.           (string-substitute ?\ backslash-placeholder format))
  631.       (setq results (cons format results))))
  632.     (setq lines (+ lines (count-array ?\n format)))
  633.     (cons lines (nreverse results))))
  634.  
  635.  
  636. ;; Is this worth optimizing?  I'd like to, since its result will be called a lot.
  637. ;; Differences from displayspec->printed-rep:
  638. ;;  * handling of multiple lines (just take the first line)
  639. ;;  * can look at the displayspecs only once, at summary-printer creation time;
  640. ;;    don't need them around all the time taking up space.
  641. ;;  * if min-width and max-width not set, ignore that processing
  642. ;; Perhaps abstract lots of stuff away from displayspec->printed-rep so the
  643. ;; parts can be reused here.  Or wait until it is very stable and then do
  644. ;; the specialization by hand.
  645.  
  646. ;; Note that we assume that dbf-summary-record is bound; this permits fewer
  647. ;; function calls.
  648. ;;   "Return a lisp form which evaluates to a printed representation for DISPLAYSPEC."
  649. (defun make-format-printer (displayspec)
  650.   (` (displayspec->printed-rep (, displayspec) formatted-record)))
  651.  
  652. (defun make-summary-initial-indentation ()
  653.   (` (if dbf-sr-markedp "* "
  654.        (, (make-summary-indentation)))))
  655.  
  656. (defun make-summary-indentation ()
  657.   '(if (and dbf-sr-omittedp (not dbf-sr-markedp))
  658.        "  [ "
  659.      "  "))
  660.  
  661. ;; ;; Problem:  this will fail (ie, won't insert the right things in the left
  662. ;; ;; margin) when a data item (as opposed to a literal) causes a newline.
  663. ;; ;; Maybe I need to just do an indent then go to the front and insert the
  664. ;; ;; proper items etc for the whole thing after all.  This would also
  665. ;; ;; localize the special code a bit.
  666. ;;
  667. ;; (defun push-literal-printer-results (literal &optional etc)
  668. ;;   (while (string-match "\n" literal)
  669. ;;     (push (substring literal 0 (1+ (match-beginning 0))) results)
  670. ;;     (push (make-summary-indentation) results)
  671. ;;     (setq lines (1+ lines))
  672. ;;     (setq literal (substring literal (1+ (match-beginning 0)))))
  673. ;;   (if etc (setq literal (concat literal etc)))
  674. ;;   (if (not (equal "" literal))
  675. ;;       (push literal results)))
  676.  
  677.  
  678. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  679. ;;; Synching the format and summary buffers
  680. ;;;
  681.  
  682. (defun dbs-in-synch-p ()
  683.   (= dbs-index (dbs-in-data-display-buffer dbc-index)))
  684. (proclaim-inline dbs-in-synch-p)
  685.  
  686. (defun dbs-out-of-date-p ()
  687.   (or dbs-recompute-p
  688.       (not (= dbs-no-of-records (database-no-of-records dbc-database)))))
  689. (proclaim-inline dbs-out-of-date-p)
  690.  
  691. ;; Should perhaps update the summary as well, particularly if it's visible.
  692. ;; If I do that, then perhaps this should no longer be inlined.
  693. (defun dbf-set-summary-out-of-date-p ()
  694.   (dbf-in-summary-buffer
  695.     (setq dbs-recompute-p t)))
  696. (proclaim-inline dbf-set-summary-out-of-date-p)
  697.  
  698. ;; When I'm in the summary, trust its variables unless it's out of date.
  699.  
  700. ;; Called by summary movement commands, maybe.
  701. ;;   "Ensure that the data display and summary buffers have the same current record."
  702. (defun dbs-synch-format-with-summary ()
  703.   (if (dbs-out-of-date-p)
  704.       (dbs-synch-summary-with-format)
  705.     (if (not (dbs-in-synch-p))
  706.     (dbs-in-data-display-buffer
  707.       (db-select-record (in-buffer dbf-summary-buffer dbs-index))))))
  708.  
  709. ;; Might want a dbf- version of this too.
  710.  
  711. (defun dbs-synch-summary-with-format ()
  712.   (if (dbs-out-of-date-p)
  713.       (dbs-in-data-display-buffer
  714.     (dbf-fill-summary-buffer)))
  715.   ;; If we just did the above, it will clearly be out of synch.
  716.   ;; But it might be even if it wasn't out of date.
  717.   (if (not (dbs-in-synch-p))
  718.       ;; Maybe have a better function here.  I don't know whether I want
  719.       ;; to try to make use of the dbs-index info; perhaps I do.  I could
  720.       ;; be way far away, in which case I might as well just go from the
  721.       ;; front; but maybe I'm not.  I don't think that it will be messed
  722.       ;; up, though.
  723.       (dbs-move-to-proper-record)))
  724.  
  725.  
  726. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  727. ;;; Moving about
  728. ;;;
  729.  
  730. ;; If omitted records aren't shown in the summary (and that should be
  731. ;; an option), then this is wrong.  And in that case it's better to do
  732. ;; relative than absolute motion.  (Eg if I move down three records, then
  733. ;; move down three summaries rather than going to the nth summary.)
  734.  
  735. ;; This moves point and sets dbs-point
  736. ;; n is 1-based.
  737. (defun dbs-goto-nth-summary (n)
  738.   (goto-line (1+ (* dbfs-lines (1- n))))
  739.   (setq dbs-point (point)))
  740. (proclaim-inline dbs-goto-nth-summary)
  741.  
  742. ;; I can't tell if this code is any good.
  743.  
  744. ;; Makes no assumptions about dbs-index.
  745. ;; If omitted records aren't shown, this is quite quick.
  746. ;; Should perhaps be split into a function that *computes* the mapping from
  747. ;; database indices to summary indices, and a function that does the rest.
  748. ;;   "Move point to the summary of the record shown in the format or to INDEX."
  749. (defun dbs-move-to-proper-record (&optional index)
  750.   ;; goto-line also moves to the beginning of the line
  751.   (if (dbs-in-data-display-buffer (or (not dbc-omit-p)
  752.                 dbf-summary-show-omitted-records-p))
  753.       (let ((index (or index (dbs-in-data-display-buffer dbc-index))))
  754.     (dbs-goto-nth-summary index)
  755.     (dbs-set-index index))
  756.     (let ((previous-displayed-records 0)
  757.       (last-displayed-record nil)
  758.       (proper-index (or index (dbs-in-data-display-buffer dbc-index))))
  759.       (maplinks-macro
  760.     (if (<= maplinks-index proper-index)
  761.         (setq previous-displayed-records
  762.           (1+ previous-displayed-records)
  763.           last-displayed-record maplinks-index)
  764.       ;; If we're past it but still haven't found a nonomitted link.
  765.       (if (not last-displayed-record)
  766.           (setq previous-displayed-records 1
  767.             last-displayed-record maplinks-index)))
  768.     dbc-database
  769.     t)
  770.       ;; If there are no displayed records at all, this will fail.
  771.       ;; But if the database is empty we refuse to make the summary anyway.
  772.       (if (not (= last-displayed-record proper-index))
  773.       (db-message "Record %s does not appear in the summary buffer."
  774.            proper-index))
  775.       (dbs-goto-nth-summary previous-displayed-records)
  776.       (dbs-set-index last-displayed-record))))
  777.  
  778.  
  779. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  780. ;;; Movement commands
  781. ;;;
  782.  
  783. ;; Do I want this to take  &optional ingore-omitting markedp ?
  784.  
  785. ;; Move point forward ARG records in the summary buffer, and set dbs-point.
  786. (defun dbs-forward-record (arg)
  787.     (goto-char dbs-point)
  788.     (forward-line-wrapping (* dbfs-lines arg))
  789.     (setq dbs-point (point)))
  790. (proclaim-inline dbs-forward-record)
  791.  
  792. ;; Maybe this is the wrong way to implement it and if contrained records
  793. ;; aren't shown in the summary buffer I should move forward in the format
  794. ;; buffer anyway and give a message in the summary buffer that we're out of
  795. ;; synch.
  796.  
  797. (defun dbs-next-record-ignore-omitting (arg)
  798.   "Go to the ARGth next record, ignoring omitting.
  799. That is, all records, even those which are omitted, are counted."
  800.   (interactive "p")
  801.   (if (not (dbs-in-data-display-buffer dbf-summary-show-omitted-records-p))
  802.       (db-next-record-ignore-omitting arg)
  803.     (progn
  804.       (dbs-synch-format-with-summary)
  805.       (dbs-in-data-display-buffer
  806.     (db-next-record-ignore-omitting arg))
  807.       (dbs-forward-record arg)
  808.       (dbs-set-index (dbs-in-data-display-buffer dbc-index)))))
  809.  
  810. (defun dbs-previous-record-ignore-omitting (arg)
  811.   "Go to the ARGth previous record, ignoring omitting.
  812. That is, all records, even those which are omitted, are counted."
  813.   (interactive "p")
  814.   (dbs-next-record-ignore-omitting (- arg)))
  815.  
  816. ;; Quite possibly, if I want this to work I'll need to remember where point
  817. ;; was before the move; keep around yet another dbs- variable.
  818.  
  819. ;; This permits the body to move to an arbitrary location; it could be used
  820. ;; with scroll-*, x-flush-mouse-queue, etc.
  821.  
  822. (defun dbs-scroll-up ()
  823.   (interactive)
  824.   (scroll-up)
  825.   (db-jump-to-point))
  826.  
  827. (defun dbs-scroll-down ()
  828.   (interactive)
  829.   (scroll-down)
  830.   (db-jump-to-point))
  831.  
  832. ;; Perhaps someday get rid of this:  merge it directly into
  833. ;; db-jump-to-point.  For now, it's called by a lot of functions.  (It
  834. ;; probably wouldn't hurt them that much to call db-jump-to-point and pay a
  835. ;; smidgen more overhead.)
  836.  
  837. ;; ;; This is wrong in the presence of omitted directory lines.
  838. ;; (defun dbs-jump-to-point ()
  839. ;;   (interactive)
  840. ;;   (beginning-of-line)
  841. ;;   (let ((difference (/ (count-lines-signed dbs-point (point)) dbs-lines)))
  842. ;;     (goto-char dbs-point)
  843. ;;     (dbs-next-record-ignore-omitting difference)))
  844.  
  845. ;; This is the cheating way to do this; fix it later.
  846. ;; (defun dbs-first-record ()
  847. ;;   (interactive)
  848. ;;   (goto-char (point-min))
  849. ;;   (dbs-jump-to-point))
  850. ;;
  851. ;; (defun dbs-last-record ()
  852. ;;   (interactive)
  853. ;;   (goto-char (point-max))
  854. ;;   (dbs-jump-to-point))
  855.  
  856.  
  857. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  858. ;;; Summary Mode Commands
  859. ;;;
  860.  
  861. ;; These keystrokes should be made to come into line with those of view-mode.
  862.  
  863. (defvar database-summary-mode-map (make-keymap)
  864.   "Keymap for database summary buffer.")
  865. (suppress-keymap database-summary-mode-map)
  866.  
  867. ;; This map and that of view-mode should be very similar.
  868. ;; Mayhap I should move all this map stuff to its own file.  I dunno.
  869.  
  870. ;; Moving around in the database
  871. (define-key database-summary-mode-map "n" 'db-next-record)
  872. (define-key database-summary-mode-map "p" 'db-previous-record)
  873. (define-key database-summary-mode-map "\C-n" 'db-next-record)
  874. (define-key database-summary-mode-map "\C-p" 'db-previous-record)
  875. (define-key database-summary-mode-map "<" 'db-first-record)
  876. (define-key database-summary-mode-map ">" 'db-last-record)
  877. (define-key database-summary-mode-map (db-meta-prefix-ify "<") 'db-first-record)
  878. (define-key database-summary-mode-map (db-meta-prefix-ify ">") 'db-last-record)
  879. (define-key database-summary-mode-map "j" 'db-jump-to-record)
  880. (define-key database-summary-mode-map " " 'db-next-screen-or-record)
  881. (define-key database-summary-mode-map "\177" 'db-previous-screen-or-record)
  882. (define-key database-summary-mode-map (db-meta-prefix-ify "n") 'dbs-next-record-ignore-omitting)
  883. (define-key database-summary-mode-map (db-meta-prefix-ify "p") 'dbs-previous-record-ignore-omitting)
  884. (define-key database-summary-mode-map (db-meta-prefix-ify "\C-n") 'db-next-marked-record)
  885. (define-key database-summary-mode-map (db-meta-prefix-ify "\C-p") 'db-previous-marked-record)
  886.  
  887.  
  888. ;; Exiting summary mode
  889. (define-key database-summary-mode-map "e" 'dbs-edit)
  890. (define-key database-summary-mode-map "v" 'dbs-view)
  891. (define-key database-summary-mode-map "q" 'dbs-exit)
  892. (define-key database-summary-mode-map "x" 'dbs-exit)
  893.  
  894. ;; Adding and removing records
  895. (define-key database-summary-mode-map "a" 'db-add-record)
  896. (define-key database-summary-mode-map "i" 'db-add-record)
  897. (define-key database-summary-mode-map "d" 'dbs-delete-record)
  898. (define-key database-summary-mode-map "k" 'dbs-delete-record)
  899. (define-key database-summary-mode-map "o" 'dbs-output-record-to-db)
  900. (define-key database-summary-mode-map "c" 'db-copy-record)
  901.  
  902. ;; Searching commands
  903. (define-key database-summary-mode-map "s" 'db-search)
  904. ;; (define-key database-summary-mode-map "S" 'db-incremental-search)
  905. (define-key database-summary-mode-map "\C-s" 'db-isearch-forward)
  906. (define-key database-summary-mode-map "\C-r" 'db-isearch-backward)
  907.  
  908.  
  909. ;; Everything else
  910. (define-key database-summary-mode-map "?" 'describe-mode)
  911. (define-key database-summary-mode-map "O" 'db-omit-record)
  912. (define-key database-summary-mode-map (db-meta-prefix-ify "o") 'db-omitting-toggle)
  913. (define-key database-summary-mode-map (db-meta-prefix-ify "O") 'db-omitting-set)
  914. (define-key database-summary-mode-map (db-meta-prefix-ify "\C-o") 'db-toggle-show-omitted-records)
  915. (define-key database-summary-mode-map "g" 'db-summary)
  916. (define-key database-summary-mode-map "h" 'db-summary)
  917. (define-key database-summary-mode-map "D" 'db-summary)
  918. (define-key database-summary-mode-map "m" 'db-mark-record)
  919. (define-key database-summary-mode-map "r" 'db-report)
  920. (define-key database-summary-mode-map "\C-xr" 'db-revert-database)
  921. (define-key database-summary-mode-map "\C-v" 'dbs-scroll-up)
  922. (define-key database-summary-mode-map (db-meta-prefix-ify "v") 'dbs-scroll-down)
  923.  
  924. (define-key database-summary-mode-map "\C-x\C-q" 'db-toggle-modifiable-p)
  925.  
  926. (define-key database-summary-mode-map "\C-x\C-@" 'db-x-jump-to-point)
  927. (define-key database-summary-mode-map "\C-c\C-c" 'dbs-exit)
  928.  
  929. (define-key database-summary-mode-map "b" 'undefined)
  930. (define-key database-summary-mode-map "f" 'undefined)
  931. (define-key database-summary-mode-map "l" 'undefined)
  932. (define-key database-summary-mode-map "t" 'undefined)
  933. ; (define-key database-summary-mode-map "u" 'db-revert-record)
  934. (define-key database-summary-mode-map "w" 'undefined)
  935. (define-key database-summary-mode-map "y" 'undefined)
  936. (define-key database-summary-mode-map "z" 'undefined)
  937.  
  938.  
  939. (defun dbs-view ()
  940.   "Manipulate this record in the data display buffer in View mode."
  941.   (interactive)
  942.   (pop-to-buffer dbs-data-display-buffer)
  943.   (db-view-mode))
  944.  
  945. (defun dbs-edit ()
  946.   "Manipulate this record in the data display buffer in Edit mode."
  947.   (interactive)
  948.   (pop-to-buffer dbs-data-display-buffer)
  949.   (if (eq dbf-minor-mode 'view)
  950.       (db-first-field)))
  951.  
  952. ;; A misstroke in the data display buffer shouldn't exit the database.
  953. (defun dbs-exit ()
  954.   "Exit the summary buffer."
  955.   (interactive)
  956.   ;; This is oh-so-very-crude.
  957.   (let ((data-display-buffer dbs-data-display-buffer))
  958.     (delete-windows-on (current-buffer))
  959.     (switch-to-buffer data-display-buffer)))
  960.  
  961. (defun dbs-delete-record (&optional force)
  962.   "Delete the current record from the database.
  963. With a prefix arg, doesn't verify."
  964.   (interactive "P")
  965.   (if (or force (y-or-n-p "Delete this record? "))
  966.       (progn
  967.     (dbs-in-data-display-buffer
  968.       (db-delete-record t))
  969.     ;; hope we're at the beginning of the record
  970.     (let ((buffer-read-only nil))
  971.       (kill-line dbfs-lines)
  972.       (if (eobp)
  973.           (goto-char (point-min))))
  974.     (setq dbs-no-of-records (1- dbs-no-of-records))
  975.     (db-message "Record deleted.")
  976.     (dbs-set-index (dbs-in-data-display-buffer dbc-index))
  977.     )))
  978.  
  979. ;;; db-summary.el ends here
  980.