[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] scratch/hyperbole-lexbind da8f3fa 09/20: Add labeled implicit but
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] scratch/hyperbole-lexbind da8f3fa 09/20: Add labeled implicit buttons, in-buffer links to g/e/ibuts |
|
Date: |
Wed, 14 Aug 2019 04:30:22 -0400 (EDT) |
branch: scratch/hyperbole-lexbind
commit da8f3fadfd3b26e0125dee8330afd30896d77971
Author: Bob Weiner <address@hidden>
Commit: Bob Weiner <address@hidden>
Add labeled implicit buttons, in-buffer links to g/e/ibuts
---
Changes | 66 ++++++
hactypes.el | 23 +-
hargs.el | 7 +-
hbut.el | 648 +++++++++++++++++++++++++++++++++++------------------
hib-kbd.el | 1 +
hibtypes.el | 83 ++++++-
hsys-org.el | 60 +++--
hui.el | 16 +-
man/hyperbole.texi | 107 +++++----
9 files changed, 707 insertions(+), 304 deletions(-)
diff --git a/Changes b/Changes
index 613d4dd..958e21c 100644
--- a/Changes
+++ b/Changes
@@ -1,7 +1,73 @@
+2019-07-13 Bob Weiner <address@hidden>
+
+* hsys-org.el (org-set-ibut-label): Added and used in org-mode ibtype.
+ (org-mode, org-at-block-start-p): Added Action Key activation of
Org blocks when
+ on 1st line of def.
+
+* hibtypes.el (link-to-gbut, glink:start, glink:end): Added for in-buffer
links to global buttons.
+ (link-to-ebut, elink:start, elink:end): Added for in-buffer
links to explicit buttons.
+ (link-to-ibut, ilink:start, ilink:end): Added for in-buffer
links to implicit buttons.
+
+* hbut.el (ebut:label-p): Updated to better handle whether point is
+ between specified delimiters.
+
+2019-07-12 Bob Weiner <address@hidden>
+
+* hbut.el (ebut:key-src-set-buffer, hbut:key-src-set-buffer, hbut:key-list,
+ hbut:ebut-key-list, hbut:ibut-key-list, hbut:label-list): Added
+ to allow selection of labeled Hyperbole buttons in currrent buffer by name.
+ (ibut:to): Added to move to an implicit button in the current buffer
+ matching a label key.
+
+2019-07-11 Bob Weiner <address@hidden>
+
+* hargs.el (hargs:at-p): Added support for reading global button arguments.
+
+* hactypes.el (link-to-gbut): Updated to handle global labeled implicit
buttons.
+
+* hbut.el (gbut:get): Added.
+
+2019-07-10 Bob Weiner <address@hidden>
+
+* man/hyperbole.texi (Invisible Text Searches): Added missing {M-s i} key
sequence.
+
+* hibtypes.el (Info-node): Modified to skip costly hpath:is-p if ref
+ string is not of the right format.
+ (hibtypes-path-line-and-col-regexp, pathname-line-and-column):
Updated
+ to handle Elisp variables with colons.
+
+2019-07-09 Bob Weiner <address@hidden>
+
+* hbut.el (ibut:at-p): Conditionalized on (not (hbut:outside-comment-p)).
+ (hbut:map, ibut:label-map): Added.
+ (ibut:key-src, ibut:key-to-label, ibut:label-to-key, ibut:summarize):
Added.
+ Global, labeled implicit buttons now exist!
+
+2019-07-08 Bob Weiner <address@hidden>
+
+* hbut.el (ibut:label-separator, hbut:outside-comment-p): Added.
+
+2019-07-01 Bob Weiner <address@hidden>
+
+* hbut.el (gbut:ibut-key-list): Added.
+
+* hui.el (hui:hbut-term-highlight, hui:hbut-term-unhighlight): Fixed so
save-excursion is outermost.
+
+2019-06-29 Bob Weiner <address@hidden>
+
+* hbut.el (ebut:get, ebut:at-p, ebut:label-to-key, ibut:at-type-p): Simplified
conditionals using 'when'.
+ (ibut:label-start, ibut:label-end, ibut:label-p, ibut:get,
+ ibut:next-occurrence, ibut:label-regexp): Added.
+ (hbut:label-regexp): Added to support labeled implicit buttons too.
+ (ebut:label-regexp): Aliased to hbut:label-regexp.
+ (hbut:label-p): Updated to handle implicit button labels.
+
2019-06-23 Bob Weiner <address@hidden>
* hsys-org.el: Added many new predicates and code to handle navigation between
Org
mode internal links and their targets, as well as radio target definitions
and their links.
+ (hsys-org-mode-function, hsys-org-mode-p): Added to determine when
hsys-org actions
+ are activated.
* hypb.el (hypb:region-with-text-property-value): Added and used in
hysy-org.el.
diff --git a/hactypes.el b/hactypes.el
index f2ba02f..d227faa 100644
--- a/hactypes.el
+++ b/hactypes.el
@@ -364,16 +364,11 @@ the window."
(while (string-equal "" (setq but-lbl
(hargs:read-match
"Global button to link to: "
- (ebut:alist gbut-file)
- nil nil nil 'ebut)))
+ (mapcar 'list (gbut:label-list))
+ nil t nil 'gbut)))
(beep))
- (ebut:label-to-key but-lbl))))))
- (let ((gbut-file (hpath:validate (hpath:substitute-value gbut:file)))
- (but (ebut:get key (find-file-noselect (expand-file-name gbut:file)))))
- (if but (hbut:act but)
- (hypb:error "(link-to-gbut): No button `%s' in `%s'."
- (ebut:key-to-label key)
- gbut-file))))
+ (hbut:label-to-key but-lbl))))))
+ (gbut:act (hbut:key-to-label key)))
(defact link-to-Info-index-item (index-item)
"Displays an Info index INDEX-ITEM cross-reference.
@@ -397,8 +392,8 @@ available. Filename may be given without the .info suffix."
(id-info string)
(hypb:error "(link-to-Info-node): Invalid Info node: `%s'" string)))
-(defact link-to-ibut (key-file key point)
- "Performs action given by an implicit button, specified by KEY-FILE, KEY and
POINT.
+(defact link-to-ibut (key-file key &optional point)
+ "Performs action given by an implicit button, specified by KEY-FILE, KEY and
optional POINT.
When creating the button, point must be on the implicit button to which to link
and its buffer must have a file attached."
(interactive
@@ -414,11 +409,11 @@ and its buffer must have a file attached."
(save-restriction
(find-file-noselect key-file)
(widen)
- (goto-char point)
- (setq but (ibut:at-p)))))
+ (if (integerp point) (goto-char (min point (point-max))))
+ (setq but (ibut:to key)))))
(hbut:act but)
(hypb:error "(link-to-ibut): No button `%s' in `%s'."
- (ebut:key-to-label key)
+ (ibut:key-to-label key)
key-file))))
(defact link-to-kcell (file cell-ref)
diff --git a/hargs.el b/hargs.el
index 57b78a6..1b3ed37 100644
--- a/hargs.el
+++ b/hargs.el
@@ -324,7 +324,10 @@ Handles all of the interactive argument types that
`hargs:iform-read' does."
(t 0)))))
((hargs:completion t))
((eq hargs:reading-p 'ebut) (ebut:label-p 'as-label))
- ((ebut:label-p) nil)
+ ((eq hargs:reading-p 'gbut)
+ (when (eq (current-buffer) (get-file-buffer gbut:file))
+ (hbut:label-p 'as-label)))
+ ((hbut:label-p) nil)
((eq hargs:reading-p 'file)
(cond ((derived-mode-p 'dired-mode)
(let ((file (dired-get-filename nil t)))
@@ -521,7 +524,7 @@ See also documentation for `interactive'."
;; `@' means select window of last mouse event.
;;
;; `^' means activate/deactivate mark depending on
invocation thru shift translation
- ;; See `this-command-keys-shift-translated' for somewhat of
an explanation.
+ ;; See `this-command-keys-shift-translated' for an
explanation.
;;
;; `_' means keep region in same state (active or inactive)
;; after this command. (XEmacs only.)
diff --git a/hbut.el b/hbut.el
index 02bf4ad..cc71510 100644
--- a/hbut.el
+++ b/hbut.el
@@ -33,8 +33,7 @@ Nil disables saving.")
(defconst ebut:max-len 100
"Maximum length of a hyper-button label.")
-
-(defun ebut:act (label)
+(defun ebut:act (label)
"Activates Hyperbole explicit button with LABEL from the current buffer."
(interactive (list (hargs:read-match "Activate explicit button labeled: "
(ebut:alist)
@@ -46,7 +45,7 @@ Nil disables saving.")
(error "(ebut:act): No explicit button labeled: %s" label))))
(defun ebut:alist (&optional file)
- "Returns alist with each element a list containing a button label.
+ "Returns alist with each element a list containing an explicit button label.
For use as a completion table. Gets labels from optional FILE or current
buffer."
(mapcar 'list (ebut:list file)))
@@ -57,7 +56,8 @@ Assumes point is within first line of button label, if at all.
Optional START-DELIM and END-DELIM are strings that override default
button delimiters."
(let ((key (ebut:label-p nil start-delim end-delim)))
- (and key (ebut:get key))))
+ (when key
+ (ebut:get key))))
(defun ebut:create (&optional but-sym)
"Creates Hyperbole explicit button based on optional BUT-SYM.
@@ -95,60 +95,58 @@ Returns entry deleted (a list of attribute values) or nil."
(defun ebut:get (&optional lbl-key buffer key-src)
"Returns explicit Hyperbole button symbol given by LBL-KEY and BUFFER.
-KEY-SRC is given when retrieving global buttons and is full source pathname.
+KEY-SRC is given when retrieving global buttons and is the full source
pathname.
+
Retrieves button data, converts into a button object and returns a symbol
which references the button.
-All arguments are optional. When none are given, returns symbol for
-button that point is within or nil. BUFFER defaults to the current
+All arguments are optional. When none are given, returns a symbol for
+the button that point is within or nil. BUFFER defaults to the current
buffer."
(hattr:clear 'hbut:current)
(save-excursion
(let ((key-file) (key-dir) (but-data) (actype))
- (or lbl-key (setq lbl-key (ebut:label-p)))
- (if buffer
- (if (bufferp buffer) (set-buffer buffer)
+ (unless lbl-key
+ (setq lbl-key (ebut:label-p)))
+ (when buffer
+ (if (bufferp buffer)
+ (set-buffer buffer)
(error "(ebut:get): Invalid buffer argument: %s" buffer)))
- (if key-src
- nil
- (if (equal lbl-key (ebut:label-p))
- nil
+ (when (not key-src)
+ (when (not (equal lbl-key (ebut:label-p)))
(goto-char (point-min))
(ebut:next-occurrence lbl-key))
- (if (setq key-src (ebut:key-src 'full))
- ;; `ebut:key-src' sets current buffer to key-src buffer.
- (setq buffer (current-buffer)))
- )
- (if (and (stringp lbl-key) key-src)
- (progn
- (if (stringp key-src)
- (setq key-dir (file-name-directory key-src)
- key-file (file-name-nondirectory key-src)))
- (setq but-data (and key-src
- (hbdata:get-entry lbl-key (or key-file key-src)
- key-dir)))
- (if (null but-data)
- nil
- (hattr:set 'hbut:current 'lbl-key lbl-key)
- (hattr:set 'hbut:current 'loc key-src)
- (hattr:set 'hbut:current 'categ 'explicit)
- (hattr:set 'hbut:current 'action nil)
- (hattr:set 'hbut:current 'actype
- (intern (setq actype (hbdata:actype but-data))))
- ;; Hyperbole V1 referent compatibility
- (if (= (length actype) 2)
- (hattr:set 'hbut:current 'referent
- (hbdata:referent but-data)))
- (hattr:set 'hbut:current 'args (hbdata:args but-data))
- (hattr:set 'hbut:current 'creator (hbdata:creator but-data))
- (hattr:set 'hbut:current
- 'create-time (hbdata:create-time but-data))
- (hattr:set 'hbut:current
- 'modifier (hbdata:modifier but-data))
- (hattr:set 'hbut:current
- 'mod-time (hbdata:mod-time but-data))
- 'hbut:current)
- )))))
+ (when (setq key-src (ebut:key-src 'full))
+ ;; `ebut:key-src' sets current buffer to key-src buffer.
+ (setq buffer (current-buffer))))
+ (when (and (stringp lbl-key) key-src)
+ (when (stringp key-src)
+ (setq key-dir (file-name-directory key-src)
+ key-file (file-name-nondirectory key-src)))
+ (setq but-data (and key-src
+ (hbdata:get-entry lbl-key (or key-file key-src)
+ key-dir)))
+ (when but-data
+ (hattr:set 'hbut:current 'lbl-key lbl-key)
+ (hattr:set 'hbut:current 'loc key-src)
+ (hattr:set 'hbut:current 'categ 'explicit)
+ (hattr:set 'hbut:current 'action nil)
+ (hattr:set 'hbut:current 'actype
+ (intern (setq actype (hbdata:actype but-data))))
+ ;; Hyperbole V1 referent compatibility
+ (if (= (length actype) 2)
+
+ (hattr:set 'hbut:current 'referent
+ (hbdata:referent but-data)))
+ (hattr:set 'hbut:current 'args (hbdata:args but-data))
+ (hattr:set 'hbut:current 'creator (hbdata:creator but-data))
+ (hattr:set 'hbut:current
+ 'create-time (hbdata:create-time but-data))
+ (hattr:set 'hbut:current
+ 'modifier (hbdata:modifier but-data))
+ (hattr:set 'hbut:current
+ 'mod-time (hbdata:mod-time but-data))
+ 'hbut:current)))))
(defun ebut:is-p (object)
"Returns non-nil if OBJECT denotes an explicit Hyperbole button."
@@ -174,21 +172,17 @@ With optional FULL when source is a pathname, the full
pathname is returned."
((save-excursion
(and (re-search-backward
"^[a-z]*make[^a-z]+\\(Entering\\|Leaving\\)
directory `\\([^']+\\)'" nil t)
- (string-equal "Entering"
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
+ (string-equal "Entering" (match-string 1))))
(let ((limit (match-end 2))
;; Latest working directory that `make' reported
- (wd (buffer-substring (match-beginning 2)
- (match-end 2)))
+ (wd (match-string 2))
cd)
;; But another cd or pushd command may have been issued.
;; Return the closest directory from the make output.
(if (re-search-backward
"\\<\\(cd\\|pushd\\)\\s
+[\"\']?\\([^;\"\'\n\r\^L\\]+\\)"
limit t)
- (progn (setq cd (buffer-substring (match-beginning 2)
- (match-end 2)))
+ (progn (setq cd (match-string 2))
;; Eliminate any trailing whitespace.
(setq cd (substring
cd 0 (string-match "\\s +\\'" cd)))
@@ -209,18 +203,22 @@ With optional FULL when source is a pathname, the full
pathname is returned."
(= (point) (point-min))))
(hbut:source full)))))
(t (current-buffer)))))
- (cond ((null src) nil)
- ((bufferp src)
- (set-buffer src)
- src)
- ((file-directory-p src)
- (file-name-as-directory src))
- ((file-readable-p src)
- (set-buffer (find-file-noselect src))
- src)
- ((file-readable-p (setq src (hpath:symlink-referent src)))
- (set-buffer (find-file-noselect src))
- src))))
+ (ebut:key-src-set-buffer src)))
+
+(defun ebut:key-src-set-buffer (src)
+ "Set buffer to SRC, a buffer, file, directory or symlink and return SRC or
nil if invalid."
+ (cond ((null src) nil)
+ ((bufferp src)
+ (set-buffer src)
+ src)
+ ((file-directory-p src)
+ (file-name-as-directory src))
+ ((file-readable-p src)
+ (set-buffer (find-file-noselect src))
+ src)
+ ((file-readable-p (setq src (hpath:symlink-referent src)))
+ (set-buffer (find-file-noselect src))
+ src)))
(defun ebut:key-src-fmt ()
"Returns unformatted filename associated with formatted current buffer.
@@ -256,35 +254,34 @@ represent the output of particular document formatters."
lbl)))
(defun ebut:label-p (&optional as-label start-delim end-delim pos-flag
two-lines-flag)
- "Returns key for Hyperbole button label that point is within.
-Returns nil if not within a label. Assumes point is within first line
- of button label, if at all.
-All following arguments are optional. If AS-LABEL is non-nil, label
-is returned rather than the key derived from the label. START-DELIM
-and END-DELIM are strings that override default button delimiters.
-With POS-FLAG non-nil, returns list of label-or-key,
-but-start-position, but-end-position. Positions include delimiters.
-With TWO-LINES-FLAG non-nil, constrains label search to two lines."
+ "Returns key for the Hyperbole explicit button label that point is within,
else nil.
+Assumes point is within the first line of any button label. All
+following arguments are optional. If AS-LABEL is non-nil, label
+is returned rather than the key derived from the label.
+START-DELIM and END-DELIM are strings that override default
+button delimiters. With POS-FLAG non-nil, returns list of
+label-or-key, but-start-position, but-end-position. Positions
+include delimiters. With TWO-LINES-FLAG non-nil, constrains
+label search to two lines."
(let ((opoint (point))
- (npoint)
(quoted "\\(^\\|[^\\{]\\)")
- (start)
(ebut:max-len ebut:max-len)
- lbl-key end but-start but-end)
- (or start-delim (setq start-delim ebut:start))
- (or end-delim (setq end-delim ebut:end))
- (setq npoint (+ opoint (length start-delim)))
- ;; Ensure label is not blank
+ npoint start lbl-key end but-start but-end start-regexp end-regexp)
+ (unless start-delim (setq start-delim ebut:start))
+ (unless end-delim (setq end-delim ebut:end))
+ (setq start-regexp (regexp-quote start-delim)
+ end-regexp (regexp-quote end-delim)
+ npoint (+ opoint (length start-delim)))
+ ;; Ensure label is not blank and point is within matching delimiters
(save-excursion
- (beginning-of-line)
+ (forward-line 0)
(while (and (progn
- (while (re-search-forward
- (concat quoted (regexp-quote start-delim))
- npoint t)
+ (while (and (< (point) npoint)
+ (re-search-forward (concat quoted start-regexp)
npoint t))
(setq start t))
start)
- (re-search-forward (concat "[^\\{]" (regexp-quote end-delim))
- npoint t))
+ (< (point) opoint)
+ (re-search-forward (concat "[^\\{]" end-regexp) opoint t))
(setq start nil))
(when start
(setq start (point)
@@ -302,49 +299,24 @@ With TWO-LINES-FLAG non-nil, constrains label search to
two lines."
(forward-line 2)
(setq ebut:max-len (- (point) start))))
(and (< (point) (+ start ebut:max-len))
- (re-search-forward (concat quoted (regexp-quote end-delim))
- (+ start ebut:max-len) t)
+ (re-search-forward (concat quoted end-regexp) (+ start
ebut:max-len) t)
(setq but-end (point)
end (- (point) (length end-delim))
- lbl-key (ebut:label-to-key (buffer-substring start end)))
+ lbl-key (ebut:label-to-key (buffer-substring-no-properties
start end)))
(cond (pos-flag
(if as-label
(list (ebut:key-to-label lbl-key) but-start but-end)
(list lbl-key but-start but-end)))
(t (if as-label (ebut:key-to-label lbl-key) lbl-key))))))))
-(defun ebut:label-regexp (lbl-key &optional no-delim)
- "Unnormalizes LBL-KEY. Returns regular expr matching delimited button label.
-Optional NO-DELIM leaves off delimiters and leading and trailing space."
- (if lbl-key
- (let* ((pos 0)
- (len (length lbl-key))
- (c)
- (sep0 "[ \t\n\r]*")
- (sep "[ \t\n\r]+")
- (regexp (if no-delim "" (concat (regexp-quote ebut:start) sep0)))
- (case-fold-search))
- (while (< pos len)
- (setq c (aref lbl-key pos)
- regexp (concat regexp
- (if (eq c ?_)
- (if (or (= (1+ pos) len)
- (not (eq (aref lbl-key (1+ pos))
?_)))
- sep
- (setq pos (1+ pos))
- "_")
- (regexp-quote (char-to-string c))))
- pos (1+ pos)))
- (if no-delim regexp
- (setq regexp (concat regexp sep0 (regexp-quote ebut:end)))))))
+(defalias 'ebut:label-regexp 'hbut:label-regexp)
(defun ebut:label-to-key (label)
"Normalizes LABEL for use as a Hyperbole button key and returns key.
Eliminates any fill prefix in the middle of the label, replaces `_' with
`__', removes leading and trailing whitespace and replaces each other
whitespace sequence with `_'."
- (if (null label)
- nil
+ (when label
(setq label (hbut:fill-prefix-remove label)
;; Remove leading and trailing space.
label (hypb:replace-match-string "\\`[ \t\n\r]+\\|[ \t\n\r]+\\'"
@@ -356,31 +328,30 @@ whitespace sequence with `_'."
"Returns list of button labels from given FILE or current buffer.
Removes duplicate labels if optional LOC-P is omitted. With LOC-P, returns
list of elements (label start end) where start and end are the buffer
-positions at which the starting button delimiter begins and ends."
+positions at which the button delimiter begins and ends."
(interactive)
(setq file (if file (and (file-exists-p file) (find-file-noselect file))
(current-buffer)))
- (if file
- (progn
- (set-buffer file)
- (let ((buts (ebut:map (if loc-p
- (lambda (lbl start end)
- ;; Normalize label spacing
- (list (ebut:key-to-label
- (ebut:label-to-key lbl))
- start end))
- (lambda (lbl start end)
- ;; Normalize label spacing
- (ebut:key-to-label
- (ebut:label-to-key lbl)))))))
- (if loc-p buts (if buts (apply #'set:create buts)))))))
-
-(defalias 'map-ebut 'ebut:map)
+ (when file
+ (set-buffer file)
+ (let ((buts (ebut:map (if loc-p
+ (lambda (lbl start end)
+ ;; Normalize label spacing
+ (list (ebut:key-to-label (ebut:label-to-key
lbl))
+ start end))
+ (lambda (lbl start end)
+ ;; Normalize label spacing
+ (ebut:key-to-label (ebut:label-to-key lbl)))))))
+ (if loc-p buts (if buts (apply #'set:create buts))))))
+
+(defalias 'map-ebut 'ebut:map)
(defun ebut:map (but-func &optional start-delim end-delim
regexp-match include-delims)
"Applies BUT-FUNC to buttons delimited by optional START-DELIM and END-DELIM.
+START-DELIM defaults to ebut:start; END-DELIM defaults to ebut:end.
If REGEXP-MATCH is non-nil, only buttons which match this argument are
considered.
+
Maps over portion of buffer visible under any current restriction.
BUT-FUNC must take precisely three arguments: the button label, the
start position of the delimited button label and its end position (positions
@@ -405,12 +376,10 @@ expression which matches an entire button string."
nil t)
(setq start (match-beginning include-delims)
end (match-end include-delims)
- but (buffer-substring (match-beginning 0) (match-end 0))
- lbl (buffer-substring (match-beginning 1) (match-end 1))
+ but (match-string 0)
+ lbl (match-string 1)
;; If within a programming language buffer, ignore matches
outside comments.
- ignore (and (derived-mode-p 'prog-mode)
- ;; Match is outside of a programming language comment
- (not (nth 4 (syntax-ppss)))))
+ ignore (hbut:outside-comment-p))
(save-excursion
(goto-char start)
;; Ignore matches with quoted delimiters.
@@ -638,9 +607,9 @@ Inserts INSTANCE-STR after END, before ending delimiter."
"\\)" match-part (regexp-quote ebut:end)))
(defconst ebut:start "<("
- "String matching the start of a hyper-button.")
+ "String matching the start of a Hyperbole explicit hyper-button.")
(defconst ebut:end ")>"
- "String matching the end of a hyper-button.")
+ "String matching the end of a Hyperbole explicit hyper-button.")
(defconst ebut:instance-sep ":"
"String of one character, separates an ebut label from its instance num.")
@@ -648,25 +617,36 @@ Inserts INSTANCE-STR after END, before ending delimiter."
;;; gbut class - Global Hyperbole buttons - activated by typing label name
;;; ========================================================================
-(defvar gbut:file (expand-file-name hbmap:filename hbmap:dir-user)
+(defvar gbut:file (expand-file-name hbmap:filename hbmap:dir-user)
"File that stores globally accessible Hyperbole buttons, accessed by name.")
-(defun gbut:act (label)
+(defun gbut:act (label)
"Activates Hyperbole global button with LABEL."
(interactive (list (hargs:read-match "Activate global button labeled: "
(mapcar 'list (gbut:label-list))
- nil t nil 'ebut)))
+ nil t nil 'gbut)))
(cond ((null label)
(error "(gbut:act): You have not created any global buttons"))
((equal label "")
(error "(gbut:act): Please try again and type ? for a list of existing
global button names"))
(t (let* ((lbl-key (hbut:label-to-key label))
- (but (ebut:get lbl-key nil gbut:file)))
+ (but (gbut:get lbl-key)))
(if but
(hbut:act but)
(error "(gbut:act): No global button labeled: %s" label))))))
-(defun gbut:help (label)
+(defun gbut:get (&optional lbl-key)
+ "Returns global Hyperbole button symbol given by optional LBL-KEY if found
in gbut:file.
+
+Retrieves any button data, converts into a button object and returns a symbol
+which references the button.
+
+All arguments are optional. When none are given, returns a symbol for
+the button that point is within or nil."
+ (or (ebut:get lbl-key nil gbut:file)
+ (ibut:get lbl-key nil gbut:file)))
+
+(defun gbut:help (label)
"Displays help for Hyperbole global button with LABEL."
(interactive (list (hargs:read-match "Report on global button labeled: "
(mapcar 'list (gbut:label-list))
@@ -677,18 +657,22 @@ Inserts INSTANCE-STR after END, before ending delimiter."
(hbut:report but)
(error "(gbut:help): No global button labeled: %s" label))))
-(defun gbut:label-list ()
+(defun gbut:label-list ()
"Returns list of global button labels."
(mapcar 'hbut:key-to-label (gbut:key-list)))
;;; ------------------------------------------------------------------------
-(defun gbut:key-list ()
+(defun gbut:key-list ()
"Returns list of global button label keys."
+ (nconc (gbut:ebut-key-list) (gbut:ibut-key-list)))
+
+(defun gbut:ebut-key-list ()
+ "Returns a list of explicit button label keys from the global button file."
(save-excursion
(if (hbdata:to-entry-buf gbut:file)
- (let ((gbuts))
+ (let (gbuts)
(save-restriction
- (narrow-to-region (point) (if (search-forward "\^L" nil t)
+ (narrow-to-region (point) (if (search-forward "\f" nil t)
(point) (point-max)))
(goto-char (point-min))
(condition-case ()
@@ -696,6 +680,15 @@ Inserts INSTANCE-STR after END, before ending delimiter."
(error nil))
gbuts)))))
+(defun gbut:ibut-key-list ()
+ "Returns a list of implicit button label keys from the global button file."
+ (when (file-readable-p gbut:file)
+ (save-excursion
+ (set-buffer (find-file-noselect gbut:file))
+ (save-restriction
+ (widen)
+ (ibut:label-map #'(lambda (label start end) (ibut:label-to-key
label)))))))
+
;;; ========================================================================
;;; hattr class
;;; ========================================================================
@@ -807,7 +800,7 @@ Suitable for use as part of `write-file-functions'."
"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)
+(defalias 'hattr:summarize 'hattr:report)
(defvar hattr:filename
(if hyperb:microsoft-os-p "_hypb" ".hypb")
@@ -918,8 +911,9 @@ Ignores email-related buffers."
"Returns non-nil if object denotes a Hyperbole button."
(and (symbolp object) (hattr:get object 'categ)))
-(defalias 'hbut:key-src 'ebut:key-src)
-(defalias 'hbut:key-to-label 'ebut:key-to-label)
+(defalias 'hbut:key-src 'ebut:key-src)
+(defalias 'hbut:key-src-set-buffer 'ebut:key-src-set-buffer)
+(defalias 'hbut:key-to-label 'ebut:key-to-label)
(defun hbut:label (hbut)
"Returns the label for Hyperbole button symbol HBUT."
@@ -928,8 +922,60 @@ Ignores email-related buffers."
(error "(hbut:label): Argument is not a Hyperbole button symbol, `%s'"
hbut)))
-(defalias 'hbut:label-p 'ebut:label-p)
-(defalias 'hbut:label-to-key 'ebut:label-to-key)
+(defun hbut:label-p (&optional as-label start-delim end-delim pos-flag
two-lines-flag)
+ "Returns key for the Hyperbole button label that point is within, else nil.
+Assumes point is within the first line of any button label. All
+following arguments are optional. If AS-LABEL is non-nil, label
+is returned rather than the key derived from the label.
+START-DELIM and END-DELIM are strings that override default
+button delimiters. With POS-FLAG non-nil, returns list of
+label-or-key, but-start-position, but-end-position. Positions
+include delimiters. With TWO-LINES-FLAG non-nil, constrains
+label search to two lines."
+ (if (and start-delim end-delim)
+ (ebut:label-p as-label start-delim end-delim pos-flag two-lines-flag)
+ (or (ebut:label-p as-label start-delim end-delim pos-flag two-lines-flag)
+ (ibut:label-p as-label start-delim end-delim pos-flag two-lines-flag))))
+
+(defun hbut:label-regexp (lbl-key &optional no-delim start-delim end-delim)
+ "Unnormalizes LBL-KEY. Returns regular expr matching delimited button label.
+Optional NO-DELIM leaves off delimiters and leading and trailing space.
+Optional START-DELIM and END-DELIM are added around the returned
+label; these default to `ebut:start' and `ebut:end'."
+ (when lbl-key
+ (let* ((pos 0)
+ (len (length lbl-key))
+ (c)
+ (sep0 "[ \t\n\r]*")
+ (sep "[ \t\n\r]+")
+ (regexp (if no-delim "" (concat (regexp-quote (or start-delim
ebut:start)) sep0)))
+ (case-fold-search))
+ (while (< pos len)
+ (setq c (aref lbl-key pos)
+ regexp (concat regexp
+ (if (eq c ?_)
+ (if (or (= (1+ pos) len)
+ (not (eq (aref lbl-key (1+ pos)) ?_)))
+ sep
+ (setq pos (1+ pos))
+ "_")
+ (regexp-quote (char-to-string c))))
+ pos (1+ pos)))
+ (if no-delim
+ regexp
+ (setq regexp (concat regexp sep0 (regexp-quote (or end-delim
ebut:end))))))))
+
+
+(defalias 'hbut:label-to-key 'ebut:label-to-key)
+
+(defalias 'hbut:map 'ebut:map)
+
+(defun hbut:outside-comment-p ()
+ "Returns t if within a programming language buffer and prior regexp match is
outside a comment, else nil."
+ (when (and (derived-mode-p 'prog-mode)
+ (not (eq major-mode 'lisp-interaction-mode)))
+ ;; Match is outside of a programming language comment
+ (not (nth 4 (syntax-ppss)))))
(defun hbut:report (&optional arg)
"Pretty prints the attributes of a button or buttons.
@@ -1003,17 +1049,17 @@ Returns number of buttons reported on or nil if none."
If a file, always returns a full path if optional FULL is non-nil."
(goto-char (match-end 0))
(cond ((looking-at "#<buffer \"?\\([^\n\"]+\\)\"?>")
- (get-buffer (buffer-substring (match-beginning 1)
- (match-end 1))))
+ (get-buffer (match-string 1)))
((looking-at "\".+\"")
- (let* ((file (buffer-substring (1+ (match-beginning 0))
- (1- (match-end 0))))
+ (let* ((file (buffer-substring-no-properties
+ (1+ (match-beginning 0))
+ (1- (match-end 0))))
(absolute (file-name-absolute-p file)))
(if (and full (not absolute))
(expand-file-name file default-directory)
file)))))
-(defalias 'hbut:summarize 'hbut:report)
+(defalias 'hbut:summarize 'hbut:report)
(defvar hbut:current nil
"The currently selected Hyperbole button. Available to action routines.")
@@ -1023,58 +1069,152 @@ If a file, always returns a full path if optional FULL
is non-nil."
This expression should be followed immediately by a file-name indicating the
source file for the buttons in the menu, if any.")
+(defun hbut:label-list ()
+ "Returns list of current buffer's Hyperbole button labels."
+ (mapcar 'hbut:key-to-label (hbut:key-list)))
+
+;;; ------------------------------------------------------------------------
+
+(defun hbut:key-list ()
+ "Returns list of global button label keys."
+ (nconc (hbut:ebut-key-list) (hbut:ibut-key-list)))
+
+(defun hbut:ebut-key-list (&optional key-src)
+ "Returns a list of explicit button label keys from optional KEY-SRC or the
current buffer."
+ (save-excursion
+ (if (hbdata:to-entry-buf (or key-src (buffer-file-name)))
+ (let (hbuts)
+ (save-restriction
+ (narrow-to-region (point) (if (search-forward "\f" nil t)
+ (point) (point-max)))
+ (goto-char (point-min))
+ (condition-case ()
+ (while (setq hbuts (cons (car (read (current-buffer))) hbuts)))
+ (error nil))
+ hbuts)))))
+
+(defun hbut:ibut-key-list (&optional key-src)
+ "Returns a list of implicit button label keys from optional KEY-SRC or the
current buffer."
+ (save-excursion
+ (when (hbut:key-src-set-buffer (or key-src (current-buffer)))
+ (save-restriction
+ (widen)
+ (ibut:label-map #'(lambda (label start end) (ibut:label-to-key
label)))))))
+
;;; ========================================================================
;;; ibut class - Implicit Hyperbole Buttons
;;; ========================================================================
(defun ibut:at-p (&optional key-only)
"Returns symbol for implicit button at point, else nil.
-With optional KEY-ONLY, returns only the label key for button."
- (let ((types (htype:category 'ibtypes))
- ;; Global var used in (hact) function, don't delete.
- (hrule:action 'actype:identity)
- (itype)
- (args)
- (is-type))
- (or key-only (hattr:clear 'hbut:current))
- (while (and (not is-type) types)
- (setq itype (car types))
- (if (setq args (funcall itype))
- (setq is-type itype)
- (setq types (cdr types))))
- (if is-type
- (if key-only
- (hattr:get 'hbut:current 'lbl-key)
- (hattr:set 'hbut:current 'loc (save-excursion
- (hbut:key-src 'full)))
- (hattr:set 'hbut:current 'categ is-type)
- (or (hattr:get 'hbut:current 'args)
- (not (listp args))
- (progn
- (hattr:set 'hbut:current 'actype
- (or
- ;; Hyperbole action type
- (intern-soft (concat "actypes::"
- (symbol-name (car args))))
- ;; Regular Emacs Lisp function symbol
- (car args)
- ))
- (hattr:set 'hbut:current 'args (cdr args))))
- 'hbut:current))))
+Point may be on the implicit button or its optional preceding label.
+With optional KEY-ONLY, returns only the label key for button.
+
+Any labeled implicit button must contain at least two characters,
+excluding delimiters, not just one."
+ (let* ((opoint (point))
+ (label-key-start-end (ibut:label-p nil nil nil t t))
+ (lbl-key (car label-key-start-end)))
+ (unwind-protect
+ (when (not (hbut:outside-comment-p))
+ ;; Skip past any optional label and separators
+ (when label-key-start-end
+ (goto-char (nth 2 label-key-start-end))
+ (when (looking-at ibut:label-separator)
+ ;; Move past up to 2 possible characters of ibut
+ ;; delimiters; this prevents recognizing labeled,
+ ;; delimited ibuts of a single character but no one
+ ;; should need that.
+ (goto-char (min (+ 2 (match-end 0)) (point-max)))))
+
+ ;; Check for an implicit button at current point, record its
+ ;; attributes and return a button symbol for it.
+ (let ((types (htype:category 'ibtypes))
+ ;; Global var used in (hact) function, don't delete.
+ (hrule:action 'actype:identity)
+ (itype)
+ (args)
+ (is-type))
+ (unless key-only
+ (hattr:clear 'hbut:current))
+ (while (and (not is-type) types)
+ (setq itype (car types))
+ (if (setq args (funcall itype))
+ (setq is-type itype)
+ (setq types (cdr types))))
+ (when is-type
+ (when lbl-key
+ (hattr:set 'hbut:current 'lbl-key lbl-key))
+ (if key-only
+ (hattr:get 'hbut:current 'lbl-key)
+ (hattr:set 'hbut:current 'loc (save-excursion
+ (hbut:key-src 'full)))
+ (hattr:set 'hbut:current 'categ is-type)
+ (or (hattr:get 'hbut:current 'args)
+ (not (listp args))
+ (progn
+ (hattr:set 'hbut:current 'actype
+ (or
+ ;; Hyperbole action type
+ (intern-soft (concat "actypes::"
+ (symbol-name (car
args))))
+ ;; Regular Emacs Lisp function symbol
+ (car args)))
+ (hattr:set 'hbut:current 'args (cdr args))))
+ 'hbut:current))))
+ (goto-char opoint))))
(defun ibut:at-type-p (ibut-type-symbol)
"Returns non-nil if point is on a button of type `ibut-type-symbol`.
+Point must be on the button itself and not its label, if any.
+
The return value is a list of the type's action type symbol and
associated arguments from the button."
- (if (and ibut-type-symbol (symbolp ibut-type-symbol))
- (let ((type-name (symbol-name ibut-type-symbol)))
- (unless (string-match "::" type-name)
- (setq ibut-type-symbol (intern-soft (concat "ibtypes::" type-name))))
- (if ibut-type-symbol
- (let ((types (htype:category 'ibtypes))
- ;; Global var used in (hact) function, don't delete.
- (hrule:action 'actype:identity))
- (funcall ibut-type-symbol))))))
+ (when (and ibut-type-symbol (symbolp ibut-type-symbol))
+ (let ((type-name (symbol-name ibut-type-symbol)))
+ (unless (string-match "::" type-name)
+ (setq ibut-type-symbol (intern-soft (concat "ibtypes::" type-name))))
+ (when ibut-type-symbol
+ (let ((types (htype:category 'ibtypes))
+ ;; Global var used in (hact) function, don't delete.
+ (hrule:action 'actype:identity))
+ (funcall ibut-type-symbol))))))
+
+(defun ibut:get (&optional lbl-key buffer key-src)
+ "Returns implicit Hyperbole button symbol given by LBL-KEY and BUFFER.
+KEY-SRC is given when retrieving global buttons and is the full source
pathname.
+
+Retrieves button data, converts into a button object and returns a symbol
+which references the button.
+
+All arguments are optional. When none are given, returns a
+symbol for the button or button label that point is within or
+nil. BUFFER defaults to the current buffer."
+ (hattr:clear 'hbut:current)
+ (save-excursion
+ (let ((key-file) (key-dir) (but-data) (actype))
+ (unless lbl-key
+ (setq lbl-key (ibut:label-p nil nil nil nil t)))
+ (when buffer
+ (if (bufferp buffer)
+ (set-buffer buffer)
+ (error "(ibut:get): Invalid buffer argument: %s" buffer)))
+ (when (not key-src)
+ (when (not (equal lbl-key (ibut:label-p nil nil nil nil t)))
+ (goto-char (point-min))
+ (ibut:next-occurrence lbl-key))
+ (when (setq key-src (hbut:key-src 'full))
+ ;; `hbut:key-src' sets current buffer to key-src buffer.
+ (setq buffer (current-buffer))))
+ (when (and (stringp lbl-key) key-src)
+ (when (stringp key-src)
+ (setq key-dir (file-name-directory key-src)
+ key-file (file-name-nondirectory key-src)))
+ (set-buffer (find-file-noselect key-src))
+ (goto-char (point-min))
+ (ibut:next-occurrence lbl-key)
+ ;; Build and return button symbol with button properties
+ (ibut:at-p)))))
(defun ibut:is-p (object)
"Returns non-nil if object denotes an implicit Hyperbole button."
@@ -1082,16 +1222,49 @@ associated arguments from the button."
(let ((categ (hattr:get object 'categ)))
(and categ (string-match "^ibtypes::" (symbol-name categ))))))
-(defun ibut:label-p ()
- "Returns key for Hyperbole implicit button label that point is on or nil."
- (ibut:at-p 'key-only))
+(defun ibut:label-map (but-func &optional start-delim end-delim
+ regexp-match include-delims)
+ "Applies BUT-FUNC to buttons delimited by optional START-DELIM and END-DELIM.
+START-DELIM defaults to ibut:label-start; END-DELIM defaults to ibut:label-end.
+If REGEXP-MATCH is non-nil, only buttons which match this argument are
+considered.
+
+Maps over portion of buffer visible under any current restriction.
+BUT-FUNC must take precisely three arguments: the button label, the
+start position of the delimited button label and its end position (positions
+include delimiters when INCLUDE-DELIMS is non-nil).
+If END-DELIM is a symbol, e.g. t, then START-DELIM is taken as a regular
+expression which matches an entire button string."
+ (hbut:map but-func ibut:label-start ibut:label-end))
+
+(defun ibut:label-p (&optional as-label start-delim end-delim pos-flag
two-lines-flag)
+ "Returns key for the Hyperbole implicit button label that point is within,
else nil.
+This is an optional label that may precede an implicit button.
+Use `ibut:at-p' instead to test if point is on either the
+implicit button itself or the label. Assumes point is within the
+first line of any button label.
+
+All following arguments are optional. If AS-LABEL is non-nil,
+label is returned rather than the key derived from the label.
+START-DELIM and END-DELIM are strings that override default
+button delimiters. With POS-FLAG non-nil, returns list of
+label-or-key, but-label-start-position, but-label-end-position.
+Positions include delimiters. With TWO-LINES-FLAG non-nil,
+constrains label search to two lines."
+ (ebut:label-p as-label (or start-delim ibut:label-start)
+ (or end-delim ibut:label-end) pos-flag two-lines-flag))
+
+(defun ibut:label-regexp (lbl-key &optional no-delim)
+ "Unnormalizes ibutton LBL-KEY. Returns regular expr matching delimited
button label.
+Optional NO-DELIM leaves off delimiters and leading and trailing space."
+ (hbut:label-regexp lbl-key no-delim ibut:label-start ibut:label-end))
(defun ibut:label-set (label &optional start end)
- "Sets current implicit button attributes from LABEL and START, END position.
-Returns label. START and END are optional. When given, they specify the
-region in the buffer to flash when this implicit button is activated or
-queried for its attributes. If LABEL is a list, it is assumed to contain all
-arguments."
+ "Sets current implicit button attributes from LABEL and optional START, END
positions.
+Returns label. When START and END are given, they specify the
+region in the buffer to flash when this implicit button is
+activated or queried for its attributes. If LABEL is a list, it
+is assumed to contain all arguments."
(cond ((stringp label)
(hattr:set 'hbut:current 'lbl-key (hbut:label-to-key label))
(and start (hattr:set 'hbut:current 'lbl-start start))
@@ -1103,12 +1276,63 @@ arguments."
(t (error "(ibut:label-set): Invalid label arg: `%s'" label)))
label)
+(defalias 'ibut:key-src 'hbut:key-src)
+(defalias 'ibut:key-to-label 'hbut:key-to-label)
+(defalias 'ibut:label-to-key 'hbut:label-to-key)
+(defun ibut:next-occurrence (lbl-key &optional buffer)
+ "Moves point to next occurrence of a labeled implicit button with LBL-KEY in
optional BUFFER.
+BUFFER defaults to current buffer. It may be a buffer name.
+Returns non-nil iff occurrence is found.
+
+Remember to use (goto-char (point-min)) before calling this in order to
+move to the first occurrence of the button."
+ (if buffer
+ (if (not (or (bufferp buffer)
+ (and (stringp buffer) (get-buffer buffer))))
+ (error "(ibut:next-occurrence): Invalid buffer arg: %s" buffer)
+ (switch-to-buffer buffer)))
+ (when (re-search-forward (ibut:label-regexp lbl-key) nil t)
+ (goto-char (+ (match-beginning 0) (length ibut:label-start)))))
+
+(defalias 'ibut:summarize 'hbut:report)
+
+(defun ibut:to (lbl-key)
+ "Find an implicit button in the current buffer with LBL-KEY (a label or
lable key), leave point inside it or its label and return the button symbol for
it, else nil."
+ ;; Handle a label given rather than a label key
+ (if (string-match-p "\\s-" lbl-key)
+ (setq lbl-key (ibut:label-to-key lbl-key)))
+ (let ((regexp (hbut:label-regexp lbl-key t))
+ pos
+ found
+ reverse)
+ (save-excursion
+ (forward-line 0)
+ ;; re-search forward
+ (while (and (not found) (re-search-forward regexp nil t))
+ (setq pos (goto-char (match-beginning 0))
+ found (equal (ibut:at-p t) lbl-key)))
+ ;; re-search backward
+ (while (and (not found) (re-search-backward regexp nil t))
+ (setq pos (goto-char (match-beginning 0))
+ found (equal (ibut:at-p t) lbl-key))))
+ (when found
+ (goto-char pos)
+ (ibut:at-p))))
+
+;;; ------------------------------------------------------------------------
+(defconst ibut:label-start "<["
+ "String matching the start of a Hyperbole implicit button label.")
+(defconst ibut:label-end "]>"
+ "String matching the end of a Hyperbole implicit button label.")
+(defvar ibut:label-separator "\\s-*[-:=]*\\s-+"
+ "Regular expression that separates an implicit button label from its
implicit button text.")
+
;;; ========================================================================
;;; ibtype class - Implicit button types
;;; ========================================================================
-(defalias 'defib 'ibtype:create)
-(put 'ibtype:create 'lisp-indent-function 'defun)
+(defalias 'defib 'ibtype:create)
+(put 'ibtype:create 'lisp-indent-function 'defun)
(defmacro ibtype:create (type params doc at-p &optional to-p style)
"Creates Hyperbole implicit button TYPE (unquoted sym) with PARAMS,
described by DOC.
PARAMS are presently ignored.
diff --git a/hib-kbd.el b/hib-kbd.el
index b24a766..8888668 100644
--- a/hib-kbd.el
+++ b/hib-kbd.el
@@ -65,6 +65,7 @@ Any key sequence must be a string of one of the following:
;; these are special quote marks, not the
;; standard ASCII characters.
(hbut:label-p t "‘" "’" t)))
+ ;; This excludes delimiters
(key-sequence (car seq-and-pos))
(start (cadr seq-and-pos))
binding)
diff --git a/hibtypes.el b/hibtypes.el
index d8eb9e0..09795d6 100644
--- a/hibtypes.el
+++ b/hibtypes.el
@@ -64,7 +64,7 @@
(run-hooks 'hibtypes-begin-load-hook)
;;; ========================================================================
-;;; Follows Org mode links by invoking a web browser.
+;;; Follows Org mode links and radio targets and cycles Org heading views
;;; ========================================================================
(require 'hsys-org)
@@ -184,10 +184,9 @@ display options."
;;; ========================================================================
(defconst hibtypes-path-line-and-col-regexp
- (if hyperb:microsoft-os-p
- ;; Allow for 'c:' single letter drive prefixes on MSWindows
- "\\([^ \t\n\r:][^ \t\n\r]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?"
- "\\([^ \t\n\r:]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?"))
+ ;; Allow for 'c:' single letter drive prefixes on MSWindows and
+ ;; Elisp vars with colons in them.
+ "\\([^
\t\n\r\f:][^\t\n\r\f:]+\\(:[^0-9\t\n\r\f]*\\)*\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?$")
(defib pathname-line-and-column ()
"Makes a valid pathname:line-num[:column-num] pattern display the path at
line-num and optional column-num.
@@ -200,10 +199,10 @@ See `hpath:find' function documentation for special file
display options."
(let ((path-line-and-col (hpath:delimited-possible-path)))
(if (and (stringp path-line-and-col)
(string-match hibtypes-path-line-and-col-regexp path-line-and-col))
- (let ((file (expand-file-name (match-string-no-properties 1
path-line-and-col)))
- (line-num (string-to-number (match-string-no-properties 2
path-line-and-col)))
- (col-num (if (match-end 3) (string-to-number
(match-string-no-properties
- 4
path-line-and-col)))))
+ (let ((file (save-match-data (expand-file-name (hpath:substitute-value
(match-string-no-properties 1 path-line-and-col)))))
+ (line-num (string-to-number (match-string-no-properties 3
path-line-and-col)))
+ (col-num (if (match-end 4) (string-to-number
(match-string-no-properties
+ 5
path-line-and-col)))))
(when (save-match-data (setq file (hpath:is-p file)))
(ibut:label-set file (match-beginning 1) (match-end 1))
(if col-num
@@ -628,6 +627,65 @@ Requires the Emacs builtin Tramp library for ftp file
retrievals."
(require 'klink)
;;; ========================================================================
+;;; Links to Hyperbole button types
+;;; ========================================================================
+
+
+(defconst elink:start "<elink:"
+ "String matching the start of a link to a Hyperbole explicit button.")
+(defconst elink:end ">"
+ "String matching the end of a link to a Hyperbole explicit button.")
+
+(defib link-to-ebut ()
+ "At point, activates a link to an explicit button.
+The explicit button's action is executed in the context of the current buffer.
+
+Recognizes the format '<elink:' <button label> '>', e.g. <elink:
project-list>."
+ (let* ((label-key-start-end (hbut:label-p nil elink:start elink:end t t))
+ (lbl-key (nth 0 label-key-start-end))
+ (start-pos (nth 1 label-key-start-end))
+ (end-pos (nth 2 label-key-start-end)))
+ (when lbl-key
+ (ibut:label-set (ebut:key-to-label lbl-key) start-pos end-pos)
+ (hact 'link-to-ebut lbl-key))))
+
+(defconst glink:start "<glink:"
+ "String matching the start of a link to a Hyperbole global button.")
+(defconst glink:end ">"
+ "String matching the end of a link to a Hyperbole global button.")
+
+(defib link-to-gbut ()
+ "At point, activates a link to a global button.
+The global button's action is executed in the context of the current buffer.
+
+Recognizes the format '<glink:' <button label> '>', e.g. <glink: open todos>."
+ (let* ((label-key-start-end (hbut:label-p nil glink:start glink:end t t))
+ (lbl-key (nth 0 label-key-start-end))
+ (start-pos (nth 1 label-key-start-end))
+ (end-pos (nth 2 label-key-start-end)))
+ (when lbl-key
+ (ibut:label-set (ebut:key-to-label lbl-key) start-pos end-pos)
+ (hact 'link-to-gbut lbl-key))))
+
+(defconst ilink:start "<ilink:"
+ "String matching the start of a link to a Hyperbole implicit button.")
+(defconst ilink:end ">"
+ "String matching the end of a link to a Hyperbole implicit button.")
+
+(defib link-to-ibut ()
+ "At point, activates a link to an implicit button.
+The implicit button's action is executed in the context of the current buffer.
+
+Recognizes the format '<ilink:' <button label> '>', e.g. <ilink: my sequence
of keys>."
+ (let* ((label-key-start-end (ibut:label-p nil ilink:start ilink:end t t))
+ (lbl-key (nth 0 label-key-start-end))
+ (start-pos (nth 1 label-key-start-end))
+ (end-pos (nth 2 label-key-start-end)))
+ (when lbl-key
+ (ibut:label-set (ibut:key-to-label lbl-key) start-pos end-pos)
+ (hact 'link-to-ibut lbl-key))))
+
+;;; ========================================================================
;;; Jumps to source line associated with ipython, ripgreb, grep or
;;; With credit to Michael Lipp and Mike Williams for the idea.
;;; ========================================================================
@@ -1052,8 +1110,11 @@ Activates only if point is within the first line of the
Info-node name."
(hbut:label-p t "``" "''" t t)
;; Regular open and close quotes
(hbut:label-p t "`" "'" t t)))
- (node-ref (hpath:is-p (car node-ref-and-pos) nil t)))
- (and node-ref (string-match "\\`([^\):]+)" node-ref)
+ (ref (car node-ref-and-pos))
+ (node-ref (and (stringp ref)
+ (string-match "\\`([^\):]+)" ref)
+ (hpath:is-p (car node-ref-and-pos) nil t))))
+ (and node-ref
(ibut:label-set node-ref-and-pos)
(hact 'link-to-Info-node node-ref))))
diff --git a/hsys-org.el b/hsys-org.el
index c36c424..2e9c117 100644
--- a/hsys-org.el
+++ b/hsys-org.el
@@ -29,6 +29,16 @@
(require 'hbut)
(require 'org)
+(defvar hsys-org-mode-function #'hsys-org-mode-p
+ "*Boolean function of no arguments that determines whether hsys-org actions
are triggered or not.")
+
+(defun hsys-org-mode-p ()
+ "Returns non-nil if an Org-related major or minor mode is active in the
current buffer."
+ (or (derived-mode-p 'org-mode)
+ (and (boundp 'outshine-mode) outshine-mode)
+ (and (boundp 'poporg-mode) poporg-mode)))
+
+
(defun hsys-org-cycle ()
"Calls org-cycle and forces it to be set as this-command to cycle through
all states."
(setq last-command 'org-cycle
@@ -47,17 +57,22 @@
(defib org-mode ()
"Follows any Org mode link at point or cycles through views of the outline
subtree at point."
- (when (derived-mode-p 'org-mode)
- (cond ((org-internal-link-target-at-p)
- (hact 'org-internal-link-target))
- ((org-radio-target-def-at-p)
- (hact 'org-radio-target))
- ((org-link-at-p)
- (hact 'org-link))
- ((org-at-heading-p)
- (hact 'hsys-org-cycle))
- (t
- (hact 'org-meta-return)))))
+ (when (funcall hsys-org-mode-function)
+ (let (start-end)
+ (cond ((setq start-end (org-internal-link-target-at-p))
+ (org-set-ibut-label start-end)
+ (hact 'org-internal-link-target))
+ ((org-radio-target-def-at-p)
+ (hact 'org-radio-target))
+ ((setq start-end (org-link-at-p))
+ (org-set-ibut-label start-end)
+ (hact 'org-link))
+ ((org-at-heading-p)
+ (hact 'hsys-org-cycle))
+ ((org-at-block-start-p)
+ (org-ctrl-c-ctrl-c))
+ (t
+ (hact 'org-meta-return))))))
(defun org-mode:help (&optional _but)
"If on an Org mode heading, cycles through views of the whole buffer outline.
@@ -125,13 +140,21 @@ uses that one. Otherwise, triggers an error."
(setq start-point (1- start-point))))
(cons start-point (next-single-property-change start-point property)))))
-(defsubst org-link-at-p ()
+(defun org-at-block-start-p ()
+ "Returns non-nil if point is on the first line of an Org block definition,
else nil."
+ (save-excursion
+ (forward-line 0)
+ (or (looking-at org-block-regexp)
+ (looking-at org-dblock-start-re))))
+
+(defun org-link-at-p ()
"Returns non-nil iff point is on an Org mode link.
Assumes caller has already checked that the current buffer is in org-mode."
- (org-face-at-p 'org-link))
+ (or (org-in-regexp org-any-link-re)
+ (org-face-at-p 'org-link)))
;; Assumes caller has already checked that the current buffer is in org-mode.
-(defsubst org-target-at-p ()
+(defun org-target-at-p ()
"Returns non-nil iff point is on an Org mode radio target (definition) or
link target (referent).
Assumes caller has already checked that the current buffer is in org-mode."
(org-face-at-p 'org-target))
@@ -217,6 +240,15 @@ White spaces are insignificant. Returns t if a target
link is found, else nil."
(goto-char origin)
nil)))
+(defun org-set-ibut-label (start-end)
+ "Record the label and START-END positions of any implicit button at point."
+ (when (consp start-end)
+ (ibut:label-set (ibut:key-to-label
+ (ibut:label-to-key
+ (buffer-substring-no-properties (car start-end) (cdr
start-end))))
+ (car start-end) (cdr start-end))))
+
+
(defun org-to-next-radio-target-link (target)
"Moves to the start of the next radio TARGET link if found. TARGET must be
a string."
(if (string-match "<<<.+>>>" target)
diff --git a/hui.el b/hui.el
index 1e8ebf0..325f287 100644
--- a/hui.el
+++ b/hui.el
@@ -722,8 +722,8 @@ All args are optional, the current button and buffer file
are the defaults."
(defun hui:hbut-term-highlight (start end)
"For terminals only: Emphasize a button spanning from START to END."
- (save-restriction
- (save-excursion
+ (save-excursion
+ (save-restriction
(goto-char start)
(narrow-to-region (point-min) start)
(sit-for 0)
@@ -737,8 +737,8 @@ All args are optional, the current button and buffer file
are the defaults."
(defun hui:hbut-term-unhighlight (start end)
"For terminals only: Remove any emphasis from hyper-button at START to END."
- (save-restriction
- (save-excursion
+ (save-excursion
+ (save-restriction
(goto-char start)
(narrow-to-region (point-min) start)
(sit-for 0)
@@ -834,7 +834,7 @@ button's source file name when the button data is stored
externally."
(t but-buf))))
(defun hui:link-create (modify but-window lbl-key but-loc but-dir
type-and-args)
- "Creates or modifies a new Hyperbole link button.
+ "Creates or modifies a new Hyperbole explicit link button.
If MODIFY is non-nil, modifies button at point in BUT-WINDOW,
otherwise, prompts for button label and creates a button.
LBL-KEY is internal form of button label. BUT-LOC is file or buffer
@@ -880,11 +880,11 @@ Buffer without File link-to-buffer-tmp"
(let (val)
(delq nil
(list (cond ((eq (current-buffer) (get-file-buffer gbut:file))
- (list 'link-to-gbut buffer-file-name (ebut:label-p)))
+ (list 'link-to-gbut buffer-file-name (hbut:label-p)))
((ebut:at-p)
(list 'link-to-ebut buffer-file-name (ebut:label-p)))
- ((ibut:at-p)
- (list 'link-to-ibut buffer-file-name (ibut:label-p))))
+ ((setq val (ibut:at-p t))
+ (list 'link-to-ibut buffer-file-name val)))
(cond ((eq major-mode 'Info-mode)
(if (and Info-current-node
(member Info-current-node
diff --git a/man/hyperbole.texi b/man/hyperbole.texi
index 4b3c352..f57abee 100644
--- a/man/hyperbole.texi
+++ b/man/hyperbole.texi
@@ -2679,7 +2679,9 @@ upon the referent context in which the Action Key is
released.
@example
Referent Context Link Type
----------------------------------------------------
+Global Button link-to-gbut
Explicit Button link-to-ebut
+Implicit Button link-to-ibut
Info Index Item link-to-Info-index-item
Info Node link-to-Info-node
Mail Reader Message link-to-mail
@@ -6494,58 +6496,29 @@ be of interest to users.
@cindex referent display
@cindex link display
@cindex display where
+@cindex display outside Emacs
@cindex where to display
+@cindex image display
+@cindex internal display
+@cindex external display
Hyperbole lets you control where link referents are displayed and even
what Emacs function or external program is used to display them.
-There are three categories of referents, each with its own display
-setting:
+There are four categories of referents, each with its own display
+setting, listed in decreasing order of priority.
+
@example
Referent Category Variable Setting
========================================================================
-Internal Standard Display hpath:display-where
+Internal Image Display hpath:native-image-suffixes
Internal Custom Display hpath:internal-display-alist
External Display hpath:external-display-alist
+Internal Standard Display hpath:display-where
@end example
-@cindex menu, Cust/Referents
-@kindex C-h h c r
-Regular file links are displayed in an Emacs window specified by the
-@code{hpath:display-where} setting which may be changed with the Cust/Referents
-@bkbd{C-h h c r} menu.
-
@noindent
-Available options are:
-
-@table @emph
-@item @bullet{} Any-Frame
-Display in the selected window of another existing frame
-@item @bullet{} Current-Win
-Display in the selected (current) window
-@item @bullet{} Diff-Frame-One-Win
-Display in the selected window of another existing frame, deleting its other
windows
-@item @bullet{} New-Frame
-Display in a new single window frame
-@item @bullet{} Other-Win
-Display in another, possibly new window of the selected frame (this is
-the default)
-@item @bullet{} Single-Win
-Display in a window of the selected frame and delete its other windows
-@end table
-
-@page
-@noindent
-Alternatively, you can use the Hyperbole menubar menu as shown here:
-
-@float Image,image:Menu-Display-Referents
-@caption{Display Referents Menu}
-@image{im/menu-display-referents,6in,,Display Referents Menu}
-@end float
-@sp 1
-
-@noindent
-Continue reading the next sections for information on custom Internal
-and External Viewers for link referencts.
+Continue reading the next sections for information on how referents
+are displayed internally and externally.
@node Internal Viewers, External Viewers, Referent Display, Customization
@subsection Internal Viewers
@@ -6554,6 +6527,13 @@ and External Viewers for link referencts.
@cindex display function
@cindex internal viewer
@cindex link, display function
+
+@cindex internal image display
+@vindex hpath:native-image-suffixes
+@cindex internal custom display
+@vindex hpath:internal-display-alist
+@cindex internal standard display
+@vindex hpath:display-where
When given a file name, Hyperbole will by default display the file for
editing within an Emacs buffer. The @code{hpath:internal-display-alist}
variable can be used to specify file name patterns, such as matching
@@ -6579,6 +6559,42 @@ Files with an @file{.rdb} suffix are displayed as
relational databases using the
available with InfoDock.
@end table
+@cindex menu, Cust/Referents
+@kindex C-h h c r
+Links to standard files, those which don't match any special referent
+category, are displayed in an Emacs window specified by the
+@code{hpath:display-where} setting. It may be changed with the Cust/Referents
+@bkbd{C-h h c r} menu.
+
+@noindent
+Available options are:
+
+@table @emph
+@item @bullet{} Any-Frame
+Display in the selected window of another existing frame
+@item @bullet{} Current-Win
+Display in the selected (current) window
+@item @bullet{} Diff-Frame-One-Win
+Display in the selected window of another existing frame, deleting its other
windows
+@item @bullet{} New-Frame
+Display in a new single window frame
+@item @bullet{} Other-Win
+Display in another, possibly new window of the selected frame (this is
+the default)
+@item @bullet{} Single-Win
+Display in a window of the selected frame and delete its other windows
+@end table
+
+@page
+@noindent
+Alternatively, you can use the Hyperbole menubar menu as shown here:
+
+@float Image,image:Menu-Display-Referents
+@caption{Display Referents Menu}
+@image{im/menu-display-referents,6in,,Display Referents Menu}
+@end float
+@sp 1
+
@xref{External Viewers}, for instructions on associating file names with
external, window-system specific viewers.
@@ -6592,6 +6608,9 @@ external, window-system specific viewers.
@cindex external program
@cindex external viewer
@cindex link, viewer program
+
+@cindex external display
+@vindex hpath:external-display-alist
If you will be using Hyperbole under a window system,
the @code{hpath:get-external-display-alist} function
in @file{hpath.el} supports hyperlinks that open files using external,
non-Emacs
@@ -6750,9 +6769,11 @@ through invisible/hidden text, making the text
temporarily visible
until point moves past that hidden part. When a search match is
selected, the surrounding text remains visible.
-This command toggles that setting (turns it off if a prefix
-argument less than or equal to 0 is given) and makes searches look at
-only visible text.
+You can temporarily disable searching of hidden text by typing {M-s i}
+while in an incremental search. This key sequence toggles that
+setting and makes searches look at only visible text (or the reverse
+when invoked again). The setting lasts only through the current
+interactive search.
@node Button Colors, , Invisible Text Searches, Customization
@subsection Configuring Button Colors
- [elpa] scratch/hyperbole-lexbind 60d51ad 12/20: Remove last references to XEmscs and xterm used under Emacs 18, (continued)
- [elpa] scratch/hyperbole-lexbind 60d51ad 12/20: Remove last references to XEmscs and xterm used under Emacs 18, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind af55195 05/20: Make Action Key handle bi-directional jumping for Org mode radio target and internal links, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind 36e4724 01/20: 7.0.3a bug fixes; add link-to-ibut, link-to-gbut, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind e647502 18/20: BSD zgrep support for Hyperbole grep command, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind 0829631 13/20: Fix small logic errors in new e/g/ilink functions, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind b128464 06/20: Update Changes and add 7.0.3 release message to HY-ANNOUNCE, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind 332ef33 19/20: V7.0.3b test release: Basic DEMO updates, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind c547ad4 10/20: Merge branch '7.0.3a' into prepare-pr-for-merging, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind 131295e 07/20: Remove conditionals on xemacs, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind ff0f602 11/20: Merge pull request #11 from matsl/prepare-pr-for-merging, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind da8f3fa 09/20: Add labeled implicit buttons, in-buffer links to g/e/ibuts,
Stefan Monnier <=
- [elpa] scratch/hyperbole-lexbind 9ad2bf0 08/20: Remove all featurep checks on xemacs and emacs, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind 21c7432 15/20: Most changes for 7.0.3a release, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind f38ee21 14/20: 7.0.3a changes for creating and modifying ibut labels, small fixes, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind 6e555e7 20/20: Merge remote-tracking branch 'hyperbole/master' into externals/hyperbole, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind d56c8c0 16/20: Most changes for 7.0.3a release, Stefan Monnier, 2019/08/14
- [elpa] scratch/hyperbole-lexbind 64c3563 17/20: Expanded Org mode doc; introduce 'key series' term in Glossary, Stefan Monnier, 2019/08/14