;;; hyrolo-logic.el --- Logic functions for GNU Hyperbole Rolo files -*- lexical-binding: t; -*- ;; ;; Author: Bob Weiner ;; ;; Orig-Date: 13-Jun-89 at 22:57:33 ;; Last-Mod: 4-Apr-26 at 14:15:14 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; ;; Copyright (C) 1989-2025 Free Software Foundation, Inc. ;; See the "HY-COPY" file for license information. ;; ;; This file is part of GNU Hyperbole. ;; ;;; Commentary: ;; ;; INSTALLATION: ;; ;; See also hyrolo.el. These functions are separated from hyrolo.el since many ;; users may never want or need them. They can be automatically loaded when ;; desired by adding the following to one of your Emacs init files: ;; ;; (autoload 'hyrolo-fgrep-logical "hyrolo-logic" "Rolo search with logical operators." t) ;; ;; FEATURES: ;; ;; 1. One command, `hyrolo-fgrep-logical' which prompts for a logical search ;; expression string and displays any matching entries. A sample expression ;; might be: ;; (and (or (not time card) (xor "french balloons" spanish)) teacher pet) ;; ;; By default, only sub-entries with matches are shown, not entire ;; hierarchies of entries, for more intuitive results. Use a prefix argument ;; ;; Either double quotes or parentheses may be used to group multiple ;; words as a single argument. ;; ;; 2. Logical `hyrolo-and', `hyrolo-or', `hyrolo-not', and `hyrolo-xor' rolo ;; entry string filter functions. They take any number of string or ;; boolean arguments and may be nested. NOTE THAT THESE FUNCTIONS ;; SHOULD NEVER BE CALLED DIRECTLY UNLESS THE FREE VARIABLES `start' ;; and `end' ARE BOUND BEFOREHAND. ;; ;; 3. Logical `hyrolo-r-and', `hyrolo-r-or', `hyrolo-r-not', and `hyrolo-r-xor' ;; rolo entry regexp filter functions. They take any number of string or ;; boolean arguments and may be nested. NOTE THAT THESE FUNCTIONS ;; SHOULD NEVER BE CALLED DIRECTLY UNLESS THE FREE VARIABLES `start' ;; and `end' ARE BOUND BEFOREHAND. ;; ;; EXAMPLE PROGRAMMATIC USAGE: ;; ;; (hyrolo-logic (hyrolo-and (hyrolo-not "Tool-And-Die") "secretary")) ;; ;; would find all non-Tool-And-Die Corporation secretaries in your rolo. ;; ;; The logical matching routines are not at all optimal, but then most ;; rolo files are not terribly lengthy either, so results are often ;; displayed quickly. ;;; Code: ;;; ************************************************************************ ;;; Other required Elisp libraries ;;; ************************************************************************ (require 'hyrolo) ;;; ************************************************************************ ;;; Public declarations ;;; ************************************************************************ (declare-function kotl-mode:goto-cell "kotl/kotl-mode") ;;; ************************************************************************ ;;; Public functions ;;; ************************************************************************ ;;;###autoload (defun hyrolo-fgrep-logical (expr &optional count-only include-sub-entries no-sub-entries-out koutline-flag) "Display rolo entries matching EXPR. EXPR is a string that may contain sexpression logical prefix operators. If optional COUNT-ONLY is non-nil, don't display entries, return count of matching entries only. If optional INCLUDE-SUB-ENTRIES flag is non-nil, SEXP will be applied across all sub-entries at once. Default is to apply SEXP to each entry and sub-entry separately. Entries are displayed with all of their sub-entries unless INCLUDE-SUB-ENTRIES is nil and optional NO-SUB-ENTRIES-OUT flag is non-nil. With optional KOUTLINE-FLAG, map entries with `hyrolo-map-kotl' rather than `hyrolo-map-entries'. A complex example of EXPR might be: (and (or (not time card) (xor (and french \"red balloons\") spanish)) teacher pet) which means: (Match neither `time' nor `card' or Match exactly one of (`french' and `red balloons') or (`spanish')) and must include the terms `teacher' as well as `pet' to match. Double quotes may be used to group multiple words as a single argument." (interactive "sLogical rolo search: \nP\nP") (when (called-interactively-p 'any) (setq no-sub-entries-out (not no-sub-entries-out))) (let* ((case-fold-search t) (total-matches)) (cond (koutline-flag (setq expr (format "(hyrolo-logic (quote %S) nil %s %s %s %s)" (read expr) count-only include-sub-entries no-sub-entries-out t)) (setq total-matches (eval (read expr)))) ((string-match-p hyrolo-logical-regexp expr) (setq expr (replace-regexp-in-string "(or " "(| " expr nil t)) (setq expr (replace-regexp-in-string "(xor " "(@ " expr nil t)) (setq expr (replace-regexp-in-string "(not " "(! " expr nil t)) (setq expr (replace-regexp-in-string "(and " "(& " expr nil t)) (setq expr (replace-regexp-in-string "(r-or " "(r-| " expr nil t)) (setq expr (replace-regexp-in-string "(r-xor " "(r-@ " expr nil t)) (setq expr (replace-regexp-in-string "(r-not " "(r-! " expr nil t)) (setq expr (replace-regexp-in-string "(r-and " "(r-& " expr nil t)) (setq expr (replace-regexp-in-string "\"\\([^\"]*\\)\"" "{\\1}" expr nil nil)) (let ((saved-expr expr)) (while (not (equal saved-expr (setq expr (replace-regexp-in-string "\\(\\s-\\)\\([^{}()\" \t\n\r]+\\)\\([^{}()]*\\([()]\\|\\s-\\)\\)" "\\1\"\\2\"\\3" expr nil nil)))) (setq saved-expr expr))) (setq expr (replace-regexp-in-string "{\\([^{}]+\\)}" "\"\\1\"" expr nil nil)) (setq expr (replace-regexp-in-string "(| " "(hyrolo-or start end " expr nil t)) (setq expr (replace-regexp-in-string "(@ " "(hyrolo-xor start end " expr nil t)) (setq expr (replace-regexp-in-string "(! " "(hyrolo-not start end " expr nil t)) (setq expr (replace-regexp-in-string "(& " "(hyrolo-and start end " expr nil t)) (setq expr (replace-regexp-in-string "(r-| " "(hyrolo-r-or start end " expr nil t)) (setq expr (replace-regexp-in-string "(r-@ " "(hyrolo-r-xor start end " expr nil t)) (setq expr (replace-regexp-in-string "(r-! " "(hyrolo-r-not start end " expr nil t)) (setq expr (replace-regexp-in-string "(r-& " "(hyrolo-r-and start end " expr nil t)) (setq expr (format "(hyrolo-logic (quote %S) nil %s %s %s %s)" (read expr) count-only include-sub-entries no-sub-entries-out koutline-flag)) (setq total-matches (eval (read expr)))) (t ;; Search string does not contain embedded logic ;; operators; do a string search instead. (setq total-matches (hyrolo-fgrep expr)))) (if (called-interactively-p 'interactive) (message "%s matching entr%s found in HyRolo." (if (= total-matches 0) "No" total-matches) (if (= total-matches 1) "y" "ies"))) total-matches)) (defun hyrolo-logic (sexp &optional in-bufs count-only include-sub-entries no-sub-entries-out koutline-flag) "Apply SEXP to all entries in optional buffer list, IN-BUFS. Display entries where SEXP is non-nil. If IN-BUFS is nil, `hyrolo-file-list' is used. If optional COUNT-ONLY is non-nil, don't display entries, return count of matching entries only. If optional INCLUDE-SUB-ENTRIES flag is non-nil, apply SEXP across all sub-entries at once. Default is to apply SEXP to each entry and sub-entry separately. Entries are displayed with all of their sub-entries unless INCLUDE-SUB-ENTRIES is nil and optional NO-SUB-ENTRIES-OUT flag is non-nil. With optional KOUTLINE-FLAG, map entries with `hyrolo-map-kotl' rather than `hyrolo-map-entries'. SEXP should utilize the free variables `start' and `end' as the region on which to operate. Return the number of evaluations of SEXP that match entries." (let* ((display-buf (unless count-only (prog1 (hyrolo-set-display-buffer) (erase-buffer) (hyrolo--cache-initialize)))) ;; Temporarily disable magit-auto-revert-mode-enable-in-buffers for hyrolo ;; buffers; not needed and can slow/hang file loading (after-change-major-mode-hook (remove 'magit-auto-revert-mode-enable-in-buffers after-change-major-mode-hook)) (result (mapcar (lambda (buf-or-file) (setq buf-or-file (or (get-buffer buf-or-file) (hyrolo-find-file-noselect buf-or-file))) (hyrolo-map-logic sexp buf-or-file count-only include-sub-entries no-sub-entries-out koutline-flag)) (cond ((null in-bufs) (hyrolo-get-file-list)) ((listp in-bufs) in-bufs) ((list in-bufs))))) (total-matches (apply '+ result))) (unless (or count-only (= total-matches 0)) (hyrolo--post-display-buffer) (hyrolo-display-matches display-buf)) total-matches)) (defun hyrolo-map-logic (sexp hyrolo-buf &optional count-only include-sub-entries _no-sub-entries-out koutline-flag) "Apply logical SEXP to each entry in HYROLO-BUF. Write out matching entries to `hyrolo-display-buffer'. If optional COUNT-ONLY is non-nil, don't display entries, return count of matching entries only. If optional INCLUDE-SUB-ENTRIES flag is non-nil, apply SEXP across all sub-entries at once. Default is to apply SEXP to each entry and sub-entry separately. Entries are displayed with all of their sub-entries unless INCLUDE-SUB-ENTRIES is nil and optional _NO-SUB-ENTRIES-OUT flag is non-nil. With optional KOUTLINE-FLAG, map entries with `hyrolo-map-kotl' rather than `hyrolo-map-entries'. SEXP should utilize the free variables `start' and `end' as the region on which to operate. Return the number of evaluations of SEXP that match entries." (setq hyrolo-buf (or (get-buffer hyrolo-buf) hyrolo-buf)) (if (or (bufferp hyrolo-buf) (when (file-exists-p hyrolo-buf) (setq hyrolo-buf (find-file-noselect hyrolo-buf t)))) (let ((display-buf (hyrolo-set-display-buffer)) (hdr-pos) (num-found 0)) (set-buffer hyrolo-buf) (save-excursion (save-restriction (hyrolo-widen) (goto-char (point-min)) ;; Ensure no entries in outline mode are hidden. (outline-show-all) (when (re-search-forward hyrolo-hdr-regexp nil t 2) (forward-line) (setq hdr-pos (cons (point-min) (point)))) (setq num-found (if koutline-flag (hyrolo-map-kotl sexp hyrolo-buf display-buf hdr-pos count-only include-sub-entries) (hyrolo-map-entries sexp hyrolo-buf display-buf hdr-pos count-only include-sub-entries))))) (hyrolo-kill-buffer hyrolo-buf) num-found) 0)) ;; ;; INTERNAL FUNCTIONS. ;; (defun hyrolo-map-entries (sexp hyrolo-buf display-buf hdr-pos &optional count-only include-sub-entries) "Apply logical SEXP to each entry in HYROLO-BUF. Write out matching entries to DISPLAY-BUF. HDR-POS is a cons of \(start . end) positions of HYROLO-BUF's file header, if any; otherwise, nil. If optional COUNT-ONLY is non-nil, don't display entries, return count of matching entries only. If optional INCLUDE-SUB-ENTRIES flag is non-nil, apply SEXP across all sub-entries at once. Default is to apply SEXP to each entry and sub-entry separately. Entries are displayed with all of their sub-entries unless INCLUDE-SUB-ENTRIES is nil. SEXP should utilize the free variables `start' and `end' as the region on which to operate. Return the number of evaluations of SEXP that match entries." (let* ((start) (end) (end-entry-hdr) (num-found 0)) (while (re-search-forward hyrolo-hdr-and-entry-regexp nil t) (setq end-entry-hdr (match-end hyrolo-entry-group-number) start (match-beginning hyrolo-entry-group-number) end (hyrolo-to-entry-end include-sub-entries)) (let ((result (eval sexp `((start . ,start) (end . ,end))))) (unless count-only (and result (= num-found 0) (let* ((src (or (hypb:buffer-file-name hyrolo-buf) hyrolo-buf)) (src-line (format (concat (if (boundp 'hbut:source-prefix) hbut:source-prefix "@loc> ") "%s") (prin1-to-string src)))) (set-buffer display-buf) (goto-char (point-max)) (if hdr-pos (progn (insert-buffer-substring hyrolo-buf (car hdr-pos) (cdr hdr-pos)) (insert src-line "\n\n")) (insert (format hyrolo-hdr-format src-line))) (set-buffer hyrolo-buf)))) (if result (progn (goto-char end) (setq num-found (1+ num-found)) (unless count-only (append-to-buffer display-buf start end) (hyrolo--cache-major-mode hyrolo-buf))) (goto-char end-entry-hdr)))) num-found)) (defun hyrolo-map-kotl (sexp hyrolo-buf display-buf hdr-pos &optional count-only include-sub-entries) "Apply logical SEXP to each entry in HYROLO-BUF. Write out matching entries to DISPLAY-BUF. HDR-POS is a cons of \(start . end) positions of HYROLO-BUF's file header, if any; otherwise, nil. If optional COUNT-ONLY is non-nil, don't display entries, return count of matching entries only. If optional INCLUDE-SUB-ENTRIES flag is non-nil, apply SEXP across all sub-entries at once. Default is to apply SEXP to each entry and sub-entry separately. Entries are displayed with all of their sub-entries unless INCLUDE-SUB-ENTRIES is nil. SEXP should utilize the free variables `start' and `end' as the region on which to operate. Return the number of evaluations of SEXP that match entries." (let* ((start) (end) (end-entry-hdr) (num-found 0) result) (mapc (lambda (cell-ref) (when (setq result (kotl-mode:goto-cell cell-ref)) (setq end-entry-hdr (point) start (line-beginning-position) end (hyrolo-to-entry-end include-sub-entries)) (unless count-only (and result (= num-found 0) (let* ((src (or (hypb:buffer-file-name hyrolo-buf) hyrolo-buf)) (src-line (format (concat (if (boundp 'hbut:source-prefix) hbut:source-prefix "@loc> ") "%s") (prin1-to-string src)))) (set-buffer display-buf) (goto-char (point-max)) (if hdr-pos (progn (insert-buffer-substring hyrolo-buf (car hdr-pos) (cdr hdr-pos)) (insert src-line "\n\n")) (insert (format hyrolo-hdr-format src-line))) (set-buffer hyrolo-buf)))) (if result (progn (goto-char end) (setq num-found (1+ num-found)) (unless count-only (append-to-buffer display-buf start end) (hyrolo--cache-major-mode (current-buffer)))) (goto-char end-entry-hdr)))) sexp) num-found)) ;; Do NOT call the following functions directly. ;; Send them as parts of an expression to `hyrolo-logic'. ;; Work with string patterns (defun hyrolo-not (start end &rest pat-list) "Logical string rolo entry filter between START and END positions. PAT-LIST is a list of pattern elements. Each element may be t, nil, or a string." (save-restriction (narrow-to-region start end) (let ((pat)) (while (and pat-list (or (null (setq pat (car pat-list))) (and (stringp pat) (goto-char start) (not (funcall hyrolo-next-match-function (regexp-quote pat)))))) (setq pat-list (cdr pat-list))) (not pat-list)))) (defun hyrolo-or (start end &rest pat-list) "Logical string rolo entry filter between START and END positions. PAT-LIST is a list of pattern elements. Each element may be t, nil, or a string." (if (memq t pat-list) t (save-restriction (narrow-to-region start end) (let ((pat)) (while (and pat-list (or (null (setq pat (car pat-list))) (and (stringp pat) (goto-char start) (not (funcall hyrolo-next-match-function (regexp-quote pat)))))) (setq pat-list (cdr pat-list))) (if pat-list t nil))))) (defun hyrolo-xor (start end &rest pat-list) "Logical string rolo entry filter between START and END positions. PAT-LIST is a list of pattern elements. Each element may be t, nil, or a string." (save-restriction (narrow-to-region start end) (let ((pat) (matches 0)) (while (and pat-list (or (not (setq pat (car pat-list))) (and (or (eq pat t) (not (goto-char start)) (funcall hyrolo-next-match-function (regexp-quote pat))) (setq matches (1+ matches))) t) (< matches 2)) (setq pat-list (cdr pat-list))) (= matches 1)))) (defun hyrolo-and (start end &rest pat-list) "Logical string rolo entry filter between START and END positions. PAT-LIST is a list of pattern elements. Each element may be t, nil, or a string." (unless (memq nil pat-list) (save-restriction (narrow-to-region start end) (let ((pat)) (while (and pat-list (setq pat (car pat-list)) (or (eq pat t) (not (goto-char start)) (funcall hyrolo-next-match-function (regexp-quote pat)))) (setq pat-list (cdr pat-list))) (not pat-list))))) ;; Work with regular expression patterns rather than strings (defun hyrolo-r-not (start end &rest pat-list) "Logical regexp rolo entry filter between START and END positions. PAT-LIST is a list of pattern elements. Each element may be t, nil, or a regular expression." (save-restriction (narrow-to-region start end) (let ((pat)) (while (and pat-list (or (null (setq pat (car pat-list))) (and (stringp pat) (goto-char start) (not (funcall hyrolo-next-match-function pat))))) (setq pat-list (cdr pat-list))) (not pat-list)))) (defun hyrolo-r-or (start end &rest pat-list) "Logical regexp rolo entry filter between START and END positions. PAT-LIST is a list of pattern elements. Each element may be t, nil, or a regular expression." (if (memq t pat-list) t (save-restriction (narrow-to-region start end) (let ((pat)) (while (and pat-list (or (null (setq pat (car pat-list))) (and (stringp pat) (goto-char start) (not (funcall hyrolo-next-match-function pat))))) (setq pat-list (cdr pat-list))) (if pat-list t nil))))) (defun hyrolo-r-xor (start end &rest pat-list) "Logical regexp rolo entry filter between START and END positions. PAT-LIST is a list of pattern elements. Each element may be t, nil, or a regular expression." (save-restriction (narrow-to-region start end) (let ((pat) (matches 0)) (while (and pat-list (or (not (setq pat (car pat-list))) (and (or (eq pat t) (not (goto-char start)) (funcall hyrolo-next-match-function pat)) (setq matches (1+ matches))) t) (< matches 2)) (setq pat-list (cdr pat-list))) (= matches 1)))) (defun hyrolo-r-and (start end &rest pat-list) "Logical regexp rolo entry filter between START and END positions. PAT-LIST is a list of pattern elements. Each element may be t, nil, or a regular expression." (unless (memq nil pat-list) (save-restriction (narrow-to-region start end) (let ((pat)) (while (and pat-list (setq pat (car pat-list)) (or (eq pat t) (not (goto-char start)) (funcall hyrolo-next-match-function pat))) (setq pat-list (cdr pat-list))) (not pat-list))))) (provide 'hyrolo-logic) ;;; hyrolo-logic.el ends here