[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.
- [elpa] externals/hyperbole 620685a 11/53: Add git and github reference support for branches, issues, pull requests and tags., (continued)
- [elpa] externals/hyperbole 620685a 11/53: Add git and github reference support for branches, issues, pull requests and tags., Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 6b68100 40/53: Fixed predicate test in kbd-key:key-and-arguments., Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole bf0e9fb 24/53: Added new git-find-file command and associated git#=file implicit button type., Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 1a85b83 10/53: * DEMO (Git References): Added., Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 67c00f5 42/53: Added additional Hyperbole Manual section changes., Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole ff17563 44/53: Use replace-regexp-in-string instead of replace-in-string, Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole e2f6fbd 21/53: V6.0.2b; Fixed ebut creation argument prompting; Normal key seqs and ESC for meta allowed in HyControl, Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 70b6a79 29/53: Added modeline drag to window to replace dest. buffer with source buffer; showed Hyperbole key bindings in menu, Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 8f70846 45/53: Correct spelling, Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole d1fb45a 15/53: File/Dir linking fix; Smart Key reloading; helm mouse control improvements; Hyperbole menu use doc strings, Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 2161b1c 22/53: Added hmouse-pulse-flag and more pulsing; fixed many small internal Hyperbole button handling functions.,
Robert Weiner <=
- [elpa] externals/hyperbole 547c18f 26/53: Added gh#status to show github status; eliminated annot-bib matches from programming modes., Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole cf8ae0c 49/53: Makefile (help): Removed misplaced double quote characters., Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 50dc88d 23/53: V6.0.2c - Smart Key and popup menu buffer fixes; simplified Assist Key handling code, Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 1188e43 51/53: smart-clib-sym: Removed file-newer Perl script dependency; file-newer: Removed., Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole c45ce9b 52/53: Merge branch 'master' of http://git.savannah.gnu.org/r/hyperbole into externals/hyperbole, Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 45714d5 46/53: Minor doc and code improvements, Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 9b2d75a 53/53: Merge branch 'externals/hyperbole' of git+ssh://git.sv.gnu.org/srv/git/emacs/elpa into externals/hyperbole, Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole a76d502 34/53: Hyperbole 6.0.2f pre-release, Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 450688e 39/53: Corrected mouse-position and mouse-pixel-position to return selected frame; added key sequences with args support., Robert Weiner, 2017/11/15
- [elpa] externals/hyperbole 55a1f04 06/53: 2017-09-18 Bob Weiner <address@hidden>, Robert Weiner, 2017/11/15