home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / Programming / Source / winterp-1.13 / contrib / doc / rolo-logic.el < prev    next >
Encoding:
Text File  |  1991-10-06  |  8.3 KB  |  233 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         rolo-logic.el
  4. ;; SUMMARY:      Performs logical retrievals on rolodex files
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;;
  7. ;; AUTHOR:       Bob Weiner
  8. ;; ORG:          Motorola, Inc., Communications Sector, Applied Research
  9. ;; E-MAIL:       USENET:  weiner@novavax.UUCP
  10. ;;
  11. ;; ORIG-DATE:    13-Jun-89 at 22:57:33
  12. ;; LAST-MOD:     14-Jul-89 at 20:05:24 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1991 Bob Weiner
  15. ;; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  16. ;; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  17. ;;
  18. ;; Permission to use, copy, modify, distribute, and sell this software and
  19. ;; its documentation for any purpose is hereby granted without fee,
  20. ;; provided that the above copyright notice appear in all copies and that
  21. ;; both that copyright notice and this permission notice appear in
  22. ;; supporting documentation, and that the name of Hewlett-Packard, Niels
  23. ;; Mayer, Brown University and Bob Weiner not be used in advertising or
  24. ;; publicity pertaining to distribution of the software without specific,
  25. ;; written prior permission.  Hewlett-Packard, Niels Mayer, Brown University
  26. ;; and Bob Weiner makes no representations about the suitability of this
  27. ;; software for any purpose.  It is provided "as is" without express or
  28. ;; implied warranty.
  29. ;;
  30. ;; This file is not part of GNU Emacs.
  31. ;;
  32. ;; DESCRIPTION:  
  33. ;;
  34. ;;  INSTALLATION:
  35. ;;
  36. ;;   See also rolo.el.  These functions are separated from rolo.el since many
  37. ;;   users may never want or need them.  They can be automatically loaded when
  38. ;;   desired by adding the following to one of your Emacs init files:
  39. ;;
  40. ;;    (autoload 'rolo-logic "rolo-logic"
  41. ;;      "Logical rolodex search filters."
  42. ;;     t)
  43. ;;
  44. ;;  FEATURES:
  45. ;;
  46. ;;   1.  One command, 'rolo-logic' which takes a logical search expression as
  47. ;;       an argument and displays any matching entries.
  48. ;;
  49. ;;   2.  Logical 'and', 'or', 'not', and 'xor' rolodex entry retrieval filter
  50. ;;       functions. They take any number of string or boolean arguments and
  51. ;;       may be nested.  NOTE THAT THESE FUNCTIONS SHOULD NEVER BE CALLED
  52. ;;       DIRECTLY UNLESS THE FREE VARIABLES 'start' and 'end' ARE BOUND
  53. ;;       BEFOREHAND.
  54. ;;
  55. ;;  EXAMPLE:
  56. ;;
  57. ;;     (rolo-logic '(lambda ()
  58. ;;                     (rolo-and
  59. ;;                        (rolo-not "Tool-And-Die")
  60. ;;                        "secretary")))
  61. ;;
  62. ;;   would find all non-Tool-And-Die Corp. secretaries in your rolodex.
  63. ;;
  64. ;;
  65. ;;
  66. ;;   The logical matching routines are not really optimal, but then most
  67. ;;   rolodex files are not terribly lengthy either.
  68. ;;
  69. ;; DESCRIP-END.
  70.  
  71. (require 'rolo)
  72.  
  73. (defun rolo-logic (func &optional in-bufs count-only include-sub-entries
  74.                   no-sub-entries-out)
  75.   "Apply FUNC to all entries in optional IN-BUFS, display entries where FUNC is non-nil.
  76. If IN-BUFS is nil, 'rolo-file-list' is used.  If optional COUNT-ONLY is
  77. non-nil, don't display entries, return count of matching entries only.  If
  78. optional INCLUDE-SUB-ENTRIES flag is non-nil, FUNC will be applied across all
  79. sub-entries at once.  Default is to apply FUNC to each entry and sub-entry
  80. separately.  Entries are displayed with all of their sub-entries unless
  81. INCLUDE-SUB-ENTRIES is nil and optional NO-SUB-ENTRIES-OUT flag is non-nil.
  82. FUNC should use the free variables 'start' and 'end' which contain the limits
  83. of the region on which it should operate.  Returns number of applications of
  84. FUNC that return non-nil."
  85.   (interactive "xLogic function of no arguments, (lambda () (<function calls>): ")
  86.   (let ((obuf (current-buffer))
  87.     (display-buf (if count-only
  88.              nil
  89.                (prog1 (set-buffer (get-buffer-create rolo-display-buffer))
  90.              (setq buffer-read-only nil)
  91.              (erase-buffer)))))
  92.     (let ((result
  93.         (mapcar
  94.           '(lambda (in-bufs)
  95.          (rolo-map-logic func in-bufs count-only include-sub-entries
  96.                  no-sub-entries-out))
  97.           (cond ((null in-bufs) rolo-file-list)
  98.             ((listp in-bufs) in-bufs)
  99.             ((list in-bufs))))))
  100.       (let ((total-matches (apply '+ result)))
  101.     (if (or count-only (= total-matches 0))
  102.         nil
  103.       (pop-to-buffer display-buf)
  104.       (goto-char (point-min))
  105.       (set-buffer-modified-p nil)
  106.       (setq buffer-read-only t)
  107.       (let ((buf (get-buffer-window obuf)))
  108.         (if buf (select-window buf) (switch-to-buffer buf))))
  109.     (if (interactive-p)
  110.         (message (concat (if (= total-matches 0) "No" total-matches)
  111.                  " matching entr"
  112.                  (if (= total-matches 1) "y" "ies")
  113.                  " found in rolodex.")))
  114.     total-matches))))
  115.  
  116. (defun rolo-map-logic (func rolo-buf &optional count-only
  117.                 include-sub-entries no-sub-entries-out)
  118.   "Apply FUNC to all entries in ROLO-BUF, write to buffer entries where FUNC is non-nil.
  119. If optional COUNT-ONLY is non-nil, don't display entries, return count of
  120. matching entries only.  If optional INCLUDE-SUB-ENTRIES flag is non-nil, FUNC
  121. will be applied across all sub-entries at once.  Default is to apply FUNC to
  122. each entry and sub-entry separately.  Entries are displayed with all of their
  123. sub-entries unless INCLUDE-SUB-ENTRIES is nil and optional NO-SUB-ENTRIES-OUT
  124. flag is non-nil.  FUNC should use the free variables 'start' and 'end' which
  125. contain the limits of the region on which it should operate.  Returns number
  126. of applications of FUNC that return non-nil."
  127.   (if (or (bufferp rolo-buf)
  128.       (if (file-exists-p rolo-buf)
  129.           (setq rolo-buf (find-file-noselect rolo-buf t))))
  130.       (let* ((display-buf (set-buffer (get-buffer-create rolo-display-buffer)))
  131.          (buffer-read-only))
  132.     (let ((hdr-pos) (num-found 0))
  133.       (set-buffer rolo-buf)
  134.       (goto-char (point-min))
  135.       (if (re-search-forward rolo-hdr-regexp nil t 2)
  136.           (progn (forward-line)
  137.              (setq hdr-pos (cons (point-min) (point)))))
  138.       (let* ((start)
  139.          (end)
  140.          (end-entry-hdr)
  141.          (curr-entry-level))
  142.         (while (re-search-forward rolo-entry-regexp nil t)
  143.           (setq start (save-excursion (beginning-of-line) (point))
  144.             next-entry-exists nil
  145.             end-entry-hdr (point)
  146.             curr-entry-level (buffer-substring start end-entry-hdr)
  147.             end (rolo-to-entry-end include-sub-entries curr-entry-level))
  148.           (let ((fun (funcall func)))
  149.         (or count-only 
  150.             (and fun (= num-found 0) hdr-pos
  151.              (append-to-buffer display-buf
  152.                        (car hdr-pos) (cdr hdr-pos))))
  153.         (if fun 
  154.             (progn (goto-char end)
  155.                (setq num-found (1+ num-found)
  156.                  end (if (or include-sub-entries
  157.                          no-sub-entries-out)
  158.                      end
  159.                        (goto-char (rolo-to-entry-end
  160.                             t curr-entry-level))))
  161.                (or count-only
  162.                    (append-to-buffer display-buf start end)))
  163.           (goto-char end-entry-hdr)))))
  164.       (rolo-kill-buffer rolo-buf)
  165.       num-found))
  166.     0))
  167.  
  168.  
  169. ;;
  170. ;; INTERNAL FUNCTIONS.
  171. ;;
  172.  
  173. ;; Do NOT call the following functions directly.
  174. ;; Send them as parts of a lambda expression to 'rolo-logic'.
  175.  
  176. (defun rolo-not (&rest pat-list)
  177.   "Logical <not> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  178. Each element may be t, nil, or a string."
  179.   (let ((pat))
  180.     (while (and pat-list
  181.         (or (not (setq pat (car pat-list)))
  182.             (and (not (eq pat t))
  183.              (goto-char start)
  184.              (not (search-forward pat end t)))))
  185.       (setq pat-list (cdr pat-list)))
  186.     (if pat-list nil t)))
  187.  
  188. (defun rolo-or (&rest pat-list)
  189.   "Logical <or> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  190. Each element may be t, nil, or a string."
  191.   (if (memq t pat-list)
  192.       t
  193.     (let ((pat))
  194.       (while (and pat-list
  195.           (or (not (setq pat (car pat-list)))
  196.               (and (not (eq pat t))
  197.                (goto-char start)
  198.                (not (search-forward pat end t)))))
  199.     (setq pat-list (cdr pat-list)))
  200.       (if pat-list t nil))))
  201.  
  202. (defun rolo-xor (&rest pat-list)
  203.   "Logical <xor> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  204. Each element may be t, nil, or a string."
  205.   (let ((pat)
  206.     (matches 0))
  207.     (while (and pat-list
  208.         (or (not (setq pat (car pat-list)))
  209.             (and (or (eq pat t)
  210.                  (not (goto-char start))
  211.                  (search-forward pat end t))
  212.              (setq matches (1+ matches)))
  213.             t)
  214.         (< matches 2))
  215.       (setq pat-list (cdr pat-list)))
  216.     (= matches 1)))
  217.  
  218. (defun rolo-and (&rest pat-list)
  219.   "Logical <and> rolodex entry filter.  PAT-LIST is a list of pattern elements.
  220. Each element may be t, nil, or a string."
  221.   (if (memq nil pat-list)
  222.       nil
  223.     (let ((pat))
  224.       (while (and pat-list
  225.           (setq pat (car pat-list))
  226.           (or (eq pat t)
  227.               (not (goto-char start))
  228.               (search-forward pat end t)))
  229.     (setq pat-list (cdr pat-list)))
  230.       (if pat-list nil t))))
  231.  
  232. (provide 'rolo-logic)
  233.