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

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

[elpa] externals/hyperbole 2161b1c 22/53: Added hmouse-pulse-flag and mo


From: Robert Weiner
Subject: [elpa] externals/hyperbole 2161b1c 22/53: Added hmouse-pulse-flag and more pulsing; fixed many small internal Hyperbole button handling functions.
Date: Wed, 15 Nov 2017 22:47:02 -0500 (EST)

branch: externals/hyperbole
commit 2161b1ccf47b054c566a7eaa486bc3d73b312719
Author: Bob Weiner <address@hidden>
Commit: Bob Weiner <address@hidden>

    Added hmouse-pulse-flag and more pulsing; fixed many small internal 
Hyperbole button handling functions.
    Replicated hui:link-directly user message for use whenever ebuttons are 
interactively created or modified.
    
    2017-10-02  Bob Weiner  <address@hidden>
    
    * hui-window.el (hmouse-pulse-flag): Added to allow disabling visual 
pulsing in Action Mouse
        Key buffer/file window placement.  Used in hmouse-pulse-buffer and 
hmsoue-pulse-line.
    
    * hload-path.el (stringp): Forced use of hyperb:dir truename (after 
resolving pathname links).
    
    * hbdata.el (hbdata:build): Modified to ensure that but-sym or hbut:current 
(if but-sym is nil)
        is updated with all modified button attributes.  This is used after 
interactive explicit
        button creation or modification to display current attributes.
    
    * hui.el (hui:ebut-operate): Removed as this was obsoleted long ago; use 
ebut:operate instead.
    
    * hbut.el (ebut:operate): Updated documentation to clarify that this 
modified button properties,
        notably its action's argument list.
      hbut.el (hattr:copy, hattr:set):
      hpath.el (hpath:substitute-var): Clarified documentation.
    
    * hui.el (hui:ebut-message): Added message for use when creating and 
modifying explicit buttons.
             (hui:ebut-create, hui:ebut-modify): Called hui:ebut-message after 
interactively creating
        or modifying an explicit button (just as hui:link-directly already did).
             (hui:link-directly): Modified to call hui:ebut-message.
    
    * hact.el (actype:param-list): Added.
      hui.el (hui:action): Fixed to handle parameter lists with keywords such 
as &optional.
    
    * hactypes.el (link-to-file): When modifying a link, changed to handle a 
variable in the pathname
        and also to maintain any prior in-file location as a default when 
prompting for changes even
        if the linked-to file is not yet loaded in a buffer.
    
    * hact.el (action:params-emacs): Added to use doc strings and autoload 
functions to get calling
        signatures for Emacs25 byte-coded functions.  Previously, functions 
with bit-coded integer
        argument parameter placeholders were not supported.
              (action:params): Called action:params-emacs on byte-coded 
objects.  Also, rewrote
        to handle indirect byte-coded actions as well.
    
    2017-10-01  Bob Weiner  <address@hidden>
    
    * hui-window.el (hmouse-item-to-window): When drag from fixed menu header 
line, pulse the menu
        buffer and move the menu buffer itself to the drag release window.
---
 .hypb         | Bin 2835 -> 2990 bytes
 Changes       |  39 +++++++++++++++++
 hact.el       |  78 ++++++++++++++++++++++++++++------
 hactypes.el   |  22 +++++++---
 hbdata.el     | 134 ++++++++++++++++++++++++++++------------------------------
 hbut.el       |   9 ++--
 hload-path.el |   5 +++
 hpath.el      |   7 ++-
 hui-window.el |  44 +++++++++++++------
 hui.el        |  45 +++++++++++---------
 10 files changed, 253 insertions(+), 130 deletions(-)

diff --git a/.hypb b/.hypb
index df46779..771efd1 100644
Binary files a/.hypb and b/.hypb differ
diff --git a/Changes b/Changes
index b2fc3f1..69028b5 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,44 @@
+2017-10-02  Bob Weiner  <address@hidden>
+
+* hui-window.el (hmouse-pulse-flag): Added to allow disabling visual pulsing 
in Action Mouse
+    Key buffer/file window placement.  Used in hmouse-pulse-buffer and 
hmsoue-pulse-line.
+
+* hload-path.el (stringp): Forced use of hyperb:dir truename (after resolving 
pathname links).
+
+* hbdata.el (hbdata:build): Modified to ensure that but-sym or hbut:current 
(if but-sym is nil)
+    is updated with all modified button attributes.  This is used after 
interactive explicit
+    button creation or modification to display current attributes.
+
+* hui.el (hui:ebut-operate): Removed as this was obsoleted long ago; use 
ebut:operate instead.
+
+* hbut.el (ebut:operate): Updated documentation to clarify that this modified 
button properties,
+    notably its action's argument list.
+  hbut.el (hattr:copy, hattr:set): 
+  hpath.el (hpath:substitute-var): Clarified documentation.
+
+* hui.el (hui:ebut-message): Added message for use when creating and modifying 
explicit buttons.
+         (hui:ebut-create, hui:ebut-modify): Called hui:ebut-message after 
interactively creating
+    or modifying an explicit button (just as hui:link-directly already did).
+         (hui:link-directly): Modified to call hui:ebut-message.
+
+* hact.el (actype:param-list): Added.
+  hui.el (hui:action): Fixed to handle parameter lists with keywords such as 
&optional.
+
+* hactypes.el (link-to-file): When modifying a link, changed to handle a 
variable in the pathname
+    and also to maintain any prior in-file location as a default when 
prompting for changes even
+    if the linked-to file is not yet loaded in a buffer.
+
+* hact.el (action:params-emacs): Added to use doc strings and autoload 
functions to get calling
+    signatures for Emacs25 byte-coded functions.  Previously, functions with 
bit-coded integer
+    argument parameter placeholders were not supported.
+          (action:params): Called action:params-emacs on byte-coded objects.  
Also, rewrote
+    to handle indirect byte-coded actions as well.
+
 2017-10-01  Bob Weiner  <address@hidden>
 
+* hui-window.el (hmouse-item-to-window): When drag from fixed menu header 
line, pulse the menu
+    buffer and move the menu buffer itself to the drag release window.
+
 * hycontrol.el (hycontrol-handle-event): 
                (hycontrol-prettify-event): Fixed to handle large integer code 
events, e.g. M-p.
 
diff --git a/hact.el b/hact.el
index 1086188..93b82a6 100644
--- a/hact.el
+++ b/hact.el
@@ -162,12 +162,65 @@ When optional SYM is given, returns the name for that 
symbol only, if any."
   "Returns Hyperbole action that executes a keyboard MACRO REPEAT-COUNT times."
   (list 'execute-kbd-macro macro repeat-count))
 
+;; This function is based on Emacs `help-function-arglist'.
+(defun action:params-emacs (def)
+  "Return the argument list for the function DEF which may be a symbol or a 
function body."
+  ;; Handle symbols aliased to other symbols.
+  (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
+  ;; If definition is a macro, find the function inside it.
+  (if (eq (car-safe def) 'macro) (setq def (cdr def)))
+  (cond
+   ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
+   ((eq (car-safe def) 'lambda) (nth 1 def))
+   ((eq (car-safe def) 'closure) (nth 2 def))
+   ((or (and (byte-code-function-p def) (integerp (aref def 0)))
+       (subrp def))
+    (or (let* ((doc (condition-case nil (documentation def) (error nil)))
+              (docargs (if doc (car (help-split-fundoc doc nil))))
+              (arglist (if docargs
+                           (cdar (read-from-string (downcase docargs)))))
+              (valid t))
+         ;; Check validity.
+         (dolist (arg arglist)
+           (unless (and (symbolp arg)
+                        (let ((name (symbol-name arg)))
+                          (if (eq (aref name 0) ?&)
+                              (memq arg '(&rest &optional))
+                            (not (string-match "\\." name)))))
+             (setq valid nil)))
+         (when valid arglist))
+       (let* ((args-desc (if (not (subrp def))
+                             (aref def 0)
+                           (let ((a (subr-arity def)))
+                             (logior (car a)
+                                     (if (numberp (cdr a))
+                                         (lsh (cdr a) 8)
+                                       (lsh 1 7))))))
+              (max (lsh args-desc -8))
+              (min (logand args-desc 127))
+              (rest (logand args-desc 128))
+              (arglist ()))
+         (dotimes (i min)
+           (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
+         (when (> max min)
+           (push '&optional arglist)
+           (dotimes (i (- max min))
+             (push (intern (concat "arg" (number-to-string (+ 1 i min))))
+                   arglist)))
+         (unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
+         (nreverse arglist))))
+   ((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
+    ;; Force autoload to get function signature.
+    (setq def (autoload-do-load def))
+    (if (not autoloadp def)
+       (action:params-emacs def)))))
+
 (defun action:params (action)
-  "Returns unmodified ACTION parameter list."
+  "Returns unmodified ACTION parameter list.
+Autoloads action function if need be to get the parameter list."
+  (when (and (symbolp action) (fboundp action))
+    (setq action (hypb:indirect-function action)))
   (cond ((null action) nil)
-       ((symbolp action)
-        (car (cdr
-              (and (fboundp action) (hypb:indirect-function action)))))
        ((listp action)
         (if (eq (car action) 'autoload)
             (error "(action:params): Autoload not supported: %s" action)
@@ -175,14 +228,9 @@ When optional SYM is given, returns the name for that 
symbol only, if any."
        ((hypb:emacs-byte-code-p action)
         (if (fboundp 'compiled-function-arglist)
             (compiled-function-arglist action)
-          ;; Turn into a list for extraction.  Under Emacs 25, the
-          ;; result could be a parameter list or an integer, a
-          ;; bitstring representing a variable length argument list,
-          ;; in which case there is no present way to get the
-          ;; argument list, so just return nil.  See "(elisp)Byte-Code
-          ;; Objects".
-          (let ((params (car (cdr (cons nil (append action nil))))))
-            (if (listp params) params))))))
+          (action:params-emacs action)))
+       ((symbolp action)
+        (car (cdr (and (fboundp action) (hypb:indirect-function action)))))))
 
 (defun action:param-list (action)
   "Returns list of actual ACTION parameters (removes `&' special forms)."
@@ -315,9 +363,13 @@ calling form."
     (and action (action:commandp action) (or (call-interactively action) t))))
 
 (defun    actype:params (actype)
-  "Returns list of ACTYPE's parameters."
+  "Returns list of ACTYPE's parameters, including keywords."
   (action:params (actype:action actype)))
 
+(defun    actype:param-list (actype)
+  "Returns list of ACTYPE's parameters without keywords."
+  (action:param-list (actype:action actype)))
+
 (provide 'hact)
 
 ;;; hact.el ends here
diff --git a/hactypes.el b/hactypes.el
index 29cf6a7..b3ca154 100644
--- a/hactypes.el
+++ b/hactypes.el
@@ -288,12 +288,22 @@ Use `link-to-file' instead for a permanent link."
   "Displays file given by PATH scrolled to optional POINT.
 With POINT, buffer is displayed with POINT at window top."
   (interactive
-   (let ((prev-reading-p hargs:reading-p))
+   (let ((prev-reading-p hargs:reading-p)
+        (existing-buf t)
+        path-buf)
      (unwind-protect
-        (let* ((default (car defaults))
+        (let* ((file-path (car defaults))
+               (file-point (cadr defaults))
                (hargs:reading-p 'file)
-               (path (read-file-name "Path to link to: " default default))
-               (path-buf (get-file-buffer path)))
+               (path (read-file-name "Path to link to: " file-path file-path))
+               ;; Ensure any variable is removed before doing path matching.
+               (expanded-path (hpath:substitute-value path)))
+          (setq existing-buf (get-file-buffer expanded-path)
+                path-buf (or existing-buf
+                             (and (file-readable-p expanded-path)
+                                  (prog1 (set-buffer (find-file-noselect 
expanded-path t))
+                                    (when (integerp file-point)
+                                      (goto-char (min (point-max) 
file-point)))))))
           (if path-buf
               (with-current-buffer path-buf
                 (setq hargs:reading-p 'character)
@@ -303,7 +313,9 @@ With POINT, buffer is displayed with POINT at window top."
                     (list path (point))
                   (list path)))
             (list path)))
-       (setq hargs:reading-p prev-reading-p))))
+       (setq hargs:reading-p prev-reading-p)
+       (when (and path-buf (not existing-buf))
+        (kill-buffer path-buf)))))
   (and (hpath:find path)
        (integerp point)
        (progn (goto-char (min (point-max) point))
diff --git a/hbdata.el b/hbdata.el
index 3a926bd..f1c2390 100644
--- a/hbdata.el
+++ b/hbdata.el
@@ -139,9 +139,9 @@ Nil is returned when button has not beened modified."
 ;;; ------------------------------------------------------------------------
 
 (defun hbdata:build (&optional mod-lbl-key but-sym)
-  "Tries to construct button data from optional MOD-LBL-KEY and BUT-SYM.
+  "Constructs button data from optional MOD-LBL-KEY and BUT-SYM; modifies 
BUT-SYM attributes.
 MOD-LBL-KEY nil means create a new entry, otherwise modify existing one.
-BUT-SYM nil means use 'hbut:current'.  If successful, returns a cons of
+Nil BUT-SYM means use 'hbut:current'.  If successful, returns a cons of
  (button-data . button-instance-str), else nil."
   (let* ((but) 
         (b (hattr:copy (or but-sym 'hbut:current) 'but))
@@ -150,67 +150,64 @@ BUT-SYM nil means use 'hbut:current'.  If successful, 
returns a cons of
         (new-key (if mod-lbl-key (hattr:get b 'lbl-key) key))
         (lbl-instance) (creator) (create-time) (modifier) (mod-time)
         (entry) loc dir)
-    (if (null l)
-       nil
+    (when l
       (setq loc (if (bufferp l) l (file-name-nondirectory l))
            dir (if (bufferp l) nil (file-name-directory l)))
-      (if (setq entry (hbdata:to-entry key loc dir (not mod-lbl-key)))
-         (if mod-lbl-key
-             (progn
-               (setq creator     (hbdata:creator entry)
-                     create-time (hbdata:create-time entry)
-                     modifier    (let* ((user (hypb:user-name))
-                                        (addr hyperb:user-email))
-                                   (if (equal creator addr)
-                                       user addr))
-                     mod-time    (htz:date-sortable-gmt)
-                     entry       (cons new-key (cdr entry)))
-               (hbdata:delete-entry-at-point)
-               (if (setq lbl-instance (hbdata:instance-last new-key loc dir))
-                   (progn
-                     (setq lbl-instance (concat ebut:instance-sep
-                                                (1+ lbl-instance)))
-                     ;; This line is needed to ensure that the highest
-                     ;; numbered instance of a label appears before
-                     ;; other instances, so 'hbdata:instance-last' will work.
-                     (if (hbdata:to-entry-buf loc dir) (forward-line 1))))
-               )
-           (let ((inst-num (hbdata:instance-last new-key loc dir)))
-             (setq lbl-instance (if inst-num
-                                    (hbdata:instance-next 
-                                     (concat new-key ebut:instance-sep
-                                             (int-to-string inst-num))))))
-           ))
-      (if (or entry (not mod-lbl-key))
-         (cons
-          (list (concat new-key lbl-instance)
-                (hattr:get b 'action)
-                ;; Hyperbole V1 referent compatibility, always nil in V2
-                (hattr:get b 'referent)
-                ;; Save actype without class prefix
-                (let ((actype (hattr:get b 'actype)))
-                  (and actype (symbolp actype)
-                       (setq actype (symbol-name actype))
-                       (intern
-                        (substring actype (if (string-match "::" actype)
-                                              (match-end 0) 0)))))
-                (let ((mail-dir (and (fboundp 'hmail:composing-dir)
-                                     (hmail:composing-dir l)))
-                      (args (hattr:get b 'args)))
-                  ;; Replace matches for Emacs Lisp directory variable
-                  ;; values with their variable names in any pathname args.
-                  (mapcar 'hpath:substitute-var
-                          (if mail-dir
-                              ;; Make pathname args absolute for outgoing mail 
and
-                              ;; news messages.
-                              (action:path-args-abs args mail-dir)
-                            args)))
-                (or creator hyperb:user-email)
-                (or create-time (htz:date-sortable-gmt))
-                modifier
-                mod-time)
-          lbl-instance)
-       ))))
+      (when (setq entry (hbdata:to-entry key loc dir (not mod-lbl-key)))
+       (if mod-lbl-key
+           (progn
+             (setq creator     (hbdata:creator entry)
+                   create-time (hbdata:create-time entry)
+                   modifier    (let* ((user (hypb:user-name))
+                                      (addr hyperb:user-email))
+                                 (if (equal creator addr)
+                                     user addr))
+                   mod-time    (htz:date-sortable-gmt)
+                   entry       (cons new-key (cdr entry)))
+             (hbdata:delete-entry-at-point)
+             (when (setq lbl-instance (hbdata:instance-last new-key loc dir))
+               (setq lbl-instance (concat ebut:instance-sep (1+ lbl-instance)))
+               ;; This line is needed to ensure that the highest
+               ;; numbered instance of a label appears before
+               ;; other instances, so 'hbdata:instance-last' will work.
+               (if (hbdata:to-entry-buf loc dir) (forward-line 1))))
+         (let ((inst-num (hbdata:instance-last new-key loc dir)))
+           (setq lbl-instance (if inst-num
+                                  (hbdata:instance-next 
+                                   (concat new-key ebut:instance-sep
+                                           (int-to-string inst-num))))))))
+      (when (or entry (not mod-lbl-key))
+       (hattr:set b 'lbl-key (concat new-key lbl-instance))
+       (hattr:set b 'loc loc)
+       (hattr:set b 'dir dir)
+       (let ((hbdata (list (hattr:get b 'lbl-key)
+                           (hattr:get b 'action)
+                           ;; Hyperbole V1 referent compatibility, always nil 
in V2
+                           (hattr:get b 'referent)
+                           ;; Save actype without class prefix.
+                           (let ((actype (hattr:get b 'actype)))
+                             (and actype (symbolp actype)
+                                  (setq actype (symbol-name actype))
+                                  (intern
+                                   (substring actype (if (string-match "::" 
actype)
+                                                         (match-end 0) 0)))))
+                           (let ((mail-dir (and (fboundp 'hmail:composing-dir)
+                                                (hmail:composing-dir l)))
+                                 (args (hattr:get b 'args)))
+                             ;; Replace matches for variable values with their 
variable names in any pathname args.
+                             (hattr:set b 'args
+                                        (mapcar 'hpath:substitute-var
+                                                (if mail-dir
+                                                    ;; Make pathname args 
absolute for outgoing mail and news messages.
+                                                    (action:path-args-abs args 
mail-dir)
+                                                  args))))
+                           (hattr:set b 'creator (or creator 
hyperb:user-email))
+                           (hattr:set b 'create-time (or create-time 
(htz:date-sortable-gmt)))
+                           (hattr:set b 'modifier modifier)
+                           (hattr:set b 'mod-time mod-time))))
+         ;; Ensure modified attributes are saved to `but-sym' or hbut:current.
+         (hattr:copy b (or but-sym 'hbut:current))
+         (cons hbdata lbl-instance))))))
 
 (defun hbdata:get-entry (lbl-key key-src &optional directory)
   "Returns button data entry given by LBL-KEY, KEY-SRC and optional DIRECTORY.
@@ -394,8 +391,7 @@ Returns non-nil if KEY-SRC is found or created, else nil."
                     buffer-read-only nil)
               (if (not (hmail:hbdata-to-p))
                   (insert "\n" hmail:hbdata-sep "\n"))
-              (backward-char 1)
-              )
+              (backward-char 1))
       (setq directory (or (file-name-directory key-src) directory))
       (let ((ln-file) (link-p key-src))
        (while (setq link-p (file-symlink-p link-p))
@@ -416,10 +412,8 @@ Returns non-nil if KEY-SRC is found or created, else nil."
                  (create
                   (setq rtn t)
                   (insert "\^L\n\"" key-src "\"\n")
-                  (backward-char 1))
-                 ))))
-    rtn
-    ))
+                  (backward-char 1))))))
+    rtn))
 
 (defun hbdata:write (&optional orig-lbl-key but-sym)
   "Tries to write Hyperbole button data from optional ORIG-LBL-KEY and BUT-SYM.
@@ -427,13 +421,13 @@ ORIG-LBL-KEY nil means create a new entry, otherwise 
modify existing one.
 BUT-SYM nil means use 'hbut:current'.  If successful, returns 
 a button instance string to append to button label or t when first instance.
 On failure, returns nil."
-  (let ((cns (hbdata:build orig-lbl-key but-sym))
+  (let ((cons (hbdata:build orig-lbl-key but-sym))
        entry lbl-instance)
     (if (or (and buffer-file-name
                 (not (file-writable-p buffer-file-name)))
-           (null cns))
+           (null cons))
        nil
-      (setq entry (car cns) lbl-instance (cdr cns))
+      (setq entry (car cons) lbl-instance (cdr cons))
       (prin1 entry (current-buffer))
       (terpri (current-buffer))
       (or lbl-instance t)
diff --git a/hbut.el b/hbut.el
index deb3856..42b79f3 100644
--- a/hbut.el
+++ b/hbut.el
@@ -451,7 +451,7 @@ move to the first occurrence of the button."
       (goto-char (+ (match-beginning 0) (length ebut:start)))))
 
 (defun    ebut:operate (curr-label new-label)
-  "Operates on a new or existing Hyperbole button given by CURR-LABEL.
+  "Operates on and modifies properties of a new or existing Hyperbole button 
given by CURR-LABEL.
 When NEW-LABEL is non-nil, this is substituted for CURR-LABEL and the
 associated button is modified.  Otherwise, a new button is created.
 Returns instance string appended to label to form unique label, nil if
@@ -502,8 +502,7 @@ in the current buffer."
                    (t (setq start (point))
                       (insert curr-label)
                       (setq end (point))))
-             (ebut:delimit start end instance-flag))
-           )
+             (ebut:delimit start end instance-flag)))
          ;; Position point
          (let ((new-key (ebut:label-to-key new-label)))
            (cond ((equal (ebut:label-p) new-key)
@@ -723,7 +722,7 @@ Inserts INSTANCE-STR after END, before ending delimiter."
       )))
 
 (defun    hattr:copy (from-hbut to-hbut)
-  "Copies attributes FROM-HBUT TO-HBUT, eliminating attributes TO-HBUT had.
+  "Copies attributes FROM-HBUT TO-HBUT, overwriting TO-HBUT attribute values.
 Returns TO-HBUT."
   (mapc (lambda (hbut)
          (or (and hbut (symbolp hbut))
@@ -804,7 +803,7 @@ Suitable for use as part of `write-file-functions'."
   nil)
 
 (defun    hattr:set (obj-symbol attr-symbol attr-value)
-  "Sets OBJ-SYMBOL's attribute ATTR-SYMBOL to ATTR-VALUE."
+  "Sets OBJ-SYMBOL's attribute ATTR-SYMBOL to ATTR-VALUE and returns 
ATR-VALUE."
   (put obj-symbol attr-symbol attr-value))
 
 (defalias    'hattr:summarize 'hattr:report)
diff --git a/hload-path.el b/hload-path.el
index db6b3c5..8650d41 100644
--- a/hload-path.el
+++ b/hload-path.el
@@ -51,6 +51,11 @@
   "Directory where the Hyperbole executable code is kept.
 It must end with a directory separator character.")
 
+;; Ensure final name (after resolving all links) of hyperb:dir is
+;; used; otherwise, Hyperbole may fail to substitute this as a
+;; variable into link path buttons.
+(if (stringp hyperb:dir) (setq hyperb:dir (file-truename hyperb:dir)))
+
 ;; Add hyperb:dir to load-path so other Hyperbole libraries can be
 ;; found unless it is already there since the Emacs Package Manager
 ;; may have already added it.
diff --git a/hpath.el b/hpath.el
index 1bc593c..e4a08cd 100644
--- a/hpath.el
+++ b/hpath.el
@@ -945,8 +945,7 @@ See the documentation of the `hpath:rfc' variable."
   (format hpath:rfc rfc-num))
 
 (defun hpath:substitute-value (path)
-  "Substitutes matching value for Emacs Lisp variables and environment 
variables in PATH.
-Returns path with variable values substituted."
+  "Substitutes matching value for Emacs Lisp variables and environment 
variables in PATH and returns PATH."
   (substitute-in-file-name
     (hypb:replace-match-string
       "\\$\{[^\}]+}"
@@ -965,8 +964,8 @@ Returns path with variable values substituted."
       t)))
 
 (defun hpath:substitute-var (path)
-  "Replaces up to one match in PATH with the first matching variable from 
`hpath:variables'.
-When embedded within a path, the format is ${variable}."
+  "Replaces up to one match in PATH with the first variable from 
`hpath:variables' whose value contains a string match to PATH.
+After any match, the resulting path will contain a varible reference like 
${variable}."
   (if (not (and (stringp path) (string-match "/" path) (hpath:is-p path)))
       path
     (setq path (hpath:symlink-referent path))
diff --git a/hui-window.el b/hui-window.el
index f2d6516..757b030 100644
--- a/hui-window.el
+++ b/hui-window.el
@@ -73,6 +73,11 @@ of screen control commands."
   :type 'function
   :group 'hyperbole-keys)
 
+(defcustom hmouse-pulse-flag t
+  "When non-nil (the default) and when display supports visual pulsing, then 
pulse lines and buffers when an Action Key drag is used to place a buffer or 
file in a window."
+  :type 'boolean
+  :group 'hyperbole-keys)
+
  ;; Mats Lidell says this should be 10 characters for GNU Emacs.
 (defvar hmouse-edge-sensitivity (if hyperb:emacs-p 10 3)
   "*Number of characters from window edges within which a click is considered 
at an edge.")
@@ -591,13 +596,19 @@ Ignores minibuffer window."
   ;; (if (fboundp 'fill-region-and-align) (fill-region-and-align (mark) 
(point)))
   )
 
+(defsubst hmouse-pulse-buffer ()
+  (when (and hmouse-pulse-flag (featurep 'pulse) (pulse-available-p))
+    (pulse-momentary-highlight-region (point-min) (point-max) 'next-error)
+    (sit-for 0.3)))
+
 (defsubst hmouse-pulse-line ()
-  (when (and (featurep 'pulse) (pulse-available-p))
+  (when (and hmouse-pulse-flag (featurep 'pulse) (pulse-available-p))
     (pulse-momentary-highlight-one-line (point) 'next-error)
     (sit-for 0.3)))
 
 (defun hmouse-item-to-window ()
-  "Displays buffer or file menu item at Action Key depress in window of Action 
Key release."
+  "Displays buffer or file menu item at Action Key depress in window of Action 
Key release.
+If depress is on the top fixed header line, moves the menu buffer to the 
release window."
   (let* ((w1 action-key-depress-window)
         (w2 action-key-release-window)
         (buf-name)
@@ -605,25 +616,32 @@ Ignores minibuffer window."
     (when (and w1 w2)
       (unwind-protect
          (progn (select-window w1)
-                (setq w1-ref (cond ((eq major-mode 'Buffer-menu-mode)
-                                    (Buffer-menu-buffer t))
-                                   ((eq major-mode 'ibuffer-mode)
-                                    (ibuffer-current-buffer t))
-                                   ((eq major-mode 'helm-major-mode)
-                                    ;; Returns item string
-                                    (helm-get-selection (current-buffer)))
-                                   (t nil)))
-                (when w1-ref (hmouse-pulse-line)))
+                (if (eq (posn-area (event-start action-key-depress-args)) 
'header-line)
+                    ;; Drag from fixed header-line means move this menu buffer
+                    ;; to release window.
+                    (progn (setq w1-ref (current-buffer))
+                           (hmouse-pulse-buffer)
+                           (bury-buffer))
+                  ;; Otherwise, move the current menu item to the release 
window.
+                  (setq w1-ref (cond ((eq major-mode 'Buffer-menu-mode)
+                                      (Buffer-menu-buffer t))
+                                     ((eq major-mode 'ibuffer-mode)
+                                      (ibuffer-current-buffer t))
+                                     ((eq major-mode 'helm-major-mode)
+                                      ;; Returns item string
+                                      (helm-get-selection (current-buffer)))
+                                     (t nil)))
+                  (when w1-ref (hmouse-pulse-line))))
        (select-window w2)))
     (unwind-protect
        (cond ((not w1-ref)
               (error "(hmouse-item-to-window): Last depress was not within a 
window."))
              ((buffer-live-p w1-ref)
               (set-window-buffer w2 w1-ref)
-              (hmouse-pulse-line))
+              (hmouse-pulse-buffer))
              ((and (stringp w1-ref) (file-readable-p w1-ref))
               (set-window-buffer w2 (find-file-noselect w1-ref))
-              (hmouse-pulse-line))
+              (hmouse-pulse-buffer))
              (t (error "(hmouse-item-to-window): Cannot find or read `%s'." 
w1-ref)))
       ;; If helm is active, end in the minibuffer window.
       (if (smart-helm-alive-p)
diff --git a/hui.el b/hui.el
index 2bfb476..fe33f5d 100644
--- a/hui.el
+++ b/hui.el
@@ -89,9 +89,10 @@ label."
       (hattr:set 'hbut:current 'actype actype)
       (hattr:set 'hbut:current 'args (hargs:actype-get actype))
       (hattr:set 'hbut:current 'action
-                (and hui:ebut-prompt-for-action (hui:action actype)))
-      )
-    (ebut:operate lbl nil)))
+                (and hui:ebut-prompt-for-action (hui:action actype))))
+    (ebut:operate lbl nil)
+    (when (called-interactively-p)
+      (hui:ebut-message nil))))
 
 (defun hui:ebut-delete (but-key &optional key-src)
   "Deletes explicit Hyperbole button given by BUT-KEY in optional KEY-SRC.
@@ -175,9 +176,10 @@ Signals an error when no such button is found in the 
current buffer."
       (hattr:set 'hbut:current 'actype actype)
       (hattr:set 'hbut:current 'args (hargs:actype-get actype 'modifying))
       (hattr:set 'hbut:current 'action
-                (and hui:ebut-prompt-for-action (hui:action actype)))
-      )
-    (ebut:operate lbl new-lbl)))
+                (and hui:ebut-prompt-for-action (hui:action actype))))
+    (ebut:operate lbl new-lbl)
+    (if (called-interactively-p)
+       (hui:ebut-message t))))
 
 (defun hui:ebut-rename (curr-label new-label)
   "Renames explicit Hyperbole button given by CURR-LABEL to NEW-LABEL.
@@ -501,13 +503,7 @@ See also documentation for `hui:link-possible-types'."
              (hui:link-create
                but-modify but-window
                lbl-key but-loc but-dir type-and-args))))
-    (message "`%s' button %s %s with %S."
-            (hbut:key-to-label lbl-key)
-            (if but-modify "now executes" "executes")
-            (car type-and-args)
-            (if (= 1 (length (cdr type-and-args)))
-                (cadr type-and-args)
-              (cdr type-and-args)))))
+    (hui:ebut-message but-modify)))
 
 ;;; ************************************************************************
 ;;; Private functions - used only within Hyperbole
@@ -518,6 +514,7 @@ See also documentation for `hui:link-possible-types'."
   (and actype
        (let* ((act) (act-str)
              (params (actype:params actype))
+             (params-no-keywords (actype:param-list actype))
              (params-str (and params (concat " " (prin1-to-string params))))
              )
         (while (progn
@@ -533,7 +530,7 @@ See also documentation for `hui:link-possible-types'."
                                (beep) (message "Invalid action syntax.")
                                (sit-for 3) t))))
                 (and (not (symbolp act))
-                     params
+                     params-no-keywords
                      ;; Use the weak condition that action must
                      ;; involve at least one of actype's parameters
                      ;; or else we assume the action is invalid, tell
@@ -548,7 +545,7 @@ See also documentation for `hui:link-possible-types'."
                                                  "[\(\) \t\n\r\"]")
                                          act-str)
                                         t))
-                                 params)))
+                                 params-no-keywords)))
                      ))
           (beep) (message "Action must use at least one parameter.")
           (sit-for 3))
@@ -560,7 +557,7 @@ See also documentation for `hui:link-possible-types'."
                              nil  ;; terminate loop
                              ))
                        ((symbolp act)
-                        (setq act (cons act params)))
+                        (setq act (cons act params-no-keywords)))
                        ((stringp act)
                         (setq act (action:kbd-macro act 1)))
                        ;; Unrecognized form
@@ -582,8 +579,7 @@ DEFAULT-ACTYPE may be a valid symbol or symbol-name."
               (hargs:read-match (or prompt "Button's action type: ")
                                (mapcar 'list (htype:names 'actypes))
                                nil t default-actype 'actype)))
-    (hypb:error "(actype): Invalid default action type received.")
-    ))
+    (hypb:error "(actype): Invalid default action type received.")))
 
 (defun hui:buf-writable-err (but-buf func-name)
   "If BUT-BUF is read-only, signal an error from FUNC-NAME."
@@ -660,8 +656,17 @@ within."
 (defun hui:ebut-delimit (start end instance-str)
   (hypb:error "(hui:ebut-delimit): Obsolete, use ebut:delimit instead."))
 
-(defun hui:ebut-operate (curr-label new-label)
-  (hypb:error "(hui:ebut-operate): Obsolete, use ebut:operate instead."))
+(defun hui:ebut-message (but-modify-flag)
+  (let ((actype (symbol-name (hattr:get 'hbut:current 'actype)))
+       (args (hattr:get 'hbut:current 'args)))
+    (if (string-match "\\`actypes::" actype)
+       (setq actype (intern (substring actype (match-end 0)))))
+    (message "%s%s%s %s %S"
+            ebut:start
+            (hbut:key-to-label (hattr:get 'hbut:current 'lbl-key))
+            ebut:end
+            (if but-modify-flag "now executes" "executes")
+            (cons actype args))))
 
 (defun hui:ebut-unmark (&optional but-key key-src directory)
   "Remove delimiters from button given by BUT-KEY in KEY-SRC of DIRECTORY.



reply via email to

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