home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / edb / db-search.el < prev    next >
Encoding:
Text File  |  1993-06-13  |  6.0 KB  |  183 lines
  1. ;;; db-search.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. ;;; Code:
  11.  
  12.  
  13. (provide 'db-search)
  14.  
  15. ;; db-interfa should have been loaded before this.
  16.  
  17.  
  18. (deflocalvar dbf-field-search-defaults nil
  19.   "Vector of defaults for field search.
  20. It is one element longer than the number of fields; the element indexed by
  21. dbf-displayspecs-length is the default for a search over all fields.")
  22.  
  23. ;;   "Keymap for database data display buffer in edit mode."
  24. (defvar database-search-mode-map (copy-keymap database-edit-mode-map))
  25.  
  26.  
  27.  
  28.  
  29. ;; Requisite changes:
  30. ;;
  31. ;;
  32. ;; change dbf-displayspecs:
  33. ;;   * displayspec->printed-rep and display->internal
  34. ;;   * constraint functions
  35. ;;   * add "any field" field.
  36. ;;
  37. ;; increment dbf-displayspecs-length by 1 to account for "any field" searches.
  38. ;;
  39. ;; change mode line to reflect that a search is going on.
  40. ;;
  41. ;; disable or rebind such keys as db-view-mode, db-next-record, etc.
  42. ;;
  43. ;; Make sure that dbf-this-record is set, never dbf-this-record-original.
  44. ;; (Actually, I take it back; the latter can point at the search record.  In
  45. ;; addition there will be another search record which remembers defaults from
  46. ;; searches on individual fields.)
  47.  
  48.  
  49.  
  50.  
  51. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  52. ;;; Searching primitives
  53. ;;;
  54.  
  55. ;; These are listed in order of precedence.
  56. ;; Perhaps add <= and >=.
  57. (defvar dbm-and-connective "[ \t]+and[ \t]+")
  58. (defvar dbm-or-connective "[ \t]+or[ \t]+")
  59. (defvar dbm-not-prefix "^[ \t]*not[ \t]+")
  60. ;; These used to be preceded by [ \t]* and followed by [ \t]+;
  61. ;; for instance, (defvar dbm-<-prefix "^[ =t]*<[ \t]+")
  62. (defvar dbm-<-prefix "^<")
  63. (defvar dbm->-prefix "^>")
  64. (defvar dbm-=-prefix "^=")
  65.  
  66. ;; Perhaps demand that after >,<,=, there is a pure string, and don't make
  67. ;; the full recursive call.
  68. ;;;###autoload
  69. (defun db-parse-match-pattern (string displayspec)
  70.   (cond ((string-match dbm-and-connective string)
  71.      (let ((and-end (match-end 0)))
  72.        (list 'db-match-and
  73.          (db-parse-match-pattern (substring string 0 (match-beginning 0))
  74.                      displayspec)
  75.          (db-parse-match-pattern (substring string and-end)
  76.                      displayspec))))
  77.     ((string-match dbm-or-connective string)
  78.      (let ((or-end (match-end 0)))
  79.        (list 'db-match-or
  80.          (db-parse-match-pattern (substring string 0 (match-beginning 0))
  81.                      displayspec)
  82.          (db-parse-match-pattern (substring string or-end)
  83.                      displayspec))))
  84.     ;; no infix connectives in string
  85.     ((string-match dbm-not-prefix string)
  86.      (list 'db-match-not
  87.            (db-parse-match-pattern (substring string (match-end 0))
  88.                        displayspec)))
  89.     ((string-match dbm-<-prefix string)
  90.      (list 'db-match-<
  91.            (db-parse-match-object (substring string (match-end 0))
  92.                        displayspec)))
  93.     ((string-match dbm->-prefix string)
  94.      (list 'db-match->
  95.            (db-parse-match-object (substring string (match-end 0))
  96.                        displayspec)))
  97.     ((string-match dbm-=-prefix string)
  98.      (list 'db-match-=
  99.            (db-parse-match-object (substring string (match-end 0))
  100.                        displayspec)))
  101.     (t
  102.      (display->actual-call
  103.       (or (displayspec-match-display->actual displayspec)
  104.           (displayspec-display->actual displayspec))
  105.       string
  106.       nil nil nil))))
  107.  
  108. (defun db-parse-match-object (string displayspec)
  109.   (db-debug-message "db-parse-match-object %s." string)
  110.   (display->actual-call
  111.    (displayspec-display->actual displayspec)
  112.    string
  113.    nil nil nil))
  114.  
  115. ;;;###autoload
  116. (defun db-print-match-pattern (pattern displayspec)
  117.   (let ((pat-type (if (listp pattern) (car pattern))))
  118.     (cond
  119.      ((eq 'db-match-and pat-type)
  120.       (concat (db-print-match-pattern (car (cdr pattern)) displayspec)
  121.           ;; extra space to emphasize its low precedence
  122.           "  AND  "
  123.           (db-print-match-pattern (car (cdr (cdr pattern))) displayspec)))
  124.      ((eq 'db-match-or pat-type)
  125.       (concat (db-print-match-pattern (car (cdr pattern)) displayspec)
  126.           " OR "
  127.           (db-print-match-pattern (car (cdr (cdr pattern))) displayspec)))
  128.      ((eq 'db-match-not pat-type)
  129.       (concat "NOT "
  130.           (db-print-match-pattern (car (cdr pattern)) displayspec)))
  131.      ((eq 'db-match-< pat-type)
  132.       (concat "< "
  133.           (db-print-match-object (car (cdr pattern)) displayspec)))
  134.      ((eq 'db-match-> pat-type)
  135.       (concat "> "
  136.           (db-print-match-object (car (cdr pattern)) displayspec)))
  137.      ((eq 'db-match-= pat-type)
  138.       (concat "= "
  139.           (db-print-match-object (car (cdr pattern)) displayspec)))
  140.      ;; pattern was not a list or the type wasn't recognized
  141.      (t
  142.       (actual->display-call (or (displayspec-match-actual->display displayspec)
  143.                 (displayspec-actual->display displayspec))
  144.                 pattern
  145.                 nil nil)))))
  146.  
  147. (defun db-print-match-object (string displayspec)
  148.   (db-debug-message "db-print-match-object %s." string)
  149.   (actual->display-call (displayspec-actual->display displayspec)
  150.             string
  151.             nil nil))
  152.  
  153. ;;;###autoload
  154. (defun db-match (pattern target recordfieldspec)
  155.   (db-debug-message "db-match: %s %s" pattern target)
  156.   (if (listp pattern)
  157.       (let ((pat-type (car pattern)))
  158.     (cond
  159.      ((eq 'db-match-and pat-type)
  160.       (and (db-match (car (cdr pattern)) target recordfieldspec)
  161.            (db-match (car (cdr (cdr pattern))) target recordfieldspec)))
  162.      ((eq 'db-match-or pat-type)
  163.       (or (db-match (car (cdr pattern)) target recordfieldspec)
  164.           (db-match (car (cdr (cdr pattern))) target recordfieldspec)))
  165.      ((eq 'db-match-not pat-type)
  166.       (not (db-match (car (cdr pattern)) target recordfieldspec)))
  167.      ((eq 'db-match-< pat-type)
  168.       (= 1 (funcall (recordfieldspec-order-function recordfieldspec)
  169.             (car (cdr pattern)) target)))
  170.      ((eq 'db-match-> pat-type)
  171.       (= -1 (funcall (recordfieldspec-order-function recordfieldspec)
  172.              (car (cdr pattern)) target)))
  173.      ((eq 'db-match-= pat-type)
  174.       (= 0 (funcall (recordfieldspec-order-function recordfieldspec)
  175.             (car (cdr pattern)) target)))
  176.      (t
  177.       (funcall (recordfieldspec-match-function recordfieldspec)
  178.            pattern target))))
  179.     (funcall (recordfieldspec-match-function recordfieldspec)
  180.          pattern target)))
  181.  
  182. ;;; db-search.el ends here
  183.