Implement saved searches for ebib.

ebib-saved-searches.el

;; Pretty printing lib
(require 'pp)

;; Associative list for filters
(defvar filters-alist())

(defvar filters-already-loaded nil)

(setq filter-ignore-case t)

(setq filter-default-file "~/filters")

;;{{{ Load filters

;; Get filters list from buffer
(defun filters-alist-from-buffer ()
  "Return a `filters-alist' from the current buffer.
The buffer must of course contain filter format information.
Does not care from where in the buffer it is called, and does not
affect point."
  (save-excursion
    (goto-char (point-min))
    (if (search-forward "(" nil t)
	(progn
	  (forward-char -1)
          (read (current-buffer)))
      ;; Else no hope of getting information here.
      (error "Not filter format"))))


;; Load filters-alist
(defun filter-load (file &optional overwrite no-msg)
  "Load filters from FILE (which must be in filters format).
Appends loaded filters to the front of the list of filters.  If
optional second argument OVERWRITE is non-nil, existing filters
are destroyed. Optional third arg NO-MSG means don't display any
messages while loading."

  (setq file (abbreviate-file-name (expand-file-name file)))
  (if (not (file-readable-p file))
      (error "Cannot read filters file %s" file)
    (if (null no-msg)
        (message "Loading filters from %s..." file))
    
    (with-current-buffer (let ((enable-local-variables nil))
                           (find-file-noselect file))
      (goto-char (point-min))

      (let ((flist (filters-alist-from-buffer)))
        (if (listp flist)
            (progn
              (if overwrite
                  (progn
                    (setq filters-alist flist))
            ))

          (error "Invalid filter list in %s" file))
      (kill-buffer (current-buffer)))
      (if (null no-msg)
         (message "Loading filters from %s...done" file))
    )))


;; Load filters file
(defun filter-maybe-load-default-file ()
  "If filters have not been loaded from the default place, load them."
  (interactive)
  (and (not filters-already-loaded)
       (null filters-alist)
       (file-readable-p filter-default-file)

       (filter-load filter-default-file t nil)
       (setq filters-already-loaded t)))

;;}}}

;;{{{ Get filter

(defun filter-get-filter (filter-name &optional noerror)
  "Return the filter record corresponding to FILTER-NAME.
If FILTER-NAME is a string, look for the corresponding
filter record in `filters-alist'; return it if found, otherwise
error."
  (cond
   ((stringp filter-name)
    (or (assoc-string filter-name filters-alist
                      filter-ignore-case)
        (unless noerror (error "Invalid filter %s" filter-name))))))

;; Sort filters
(defun filter-sort-alist ()
  "Return `filters-alist' for display."
  (interactive)
  (progn
    (sort (copy-alist filters-alist)
	  (function
	   (lambda (x y) (string-lessp (car x) (car y))))) 
    ))

;;}}}

;;{{{ Rename filter
(defun filter-set-name (filter-name newname)
  "Set filter's name to NEWNAME."
  (setcar (filter-get-filter filter-name) newname))

(defun ebib-rename-filter ()
  (interactive)
  (let ((old-name (completing-read (format "Choose a saved filter: ")
				 (mapcar #'(lambda(x)
					     (cons x 0))
					  (filter-all-names))
			       
                                nil t)))
    (let ((new-name (read-from-minibuffer "Enter new name: ")))
      (if (filter-get-filter new-name 'noerror)
	  (error "There is already a filter with that name. Better overwrite that filter instead.")
	(progn
	  (filter-set-name old-name new-name)
	  (filter-write-file)
	  (setq filters-alist nil)
	  (setq filters-already-loaded nil)))
)))

;;}}}

;;{{{ Add filter to alist

;; Check for dups and store filter
(defun filter-store (name alist no-overwrite)
  "Store the filter NAME with data ALIST.
If NO-OVERWRITE is non-nil and another filter of the same name
already exists in `filter-alist', record the new filter without
throwing away the old one."
  (interactive)
  (filter-maybe-load-default-file)
    (if (and (not no-overwrite)
           (filter-get-filter name 'noerror))
      ;; already existing filter under that name and
      ;; no prefix arg means just overwrite old filter
      ;; Use the new (NAME . ALIST) format.
      (setcdr (filter-get-filter name) (cons alist '()))

    ;; otherwise just cons it onto the front (either the filter
    ;; doesn't exist already, or there is no prefix arg.  In either
    ;; case, we want the new filter consed onto the alist...)
    (push (cons name (cons alist '())) filters-alist))
)

;;}}}

;;{{{ Save filters

(defun filter-write-file ()
  "Write `filters-alist' to FILTER-DEFAULT-FILE."
  (interactive)
  (message "Saving filters to file %s..." filter-default-file)
  (with-current-buffer (get-buffer-create " *Filters*")
    (goto-char (point-min))
    (delete-region (point-min) (point-max))
    (let ((print-length nil)
          (print-level nil)
          (print-circle t))
      ;;(filter-insert-header)
      
      (insert "(")
      (dolist (i filters-alist) (pp i (current-buffer)))
      (insert ")")

      (condition-case nil
	  (write-region (point-min) (point-max) filter-default-file)
	(file-error (message "Can't write %s" filter-default-file)))
      
      (kill-buffer (current-buffer))
      (message "Saving filters to file %s...done" filter-default-file)
)))

;;}}}

;;{{{ Save ebib filter
(defun ebib-save-filter ()
  (interactive)

  (setq filter (edb-virtual ebib-cur-db))

  (let ((ebib-filter-name (read-from-minibuffer "Enter filter name: ")))
    (filter-store ebib-filter-name filter nil)
    (filter-write-file)
    (setq filters-alist nil)
    (setq filters-already-loaded nil)
))

;;}}}

;;{{{ Show saved filters
(defun filter-name-from-full-record (filter-record)
  "Return the name of FILTER-RECORD. FILTER-RECORD is, e.g.,
one element from `filters-alist'."
  (car filter-record))

(defun filter-all-names ()
  "Return a list of all current filter names."
  (filter-maybe-load-default-file)
  (mapcar 'filter-name-from-full-record (filter-sort-alist)))

;;}}}

;;{{{ Load ebib filter

;; Create virtual database with saved filter
(defun filter-create-virtual-db (filter)
  "Creates a virtual database based on saved filter."
  (let ((new-db (ebib-create-new-database ebib-cur-db)))
    (setf (edb-virtual new-db) filter)
    (setf (edb-filename new-db) nil)
    (setf (edb-name new-db) (concat "V:" (edb-name new-db)))
    (setf (edb-modified new-db) nil)
    (setf (edb-make-backup new-db) nil)
    new-db))

;; Load saved filter
(defun ebib-load-filter ()
  (interactive)

  (ebib-execute-when
    ((virtual-db)
     (error "A saved filter can only be applied to a real database")
    ))

  (ebib-execute-when
    ((real-db)
     (let ((filter (completing-read (format "Choose a saved filter: ")
                               (mapcar #'(lambda(x)
					(cons x 0))
					(filter-all-names))
			       
                                nil t)))
       (setq filter-record (car (cdr (filter-get-filter filter))))
   

       (setq ebib-cur-db (filter-create-virtual-db filter-record))

       (ebib-run-filter (edb-virtual ebib-cur-db) ebib-cur-db)
       (ebib-fill-entry-buffer)
       (ebib-fill-index-buffer)))
))

;;}}}