;;!emacs
;;
;; FILE:         wrolo.el V2 (Renamed from rolo.el in earlier versions to avoid
;;                            load path conflicts with the rolo.el written by
;;                            another author.)
;; SUMMARY:      Hierarchical, multi-file, easy to use rolo system
;; USAGE:        GNU Emacs Lisp Library
;; KEYWORDS:     hypermedia, matching
;;
;; AUTHOR:       Bob Weiner
;; ORG:          BeOpen.com
;;
;; ORIG-DATE:     7-Jun-89 at 22:08:29
;; LAST-MOD:     25-Jun-99 at 20:47:37 by Bob Weiner
;;
;; Copyright (C) 1991-1999, BeOpen.com and the Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of Hyperbole.

;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************

(require 'custom) ;; For defface.
(require 'hversion)
(require 'hmail)
(require 'htz)
(autoload 'rolo-fgrep-logical "wrolo-logic"
  "rolo search with logical operators." t)

;;; ************************************************************************
;;; Public variables
;;; ************************************************************************

(defvar rolo-display-format-function 'identity
  "*Function of one argument, a rolo entry string, which modifies the string for display.")

(defvar rolo-email-format "%s\t\t<%s>"
  "Format string to use when adding an entry with e-mail addr from a mail msg.
It must contain a %s indicating where to put the entry name and a second
%s indicating where to put the e-mail address.")

(defvar rolo-file-list
  (if hyperb:microcruft-os-p '("c:/_rolo.otl") '("~/.rolo.otl"))
  "*List of files containing rolo entries.
The first file should be a user-specific rolo file, typically in the home
directory.

A rolo-file consists of:
   (1) an optional header beginning with and ending with a line which matches
       rolo-hdr-regexp;
   (2) one or more rolo entries which each begin with
       rolo-entry-regexp and may be nested.")

(defvar rolo-highlight-face nil
  "*Face used to highlight rolo search matches.")
(if rolo-highlight-face
    nil
  (setq rolo-highlight-face
	(cond (hyperb:emacs19-p
	       (if (fboundp 'defface)
		   (progn (defface rolo-highlight-face nil
			    "*Face used to highlight rolo search matches.")
			  'rolo-highlight-face)))
	      (t (if (fboundp 'defface)
		     (face-name
		      (defface rolo-highlight-face nil
			"*Face used to highlight rolo search matches."))))))
  (if (fboundp 'hproperty:set-item-highlight)
      (hproperty:set-item-highlight)))

(defvar rolo-kill-buffers-after-use nil
  "*Non-nil means kill rolo file buffers after searching them for entries.
Only unmodified buffers are killed.")

(defvar rolo-save-buffers-after-use t
  "*Non-nil means save rolo file after an entry is killed.")

;; Insert or update the entry date each time an entry is added or edited.
(add-hook 'wrolo-add-hook 'rolo-set-date)
(add-hook 'wrolo-edit-hook 'rolo-set-date)

(defvar wrolo-yank-reformat-function nil
  "*Value is a function of two arguments, START and END, invoked after a rolo-yank.
It should reformat the region given by the arguments to some preferred style.
Default value is nil, meaning no reformmating is done.")

;;; ************************************************************************
;;; Commands
;;; ************************************************************************

;;;###autoload
(defun rolo-add (name &optional file)
  "Adds a new entry in personal rolo for NAME.
Last name first is best, e.g. \"Smith, John\".
With prefix argument, prompts for optional FILE to add entry within.
NAME may be of the form: parent/child to insert child below a parent
entry which begins with the parent string."
  (interactive
   (progn
     (or (fboundp 'mail-fetch-field) (require 'mail-utils))
     (let* ((lst (rolo-name-and-email))
	    (name (car lst))
	    (email (car (cdr lst)))
	    (entry (read-string "Name to add to rolo: "
				(or name email))))
       (list (if (and email name
		      (string-match (concat "\\`" (regexp-quote entry)) name))
		 (format rolo-email-format entry email) entry)
	     current-prefix-arg))))
  (if (or (not (stringp name)) (string= name ""))
      (error "(rolo-add): Invalid name: `%s'" name))
  (if (and (interactive-p) file)
      (setq file (completing-read "File to add to: "
				  (mapcar 'list rolo-file-list))))
  (if (null file) (setq file (car rolo-file-list)))
  (cond ((and file (or (not (stringp file)) (string= file "")))
	 (error "(rolo-add): Invalid file: `%s'" file))
	((and (file-exists-p file) (not (file-readable-p file)))
	 (error "(rolo-add): File not readable: `%s'" file))
	((not (file-writable-p file))
	 (error "(rolo-add): File not writable: `%s'" file)))
  (set-buffer (or (get-file-buffer file) (find-file-noselect file)))
  (if (interactive-p) (message "Locating insertion point for `%s'..." name))
  (let ((parent "") (level "") end)
    (widen) (goto-char 1)
    (while (string-match "\\`[^\]\[<>{}\"]*/" name)
      (setq end (1- (match-end 0))
	    parent (substring name 0 end)
	    name (substring name (min (1+ end) (length name))))
      (if (re-search-forward
	   (concat "\\(" rolo-entry-regexp "\\)[ \t]*" 
		   (regexp-quote parent)) nil t)
	  (setq level (buffer-substring (match-beginning 1)
					(match-end 1)))
	(error "(rolo-add): `%s' category not found in \"%s\"."
	       parent file)))
    (narrow-to-region (point)
		      (progn (rolo-to-entry-end t level) (point)))
    (let* ((len (length name))
	   (name-level (concat level "*"))
	   (level-len (length name-level))
	   (first-char (aref name 0))
	   (entry "")
	   (entry-spc "")
	   (entry-level)
	   (match)
	   (again t))
      ;; Speed up entry insertion point location if this is a first-level
      ;; entry by moving to an entry with the same (or nearest) first character
      ;; to that of `name'.
      (if (and (= level-len 1)
	       (equal rolo-entry-regexp "^\\*+"))
	  (progn (goto-char (point-min))
		 (if (re-search-forward (concat "^\\*[ \t]*"
						(char-to-string first-char))
					nil t)
		     (goto-char (match-beginning 0))
		   (goto-char (point-max))
		   (if (and (> first-char ?0)
			    (re-search-backward
			     (concat "^\\*[ \t]*["
				     (substring
				      "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
				      0 (min (- first-char ?0) 62))
				     "]")
			     nil t))
		       (progn (goto-char (match-end 0))
			      (rolo-to-entry-end t entry-level)
			      ;; Now at the insertion point, immediately after
			      ;; the last existing entry whose first character
			      ;; is less than that of `name'.  Setting `again'
			      ;; to nil prevents further searching for an
			      ;; insertion point.
			      (setq again nil)))))
	(goto-char (point-min)))

      (while (and again
		  (re-search-forward
		   (concat "\\(" rolo-entry-regexp "\\)\\([ \t]*\\)")
		   nil 'end))
	(setq entry-level (buffer-substring (match-beginning 1)
					    (match-end 1)))
	(if (/= (length entry-level) level-len)
	    (rolo-to-entry-end t entry-level)
	  (setq entry (buffer-substring (point) (+ (point) len))
		entry-spc (buffer-substring (match-beginning 2)
					    (match-end 2)))
	  (cond ((string< entry name)
		 (rolo-to-entry-end t entry-level))
		((string< name entry)
		 (setq again nil) (beginning-of-line))
		(t ;; found existing entry matching name
		 (setq again nil match t)))))
      (setq buffer-read-only nil)
      (if match
	  nil
	(insert (or entry-level (concat level "*"))
		(if (string= entry-spc "") "   " entry-spc)
		name "\n")
	(backward-char 1))
      ;; Rolo-to-buffer may move point from its desired location, so
      ;; restore it.
      (let ((opoint (point)))
	(widen)
	(rolo-to-buffer (current-buffer))
	(goto-char opoint))
      (run-hooks 'wrolo-add-hook)
      (if (interactive-p)
	  (message "Edit entry at point.")))))

;;;###autoload
(defun rolo-display-matches (&optional display-buf return-to-buffer)
  "Display optional DISPLAY-BUF buffer of previously found rolo matches.
If DISPLAY-BUF is nil, use the value in `rolo-display-buffer'.
Second arg RETURN-TO-BUFFER is the buffer to leave point within after the display."
  (interactive)
  (or display-buf (setq display-buf (get-buffer rolo-display-buffer)))
  (if display-buf nil
    (error "(rolo-display-matches): Search the rolo first."))
  ;; Save current window configuration if rolo match buffer is not
  ;; displayed in one of the windows already.
  (or
   ;; Handle both Emacs V18 and V19 versions of get-buffer-window.
   (condition-case ()
       (get-buffer-window display-buf (selected-frame))
     (error (get-buffer-window display-buf)))
   (setq *rolo-wconfig* (current-window-configuration)))
  (rolo-to-buffer display-buf)
  (if (eq major-mode 'wrolo-mode) nil (wrolo-mode))
  (setq buffer-read-only nil)
  (if (fboundp 'hproperty:but-create) (hproperty:but-create))
  (rolo-shrink-window)
  (goto-char (point-min))
  (set-buffer-modified-p nil)
  (setq buffer-read-only t)
  (run-hooks 'wrolo-display-hook)
  ;; Leave point in match buffer unless a specific RETURN-TO-BUFFER has
  ;; been specified.  Use {q} to quit and restore display.
  (if return-to-buffer (rolo-to-buffer return-to-buffer)))

;;;###autoload
(defun rolo-edit (&optional name file)
  "Edits a rolo entry given by optional NAME within `rolo-file-list'.
With prefix argument, prompts for optional FILE to locate entry within.
With no NAME arg, simply displays FILE or first entry in `rolo-file-list' in an
editable mode.  NAME may be of the form: parent/child to edit child below a
parent entry which begins with the parent string."
  (interactive "sEdit rolo entry named: \nP")
  (if (string-equal name "") (setq name nil))
  (and name (not (stringp name))
       (error "(rolo-edit): Invalid name: `%s'" name))
  (if (and (interactive-p) current-prefix-arg)
      (if (= (length rolo-file-list) 1)
	  (setq file (car rolo-file-list))
	(setq file (completing-read "Entry's File: "
				    (mapcar 'list rolo-file-list)))))
  (let ((found-point) (file-list (if file (list file) rolo-file-list)))
    (or file (setq file (car file-list)))
    (if (null name)
	(progn (if (not (file-writable-p file))
		  (error "(rolo-edit): File not writable: `%s'" file))
	       (find-file-other-window file) (setq buffer-read-only nil))
      (if (setq found-point (rolo-to name file-list))
	  (progn
	    (setq file buffer-file-name)
	    (if (file-writable-p file)
		(setq buffer-read-only nil)
	      (message
	       "(rolo-edit): Entry found but file not writable: `%s'" file)
	      (beep))
	    (rolo-to-buffer (current-buffer)))
	(message "(rolo-edit): `%s' not found." name)
	(beep)
	(rolo-to-buffer (or (get-file-buffer (car file-list))
			    (find-file-noselect (car file-list))))
	(setq buffer-read-only nil))
      (widen)
      ;; Rolo-to-buffer may have moved point from its desired location, so
      ;; restore it.
      (if found-point (goto-char found-point))
      (run-hooks 'wrolo-edit-hook))))

(defun rolo-edit-entry ()
  "Edit the source entry of the rolo match buffer entry at point.
Returns entry name if found, else nil."
  (interactive)
  (let ((name (rolo-name-at)))
    (if name (progn (rolo-edit name (hbut:key-src))
		    name))))

;;;###autoload
(defun rolo-fgrep (string &optional max-matches rolo-file count-only no-display)
  "Display rolo entries matching STRING (or a logical match expression).
To a maximum of optional prefix arg MAX-MATCHES, in file(s) from optional
ROLO-FILE or `rolo-file-list'.  Default is to find all matching entries.
Each entry is displayed with all of its sub-entries.  Optional COUNT-ONLY
non-nil means don't retrieve and don't display matching entries.  Optional
NO-DISPLAY non-nil means retrieve entries but don't display.

Nil value of MAX-MATCHES means find all matches, t value means find all
matches but omit file headers, negative values mean find up to the inverse of
that number of entries and omit file headers.

Returns number of entries matched.  See also documentation for the variable
`rolo-file-list' and the function `rolo-fgrep-logical' for documentation on
the logical expression matching."
  (interactive "sFind rolo string (or logical expression): \nP")
  (let ((total-matches
	 (if (string-match "\(\\(and\\|or\\|xor\\|not\\)\\>" string)
	     ;; Search string contains embedded logic operators.
	     (rolo-fgrep-logical string)
	   (rolo-grep (regexp-quote string) max-matches
		      rolo-file count-only no-display))))
    (if (interactive-p)
	(message "%s matching entr%s found in rolo."
		 (if (= total-matches 0) "No" total-matches)
		 (if (= total-matches 1) "y" "ies")))
    total-matches))

;;;###autoload
(defun rolo-grep (regexp &optional max-matches rolo-bufs count-only no-display)
  "Display rolo entries matching REGEXP.
To a maximum of prefix arg MAX-MATCHES, in buffer(s) from optional ROLO-BUFS or
rolo-file-list.  Default is to find all matching entries.  Each entry is
displayed with all of its sub-entries.  Optional COUNT-ONLY non-nil means don't
retrieve and don't display matching entries.  Optional NO-DISPLAY non-nil
means retrieve entries but don't display.

Nil value of MAX-MATCHES means find all matches, t value means find all matches
but omit file headers, negative values mean find up to the inverse of that
number of entries and omit file headers.

Returns number of entries matched.  See also documentation for the variable
rolo-file-list."
  (interactive "sFind rolo regular expression: \nP")
  (let ((rolo-file-list
	 (cond ((null rolo-bufs) rolo-file-list)
	       ((listp rolo-bufs) rolo-bufs)
	       ((list rolo-bufs))))
	(display-buf (if count-only
			 nil
		       (set-buffer (get-buffer-create rolo-display-buffer))))
	(total-matches 0)
	(num-matched 0)
	(inserting (or (eq max-matches t)
		       (and (integerp max-matches) (< max-matches 0))))
	(file))
    (if count-only nil
      (setq buffer-read-only nil)
      (or inserting (erase-buffer)))
    (while (and (setq file (car rolo-file-list))
		(or (not (integerp max-matches))
		    (< total-matches (max max-matches (- max-matches)))))
      (setq rolo-file-list (cdr rolo-file-list)
	    num-matched (rolo-grep-file file regexp max-matches count-only)
	    total-matches (+ total-matches num-matched))
      (if (integerp max-matches)
	  (setq max-matches
		(if (>= max-matches 0)
		    (- max-matches num-matched)
		  (+ max-matches num-matched)))))
    (if (or count-only no-display inserting (= total-matches 0))
	nil
      (rolo-display-matches display-buf))
    (if (interactive-p)
	(message "%s matching entr%s found in rolo."
		 (if (= total-matches 0) "No" total-matches)
		 (if (= total-matches 1) "y" "ies")
		 ))
    total-matches))

(defun rolo-isearch ()
  "Interactively search forward for next occurrence of current match regexp.
Use this to add characters to further narrow the search."
  (interactive)
  (if (equal (buffer-name) rolo-display-buffer)
      (execute-kbd-macro (concat "\e\C-s" rolo-match-regexp))
    (error "(rolo-isearch): Use this command in the %s match buffer"
	   rolo-display-buffer)))

;;;###autoload
(defun rolo-kill (name &optional file)
  "Kills a rolo entry given by NAME within `rolo-file-list'.
With prefix argument, prompts for optional FILE to locate entry within.
NAME may be of the form: parent/child to kill child below a parent entry
which begins with the parent string.
Returns t if entry is killed, nil otherwise."
  (interactive "sKill rolo entry named: \nP")
  (if (or (not (stringp name)) (string= name ""))
      (error "(rolo-kill): Invalid name: `%s'" name))
  (if (and (interactive-p) current-prefix-arg)
      (setq file (completing-read "Entry's File: "
				  (mapcar 'list rolo-file-list))))
  (let ((file-list (if file (list file) rolo-file-list))
	(killed))
    (or file (setq file (car file-list)))
    (if (rolo-to name file-list)
	(progn
	  (setq file buffer-file-name)
	  (if (file-writable-p file)
	      (let ((kill-op
		     (function (lambda (start level)
				 (kill-region
				  start (rolo-to-entry-end t level))
				 (setq killed t)
				 (rolo-save-buffer)
				 (rolo-kill-buffer))))
		    start end level)
		(setq buffer-read-only nil)
		(re-search-backward rolo-entry-regexp nil t)
		(setq end (match-end 0))
		(beginning-of-line)
		(setq start (point)
		      level (buffer-substring start end))
		(goto-char end)
		(skip-chars-forward " \t")
		(if (interactive-p)
		    (let ((entry-line (buffer-substring
				       (point)
				       (min (+ (point) 60)
					    (progn (end-of-line) (point))))))
		      (if (y-or-n-p (format "Kill `%s...' " entry-line))
			  (progn
			    (funcall kill-op start level)
			    (message "Killed"))
			(message "Aborted")))
		  (funcall kill-op start level)))
	    (message
	     "(rolo-kill): Entry found but file not writable: `%s'" file)
	    (beep)))
      (message "(rolo-kill): `%s' not found." name)
      (beep))
    killed))

(defun rolo-locate (start-string)
  "Interactively search for an entry beginning with a set of search characters."
  (interactive (list ""))
  (execute-kbd-macro (concat "\e\C-s" rolo-entry-regexp "[ \t]*" start-string)))

(defun rolo-mail-to ()
  "Start composing mail addressed to the first e-mail address at or after point."
  (interactive)
  (let ((opoint (point)) button)
    (skip-chars-backward "^ \t\n\r<>")
    (if (and (re-search-forward mail-address-regexp nil t)
	     (goto-char (match-beginning 1))
	     (setq button (ibut:at-p)))
	(hui:hbut-act button)
      (goto-char opoint)
      (beep)
      (message "(rolo-mail-to): Invalid buffer or no e-mail address found"))))

(defun rolo-next-match ()
  "Move point forward to the start of the next rolo search match."
  (interactive)
  (if (not (stringp rolo-match-regexp))
      (error "(rolo-next-match): Invoke a rolo search expression first"))
  (let ((start (point))
	(case-fold-search t))
    (if (looking-at rolo-match-regexp)
	(goto-char (match-end 0)))
    (if (re-search-forward rolo-match-regexp nil t)
	(goto-char (match-beginning 0))
      (goto-char start)
      (error
       "(rolo-next-match): No following matches for \"%s\"" rolo-match-regexp))))

(defun rolo-previous-match ()
  "Move point back to the start of the previous rolo search match."
  (interactive)
  (if (not (stringp rolo-match-regexp))
      (error "(rolo-previous-match): Invoke a rolo search expression first"))
  (let ((case-fold-search t))
    (if (re-search-backward rolo-match-regexp nil t)
	nil
      (error
       "(rolo-previous-match): No prior matches for \"%s\"" rolo-match-regexp))))

(defun rolo-prompt (keyboard-function dialog-box-function prompt)
  "Use KEYBOARD-FUNCTION or DIALOG-BOX-FUNCTION, if available, to PROMPT for a yes/no answer."
  (if (and (not (eq (device-type) 'tty))
	   (fboundp 'yes-or-no-p-maybe-dialog-box))
      (funcall dialog-box-function prompt)
    (funcall keyboard-function prompt)))

(defun rolo-quit ()
  "Quit from the rolo match buffer and restore the prior frame display."
  (interactive)
  (bury-buffer)
  (if (and *rolo-wconfig*
	   (if (fboundp 'window-configuration-p)
	       (window-configuration-p *rolo-wconfig*)
	     t))
      (set-window-configuration *rolo-wconfig*)))

(defun rolo-rename (old-file new-file)
  "Prompt user to rename OLD-FILE to NEW-FILE."
  (interactive (if hyperb:microcruft-os-p
		   '("c:/_rolodex.otl" "c:/_rolo.otl")
		 '("~/.rolodex.otl" "~/.rolo.otl")))
  (if (and (equal (car rolo-file-list) new-file)
	   (file-readable-p old-file)
	   (progn (beep)
		  (or (rolo-prompt
		       'y-or-n-p 'yes-or-no-p-dialog-box
		       (format "(rolo-rename): Rename \"%s\" to the new standard \"%s\"? "
			       old-file new-file))
		      ;; Setup to get rolo matches from OLD-FILE.
		      (progn (setq rolo-file-list
				   (cons old-file (cdr rolo-file-list)))
			     nil))))
      (progn (rename-file old-file new-file 1)
	     ;; Also rename backup file if it exists.
	     (if (file-readable-p (concat old-file "~"))
		 (rename-file (concat old-file "~") (concat new-file "~") 1))
	     (if (get-file-buffer old-file)
		 (save-excursion
		   (set-buffer (get-file-buffer old-file))
		   (rename-buffer (file-name-nondirectory new-file))
		   (setq buffer-file-name (expand-file-name new-file))))
	     (message "(rolo-rename): Your personal rolo file is now: \"%s\"."
		      new-file))))

;;;###autoload
(defun rolo-sort (&optional rolo-file)
  "Sorts up to 14 levels of entries in ROLO-FILE (default is personal rolo).
Assumes entries are delimited by one or more `*'characters.
Returns list of number of groupings at each entry level." 
  (interactive
   (list (let ((default "")
	       (file))
	 (setq file
	       (completing-read
		(format "Sort rolo file (default %s): "
			(file-name-nondirectory
			 (setq default
			       (if (and buffer-file-name
					(memq
					 t (mapcar
					    (function
					     (lambda (file)
					       (equal buffer-file-name
						      (expand-file-name file))))
					    rolo-file-list)))
				   buffer-file-name
				 (car rolo-file-list)))))
		(mapcar 'list rolo-file-list)))
	 (if (string= file "") default file))))
  (if (or (not rolo-file) (equal rolo-file ""))
      (setq rolo-file (car rolo-file-list)))
  (if (not (and (stringp rolo-file) (file-readable-p rolo-file)))
      (error "(rolo-sort): Invalid or unreadable file: %s" rolo-file))
  (let ((level-regexp (regexp-quote "**************"))
	(entries-per-level-list)
	(n))
    (while (not (equal level-regexp ""))
      (setq n (rolo-sort-level rolo-file level-regexp))
      (if (or (/= n 0) entries-per-level-list)
	  (setq entries-per-level-list
		(append (list n) entries-per-level-list)))
      (setq level-regexp (substring level-regexp 0 (- (length level-regexp) 2))))
    entries-per-level-list))

(defun rolo-sort-level (rolo-file level-regexp &optional max-groupings)
  "Sorts groupings of entries in ROLO-FILE at hierarchy level LEVEL-REGEXP.
To a maximum of optional MAX-GROUPINGS.  Nil value of MAX-GROUPINGS means all
groupings at the given level.  LEVEL-REGEXP should simply match the text of
any rolo entry of the given level, not the beginning of a line (^); an
example, might be (regexp-quote \"**\") to match level two.  Returns number
of groupings sorted."
  (interactive "sSort rolo file: \nRegexp for level's entries: \nP")
  (let ((sort-fold-case t))
    (rolo-map-level
     (function (lambda (start end) (sort-lines nil start end)))
     rolo-file
     level-regexp
     max-groupings)))

;;;###autoload
(defun rolo-toggle-datestamps (&optional arg)
  "Toggle whether datestamps are updated when rolo entries are modified.
With optional ARG, turn them on iff ARG is positive."
  (interactive "P")
  (if (or (and arg (<= (prefix-numeric-value arg) 0))
	  (and (not (and arg (> (prefix-numeric-value arg) 0)))
	       (boundp 'wrolo-add-hook) (listp wrolo-add-hook)
	       (memq 'rolo-set-date wrolo-add-hook)))
      (progn (remove-hook 'wrolo-add-hook 'rolo-set-date)
	     (remove-hook 'wrolo-edit-hook 'rolo-set-date)
	     (message "rolo date stamps are now turned off."))
    (add-hook 'wrolo-add-hook 'rolo-set-date)
    (add-hook 'wrolo-edit-hook 'rolo-set-date)
    (message "rolo date stamps are now turned on.")))

(defun rolo-toggle-narrow-to-entry ()
  "Toggle between display of current entry and display of all matched entries.
Useful when bound to a mouse key."
  (interactive)
  (if (rolo-narrowed-p)
      (widen)
    (if (or (looking-at rolo-entry-regexp)
	    (re-search-backward rolo-entry-regexp nil t))
	(progn (forward-char)
	       (narrow-to-region (1- (point)) (rolo-display-to-entry-end)))))
  (rolo-shrink-window)
  (goto-char (point-min)))

(defun rolo-word (string
		  &optional max-matches rolo-file count-only no-display)
  "Display rolo entries with whole word matches for STRING.
To a maximum of optional prefix arg MAX-MATCHES, in file(s) from optional
ROLO-FILE or rolo-file-list.  Default is to find all matching entries.  Each
entry is displayed with all of its sub-entries.  Optional COUNT-ONLY non-nil
means don't retrieve and don't display matching entries.  Optional NO-DISPLAY
non-nil means retrieve entries but don't display.

Nil value of MAX-MATCHES means find all matches, t value means find all matches
but omit file headers, negative values mean find up to the inverse of that
number of entries and omit file headers.

Returns number of entries matched.  See also documentation for the variable
rolo-file-list."
  (interactive "sFind rolo whole word matches of: \nP")
  (let ((total-matches (rolo-grep (format "\\b%s\\b" (regexp-quote string))
				  max-matches
				  rolo-file count-only no-display)))
    (if (interactive-p)
	(message "%s matching entr%s found in the rolo."
		 (if (= total-matches 0) "No" total-matches)
		 (if (= total-matches 1) "y" "ies")))
    total-matches))

;;;###autoload
(defun rolo-yank (name &optional regexp-p)
  "Inserts at point the first rolo entry matching NAME.
With optional prefix arg, REGEXP-P, treats NAME as a regular expression instead
of a string."
  (interactive "sInsert rolo entry named: \nP")
  (let ((rolo-display-buffer (current-buffer))
	(start (point))
	found)
    (save-excursion
      (setq found (if regexp-p
		      (rolo-grep name -1)
		    (rolo-grep (regexp-quote name) -1))))
    ;; Let user reformat the region just yanked.
    (if (and (= found 1) (fboundp wrolo-yank-reformat-function))
	(funcall wrolo-yank-reformat-function start (point)))
    found))

;;; ************************************************************************
;;; Public functions
;;; ************************************************************************

(defun rolo-fgrep-file (rolo-buf string &optional max-matches count-only)
  "Retrieve entries in ROLO-BUF matching STRING to a maximum of optional MAX-MATCHES.
Nil value of MAX-MATCHES means find all matches, t value means find all matches
but omit file headers, negative values mean find up to the inverse of that
number of entries and omit file headers.  Optional COUNT-ONLY non-nil
means don't retrieve matching entries.
Returns number of matching entries found."
  (rolo-grep-file rolo-buf (regexp-quote string) max-matches count-only))

(defun rolo-grep-file (rolo-buf regexp &optional max-matches count-only)
  "Retrieve entries in ROLO-BUF matching REGEXP to a maximum of optional MAX-MATCHES.
Nil value of MAX-MATCHES means find all matches, t value means find all matches
but omit file headers, negative values mean find up to the inverse of that
number of entries and omit file headers.  Optional COUNT-ONLY non-nil
means don't retrieve matching entries.
Returns number of matching entries found."
  ;;
  ;; Save regexp as last rolo search expression.
  (setq rolo-match-regexp regexp)
  ;;
  (let ((new-buf-p) (actual-buf))
    (if (and (or (null max-matches) (eq max-matches t) (integerp max-matches))
	     (or (setq actual-buf (rolo-buffer-exists-p rolo-buf))
		 (if (file-exists-p rolo-buf)
		     (setq actual-buf (find-file-noselect rolo-buf t)
			   new-buf-p t))))
	(let ((hdr-pos) (num-found 0) (curr-entry-level)
	      (incl-hdr t) start next-entry-exists)
	  (if max-matches
	      (cond ((eq max-matches t)
		     (setq incl-hdr nil max-matches nil))
		    ((< max-matches 0)
		     (setq incl-hdr nil
			   max-matches (- max-matches)))))
	  (set-buffer actual-buf)
	  (if new-buf-p (setq buffer-read-only t))
	  (save-excursion
	    (save-restriction
	      (widen)
	      (goto-char 1)
	      ;; Ensure no entries in outline mode are hidden.
	      ;; Uses `show-all' function from outline.el.
	      (if (search-forward "\r" nil t)
		  (show-all))
	      (if (re-search-forward rolo-hdr-regexp nil t 2)
		  (progn (forward-line)
			 (setq hdr-pos (cons (point-min) (point)))))
	      (re-search-forward rolo-entry-regexp nil t)
	      (while (and (or (null max-matches) (< num-found max-matches))
			  (re-search-forward regexp nil t))
		(re-search-backward rolo-entry-regexp nil t)
		(setq start (point)
		      next-entry-exists nil)
		(re-search-forward rolo-entry-regexp nil t)
		(setq curr-entry-level (buffer-substring start (point)))
		(rolo-to-entry-end t curr-entry-level)
		(or count-only
		    (if (and (zerop num-found) incl-hdr)
			(let* ((src (or (buffer-file-name actual-buf)
					actual-buf))
			       (src-line
				(format
				 (concat (if (boundp 'hbut:source-prefix)
					     hbut:source-prefix
					   "@loc> ")
					 "%s")
				 (prin1-to-string src))))
			  (set-buffer rolo-display-buffer)
			  (goto-char (point-max))
			  (if hdr-pos
			      (progn
				(insert-buffer-substring
				 actual-buf (car hdr-pos) (cdr hdr-pos))
				(insert src-line "\n\n"))
			    (insert (format rolo-hdr-format src-line)))
			  (set-buffer actual-buf))))
		(setq num-found (1+ num-found))
		(or count-only
		    (rolo-add-match rolo-display-buffer regexp start (point))))))
	  (rolo-kill-buffer actual-buf)
	  num-found)
      0)))

(defun rolo-map-level (func rolo-buf level-regexp &optional max-groupings)
  "Perform FUNC on groupings of ROLO-BUF entries at level LEVEL-REGEXP,
to a maximum of optional argument MAX-GROUPINGS.  Nil value of MAX-GROUPINGS
means all groupings at the given level.  FUNC should take two arguments, the
start and the end of the region that it should manipulate.  LEVEL-REGEXP
should simply match the text of any rolo entry of the given level, not the
beginning of a line (^); an example, might be (regexp-quote \"**\") to match
level two.  Returns number of groupings matched."
  (let ((actual-buf))
    (if (and (or (null max-groupings) (< 0 max-groupings))
	     (or (setq actual-buf (rolo-buffer-exists-p rolo-buf))
		 (if (file-exists-p rolo-buf)
		     (progn (setq actual-buf (find-file-noselect rolo-buf t))
			    t))))
	(progn
	  (set-buffer actual-buf)
	  (let ((num-found 0)
		(exact-level-regexp (concat "^\\(" level-regexp "\\)[ \t\n\r]"))
		(outline-regexp rolo-entry-regexp)
		(buffer-read-only)
		(level-len))
	    ;; Load `outline' library since its functions are used here.
	    (if (not (boundp 'outline-mode-map))
		(load-library "outline"))
	    (goto-char (point-min))
	    ;; Pass buffer header if it exists
	    (if (re-search-forward rolo-hdr-regexp nil t 2)
		(forward-line))
	    (while (and (or (null max-groupings) (< num-found max-groupings))
			(re-search-forward exact-level-regexp nil t))
	      (setq num-found (1+ num-found))
	      (let* ((opoint (prog1 (point) (beginning-of-line)))
		     (grouping-start (point))
		     (start grouping-start)
		     (level-len (or level-len (- (1- opoint) start)))
		     (next-level-len)
		     (next-entry-exists)
		     (grouping-end)
		     (no-subtree))
		(while (and (progn
			      (if (setq next-entry-exists
					(re-search-forward
					 rolo-entry-regexp nil t 2))
				  (setq next-level-len
					(- (point)
					   (progn (beginning-of-line)
						  (point)))
					grouping-end
					(< next-level-len level-len)
					no-subtree
					(<= next-level-len level-len))
				(setq grouping-end t no-subtree t)
				(goto-char (point-max)))
			      (let ((end (point)))
				(goto-char start)
				(hide-subtree) ; And hide multiple entry lines
				;; Move to start of next entry at equal
				;; or higher level.
				(setq start
				      (if no-subtree
					  end
					(if (re-search-forward
					     rolo-entry-regexp nil t)
					    (progn (beginning-of-line) (point))
					  (point-max))))
				;; Remember last expression in `progn'
				;; must always return non-nil.
				(goto-char start)))
			    (not grouping-end)))
		(let ((end (point)))
		  (goto-char grouping-start)
		  (funcall func grouping-start end)
		  (goto-char end))))
	    (show-all)
	    (rolo-kill-buffer actual-buf)
	    num-found))
      0)))

;;; ************************************************************************
;;; Private functions
;;; ************************************************************************

(defun rolo-add-match (rolo-matches-buffer regexp start end)
  "Insert before point in ROLO-MATCHES-BUFFER an entry matching REGEXP from the current region between START to END."
  (let ((rolo-buf (current-buffer))
	(rolo-entry (buffer-substring start end))
	opoint)
    (set-buffer (get-buffer-create rolo-matches-buffer))
    (setq opoint (point))
    (insert (funcall rolo-display-format-function rolo-entry))
    (rolo-highlight-matches regexp opoint (point))
    (set-buffer rolo-buf)))

(defun rolo-buffer-exists-p (rolo-buf)
  "Returns buffer given by ROLO-BUF or nil.
ROLO-BUF may be a file-name, buffer-name, or buffer."
  (car (memq (get-buffer (or (and (stringp rolo-buf)
				  (get-file-buffer rolo-buf))
			     rolo-buf))
	     (buffer-list))))

(defun rolo-current-date ()
  "Return the current date (a string) in a form used for rolo entry insertion."
  (let ((year-month-day (htz:date-parse (current-time-string))))
    (format "\t%02s/%02s/%s"
	    (aref year-month-day 1)
	    (aref year-month-day 2)
	    (aref year-month-day 0))))

(defun rolo-display-to-entry-end ()
  "Go to end of current entry, ignoring sub-entries."
  (if (re-search-forward (concat rolo-hdr-regexp "\\|"
				 rolo-entry-regexp) nil t)
      (progn (beginning-of-line) (point))
    (goto-char (point-max))))

	  
(defun rolo-format-name (name-str first last)
  "Reverse order of NAME-STR field given my regexp match field FIRST and LAST."
  (if (match-beginning last)
      (concat (substring name-str (match-beginning last) (match-end last))
	      ", "
	      (substring name-str (match-beginning first) (match-end first)))))

(defun rolo-highlight-matches (regexp start end)
  "Highlight matches for REGEXP in region from START to END."
  (if (fboundp 'hproperty:but-add)
      (let ((hproperty:but-emphasize-p))
	(save-excursion
	  (goto-char start)
	  (while (re-search-forward regexp nil t)
	    (hproperty:but-add (match-beginning 0) (match-end 0)
			       (or rolo-highlight-face
				   hproperty:highlight-face)))))))

(defun rolo-kill-buffer (&optional rolo-buf)
  "Kills optional ROLO-BUF if unchanged and `rolo-kill-buffers-after-use' is t.
Default is current buffer."
  (or rolo-buf (setq rolo-buf (current-buffer)))
  (and rolo-kill-buffers-after-use (not (buffer-modified-p rolo-buf))
       (kill-buffer rolo-buf)))

(defun rolo-name-and-email ()
  "If point is in a mail message, returns list of (name email-addr) of sender.
Name is returned as `last, first-and-middle'."
  (let ((email) (name) (from))
    (save-window-excursion
      (if (or (hmail:lister-p) (hnews:lister-p))
	  (other-window 1))
      (save-excursion
	(save-restriction
	  (goto-char (point-min))
	  (if (search-forward "\n\n" nil t)
	      (narrow-to-region (point-min) (point)))
	  (setq email (mail-fetch-field "reply-to")
		from  (mail-fetch-field "from")))))
    (if from
	(cond
	 ;; Match: email, email (name), email "name"
	 ((string-match
	   (concat "^\\([^\"<>() \t\n\r\f]+\\)"
		   "\\([ \t]*[(\"][ \t]*\\([^\"()]+\\)[ \t]+"
		   "\\([^\" \t()]+\\)[ \t]*[)\"]\\)?[ \t]*$")
	   from)
	  (setq name (rolo-format-name from 3 4))
	  (or email (setq email (substring from (match-beginning 1)
					   (match-end 1)))))
	 ;; Match: <email>, name <email>, "name" <email>
	 ((string-match
	   (concat "^\\(\"?\\([^\"<>()\n]+\\)[ \t]+"
		   "\\([^\" \t()<>]+\\)\"?[ \t]+\\)?"
		   "<\\([^\"<>() \t\n\r\f]+\\)>[ \t]*$")
	   from)
	  (setq name (rolo-format-name from 2 3))
	  (or email (setq email (substring from (match-beginning 4)
					   (match-end 4)))))))
    (if (or name email)
	(list name email))))

(defun rolo-name-at ()
  "If point is within an entry in `rolo-display-buffer', returns the entry name, else nil."
  (if (string-equal (buffer-name) rolo-display-buffer)
      (save-excursion
	(if (or (looking-at rolo-entry-regexp)
		(progn (end-of-line)
		       (re-search-backward rolo-entry-regexp nil t)))
	    (progn (goto-char (match-end 0))
		   (skip-chars-forward " \t")
		   (if (or (looking-at "[^ \t\n\r]+ ?, ?[^ \t\n\r]+")
			   (looking-at "\\( ?[^ \t\n\r]+\\)+"))
		       (buffer-substring (match-beginning 0)
					 (match-end 0))))))))

(defun rolo-narrowed-p ()
  (or (/= (point-min) 1) (/= (1+ (buffer-size)) (point-max))))

(defun rolo-save-buffer (&optional rolo-buf)
  "Saves optional ROLO-BUF if changed and `rolo-save-buffers-after-use' is t.
Default is current buffer.  Used, for example, after a rolo entry is killed."
  (or rolo-buf (setq rolo-buf (current-buffer)))
  (and rolo-save-buffers-after-use (buffer-modified-p rolo-buf)
       (set-buffer rolo-buf) (save-buffer)))

(defun rolo-set-date ()
  "Add a line with the current date at the end of the current rolo entry.
Suitable for use as an entry in `wrolo-add-hook' and `wrolo-edit-hook'.
The default date format is MM/DD/YYYY.  Rewrite `rolo-current-date' to
return a different format, if you prefer."
  (save-excursion
    (skip-chars-forward "*")
    (rolo-to-entry-end)
    (skip-chars-backward " \t\n\r\f")
    (skip-chars-backward "^\n\r\f")
    (if (looking-at "\\s-+[-0-9./]+\\s-*$") ;; a date
	(progn (delete-region (point) (match-end 0))
	       (insert (rolo-current-date)))
	(end-of-line)
	(insert "\n" (rolo-current-date)))))

(defun rolo-shrink-window ()
  (let* ((lines (count-lines (point-min) (point-max)))
	 (height (window-height))
	 (window-min-height 2)
	 (desired-shrinkage (1- (min (- height lines)))))
    (and (>= lines 0)
	 (/= desired-shrinkage 0)
	 (> (frame-height) (1+ height))
	 (shrink-window 
	   (if (< desired-shrinkage 0)
	       (max desired-shrinkage (- height (/ (frame-height) 2)))
  (min desired-shrinkage (- height window-min-height)))))))

(defun rolo-to (name &optional file-list)
  "Moves point to entry for NAME within optional FILE-LIST.
`rolo-file-list' is used as default when FILE-LIST is nil.
Leaves point immediately after match for NAME within entry.
Switches internal current buffer but does not alter the frame.
Returns point where matching entry begins or nil if not found."
  (or file-list (setq file-list rolo-file-list))
  (let ((found) file)
    (while (and (not found) file-list)
      (setq file (car file-list)
	    file-list (cdr file-list))
      (cond ((and file (or (not (stringp file)) (string= file "")))
	     (error "(rolo-to): Invalid file: `%s'" file))
	    ((and (file-exists-p file) (not (file-readable-p file)))
	     (error "(rolo-to): File not readable: `%s'" file)))
      (set-buffer (or (get-file-buffer file) (find-file-noselect file)))
      (let ((case-fold-search t) (real-name name) (parent "") (level) end)
	(widen) (goto-char 1)
	(while (string-match "\\`[^\]\[<>{}\"]*/" name)
	  (setq end (1- (match-end 0))
		level nil
		parent (substring name 0 end)
		name (substring name (min (1+ end) (length name))))
	  (cond ((progn
		   (while (and (not level) (search-forward parent nil t))
		     (save-excursion
		       (beginning-of-line)
		       (if (looking-at
			    (concat "\\(" rolo-entry-regexp "\\)[ \t]*" 
				    (regexp-quote parent)))
			   (setq level (buffer-substring (match-beginning 1)
							 (match-end 1))))))
		   level))
		((equal name real-name)) ;; Try next file.
		(t ;; Found parent but not child
		 (setq buffer-read-only nil)
		 (rolo-to-buffer (current-buffer))
		 (error "(rolo-to): `%s' part of name not found in \"%s\"."
			parent file)))
	  (if level
	      (narrow-to-region (point)
				(save-excursion
				  (rolo-to-entry-end t level) (point)))))
	(goto-char (point-min))
	(while (and (search-forward name nil t)
		    (not (save-excursion
			   (beginning-of-line)
			   (setq found
				 (if (looking-at
				      (concat "\\(" rolo-entry-regexp
					      "\\)[ \t]*"
					      (regexp-quote name)))
				     (point))))))))
      (or found (rolo-kill-buffer))) ;; conditionally kill
    (widen)
    found))

(defun rolo-to-buffer (buffer &optional other-window-flag frame)
  "Pop to BUFFER."
  (cond (hyperb:xemacs-p
	  (pop-to-buffer buffer other-window-flag
			 ;; default is to use selected frame
			 (or frame (selected-frame))))
	(t (pop-to-buffer buffer other-window-flag))))

(defun rolo-to-entry-end (&optional include-sub-entries curr-entry-level)
"Moves point to the end of the whole entry that point is within if optional INCLUDE-SUB-ENTRIES is non-nil.
CURR-ENTRY-LEVEL is a string whose length is the same as the last found entry
header.  If INCLUDE-SUB-ENTRIES is nil, CURR-ENTRY-LEVEL is not needed.
Returns current point."
  (while (and (setq next-entry-exists
		    (re-search-forward rolo-entry-regexp nil t))
	      include-sub-entries
	      (> (- (point) (save-excursion
			      (beginning-of-line)
			      (point)))
		 (length curr-entry-level))))
  (if next-entry-exists
      (progn (beginning-of-line) (point))
    (goto-char (point-max))))

(defun wrolo-mode ()
  "Major mode for the rolo match buffer.
Calls the functions given by `wrolo-mode-hook'.
\\{wrolo-mode-map}"
  (interactive)
  (setq major-mode 'wrolo-mode
	mode-name "rolo")
  (use-local-map wrolo-mode-map)
  ;;
  (set-syntax-table wrolo-mode-syntax-table)
  ;;
  ;; Loads menus under non-tty InfoDock, XEmacs or Emacs19; does nothing
  ;; otherwise.
  (and (not (featurep 'wrolo-menu)) hyperb:window-system
       (or hyperb:xemacs-p hyperb:emacs19-p) (require 'wrolo-menu))
  ;;
  (if (not (fboundp 'outline-minor-mode))
      nil
    (outline-minor-mode 1))
  (run-hooks 'wrolo-mode-hook))

;;; ************************************************************************
;;; Private variables
;;; ************************************************************************

(defvar rolo-display-buffer "*Hyperbole Rolo*"
  "Buffer used to display set of last matching rolo entries.")

(defvar rolo-entry-regexp "^\\*+"
  "Regular expression to match the beginning of a rolo entry.
This pattern must match the beginning of the line.  Entries may be nested
through the use of increasingly longer beginning patterns.")

(defconst rolo-hdr-format
  (concat
   "======================================================================\n"
   "%s\n"
   "======================================================================\n")
  "Header to insert preceding a file's first rolo entry match when
file has none of its own.  Used with one argument, the file name."
)

(defconst rolo-hdr-regexp "^==="
  "Regular expression to match the first and last lines of rolo file headers.
This header is inserted into rolo-display-buffer before any entries from the
file are added.")

(defconst rolo-match-regexp nil
  "Last regular expression used to search the rolo.
Nil before a search is done.
String search expressions are converted to regular expressions.")

(defvar *rolo-wconfig* nil
  "Saves frame's window configuration prior to a rolo search.")

(defvar wrolo-mode-syntax-table nil
  "Syntax table used while in wrolo match mode.")

(if wrolo-mode-syntax-table
    ()
  (setq wrolo-mode-syntax-table (make-syntax-table text-mode-syntax-table))
  ;; Support syntactic selection of delimited e-mail addresses.
  (modify-syntax-entry ?\<  "\(\>" wrolo-mode-syntax-table)
  (modify-syntax-entry ?\>  "\)\<" wrolo-mode-syntax-table))

(defvar wrolo-mode-map nil
  "Keymap for the rolo match buffer.")

(if wrolo-mode-map
    nil
  (setq wrolo-mode-map (make-keymap))
  (if (fboundp 'set-keymap-name)
      (set-keymap-name wrolo-mode-map 'wrolo-mode-map))
  (suppress-keymap wrolo-mode-map)
  (define-key wrolo-mode-map "<"        'beginning-of-buffer)
  (define-key wrolo-mode-map ">"        'end-of-buffer)
  (define-key wrolo-mode-map "."        'beginning-of-buffer)
  (define-key wrolo-mode-map ","        'end-of-buffer)
  (define-key wrolo-mode-map "?"        'describe-mode)
  (define-key wrolo-mode-map "\177"     'scroll-down)
  (define-key wrolo-mode-map " "        'scroll-up)
  (define-key wrolo-mode-map "a"        'show-all)
  (define-key wrolo-mode-map "b"        'outline-backward-same-level)
  (define-key wrolo-mode-map "e"        'rolo-edit-entry)
  (define-key wrolo-mode-map "f"        'outline-forward-same-level)
  (define-key wrolo-mode-map "h"        'hide-subtree)
  (define-key wrolo-mode-map "l"        'rolo-locate)
  (define-key wrolo-mode-map "m"        'rolo-mail-to)
  (define-key wrolo-mode-map "n"        'outline-next-visible-heading)
  (define-key wrolo-mode-map "p"        'outline-previous-visible-heading)
  (define-key wrolo-mode-map "q"        'rolo-quit)
  (define-key wrolo-mode-map "r"        'rolo-previous-match)
  (define-key wrolo-mode-map "s"        'show-subtree)
  (define-key wrolo-mode-map "\M-s"     'rolo-isearch)
  (define-key wrolo-mode-map "t"        'hide-body)
  (define-key wrolo-mode-map "\C-i"     'rolo-next-match)      ;; {TAB}
  (define-key wrolo-mode-map "\M-\C-i"  'rolo-previous-match)  ;; {M-TAB}
  (define-key wrolo-mode-map "u"        'outline-up-heading)
  )

;; Prompt user to rename old personal rolo file to new name, if necessary.
(or noninteractive (call-interactively 'rolo-rename))

(provide 'wrolo)
