cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/wrolo-logic.el

   1 ;;; wrolo-logic.el --- Performs logical retrievals on rolodex files
   2
   3 ;; Copyright (C) 1989-1995, Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: hypermedia, matching
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28 ;;
  29 ;;  INSTALLATION:
  30 ;;
  31 ;;   See also wrolo.el.  These functions are separated from wrolo.el since many
  32 ;;   users may never want or need them.  They can be automatically loaded when
  33 ;;   desired by adding the following to one of your Emacs init files:
  34 ;;
  35 ;;    (autoload 'rolo-logic "wrolo-logic" "Logical rolodex search filters." t)
  36 ;;
  37 ;;  FEATURES:
  38 ;;
  39 ;;   1.  One command, 'rolo-logic' which takes a logical search expression as
  40 ;;       an argument and displays any matching entries.
  41 ;;
  42 ;;   2.  Logical 'and', 'or', 'not', and 'xor' rolodex entry retrieval filter
  43 ;;       functions. They take any number of string or boolean arguments and
  44 ;;       may be nested.  NOTE THAT THESE FUNCTIONS SHOULD NEVER BE CALLED
  45 ;;       DIRECTLY UNLESS THE FREE VARIABLES 'start' and 'end' ARE BOUND
  46 ;;       BEFOREHAND.
  47 ;;
  48 ;;  EXAMPLE:
  49 ;;
  50 ;;     (rolo-logic (function
  51 ;;                   (lambda ()
  52 ;;                     (rolo-and
  53 ;;                        (rolo-not "Tool-And-Die")
  54 ;;                        "secretary"))))
  55 ;;
  56 ;;   would find all non-Tool-And-Die Corp. secretaries in your rolodex.
  57 ;;
  58 ;;   The logical matching routines are not at all optimal, but then most
  59 ;;   rolodex files are not terribly lengthy either.
  60 ;;
  61
  62 ;;; Code:
  63
  64 (require 'wrolo)
  65
  66 ;;;###autoload
  67 (defun rolo-logic (func &optional in-bufs count-only include-sub-entries
  68                               no-sub-entries-out)
  69   "Apply FUNC to all entries in optional IN-BUFS, display entries where FUNC is non-nil.
  70 If IN-BUFS is nil, 'rolo-file-list' is used.  If optional COUNT-ONLY is
  71 non-nil, don't display entries, return count of matching entries only.  If
  72 optional INCLUDE-SUB-ENTRIES flag is non-nil, FUNC will be applied across all
  73 sub-entries at once.  Default is to apply FUNC to each entry and sub-entry
  74 separately.  Entries are displayed with all of their sub-entries unless
  75 INCLUDE-SUB-ENTRIES is nil and optional NO-SUB-ENTRIES-OUT flag is non-nil.
  76 FUNC should use the free variables 'start' and 'end' which contain the limits
  77 of the region on which it should operate.  Returns number of applications of
  78 FUNC that return non-nil."
  79   (interactive "xLogic function of no arguments, (lambda () (<function calls>): ")
  80   (let ((obuf (current-buffer))
  81         (display-buf (if count-only
  82                          nil
  83                        (prog1 (set-buffer (get-buffer-create rolo-display-buffer))
  84                          (setq buffer-read-only nil)
  85                          (erase-buffer)))))
  86     (let ((result
  87             (mapcar
  88              (function
  89               (lambda (in-bufs)
  90                  (rolo-map-logic func in-bufs count-only include-sub-entries
  91                                  no-sub-entries-out)))
  92               (cond ((null in-bufs) rolo-file-list)
  93                     ((listp in-bufs) in-bufs)
  94                     ((list in-bufs))))))
  95       (let ((total-matches (apply '+ result)))
  96         (if (or count-only (= total-matches 0))
  97             nil
  98           (pop-to-buffer display-buf)
  99           (goto-char (point-min))
 100           (set-buffer-modified-p nil)
 101           (setq buffer-read-only t)
 102           (let ((buf (get-buffer-window obuf)))
 103             (if buf (select-window buf) (switch-to-buffer buf))))
 104         (if (interactive-p)
 105             (message (concat (if (= total-matches 0) "No" total-matches)
 106                              " matching entr"
 107                              (if (= total-matches 1) "y" "ies")
 108                              " found in rolodex.")))
 109         total-matches))))
 110
 111 (defun rolo-map-logic (func rolo-buf &optional count-only
 112                             include-sub-entries no-sub-entries-out)
 113   "Apply FUNC to all entries in ROLO-BUF, write to buffer entries where FUNC is non-nil.
 114 If optional COUNT-ONLY is non-nil, don't display entries, return count of
 115 matching entries only.  If optional INCLUDE-SUB-ENTRIES flag is non-nil, FUNC
 116 will be applied across all sub-entries at once.  Default is to apply FUNC to
 117 each entry and sub-entry separately.  Entries are displayed with all of their
 118 sub-entries unless INCLUDE-SUB-ENTRIES is nil and optional NO-SUB-ENTRIES-OUT
 119 flag is non-nil.  FUNC should use the free variables 'start' and 'end' which
 120 contain the limits of the region on which it should operate.  Returns number
 121 of applications of FUNC that return non-nil."
 122   (if (or (bufferp rolo-buf)
 123           (if (file-exists-p rolo-buf)
 124               (setq rolo-buf (find-file-noselect rolo-buf t))))
 125       (let* ((display-buf (set-buffer (get-buffer-create rolo-display-buffer)))
 126              (buffer-read-only))
 127         (let ((hdr-pos) (num-found 0))
 128           (set-buffer rolo-buf)
 129           (goto-char (point-min))
 130           (if (re-search-forward rolo-hdr-regexp nil t 2)
 131               (progn (forward-line)
 132                      (setq hdr-pos (cons (point-min) (point)))))
 133           (let* ((start)
 134                  (end)
 135                  (end-entry-hdr)
 136                  (curr-entry-level))
 137             (while (re-search-forward rolo-entry-regexp nil t)
 138               (setq start (save-excursion (beginning-of-line) (point))
 139                     next-entry-exists nil
 140                     end-entry-hdr (point)
 141                     curr-entry-level (buffer-substring start end-entry-hdr)
 142                     end (rolo-to-entry-end include-sub-entries curr-entry-level))
 143               (let ((fun (funcall func)))
 144                 (or count-only
 145                     (and fun (= num-found 0) hdr-pos
 146                          (append-to-buffer display-buf
 147                                            (car hdr-pos) (cdr hdr-pos))))
 148                 (if fun
 149                     (progn (goto-char end)
 150                            (setq num-found (1+ num-found)
 151                                  end (if (or include-sub-entries
 152                                              no-sub-entries-out)
 153                                          end
 154                                        (goto-char (rolo-to-entry-end
 155                                                     t curr-entry-level))))
 156                            (or count-only
 157                                (append-to-buffer display-buf start end)))
 158                   (goto-char end-entry-hdr)))))
 159           (rolo-kill-buffer rolo-buf)
 160           num-found))
 161     0))
 162
 163
 164 ;;
 165 ;; INTERNAL FUNCTIONS.
 166 ;;
 167
 168 ;; Do NOT call the following functions directly.
 169 ;; Send them as parts of a lambda expression to 'rolo-logic'.
 170
 171 (defun rolo-not (&rest pat-list)
 172   "Logical <not> rolodex entry filter.  PAT-LIST is a list of pattern elements.
 173 Each element may be t, nil, or a string."
 174   (let ((pat))
 175     (while (and pat-list
 176                 (or (not (setq pat (car pat-list)))
 177                     (and (not (eq pat t))
 178                          (goto-char start)
 179                          (not (search-forward pat end t)))))
 180       (setq pat-list (cdr pat-list)))
 181     (if pat-list nil t)))
 182
 183 (defun rolo-or (&rest pat-list)
 184   "Logical <or> rolodex entry filter.  PAT-LIST is a list of pattern elements.
 185 Each element may be t, nil, or a string."
 186   (if (memq t pat-list)
 187       t
 188     (let ((pat))
 189       (while (and pat-list
 190                   (or (not (setq pat (car pat-list)))
 191                       (and (not (eq pat t))
 192                            (goto-char start)
 193                            (not (search-forward pat end t)))))
 194         (setq pat-list (cdr pat-list)))
 195       (if pat-list t nil))))
 196
 197 (defun rolo-xor (&rest pat-list)
 198   "Logical <xor> rolodex entry filter.  PAT-LIST is a list of pattern elements.
 199 Each element may be t, nil, or a string."
 200   (let ((pat)
 201         (matches 0))
 202     (while (and pat-list
 203                 (or (not (setq pat (car pat-list)))
 204                     (and (or (eq pat t)
 205                              (not (goto-char start))
 206                              (search-forward pat end t))
 207                          (setq matches (1+ matches)))
 208                     t)
 209                 (< matches 2))
 210       (setq pat-list (cdr pat-list)))
 211     (= matches 1)))
 212
 213 (defun rolo-and (&rest pat-list)
 214   "Logical <and> rolodex entry filter.  PAT-LIST is a list of pattern elements.
 215 Each element may be t, nil, or a string."
 216   (if (memq nil pat-list)
 217       nil
 218     (let ((pat))
 219       (while (and pat-list
 220                   (setq pat (car pat-list))
 221                   (or (eq pat t)
 222                       (not (goto-char start))
 223                       (search-forward pat end t)))
 224         (setq pat-list (cdr pat-list)))
 225       (if pat-list nil t))))
 226
 227 ;; Work with regular expression patterns rather than strings
 228
 229 (defun rolo-r-not (&rest pat-list)
 230   "Logical <not> rolodex entry filter.  PAT-LIST is a list of pattern elements.
 231 Each element may be t, nil, or a string."
 232   (let ((pat))
 233     (while (and pat-list
 234                 (or (not (setq pat (car pat-list)))
 235                     (and (not (eq pat t))
 236                          (goto-char start)
 237                          (not (re-search-forward pat end t)))))
 238       (setq pat-list (cdr pat-list)))
 239     (if pat-list nil t)))
 240
 241 (defun rolo-r-or (&rest pat-list)
 242   "Logical <or> rolodex entry filter.  PAT-LIST is a list of pattern elements.
 243 Each element may be t, nil, or a string."
 244   (if (memq t pat-list)
 245       t
 246     (let ((pat))
 247       (while (and pat-list
 248                   (or (not (setq pat (car pat-list)))
 249                       (and (not (eq pat t))
 250                            (goto-char start)
 251                            (not (re-search-forward pat end t)))))
 252         (setq pat-list (cdr pat-list)))
 253       (if pat-list t nil))))
 254
 255 (defun rolo-r-xor (&rest pat-list)
 256   "Logical <xor> rolodex entry filter.  PAT-LIST is a list of pattern elements.
 257 Each element may be t, nil, or a string."
 258   (let ((pat)
 259         (matches 0))
 260     (while (and pat-list
 261                 (or (not (setq pat (car pat-list)))
 262                     (and (or (eq pat t)
 263                              (not (goto-char start))
 264                              (re-search-forward pat end t))
 265                          (setq matches (1+ matches)))
 266                     t)
 267                 (< matches 2))
 268       (setq pat-list (cdr pat-list)))
 269     (= matches 1)))
 270
 271 (defun rolo-r-and (&rest pat-list)
 272   "Logical <and> rolodex entry filter.  PAT-LIST is a list of pattern elements.
 273 Each element may be t, nil, or a string."
 274   (if (memq nil pat-list)
 275       nil
 276     (let ((pat))
 277       (while (and pat-list
 278                   (setq pat (car pat-list))
 279                   (or (eq pat t)
 280                       (not (goto-char start))
 281                       (re-search-forward pat end t)))
 282         (setq pat-list (cdr pat-list)))
 283       (if pat-list nil t))))
 284
 285 (provide 'wrolo-logic)
 286
 287 ;;; wrolo-logic.el ends here