diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2019-08-14 04:29:57 -0400 |
|---|---|---|
| committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2019-08-14 04:29:57 -0400 |
| commit | 6e555e763567c66ad8e50724a7dd5e286dbb1e65 (patch) | |
| tree | 86fb29daa274d8007063babec826719154bf087e /hyrolo.el | |
| parent | 98a5ecb3bf80f2b53523c769459d1a1a49491125 (diff) | |
| parent | 332ef336a7ad87e25c0563bfeaf0e6758d52c59c (diff) | |
Merge remote-tracking branch 'hyperbole/master' into externals/hyperbolescratch/hyperbole-lexbind
Diffstat (limited to 'hyrolo.el')
| -rw-r--r-- | hyrolo.el | 89 |
1 files changed, 36 insertions, 53 deletions
@@ -4,7 +4,7 @@ ;; ;; Orig-Date: 7-Jun-89 at 22:08:29 ;; -;; Copyright (C) 1991-2017 Free Software Foundation, Inc. +;; Copyright (C) 1991-2019 Free Software Foundation, Inc. ;; See the "HY-COPY" file for license information. ;; ;; This file is part of GNU Hyperbole. @@ -85,10 +85,10 @@ executable must be found as well (for Oauth security)." (ms "c:/_rolo.otl") (unix "~/.rolo.otl") (list (delq nil (if (and (boundp 'bbdb-file) (stringp bbdb-file)) - (if hyperb:microcruft-os-p + (if hyperb:microsoft-os-p (list ms bbdb-file gcontacts) (list "~/.rolo.otl" bbdb-file gcontacts)) - (if hyperb:microcruft-os-p (list ms gcontacts) (list unix gcontacts)))))) + (if hyperb:microsoft-os-p (list ms gcontacts) (list unix gcontacts)))))) (setq hyrolo-file-list list) (when (called-interactively-p 'interactive) (message "HyRolo Search List: %S" list)) @@ -112,16 +112,10 @@ A hyrolo-file consists of: :group 'hyperbole-rolo) (unless hyrolo-highlight-face (setq hyrolo-highlight-face - (cond ((not (featurep 'xemacs)) - (if (fboundp 'defface) - (defface hyrolo-highlight-face nil - "*Face used to highlight rolo search matches." - :group 'hyperbole-rolo))) - (t (if (fboundp 'defface) - (face-name - (defface hyrolo-highlight-face nil - "*Face used to highlight rolo search matches." - :group 'hyperbole-rolo)))))) + (if (fboundp 'defface) + (defface hyrolo-highlight-face nil + "*Face used to highlight rolo search matches." + :group 'hyperbole-rolo))) (if (fboundp 'hproperty:set-item-highlight) (hproperty:set-item-highlight))) @@ -189,10 +183,8 @@ entry which begins with the parent string." parent (substring name 0 end) name (substring name (min (1+ end) (length name)))) (if (re-search-forward - (concat "\\(" hyrolo-entry-regexp "\\)[ \t]*" - (regexp-quote parent)) nil t) - (setq level (buffer-substring-no-properties (match-beginning 1) - (match-end 1))) + (concat hyrolo-entry-regexp (regexp-quote parent)) nil t) + (setq level (match-string-no-properties hyrolo-entry-group-number)) (error "(hyrolo-add): `%s' category not found in \"%s\"." parent file))) (narrow-to-region (point) @@ -210,10 +202,10 @@ entry which begins with the parent string." ;; entry by moving to an entry with the same (or nearest) first character ;; to that of `name'. (if (and (= level-len 1) - (equal hyrolo-entry-regexp "^\\*+")) + (equal hyrolo-entry-regexp "^\\(\\*+\\)\\([ \t]+\\)")) (progn (goto-char (point-min)) - (if (re-search-forward (concat "^\\*[ \t]*" - (char-to-string first-char)) + (if (re-search-forward (concat hyrolo-entry-regexp + (regexp-quote (char-to-string first-char))) nil t) (goto-char (match-beginning 0)) (goto-char (point-max)) @@ -235,17 +227,12 @@ entry which begins with the parent string." (setq again nil))))) (goto-char (point-min))) - (while (and again - (re-search-forward - (concat "\\(" hyrolo-entry-regexp "\\)\\([ \t]*\\)") - nil 'end)) - (setq entry-level (buffer-substring-no-properties (match-beginning 1) - (match-end 1))) + (while (and again (re-search-forward hyrolo-entry-regexp nil 'end)) + (setq entry-level (match-string-no-properties hyrolo-entry-group-number)) (if (/= (length entry-level) level-len) (hyrolo-to-entry-end t entry-level) (setq entry (buffer-substring-no-properties (point) (+ (point) len)) - entry-spc (buffer-substring-no-properties (match-beginning 2) - (match-end 2))) + entry-spc (match-string-no-properties hyrolo-entry-trailing-space-group-number)) (cond ((string< entry name) (hyrolo-to-entry-end t entry-level)) ((string< name entry) @@ -534,7 +521,7 @@ Returns t if entry is killed, nil otherwise." (defun hyrolo-locate () "Interactively search for an entry beginning with a set of search characters." (interactive) - (hyrolo-isearch-for-regexp (concat hyrolo-entry-regexp "[ \t]*"))) + (hyrolo-isearch-for-regexp hyrolo-entry-regexp)) (defun hyrolo-mail-to () "Start composing mail addressed to the first e-mail address at or after point." @@ -606,7 +593,7 @@ XEmacs only." (defun hyrolo-rename (old-file new-file) "Prompt user to rename OLD-FILE to NEW-FILE." - (interactive (if hyperb:microcruft-os-p + (interactive (if hyperb:microsoft-os-p '("c:/_rolodex.otl" "c:/_rolo.otl") '("~/.rolodex.otl" "~/.rolo.otl"))) (if (and (equal (car hyrolo-file-list) new-file) @@ -694,7 +681,7 @@ If ARG is zero, move to the beginning of the current line." (if (null arg) (setq arg 1)) (forward-visible-line arg)) -;; Derived from `sort-lines' in "sort.el" since through Emacs 25.0 +;; Derived from `sort-lines' in "sort.el" since through at least Emacs 25.0 ;; invisible lines are not grouped with the prior visible line, making ;; rolo entry (or any record) sorts fail. This next function fixes that. (defun hyrolo-sort-lines (reverse beg end) @@ -1276,8 +1263,7 @@ Name is returned as `last, first-and-middle'." "\\([^\" \t()]+\\)[ \t]*[)\"]\\)?[ \t]*$") from) (setq name (hyrolo-format-name from 3 4)) - (or email (setq email (substring from (match-beginning 1) - (match-end 1))))) + (or email (setq email (match-string 1 from)))) ;; Match: <email>, name <email>, "name" <email> ((string-match (concat "^\\(\"?\\([^\"<>()\n]+\\)[ \t]+" @@ -1285,8 +1271,7 @@ Name is returned as `last, first-and-middle'." "<\\([^\"<>() \t\n\r\f]+\\)>[ \t]*$") from) (setq name (hyrolo-format-name from 2 3)) - (or email (setq email (substring from (match-beginning 4) - (match-end 4))))))) + (or email (setq email (match-string 4 from)))))) (if (or name email) (list name email)))) @@ -1301,8 +1286,7 @@ Name is returned as `last, first-and-middle'." (skip-chars-forward " \t") (if (or (looking-at "[^ \t\n\r]+ ?, ?[^ \t\n\r]+") (looking-at "\\( ?[^ \t\n\r]+\\)+")) - (buffer-substring-no-properties (match-beginning 0) - (match-end 0)))))))) + (match-string-no-properties 0))))))) (defun hyrolo-narrowed-p () (or (/= (point-min) 1) (/= (1+ (buffer-size)) (point-max)))) @@ -1393,11 +1377,8 @@ Returns point where matching entry begins or nil if not found." (while (and (not level) (search-forward parent nil t)) (save-excursion (beginning-of-line) - (if (looking-at - (concat "\\(" hyrolo-entry-regexp "\\)[ \t]*" - (regexp-quote parent))) - (setq level (buffer-substring-no-properties (match-beginning 1) - (match-end 1)))))) + (if (looking-at (concat hyrolo-entry-regexp (regexp-quote parent))) + (setq level (match-string-no-properties hyrolo-entry-group-number))))) level)) ((equal name real-name)) ;; Try next file. (t ;; Found parent but not child @@ -1415,9 +1396,7 @@ Returns point where matching entry begins or nil if not found." (beginning-of-line) (setq found (if (looking-at - (concat "\\(" hyrolo-entry-regexp - "\\)[ \t]*" - (regexp-quote name))) + (concat hyrolo-entry-regexp (regexp-quote name))) (point)))))))) (or found (hyrolo-kill-buffer))) ;; conditionally kill (widen) @@ -1425,11 +1404,7 @@ Returns point where matching entry begins or nil if not found." (defun hyrolo-to-buffer (buffer &optional other-window-flag frame) "Pop to BUFFER." - (cond ((featurep 'xemacs) - (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)))) + (pop-to-buffer buffer other-window-flag)) (defun hyrolo-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. @@ -1472,10 +1447,18 @@ Calls the functions given by `hyrolo-mode-hook'. "Buffer used to display set of last matching rolo entries.") (define-obsolete-variable-alias 'rolo-display-buffer 'hyrolo-display-buffer "06.00") -(defvar hyrolo-entry-regexp "^\\*+" +(defvar hyrolo-entry-group-number 1 + "Group number within `hyrolo-entry-regexp' whose length represents the level of any entry matched.") + +(defvar hyrolo-entry-trailing-space-group-number 2 + "Group number within `hyrolo-entry-regexp; containing trailing space.") + +(defvar hyrolo-entry-regexp "^\\(\\*+\\)\\([ \t]+\\)" "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.") +This pattern must match the beginning of the line. Use +`hyrolo-entry-group-number' to compute the entry's level in the +hierarchy. Use `hyrolo-entry-trailing-space-group-number' to capture +the whitespace following the entry hierarchy level.") (define-obsolete-variable-alias 'rolo-entry-regexp 'hyrolo-entry-regexp "06.00") (defconst hyrolo-hdr-format |
