emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/hyperbole f733d4f 20/51: Bug fixes in preparation for t


From: Stefan Monnier
Subject: [elpa] externals/hyperbole f733d4f 20/51: Bug fixes in preparation for test release V7.0.9
Date: Sun, 12 Jul 2020 18:10:11 -0400 (EDT)

branch: externals/hyperbole
commit f733d4fc6c5aefc01eae8f9101e8e56877fb4507
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>

    Bug fixes in preparation for test release V7.0.9
---
 .hypb           | Bin 2413 -> 2527 bytes
 Changes         |  33 +++++++++++--
 DEMO            |   8 +--
 HY-NEWS         |  13 +++++
 hib-kbd.el      | 131 +++++++++++++++++++++++++++----------------------
 hpath.el        |   4 +-
 hypb.el         |  17 ++++++-
 hyrolo-logic.el |  14 +++---
 hyrolo.el       | 148 +++++++++++++++++++++++++++++---------------------------
 9 files changed, 225 insertions(+), 143 deletions(-)

diff --git a/.hypb b/.hypb
index bb92e42..efa003a 100644
Binary files a/.hypb and b/.hypb differ
diff --git a/Changes b/Changes
index ddb616f..99aba85 100644
--- a/Changes
+++ b/Changes
@@ -1,9 +1,36 @@
+2020-02-09  Bob Weiner  <rsw@gnu.org>
+
+* DEMO (Windows Grid): Use {Q} to ensure quit from HyControl and not from the 
DEMO (which is in Help mode).
+
+* hypb.el (hypb:mark-object, hypb:object-p): Added these to give strings and 
symbols a hyperbole property.
+  hpath.el (hpath:relative-to, hpath:absolute-to): Ignore any string with a 
hyperbole property.
+    Prevents removal of trailing whitespace from normalized key series, for 
example.
+
+* hib-kbd.el (kbd-key:hyperbole-mini-menu-key-p): Optimized to compute 
kbd-key:mini-menu-key only once.
+             (kbd-key): Allow for double-quoted key series, i.e. "{C-x o}".
+
+2020-02-08  Bob Weiner  <rsw@gnu.org>
+
+* hib-kbd.el (kbd-key:normalize): Prevent multiple normalizations which can 
strip desired RET and SPC characters.
+
+* hyrolo-logic.el (hyrolo-map-logic):
+                  (hyrolo-kill):
+  hyrolo.el (hyrolo-add):
+           (hyrolo-grep-file):
+            (hyrolo-to):
+            (hyrolo-to-entry-end): Fixed bug that caused addition of new 
entries at the end of the hyrolo file,
+    rather than in sorted order.  Also caused hyrolo-logic functions to fail.
+    The issue was that 'hyrolo-entry-regexp' had been updated to include the 
whitespace following the entry prefix
+    and this whitespace was improperly included when computing the hierarchy 
level of the entry.  Also, changed
+    'curr-entry-level' parameter from a string to an integer to reduce length 
comparisons.
+            (hyrolo-r-not): Fixed typo 'path' should be 'pat'.
+
 2020-02-06  Bob Weiner  <rsw@gnu.org>
 
 * hui-em-but.el (hproperty:set-face-after-init): Conditionalized settings to 
avoid overriding customizations.
-(hproperty:item-highlight-color): Fixed initialization error.
-(hproperty:set-flash-color): Ensured not setting to nil values.
-(hproperty:flash-face, hproperty:highlight-face): Converted to defcustom 
variables.
+                (hproperty:item-highlight-color): Fixed initialization error.
+                (hproperty:set-flash-color): Ensured not setting to nil values.
+                (hproperty:flash-face, hproperty:highlight-face): Converted to 
defcustom variables.
 
 2020-02-02  Bob Weiner  <rsw@gnu.org>
 
diff --git a/DEMO b/DEMO
index 68363a6..f3a72b9 100644
--- a/DEMO
+++ b/DEMO
@@ -265,11 +265,11 @@ a 2 x 3 grid.  We can do multiple commands in one 'key 
series'.  Press the
 action key within the braces: {.1 % .23 @}.
 
 You can even write something like this to do the whole thing in one sequence.
-First, let's quit out of HyControl Frames mode with {q}.  Then go back to one
+First, let's quit out of HyControl Frames mode with {Q}.  Then go back to one
 window with {C-x 1}.  Now we can execute a single sequence from any buffer
-that creates our 2x3 window grid: {C-h h s f .1 % .23 @ q}.  Pretty amazing,
+that creates our 2x3 window grid: {C-h h s f .1 % .23 @ Q}.  Pretty amazing,
 right?  You can separate each command by any number of spaces or even jam
-them all together: {C-hhsf.1%.23@q}.  Use SPC (separated by spaces) to
+them all together: {C-hhsf.1%.23@Q}.  Use SPC (separated by spaces) to
 include a space as part of the key series.
 
 A zero argument to the {@} command is special.  It means you want to display
@@ -1348,7 +1348,7 @@ Boom, the buffers are swapped.  This works across frames 
as well.
 
 If you have just two windows in an Emacs frame, you can swap their buffers
 from the keyboard.  Use this Hyperbole minibuffer menu key sequence to swap
-the buffers and quit from the Hyperbole minibuffer menu: {C-h h s w ~ q}.
+the buffers and quit from the Hyperbole minibuffer menu: {C-h h s w ~ Q}.
 
 *** Displaying Buffers
 
diff --git a/HY-NEWS b/HY-NEWS
index df80691..e3de692 100644
--- a/HY-NEWS
+++ b/HY-NEWS
@@ -18,10 +18,23 @@
       With no region active, this command stillthrows the source buffer to the
       target window.
 
+  DEMO
+
+    - Fixed many smaller issues that caused example implicit buttons to fail.
+
   GLOSSARY
 
     - Added Action Button, Elink, Ilink, Glink definitions.
 
+  HYROLO
+
+    - Fixed new entry addition to add in sorted order and logic operators to
+      perform properly, after a bug in level calculation had been introduced.
+
+  IMPLICIT BUTTONS
+
+    - Key series delimited by {} may not also be in double quotes, e.g. "{C-x 
o}".
+
   PROGRAMMING
 
     - If using Emacs imenu package, the Action Key will look up in-buffer
diff --git a/hib-kbd.el b/hib-kbd.el
index eada6e8..b542fb1 100644
--- a/hib-kbd.el
+++ b/hib-kbd.el
@@ -72,9 +72,10 @@ Any key sequence must be a string of one of the following:
           (key-series (car seq-and-pos))
           (start (cadr seq-and-pos))
           binding)
-      ;; Match only when start delimiter is preceded by whitespace or
-      ;; is the 1st buffer character, so do not match to things like 
${variable}.
-      (when (memq (char-before start) '(nil ?\ ?\t ?\n ?\j ?\f))
+      ;; Match only when start delimiter is preceded by whitespace,
+      ;; double quotes or is the 1st buffer character, so do not
+      ;; match to things like ${variable}.
+      (when (memq (char-before start) '(nil ?\ ?\t ?\n ?\j ?\f ?\"))
        (when (and (stringp key-series)
                   (not (eq key-series "")))
          (setq key-series (kbd-key:normalize key-series)
@@ -113,7 +114,7 @@ With optional prefix arg FULL, display full documentation 
for command."
   (interactive "kKey sequence: \nP")
   (let* ((keys (kbd-key:normalize key-series))
         (cmd  (let ((cmd (key-binding keys)))
-                (if (not (integerp cmd)) cmd)))
+                (unless (integerp cmd) cmd)))
         (doc (and cmd (documentation cmd)))
         (end-line))
     (cond (cmd
@@ -136,62 +137,70 @@ With optional prefix arg FULL, display full documentation 
for command."
 (defun kbd-key:help (but)
   "Display documentation for binding of keyboard key given by BUT's label."
   (let ((kbd-key (hbut:key-to-label (hattr:get but 'lbl-key))))
-    (if kbd-key (kbd-key:doc kbd-key t))))
+    (when kbd-key
+      (kbd-key:doc kbd-key t))))
 
 (defun kbd-key:normalize (key-series)
   "Return KEY-SERIES string (without surrounding {}) normalized into a form 
that can be parsed by commands."
   (interactive "kKeyboard key sequence to normalize (no {}): ")
   (if (stringp key-series)
-      (let ((norm-key-seq (copy-sequence key-series))
-           (case-fold-search nil)
-           (case-replace t)
-           (substring)
-           (arg))
-       (setq norm-key-seq (hypb:replace-match-string
-                           "@key{DEL}\\|<DEL>\\|\\<DEL\\>" norm-key-seq "\177" 
t)
-             norm-key-seq (hypb:replace-match-string
-                           
"@key{RET}\\|<RET>\\|@key{RTN}\\|\\<RETURN\\>\\|\\<RET\\>\\|\\<RTN\\>"
-                           norm-key-seq "$#@!" t)
-             norm-key-seq (hypb:replace-match-string
-                           "\\<ESC\s-*ESC\\>" norm-key-seq "\233" t)
-             norm-key-seq (hypb:replace-match-string
-                           "@key{ESC}\\|<ESC>\\|\\<ESC\\(APE\\)?\\>" 
norm-key-seq "M-" t)
-             norm-key-seq (hypb:replace-match-string
-                           "C-M-" norm-key-seq "M-C-" t)
-             norm-key-seq (kbd-key:mark-spaces-to-keep norm-key-seq "(" ")")
-             norm-key-seq (kbd-key:mark-spaces-to-keep norm-key-seq "\\[" 
"\\]")
-             norm-key-seq (kbd-key:mark-spaces-to-keep norm-key-seq "<" ">")
-             norm-key-seq (kbd-key:mark-spaces-to-keep norm-key-seq "\"" "\"")
-             norm-key-seq (hypb:replace-match-string "\\\\ " norm-key-seq 
"\0\0\0" t)
-             norm-key-seq (hypb:replace-match-string
-                           "[ \t\n\r]+" norm-key-seq "" t)
-             norm-key-seq (hypb:replace-match-string
-                           "\0\0\0\\|@key{SPC}\\|<SPC>\\|\\<SPC\\>" 
norm-key-seq "\040" t)
-             norm-key-seq (hypb:replace-match-string "$#@!" norm-key-seq 
"\015" t)
-             ;; Unqote special {} chars.
-             norm-key-seq (hypb:replace-match-string "\\\\\\([{}]\\)"
-                                                     norm-key-seq "\\1"))
-       (while (string-match "\\`\\(C-u\\|M-\\)\\(-?[0-9]+\\)" norm-key-seq)
-         (setq arg
-               (string-to-number (substring norm-key-seq (match-beginning 2)
-                                            (match-end 2)))
-               norm-key-seq (substring norm-key-seq (match-end 0))))
+      (if (hypb:object-p key-series)
+         ;; Prevent multiple normalizations which can strip desired
+         ;; RET and SPC characters.
+         key-series
+       (let ((norm-key-series (copy-sequence key-series))
+             (case-fold-search nil)
+             (case-replace t)
+             (substring)
+             (arg))
+         (setq norm-key-series (hypb:replace-match-string
+                             "@key{DEL}\\|<DEL>\\|\\<DEL\\>" norm-key-series 
"\177" t)
+               norm-key-series (hypb:replace-match-string
+                             
"@key{RET}\\|<RET>\\|@key{RTN}\\|\\<RETURN\\>\\|\\<RET\\>\\|\\<RTN\\>"
+                             norm-key-series "$#@!" t)
+               norm-key-series (hypb:replace-match-string
+                             "\\<ESC\s-*ESC\\>" norm-key-series "\233" t)
+               norm-key-series (hypb:replace-match-string
+                             "@key{ESC}\\|<ESC>\\|\\<ESC\\(APE\\)?\\>" 
norm-key-series "M-" t)
+               norm-key-series (hypb:replace-match-string
+                             "C-M-" norm-key-series "M-C-" t)
+               norm-key-series (kbd-key:mark-spaces-to-keep norm-key-series 
"(" ")")
+               norm-key-series (kbd-key:mark-spaces-to-keep norm-key-series 
"\\[" "\\]")
+               norm-key-series (kbd-key:mark-spaces-to-keep norm-key-series 
"<" ">")
+               norm-key-series (kbd-key:mark-spaces-to-keep norm-key-series 
"\"" "\"")
+               norm-key-series (hypb:replace-match-string "\\\\ " 
norm-key-series "\0\0\0" t)
+               norm-key-series (hypb:replace-match-string
+                             "[ \t\n\r]+" norm-key-series "" t)
+               norm-key-series (hypb:replace-match-string
+                             "\0\0\0\\|@key{SPC}\\|<SPC>\\|\\<SPC\\>" 
norm-key-series " " t)
+               norm-key-series (hypb:replace-match-string "$#@!" 
norm-key-series "\C-m" t)
+               ;; Unqote special {} chars.
+               norm-key-series (hypb:replace-match-string "\\\\\\([{}]\\)"
+                                                       norm-key-series "\\1"))
+         (while (string-match "\\`\\(C-u\\|M-\\)\\(-?[0-9]+\\)" 
norm-key-series)
+           (setq arg
+                 (string-to-number (substring norm-key-series (match-beginning 
2)
+                                              (match-end 2)))
+                 norm-key-series (substring norm-key-series (match-end 0))))
 
-       ;; Quote Control and Meta key names
-       (setq norm-key-seq (hypb:replace-match-string
-                           "C-\\(.\\)" norm-key-seq
-                           (lambda (str)
-                             (char-to-string
-                              (1+ (- (downcase
-                                      (string-to-char
-                                       (substring str (match-beginning 1)
-                                                  (1+ (match-beginning 1)))))
-                                     ?a)))))
-             norm-key-seq (hypb:replace-match-string
-                           "M-\\(.\\)" norm-key-seq
-                           (lambda (str)
-                             (concat "" (substring str (match-beginning 1)
-                                                     (1+ (match-beginning 
1))))))))
+         ;; Quote Control and Meta key names
+         (setq norm-key-series (hypb:replace-match-string
+                             "C-\\(.\\)" norm-key-series
+                             (lambda (str)
+                               (char-to-string
+                                (1+ (- (downcase
+                                        (string-to-char
+                                         (substring str (match-beginning 1)
+                                                    (1+ (match-beginning 1)))))
+                                       ?a)))))
+               norm-key-series (hypb:replace-match-string
+                             "M-\\(.\\)" norm-key-series
+                             (lambda (str)
+                               (concat "" (substring str (match-beginning 1)
+                                                       (1+ (match-beginning 
1)))))))
+         (unless (string-empty-p norm-key-series)
+           (hypb:mark-object norm-key-series))
+         norm-key-series))
     (error "(kbd-key:normalize): requires a string argument, not `%s'" 
key-series)))
 
 ;;; ************************************************************************
@@ -214,10 +223,12 @@ Allows for multiple key sequences strung together."
        t))
 
 (defun kbd-key:hyperbole-mini-menu-key-p (key-series)
-  "Return t if normalized KEY-SERIES appears to invoke a Hyperbole menu item 
or sequence of keys, else nil."
+  "Return t if normalized KEY-SERIES appears to invoke a Hyperbole menu item 
or sequence of keys, else nil.
+Also, initialize `kbd-key:mini-menu-key' to the key sequence that invokes the 
Hyperbole minibuffer menu."
   (when key-series
-    (let ((mini-menu-key (kbd-key:normalize (key-description (car 
(where-is-internal 'hyperbole))))))
-      (if (string-match (regexp-quote mini-menu-key) key-series) t))))
+    (unless kbd-key:mini-menu-key
+      (setq kbd-key:mini-menu-key (regexp-quote (kbd-key:normalize 
(key-description (car (where-is-internal 'hyperbole)))))))
+    (when (string-match kbd-key:mini-menu-key key-series) t)))
 
 (defun kbd-key:key-and-arguments (key-series)
   "Return t if normalized KEY-SERIES appears to be a bound key sequence 
possibly with following interactive arguments, else nil."
@@ -267,6 +278,12 @@ a M-x extended command,
   (kbd-key:normalize (key-description (where-is-internal 
'execute-extended-command (current-global-map) t)))
   "Normalized prefix string that invokes an extended command; typically ESC 
x.")
 
+(defvar kbd-key:mini-menu-key nil
+  "The key sequence that invokes the Hyperbole minibuffer menu.")
+;; Set above variable
+(kbd-key:hyperbole-mini-menu-key-p "")
+
+
 (provide 'hib-kbd)
 
 ;;; hib-kbd.el ends here
diff --git a/hpath.el b/hpath.el
index 7092db3..468467a 100644
--- a/hpath.el
+++ b/hpath.el
@@ -542,6 +542,7 @@ Return PATH unchanged when it is not a valid path or when 
DEFAULT-DIRS
 is invalid.  DEFAULT-DIRS when non-nil may be a single directory or a list of
 directories.  The first one in which PATH is found is used."
   (cond ((not (and (stringp path)
+                  (not (hypb:object-p path))
                    (hpath:is-p (hpath:trim path) nil t)))
          path)
         ((progn (setq path (hpath:trim path))
@@ -1186,7 +1187,8 @@ Is a no-op if the function `push-tag-mark' is not 
available."
   "Return PATH relative to optional DEFAULT-DIR or `default-directory'.
 Expand any other valid path.  Return PATH unchanged when it is not a
 valid path."
-  (cond ((not (stringp path))
+  (cond ((not (and (stringp path)
+                  (not (hypb:object-p path))))
         path)
        ((and (setq path (hpath:trim path))
              (not (hpath:is-p path)))
diff --git a/hypb.el b/hypb.el
index d89e560..148c7f3 100644
--- a/hypb.el
+++ b/hypb.el
@@ -223,7 +223,7 @@ Global keymap is used unless optional KEYMAP is given."
       (and (fboundp 'compiled-function-p) (compiled-function-p obj))))
 
 (defun hypb:error (&rest args)
-  "Signals an error typically to be caught by `hyperbole'."
+  "Signal an error typically to be caught by `hyperbole'."
   (let ((msg (if (< (length args) 2)
                 (car args)
               (apply 'format (cons (car args)
@@ -490,6 +490,14 @@ OBJECT should be a vector or `byte-code' object."
            i (1+ i)))
     (nreverse result)))
 
+(defun hypb:mark-object (object)
+  "Mark OBJECT as a Hyperbole object if possible to prevent generic functions 
from changing it.
+OBJECT must be a non-empty string or a symbol or this has no effect."
+  (cond ((and (stringp object) (not (string-empty-p object)))
+        (put-text-property 0 1 'hyperbole t object))
+       ((symbolp object)
+        (put object 'hyperbole t))))
+
 ;; Derived from "window.el".
 (defun hypb:maximize-window-height (&optional window)
   "Maximize WINDOW.
@@ -504,6 +512,13 @@ WINDOW pixelwise."
    window (window-max-delta window nil nil nil nil nil window-resize-pixelwise)
    nil nil window-resize-pixelwise))
 
+(defun hypb:object-p (object)
+  "Return t if OBJECT is marked as a Hyperbole object, else nil."
+  (cond ((and (stringp object) (not (string-empty-p object)))
+        (get-text-property 0 'hyperbole object))
+       ((symbolp object)
+        (get object 'hyperbole))))
+
 (defun hypb:replace-match-string (regexp str newtext &optional literal)
   "Replace all matches for REGEXP in STR with NEWTEXT string and return the 
result.
 Optional LITERAL non-nil means do a literal replacement.
diff --git a/hyrolo-logic.el b/hyrolo-logic.el
index 7c6e615..1e34b99 100644
--- a/hyrolo-logic.el
+++ b/hyrolo-logic.el
@@ -179,13 +179,13 @@ of applications of SEXP that matched entries."
              (let* ((start)
                     (end)
                     (end-entry-hdr)
-                    (curr-entry-level))
+                    (curr-entry-level-len))
                (while (re-search-forward hyrolo-entry-regexp nil t)
-                 (setq end-entry-hdr (point)
-                       start (save-excursion (beginning-of-line) (point))
+                 (setq end-entry-hdr (match-end hyrolo-entry-group-number)
+                       start (match-beginning hyrolo-entry-group-number)
                        next-entry-exists nil
-                       curr-entry-level (buffer-substring start end-entry-hdr)
-                       end (hyrolo-to-entry-end include-sub-entries 
curr-entry-level))
+                       curr-entry-level-len (length 
(match-string-no-properties hyrolo-entry-regexp))
+                       end (hyrolo-to-entry-end include-sub-entries 
curr-entry-level-len))
                  (let ((result (eval sexp)))
                    (or count-only
                        (and result (= num-found 0) hdr-pos
@@ -214,7 +214,7 @@ of applications of SEXP that matched entries."
                                                 no-sub-entries-out)
                                             end
                                           (goto-char (hyrolo-to-entry-end
-                                                      t curr-entry-level))))
+                                                      t 
curr-entry-level-len))))
                               (or count-only
                                   (append-to-buffer display-buf start end)))
                      (goto-char end-entry-hdr)))))))
@@ -292,7 +292,7 @@ Each element may be t, nil, or a string."
   (let ((pat))
     (while (and pat-list
                (or (null (setq pat (car pat-list)))
-                   (and (stringp path)
+                   (and (stringp pat)
                         (goto-char start)
                         (not (re-search-forward pat end t)))))
       (setq pat-list (cdr pat-list)))
diff --git a/hyrolo.el b/hyrolo.el
index da9be5c..1e8bda5 100644
--- a/hyrolo.el
+++ b/hyrolo.el
@@ -112,12 +112,12 @@ A hyrolo-file consists of:
   :group 'hyperbole-rolo)
 (unless hyrolo-highlight-face
   (setq hyrolo-highlight-face
-       (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)))
+       (when (fboundp 'defface)
+         (defface hyrolo-highlight-face nil
+           "*Face used to highlight rolo search matches."
+           :group 'hyperbole-rolo)))
+  (when (fboundp 'hproperty:set-item-highlight)
+    (hproperty:set-item-highlight)))
 
 (defcustom hyrolo-kill-buffers-after-use nil
   "*Non-nil means kill rolo file buffers after searching them for entries.
@@ -152,7 +152,8 @@ 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))
+     (unless (fboundp 'mail-fetch-field)
+       (require 'mail-utils))
      (let* ((lst (hyrolo-name-and-email))
            (name (car lst))
            (email (car (cdr lst)))
@@ -162,22 +163,25 @@ entry which begins with the parent string."
                      (string-match (concat "\\`" (regexp-quote entry)) name))
                 (format hyrolo-email-format entry email) entry)
             current-prefix-arg))))
-  (if (or (not (stringp name)) (string= name ""))
-      (error "(hyrolo-add): Invalid name: `%s'" name))
-  (if (and (called-interactively-p 'interactive) file)
-      (setq file (completing-read "File to add to: "
-                                 (mapcar 'list hyrolo-file-list))))
-  (if (null file) (setq file (car hyrolo-file-list)))
-  (cond ((and file (or (not (stringp file)) (string= file "")))
+  (when (or (not (stringp name)) (string-equal name ""))
+    (error "(hyrolo-add): Invalid name: `%s'" name))
+  (when (and (called-interactively-p 'interactive) file)
+    (setq file (completing-read "File to add to: "
+                               (mapcar 'list hyrolo-file-list))))
+  (unless file
+    (setq file (car hyrolo-file-list)))
+  (cond ((and file (or (not (stringp file)) (string-equal file "")))
         (error "(hyrolo-add): Invalid file: `%s'" file))
        ((and (file-exists-p file) (not (file-readable-p file)))
         (error "(hyrolo-add): File not readable: `%s'" file))
        ((not (file-writable-p file))
         (error "(hyrolo-add): File not writable: `%s'" file)))
   (set-buffer (or (get-file-buffer file) (find-file-noselect file)))
-  (if (called-interactively-p 'interactive) (message "Locating insertion point 
for `%s'..." name))
+  (when (called-interactively-p 'interactive)
+    (message "Locating insertion point for `%s'..." name))
   (let ((parent "") (level "") end)
-    (widen) (goto-char 1)
+    (widen)
+    (goto-char 1)
     (while (string-match "\\`[^\]\[<>{}\"]*/" name)
       (setq end (1- (match-end 0))
            parent (substring name 0 end)
@@ -187,15 +191,14 @@ entry which begins with the parent string."
          (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)
-                     (progn (hyrolo-to-entry-end t level) (point)))
+    (narrow-to-region (point) (progn (hyrolo-to-entry-end t (length 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)
+          (entry-level-len)
           (match)
           (again t))
       ;; Speed up entry insertion point location if this is a first-level
@@ -218,7 +221,7 @@ entry which begins with the parent string."
                                     "]")
                             nil t))
                       (progn (goto-char (match-end 0))
-                             (hyrolo-to-entry-end t entry-level)
+                             (hyrolo-to-entry-end t level-len)
                              ;; Now at the insertion point, immediately after
                              ;; the last existing entry whose first character
                              ;; is less than that of `name'.  Setting `again'
@@ -228,22 +231,22 @@ entry which begins with the parent string."
        (goto-char (point-min)))
 
       (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-level-len (length (match-string-no-properties 
hyrolo-entry-group-number)))
+       (if (/= entry-level-len level-len)
+           (hyrolo-to-entry-end t entry-level-len)
          (setq entry (buffer-substring-no-properties (point) (+ (point) len))
                entry-spc (match-string-no-properties 
hyrolo-entry-trailing-space-group-number))
          (cond ((string< entry name)
-                (hyrolo-to-entry-end t entry-level))
+                (hyrolo-to-entry-end t entry-level-len))
                ((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)
+      (unless match
+       (insert (unless entry-level-len
+                 (concat level "*"))
+               (if (string-equal entry-spc "") "   " entry-spc)
                name "\n")
        (backward-char 1))
       ;; hyrolo-to-buffer may move point from its desired location, so
@@ -388,7 +391,7 @@ 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
+Return number of entries matched.  See also documentation for the variable
 hyrolo-file-list."
   (interactive "sFind rolo regular expression: \nP")
   (unless (or (integerp max-matches) (memq max-matches '(nil t)))
@@ -470,9 +473,9 @@ search for the current match string rather than regular 
expression."
 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."
+Return t if entry is killed, nil otherwise."
   (interactive "sKill rolo entry named: \nP")
-  (if (or (not (stringp name)) (string= name "") (string-match "\\*" name))
+  (if (or (not (stringp name)) (string-equal name "") (string-match "\\*" 
name))
       (error "(hyrolo-kill): Invalid name: `%s'" name))
   (if (and (called-interactively-p 'interactive) current-prefix-arg)
       (setq file (completing-read "Entry's File: "
@@ -485,19 +488,19 @@ Returns t if entry is killed, nil otherwise."
          (setq file buffer-file-name)
          (if (file-writable-p file)
              (let ((kill-op
-                    (lambda (start level)
+                    (lambda (start level-len)
                       (kill-region
-                       start (hyrolo-to-entry-end t level))
+                       start (hyrolo-to-entry-end t level-len))
                       (setq killed t)
                       (hyrolo-save-buffer)
                       (hyrolo-kill-buffer)))
-                   start end level)
+                   start end level-len)
                (setq buffer-read-only nil)
                (re-search-backward hyrolo-entry-regexp nil t)
                (setq end (match-end 0))
                (beginning-of-line)
                (setq start (point)
-                     level (buffer-substring-no-properties start end))
+                     level-len (length (buffer-substring-no-properties start 
end)))
                (goto-char end)
                (skip-chars-forward " \t")
                (if (called-interactively-p 'interactive)
@@ -507,10 +510,10 @@ Returns t if entry is killed, nil otherwise."
                                            (progn (end-of-line) (point))))))
                      (if (y-or-n-p (format "Kill `%s...'? " entry-line))
                          (progn
-                           (funcall kill-op start level)
+                           (funcall kill-op start level-len)
                            (message "Killed"))
                        (message "Aborted")))
-                 (funcall kill-op start level)))
+                 (funcall kill-op start level-len)))
            (message
             "(hyrolo-kill): Entry found but file not writable: `%s'" file)
            (beep)))
@@ -622,7 +625,7 @@ XEmacs only."
 (defun hyrolo-sort (&optional hyrolo-file)
   "Sort up to 14 levels of entries in HYROLO-FILE (default is personal rolo).
 Assumes entries are delimited by one or more `*'characters.
-Returns list of number of groupings at each entry level."
+Return list of number of groupings at each entry level."
   (interactive
    (list (let ((default "")
               (file))
@@ -641,7 +644,7 @@ Returns list of number of groupings at each entry level."
                                     buffer-file-name
                                   (car hyrolo-file-list)))))
                  (mapcar 'list hyrolo-file-list)))
-          (if (string= file "") default file))))
+          (if (string-equal file "") default file))))
   (if (or (not hyrolo-file) (equal hyrolo-file ""))
       (setq hyrolo-file (car hyrolo-file-list)))
   (if (not (and (stringp hyrolo-file) (file-readable-p hyrolo-file)))
@@ -747,7 +750,7 @@ 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
+Return number of entries matched.  See also documentation for the variable
 hyrolo-file-list."
   (interactive "sFind rolo whole word matches of: \nP")
   (let ((total-matches (hyrolo-grep (format "\\b%s\\b" (regexp-quote string))
@@ -822,7 +825,7 @@ 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."
+Return number of matching entries found."
   (let ((hyrolo-entry-regexp "^\\[")
        (hyrolo-display-format-function #'hyrolo-bbdb-entry-format)
        ;; Kill the bbdb file after use if it is not already in a buffer.
@@ -875,7 +878,7 @@ 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."
+Return number of matching entries found."
   ;; Kill the google-contacts buffer after use if it is not already in use.
   (let ((hyrolo-kill-buffers-after-use (not (get-buffer 
google-contacts-buffer-name))))
     (hyrolo-grep-file hyrolo-file-or-buf regexp max-matches count-only)))
@@ -921,19 +924,19 @@ Returns number of matching entries found."
                                                                   
(xml-node-get-attribute-type child 'protocol)
                                                                   (cdr (assoc 
'address (xml-node-attributes child))))))
              (beg (point)))
-        (unless (and (string= familyname "") (string= givenname "") (string= 
nickname ""))
-         (insert contact-prefix-string familyname (if (or (string= familyname 
"")
-                                                          (string= givenname 
"")) "" ", ")
+        (unless (and (string-equal familyname "") (string-equal givenname "") 
(string-equal nickname ""))
+         (insert contact-prefix-string familyname (if (or (string-equal 
familyname "")
+                                                          (string-equal 
givenname "")) "" ", ")
                  givenname
-                 (if (string= nickname "")
+                 (if (string-equal nickname "")
                      ""
                    (format " (%s)" nickname))
                  "\n"))
 
-        (unless (and (string= organization-name "")
-                     (string= organization-title ""))
+        (unless (and (string-equal organization-name "")
+                     (string-equal organization-title ""))
          (insert (google-contacts-margin-element))
-         (if (string= organization-title "")
+         (if (string-equal organization-title "")
              (insert organization-name "\n")
            (insert organization-title " @ " organization-name "\n")))
 
@@ -961,7 +964,7 @@ Returns number of matching entries found."
         (when birthday
           (insert "\n" (google-contacts-margin-element) "Birthday: " birthday 
"\n"))
 
-        (unless (string= notes "")
+        (unless (string-equal notes "")
           (insert "\n" (google-contacts-margin-element) "Notes:  "
                   (google-contacts-add-margin-to-text notes 8)
                   "\n"))
@@ -1029,7 +1032,7 @@ 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."
+Return number of matching entries found."
   ;;
   ;; Save regexp as last rolo search expression.
   (setq hyrolo-match-regexp regexp)
@@ -1040,7 +1043,7 @@ Returns number of matching entries found."
                 (if (file-exists-p hyrolo-file-or-buf)
                     (setq actual-buf (find-file-noselect hyrolo-file-or-buf t)
                           new-buf-p t))))
-       (let ((hdr-pos) (num-found 0) (curr-entry-level)
+       (let ((hdr-pos) (num-found 0) (curr-entry-level-len)
              (incl-hdr t) start next-entry-exists)
          (if max-matches
              (cond ((eq max-matches t)
@@ -1066,8 +1069,8 @@ Returns number of matching entries found."
                (setq start (point)
                      next-entry-exists nil)
                (re-search-forward hyrolo-entry-regexp nil t)
-               (setq curr-entry-level (buffer-substring-no-properties start 
(point)))
-               (hyrolo-to-entry-end t curr-entry-level)
+               (setq curr-entry-level-len (length 
(buffer-substring-no-properties start (point))))
+               (hyrolo-to-entry-end t curr-entry-level-len)
                (or count-only
                    (if (and (zerop num-found) incl-hdr)
                        (let* ((src (or (buffer-file-name actual-buf)
@@ -1102,7 +1105,8 @@ 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 match the prefix 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."
+level two.
+Return number of groupings matched."
   (let ((actual-buf))
     (if (and (or (null max-groupings) (< 0 max-groupings))
             (or (setq actual-buf (hyrolo-buffer-exists-p hyrolo-file-or-buf))
@@ -1355,13 +1359,13 @@ a default of MM/DD/YYYY."
 `hyrolo-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."
+Return point where matching entry begins or nil if not found."
   (or file-list (setq file-list hyrolo-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 "")))
+      (cond ((and file (or (not (stringp file)) (string-equal file "")))
             (error "(hyrolo-to): Invalid file: `%s'" file))
            ((and (file-exists-p file) (not (file-readable-p file)))
             (error "(hyrolo-to): File not readable: `%s'" file)))
@@ -1386,10 +1390,10 @@ Returns point where matching entry begins or nil if not 
found."
                 (hyrolo-to-buffer (current-buffer))
                 (error "(hyrolo-to): `%s' part of name not found in \"%s\""
                        parent file)))
-         (if level
-             (narrow-to-region (point)
-                               (save-excursion
-                                 (hyrolo-to-entry-end t level) (point)))))
+         (when level
+           (narrow-to-region (point)
+                             (save-excursion
+                               (hyrolo-to-entry-end t (length level)) 
(point)))))
        (goto-char (point-min))
        (while (and (search-forward name nil t)
                    (not (save-excursion
@@ -1398,7 +1402,8 @@ Returns point where matching entry begins or nil if not 
found."
                                 (if (looking-at
                                      (concat hyrolo-entry-regexp (regexp-quote 
name)))
                                     (point))))))))
-      (or found (hyrolo-kill-buffer))) ;; conditionally kill
+      (unless found
+       (hyrolo-kill-buffer))) ;; conditionally kill
     (widen)
     found))
 
@@ -1406,19 +1411,22 @@ Returns point where matching entry begins or nil if not 
found."
   "Pop to BUFFER."
   (pop-to-buffer buffer other-window-flag))
 
-(defun hyrolo-to-entry-end (&optional include-sub-entries curr-entry-level)
+(defun hyrolo-to-entry-end (&optional include-sub-entries curr-entry-level-len)
   "Move 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."
+CURR-ENTRY-LEVEL-LEN is a the integer length of the last found entry
+header.  If INCLUDE-SUB-ENTRIES is nil, CURR-ENTRY-LEVEL-LEN is not needed.
+Return current point."
   ;; Sets free variable, next-entry-exists, for speed.
   (while (and (setq next-entry-exists
                    (re-search-forward hyrolo-entry-regexp nil t))
              include-sub-entries
+             ;; Prevents including trailing whitespace in entry level
+             ;; length which in turn causes moving to (point-max).
+             (goto-char (match-end hyrolo-entry-group-number))
              (> (- (point) (save-excursion
                              (beginning-of-line)
                              (point)))
-                (length curr-entry-level))))
+                curr-entry-level-len)))
   (if next-entry-exists
       (progn (beginning-of-line) (point))
     (goto-char (point-max))))
@@ -1455,9 +1463,9 @@ Calls the functions given by `hyrolo-mode-hook'.
 
 (defvar hyrolo-entry-regexp "^\\(\\*+\\)\\([ \t]+\\)"
   "Regular expression to match the beginning of a rolo entry.
-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
+This pattern must match the beginning of a line.
+`hyrolo-entry-group-number' must capture the entry's level in the
+hierarchy.  `hyrolo-entry-trailing-space-group-number' must capture
 the whitespace following the entry hierarchy level.")
 (define-obsolete-variable-alias 'rolo-entry-regexp 'hyrolo-entry-regexp 
"06.00")
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]