[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole 8792e1c 19/21: Large changeset: add action ib
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/hyperbole 8792e1c 19/21: Large changeset: add action ibtype, symtables to speed ibtype lookup |
|
Date: |
Fri, 4 Oct 2019 14:58:27 -0400 (EDT) |
branch: externals/hyperbole
commit 8792e1ce25bda33621f771e4d120bc09dc7159b4
Author: Bob Weiner <address@hidden>
Commit: Bob Weiner <address@hidden>
Large changeset: add action ibtype, symtables to speed ibtype lookup
---
.hypb | Bin 2234 -> 2413 bytes
Changes | 171 +++++++++++++++++++
DEMO | 78 ++++++++-
HY-NEWS | 94 ++++++----
hact.el | 241 +++++++++++++++++++++-----
hactypes.el | 111 +++++++-----
hargs.el | 4 +-
hbdata.el | 3 +-
hbut.el | 105 +++++++-----
hib-debbugs.el | 22 +--
hib-kbd.el | 10 +-
hibtypes.el | 290 +++++++++++++++----------------
hmouse-tag.el | 37 ++--
hpath.el | 493 ++++++++++++++++++++++++++++++-----------------------
hui.el | 49 +++---
hyperbole.el | 6 +-
man/hyperbole.texi | 55 +++---
set.el | 44 +++--
18 files changed, 1185 insertions(+), 628 deletions(-)
diff --git a/.hypb b/.hypb
index a3c7217..bb92e42 100644
Binary files a/.hypb and b/.hypb differ
diff --git a/Changes b/Changes
index a8bd04e..969cdb6 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,176 @@
+2019-09-17 Bob Weiner <address@hidden>
+
+* hpath.el (hpath:to-line): Added and used in hpath:find and hpath:find-line.
+ (hpath:find-line): Changed to save-restriction when move.
+ (hpath:shell-modes): Added and used in hpath:to-markup-anchor.
+
+2019-09-16 Bob Weiner <address@hidden>
+
+* hpath.el (hpath:line-and-column-regexp): Added.
+ (hpath:markup-link-anchor-regexp): Added group number to doc.
+ (hpath:find): Added support to jump to line and optional
+ column based on :line-num:col-num path suffix, even when preceded
+ by a link anchor.
+
+2019-09-15 Bob Weiner <address@hidden>
+
+* hmouse-tag.el (smart-lisp-at-tag-p): Ignore any leading '<' character
+ from action buttons or other links, i.e. only when followed by an
+ alphabetic character.
+
+* hibtypes.el (action): Moved to near highest priority so embedded
+ paths or other constructs do not match first.
+
+* hact.el (symset:create): Added. Can be used to manually test out
+ different ibtype activation priorities.
+
+* hibtypes.el (pathname-line-and-column): Moved to higher priority
+ than grep, debugger and stack frame matches, so optional col
+ number is not ignored.
+
+* hpath.el (hpath:markdown-section-pattern): Added '*' as a section prefix
+ and allowed for leading whitespace.
+
+* hbut.el (ibut:at-p): Ignore any invalid null ibtype entries.
+
+* hact.el (htype:category, htype:names): Simplified and speeded up. Don't
+ check existence of types. Only valid types should be in
+ the type category list.
+
+* hbut.el (hattr:report): Changed intern call to make-symbol.
+
+* hact.el (actype:elisp-symbol, actype:def-symbol): Added.
+ hui.el (hui:ebut-message, hui:actype, hui:link-create): Changed
+ to use above two functions.
+
+2019-09-14 Bob Weiner <address@hidden>
+
+* hui.el (hui:link-directly):
+ hbut.el (ibut:at-p):
+ hact.el (actype:act, actype:action, actype:create, actype:delete,
+ actype:action-body, actype:interact, ibtype:create,
+ ibtype:delete, htype:category, htype:delete, htype:symbol):
+ Changed to use new, faster symtable instead of symset.
+
+* hact (actype:action): Fixed to handle regular Elisp functions properly.
+
+* set.el: Changed doc strings to imperative form. Explained in the
+ commentary that set:add can create a new single element set if the
+ set passed is nil (empty).
+ (set:empty): Added to test for emptiness.
+
+* hact.el (symtable): Added to speed checks of whether a symbol is an
+ existing Hyperbole type or not. Created symtable:ibtypes and
+ symtable:actypes to hold the categories of types.
+* hact.el (actype:obarray): Added and filled in actype:create to speed
+ checks of whether a symbol is an actype.
+
+2019-09-13 Bob Weiner <address@hidden>
+
+* hpath.el (hpath:to-markup-anchor): Added buffer-name to error messages as
+ may be called when a buffer is temporarily selected.
+
+2019-09-12 Bob Weiner <address@hidden>
+
+* hpath.el (hpath:find): Changed to return buffer if path is displayed
+ within a buffer and not externally (used to return t). Added
+ third parameter 'noselect' flag to return a buffer attached
+ to the parsed filename but not to display it.
+ (hpath:find-noselect): Added.
+ (hpath:normalize): Added and used in link-to-e/ibutton
+
+2019-09-11 Bob Weiner <address@hidden>
+
+* hmouse-tag.el (smart-emacs-lisp-mode-p): Added change-log-mode so
+ Elisp symbols there are matched.
+
+* hact.el (actype:create): Added definition-name property used by
+ find-function-search-for-symbol so now Elisp stack frame function
+ calls that look like actypes::<action-type> and
+ ibtypes::<implicit-button-type> jump to the associated defact and
+ defib definitions.
+
+ actypes::link-to-file
+
+* hmouse-tag.el (smart-lisp-at-definition-p): Don't match to 'def' alone.
+
+2019-09-10 Bob Weiner <address@hidden>
+
+* hact.el (actype:action-body): Renamed from actype:action.
+ (actype:action): Return action function symbol whenever possible
+
+* hibtypes.el (hlink): Fixed to include link type in ibut:label-set call.
+
+* hbut.el (gbut:help): Added labeled implicit button support.
+
+* hargs.el (hargs:reading-p): Updated doc string.
+
+2019-09-02 Bob Weiner <address@hidden>
+
+* hbut.el (ibut:to): Point might be on closing delimiter of ibut in which
+ case ibut:label-p returns nil; moved back one character to prevent this.
+ Also changed wrong ibut:label-p call to proper ibut:at-p call to
+ compare ibut key value at point to search match.
+
+* hpath.el (hpath:substitute-value): Handled case where path does not
+ include a directory separator after the variable name since the
+ variable itself does, e.g.
+ "${hyperb:dir}DEMO#POSIX and MSWindows Paths". Also works if path
+ separator is included.
+
+* hui.el (hui:gbut-create, hui:gbut-modify): Fixed so that when link button
paths
+ are created, they are normalized and made absolute based upon the
+ current buffer's default directory, not the global button file directory.
+ hact.el (action:path-args-rel): Prior to button data storage, make absolute
+ paths relative to the default-directory of their button file, not the
current
+ directory.
+
+* hpath.el (hpath:find): Improved default-directory handling.
+
+* hpath.el (hpath:relative-to, hpath:absolute-to):
+ hactypes.el (link-to-file, link-to-file-line, link-to-file-line-and-column):
+ Remove any double quotes and whitespace at the start and end of the path
+ that interactive use or key series may have introduced.
+ hactypes.el (link-to-file): Rewrote for use with global buttons where the
button
+ source directory is different than the link-to directory. If path is not
+ absolute, add its link-to directory to it.
+
+* hibtypes.el, hpath.el: Added require of subr-x for string-trim function.
+ hpath.el (hpath:trim): Added.
+
+* hpath.el (hpath:is-p): Fixed failure to expand variables when path contains
+ a [#,] suffix.
+
+2019-08-31 Bob Weiner <address@hidden>
+
+* XEmacs: Removed support since no one uses it anymore.
+
+* hbdata.el (hbdata:build): Fixed bug where int was sent to concat.
+
+* hbut.el (ebut:operate): Fixed bug that caused hui:gbut-create to
+ create buttons in the wrong place, sometimes in the middle of
+ other buttons. Added (and (not curr-label) (hmouse-use-region-p)
+ calls to fix this.
+
+* hib-kbd.el (kbd-key): Handled long key series up to 3000 characters
+ with embedded elisp actions.
+
+* hactypes.el (exec-shell-cmd): Fixed window handling accounting for
+ pop-to-buffer call in shell function when shell is newly created.
+
+* DEMO: Added sections on Button Files and Global Buttons.
+
+2019-08-28 Bob Weiner <address@hidden>
+
+* hibtypes.el, hib-social.el, hib-debbugs.el: Changed from active to
+ imperative tense.
+
+* man/hyperbole.texi (Implicit Button Types): Added 'links' concept index
entry.
+
2019-08-27 Bob Weiner <address@hidden>
+* DEMO: Changed most 'click' uses in DEMO to 'press'.
+
* man/hyperbole.texi (Implicit Button Type Summaries): Changed to Implicit
Button Types.
(Implicit Button Type): Changed to Implicit Button
diff --git a/DEMO b/DEMO
index f7a2228..e730e06 100644
--- a/DEMO
+++ b/DEMO
@@ -12,6 +12,8 @@
* History
* Implicit Buttons
* Explicit Buttons
+ * Button Files
+ * Global Buttons
* Smart Mouse Keys
* Epilog
* References
@@ -260,7 +262,7 @@ The {@} command splits a frame into a grid of up to 9 rows
by 9 columns of
windows, showing a different buffer in each window, if available. First
let's expand our frame to full screen with the {.1 %} command and then show
a 2 x 3 grid. We can do multiple commands in one 'key series'. Press the
-action key here: {.1 % .23 @}.
+action key within the braces: {.1 % .23 @}.
You can even write something like this to do the whole thing in one sequence.
First, let's quit out of HyControl Frames mode with {q}. Then go back to one
@@ -1120,12 +1122,78 @@ so these features are disabled by default. If you want
to try them knowing
this, {C-h h c m} will toggle this feature on and off.
+* Button Files
+
+It is often convenient to create files filled with buttons as a means
+of navigating distributed information pools or for other purposes.
+These files can also serve as useful roadmaps that guide you through
+both unfamiliar and highly familiar information spaces. Files that are
+created specifically for this purpose are called "Hyperbole button
+files".
+
+Hyperbole's ButFile menu provides quick access to two types of these
+button files. Your personal button file is stored in
+"${hbmap:dir-user}/HYPB" and accessed with {C-h h b p}. Per-directory
+button files are stored in the respective directories and are also
+named "HYPB". Access the current one with {C-h h b d}.
+
+If you want group and site-specific button files, simply place links
+to such files at the top of your personal button file and do so for your
+colleagues. This provides a flexible means of connecting to such
+resources.
+
+
+* Global Buttons
+
+Global buttons are labeled Hyperbole buttons in your personal button
+file, as explained above. All global buttons are activated by name
+with completion provided, independent of which buffers are displayed.
+Global buttons may be explicit buttons or labeled/named implicit
+buttons.
+
+The Hyperbole Gbut menu creates, modifies and activates global buttons
+by name. Each button created by this menu is stored as an explicit
+button near the end of your personal button file. But any buttons you
+create in other ways within this file also become global buttons.
+
+A good strategy for frequently used global buttons is to use short
+names that you can remember. Then they can be activated quickly.
+
+Let's create a global button that counts the lines in the current
+buffer and displays the count in the minibuffer. Press the Action Key
+on the first line of this key series to create the global button:
+
+ {C-h h g c line-count RET eval-elisp RET
+ (message "Lines in %s = %s"
+ (buffer-name) (count-lines (point-min) (point-max))) RET}
+
+Then activate it with {C-h h g a}, type its name and try it out in
+different buffers.
+
+To avoid embedding such code in the button itself, just define a
+function in your Emacs initialization file and then activate that:
+
+(defun line-count ()
+ (interactive)
+ (message "Lines in %s = %s"
+ (buffer-name) (count-lines (point-min) (point-max))))
+
+Then button creation would be:
+
+ {C-h h g c line-count RET eval-elisp RET (line-count) RET}
+
+Defining a link to a file section is even easier, say to the section
+below here:
+
+ {C-h h g c smk RET link-to-file RET "DEMO#Smart Mouse Keys" RET}
+
+
* Smart Mouse Keys
-If you use Emacs with mouse support under the macOS window system, the X
-Window System or MS Windows, Hyperbole automatically configures your mouse
-keys for use as Smart Keys and provides additional display-oriented
-operations as demonstrated here.
+If you use Emacs with mouse support under the macOS window system, the
+X Window System or MS Windows, Hyperbole automatically configures your
+mouse keys for use as Smart Keys and provides additional
+display-oriented operations as demonstrated here.
See the Hyperbole menu item, Doc/SmartKeys {C-h h d s}, for a summary of
all Smart Key operations. For extensive details on Smart Key operation,
diff --git a/HY-NEWS b/HY-NEWS
index 54d37c1..d2ef8b4 100644
--- a/HY-NEWS
+++ b/HY-NEWS
@@ -8,18 +8,20 @@
BUTTONS
- Action Buttons: A new, universal syntax for creating implicit buttons
- that execute any existing action types or Elisp functions. Such buttons
- are delimited by angle brackets, < >, and come in three types:
+ that execute any existing action types or Elisp functions. Such
+ buttons are delimited by angle brackets, < >, and come in three types:
action type invocations, function calls and variable displays. See
"(hyperbole)Action Buttons" for examples and details on this exciting
new capability.
- - Labeled Implicit Buttons: Optional <[labels]> that precede
- implicit buttons. This enables implicit buttons to be activated
- by name when in the current buffer or anywhere when added to the
- global buttons file (personal button file).
+ - Labeled Implicit Buttons: Optional <[labels]> that precede implicit
+ buttons. This enables implicit buttons to be activated by name when
+ in the current buffer or anywhere when added to the global buttons
+ file (personal button file).
+
+ - Link to Buttons: New implicit button types that link to buttons based
+ on their categories and labels:
- - Link to Buttons: New implicit button types that link to button
categories:
In Buffer Syntax Implicit Button
Type
===========================================================================
<elink: explicit button label to link to: optional ebut file>
link-to-ebut
@@ -30,68 +32,92 @@
debugger-source: Jump to the source of errors from the Python pytype
package
ipython-stack-frame: Jump to the source of ipython stack traces and
exceptions
+ - Must Faster Implicit Buttons: Major speedup in implicit button
identification
+ and activation even with the new generalized Action Button syntax thanks
to
+ internal optimizations.
+
- Pathname implicit buttons now flash when activated.
+ - Pathname implicit buttons may contain both link anchors and line and
column
+ numbers. Link anchors now work for shell script editing modes as well
+ using comment lines as anchors.
+
+ - Variables in paths no longer require a trailing directory separator.
+ Both of these are live Hyperbole paths:
+ "${hyperb:dir}DEMO#Smart Mouse Keys"
+ "${hyperb:dir}/DEMO#Smart Mouse Keys"
+
DOCUMENTATION
+ - DEMO: New sections on Button Files and Global Buttons.
+
- Action Types: link-to-gbut, link-to-ibut - Added.
- - hpath:native-image-suffixes: documented this setting for
- controlling image types that Hyperbole displays within Emacs.
+ - hpath:native-image-suffixes: documented this setting for controlling
+ image types that Hyperbole displays within Emacs.
- Implicit Button Types: Split off type descriptions to this new
subsection and added these types: ripgrep-msg, ipython-stack-frame,
ilink (link to implicit button), glink (link to global button), and
- elink (link to explicit button).
+ib elink (link to explicit button).
- DEMO (Action Buttons): Added description and examples.
- Hyperbole Manual, DEMO (Implicit Buttons): Added description and
example of implicit button labels.
- - Glossary: Updated Implicit Button and Global Button entries with changes.
+ - Glossary: Updated Implicit Button and Global Button entries with
+ changes.
KOUTLINER
- - When 'c' (clip to lines per cell) is omitted from a viewspec, clipping
now changes to
- whatever the default number of lines per cell is (typically, unlimited).
The same goes
- for the 'l' spec (limit display to a certain level of cells).
+ - When 'c' (clip to lines per cell) is omitted from a viewspec, clipping
+ now changes to whatever the default number of lines per cell is
+ (typically, unlimited). The same goes for the 'l' spec (limit display
+ to a certain level of cells).
MENUS
- Pulldown Menus: Implicit-Button/Label: Added to add a label.
- Implicit-Button/Rename - Added to rename the label of
an implicit button.
+ Implicit-Button/Rename - Added to rename the label
+ of an implicit button.
- - Minibuffer Menus: hui-mini.el (hui:menus): Added Ibut/Label and
Ibut/Rename.
+ - Minibuffer Menus: hui-mini.el (hui:menus): Added Ibut/Label and
+ Ibut/Rename.
- ORG MOde
+ ORG MODE
- Radio Targets and Links: Smart Keys now handle these.
- Links: Smart Keys handle both internal and external Org mode links.
+
PROGRAMMING
- - ibut:at-type-p: Added to test if point is on a specific type of implicit
button.
+ - ibut:at-type-p: Added to test if point is on a specific type of
+ implicit button.
- hypb:region-with-text-property-value: Added and used in hysy-org.el.
- - hsys-org-mode-function, hsys-org-mode-p: Added to determine when
hsys-org actions
- are activated.
+ - hsys-org-mode-function, hsys-org-mode-p: Added to determine when
+ hsys-org actions are activated.
- 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.
-
- - gbut:get, hbut:map, ibut:label-map, ibut:key-src, ibut:key-to-label,
ibut:label-to-key,
- hui:ebut-act, ibut:summarize, ibut:label-start, ibut:label-end,
ibut:label-p, ibut:get,
- hui:ibut-label-create, hui:ibut-rename, hui:ibut-message, ibut:alist,
ibut:list, ibut:map,
- ibut:next-occurrence, ibut:label-regexp, gbut:ibut-key-list, ebut:to,
gbut:to, ibut:to,
- ibut:label-separator, hbut:label-regexp, ibut:rename, hbut:get: Added to
support labeled
- implicit buttons and links to buttons.
+ to allow selection of labeled Hyperbole buttons in currrent buffer by
+ name.
+
+ - gbut:get, hbut:map, ibut:label-map, ibut:key-src, ibut:key-to-label,
+ ibut:label-to-key, hui:ebut-act, ibut:summarize, ibut:label-start,
+ ibut:label-end, ibut:label-p, ibut:get, hui:ibut-label-create,
+ hui:ibut-rename, hui:ibut-message, ibut:alist, ibut:list, ibut:map,
+ ibut:next-occurrence, ibut:label-regexp, gbut:ibut-key-list, ebut:to,
+ gbut:to, ibut:to, ibut:label-separator, hbut:label-regexp,
+ ibut:rename, hbut:get: Added to support implicit button labels and
+ links to buttons.
hbut:label-p: Updated to handle implicit button labels.
ibut:label-separator-regexp, hbut:outside-comment-p: Added.
@@ -100,16 +126,16 @@
ilink, ilink:start, ilink:end: Added for in-buffer links to implicit
buttons.
- hsys-org-set-ibut-label: Added and used in org-mode ibtype.
- org-mode, hsys-org-at-block-start-p: Added Action Key activation of Org
blocks when
- on 1st line of def.
+ org-mode, hsys-org-at-block-start-p: Added Action Key activation of
+ Org blocks when on 1st line of def.
SMART (ACTION AND ASSIST) KEYS
- - hpath:find-program: Changed to prioritize hpath:native-image-suffixes
over
- hpath:internal-display-alist over hpath:external-display-alist-macos
instead of the
- reverse. This prevents external viewers from being used when internal
viewers are
- also in effect.
+ - hpath:find-program: Changed to prioritize hpath:native-image-suffixes
+ over hpath:internal-display-alist over hpath:external-display-alist-macos
+ instead of the reverse. This prevents external viewers from being
+ used when internal viewers are also in effect.
===========================================================================
diff --git a/hact.el b/hact.el
index fb3164b..c90f2d6 100644
--- a/hact.el
+++ b/hact.el
@@ -32,29 +32,146 @@ e.g. to inhibit actions.")
;;; ************************************************************************
;;; ========================================================================
-;;; symset class - Hyperbole internal symbol set maintenance
+;;; symtable class - Hyperbole unordered symbol tables with fast lookup
;;; ========================================================================
-(defun symset:add (elt symbol prop)
- "Add ELT to SYMBOL's PROP set.
-Return nil iff ELT is already in SET. Uses `eq' for comparison."
- (let* ((set (get symbol prop))
+(defvar symtable:category-plist nil
+ "Holds a property list of Hyperbole type category symbols ('actypes or
'ibtypes) and their associated symtables.")
+
+(defun symtable:operate (operation symbol-or-name symtable)
+ "Call hash-table function OPERATION with Hyperbole SYMBOL-OR-NAME as key
upon SYMTABLE.
+Trigger an error if SYMBOL-OR-NAME cannot be mapped to an existing Elisp
+symbol or if SYMTABLE is invalid."
+ (let ((name (cond ((stringp symbol-or-name)
+ symbol-or-name)
+ ((symbolp symbol-or-name)
+ (symbol-name symbol-or-name))
+ (t (error "(symtable:operate): Invalid type for
symbol-or-name: %s" symbol-or-name))))
+ (hash-table (plist-get symtable 'hash-table))
+ (intern-op (if (eq operation #'puthash) #'intern #'intern-soft))
+ def-name elisp-name elisp-symbol)
+ (unless hash-table
+ (error "(symtable:operate): symtable lacks required hash-table property:
%s" symtable))
+ (if (string-match "\\`\\(actypes\\|ibtypes\\)::" name)
+ (setq def-name (substring name (match-end 0))
+ elisp-name name
+ elisp-symbol (funcall intern-op elisp-name))
+ (setq def-name name
+ elisp-name (concat (symtable:name symtable) "::" name)
+ elisp-symbol (funcall intern-op elisp-name)))
+ ;; Comment this out so can look for and try to remove symbols yet not
defined.
+ ;; (unless elisp-symbol
+ ;; (error "(symtable:operate): Use `%s' to create a new type named `%s'
before using `%s' on it"
+ ;; (if (equal (plist-get symtable 'name) "actypes") "defact"
"defib")
+ ;; def-name
+ ;; operation))
+ (pcase operation
+ ('gethash
+ (funcall operation def-name hash-table))
+ ('remhash
+ (funcall operation elisp-name hash-table)
+ (funcall operation def-name hash-table))
+ ('puthash
+ (funcall operation elisp-name elisp-symbol hash-table)
+ (funcall operation def-name elisp-symbol hash-table)
+ (gethash def-name hash-table))
+ (_ (error "(symtable:operate): Invalid operation request: %s"
operation)))))
+
+(defsubst symtable:select (type-category)
+ "Inline the return of the symtable for TYPE-CATEGORY, one of 'actypes or
'ibtypes."
+ (plist-get symtable:category-plist type-category))
+
+(defun symtable:create (name size)
+ "Create and return a new Hyperbole type symbol table with NAME and SIZE.
+Also add it under the symbol for its NAME in `symtable:category-plist'."
+ (let ((symtable (list 'name name
+ 'hash-table (make-hash-table :test #'equal :size
size))))
+ (setq symtable:category-plist (plist-put symtable:category-plist (intern
name) symtable))
+ symtable))
+
+(defsubst symtable:hash-table (symtable)
+ "Return the hash-table containing symbol names and values from SYMTABLE."
+ (plist-get symtable 'hash-table))
+
+(defsubst symtable:name (symtable)
+ "Return the name of SYMTABLE as a string."
+ (plist-get symtable 'name))
+
+(defvar symtable:actypes (symtable:create "actypes" 97)
+ "Symbol table (hash table) of Hyperbole action type symbols.
+For each actype, there are two entries whose keys are strings: one
+with the `actypes::' prefix and one without. The value for both
+keys is the Elisp symbol for the type, which includes the prefix.")
+
+(defvar symtable:ibtypes (symtable:create "ibtypes" 97)
+ "Symbol table (hash table) of Hyperbole implicit button type symbols.
+For each ibtype, there are two entries whose keys are strings: one
+with the `ibtypes::' prefix and one without. The value for both
+keys is the Elisp symbol for the type, which includes the prefix.")
+
+(defsubst symtable:actype-p (symbol-or-name)
+ "Return the Elisp symbol given by SYMBOL-OR-NAME if it is a Hyperbole action
type name, else nil."
+ (symtable:get symbol-or-name symtable:actypes))
+
+(defsubst symtable:ibtype-p (symbol-or-name)
+ "Return the Elisp symbol given by SYMBOL-OR-NAME if it is a Hyperbole
implicit button type name, else nil."
+ (symtable:get symbol-or-name symtable:ibtypes))
+
+(defun symtable:add (symbol-or-name symtable)
+ "Add Hyperbole SYMBOL-OR-NAME to existing SYMTABLE.
+Return the Elisp symbol for SYMBOL-OR-NAME.
+Caller must ensure SYMBOL-OR-NAME is a symbol or string."
+ (symtable:operate #'puthash symbol-or-name symtable))
+
+(defalias 'symtable:delete 'symtable:remove)
+
+(defun symtable:get (symbol-or-name symtable)
+ "Return the Elisp symbol given by Hyperbole SYMBOL-OR-NAME if it is in
existing SYMTABLE, else nil.
+Caller must ensure SYMBOL-OR-NAME is a symbol or string."
+ (symtable:operate #'gethash symbol-or-name symtable))
+
+(defun symtable:remove (symbol-or-name symtable)
+ "Remove the Elisp symbol given by Hyperbole SYMBOL-OR-NAME if it is in
existing SYMTABLE.
+Always return nil.
+Caller must ensure SYMBOL-OR-NAME is a symbol or string."
+ (symtable:operate #'remhash symbol-or-name symtable))
+
+
+;;; ========================================================================
+;;; symset class - Hyperbole internal ordered symbol sets
+;;; ========================================================================
+
+(defun symset:create (symbol property &rest symbols)
+ "Set SYMBOL's PROPERTY to a new symset created from any number of SyMBOLS.
+If no SYMBOLS are given, set it to the empty set. Return the symset. Uses
+`eq' for comparison."
+ (let* ((set:equal-op 'eq)
+ (first (car symbols)))
+ (when (and symbols first (listp first))
+ (setq symbols first))
+ (put symbol property (apply #'set:create symbols))))
+
+(defun symset:add (elt symbol property)
+ "Add ELT to SYMBOL's PROPERTY set.
+Return nil iff ELT is already in SET; otherwise, return PROPERTY's value.
+Use `eq' for comparison."
+ (let* ((set (get symbol property))
(set:equal-op 'eq)
(new-set (set:add elt set)))
- (and new-set (put symbol prop new-set))))
+ (and new-set (put symbol property new-set))))
-(defalias 'symset:delete 'symset:remove)
+(defalias 'symset:delete 'symset:remove)
-(defun symset:get (symbol prop)
- "Return SYMBOL's PROP set."
- (get symbol prop))
+(defun symset:get (symbol property)
+ "Return SYMBOL's PROPERTY set."
+ (get symbol property))
-(defun symset:remove (elt symbol prop)
- "Remove ELT from SYMBOL's PROP set and return the new set.
-Assumes PROP is a valid set. Uses `eq' for comparison."
- (let ((set (get symbol prop))
+(defun symset:remove (elt symbol property)
+ "Remove ELT from SYMBOL's PROPERTY set and return the new set.
+Assume PROPERTY is a valid set. Use `eq' for comparison."
+ (let ((set (get symbol property))
(set:equal-op 'eq))
- (put symbol prop (set:remove elt set))))
+ (put symbol property (set:remove elt set))))
;;; ========================================================================
;;; htype class - Hyperbole Types, e.g. action and implicit button types
@@ -68,11 +185,12 @@ Assumes PROP is a valid set. Uses `eq' for comparison."
"Return list of symbols in Hyperbole TYPE-CATEGORY in priority order.
Symbols contain category component.
TYPE-CATEGORY should be 'actypes, 'ibtypes or nil for all."
- (let ((types (symset:get type-category 'symbols))
- (categ-name (symbol-name type-category)))
- (mapcar (lambda (type)
- (intern (concat categ-name "::" (symbol-name type))))
- types)))
+ (let ((def-symbols (symset:get type-category 'symbols))
+ (symtable (symtable:select type-category)))
+ ;; Expand def-symbols to Elisp symbols by adding prefix
+ (when (and def-symbols symtable)
+ (mapcar (lambda (sym) (symtable:get sym symtable)) def-symbols))))
+
;; Thanks to JWZ for help on this.
(defmacro htype:create (type type-category doc params body property-list)
@@ -82,9 +200,11 @@ Fourth arg PARAMS is a list of parameters to send to the
fifth arg BODY,
which is a list of forms executed when the type is evaluated.
Sixth arg PROPERTY-LIST is attached to the new type's symbol.
-Returns the new function symbol derived from TYPE."
+Return the new function symbol derived from TYPE."
+ (when (null type)
+ (error "(htype:create): `type' must not be null"))
(let* ((sym (htype:symbol type type-category))
- (action (nconc (list 'defun sym params doc) body)))
+ (action (nconc (list 'defun sym params doc) body)))
`(progn
,action
(setplist ',sym ,property-list)
@@ -98,6 +218,7 @@ Return the Hyperbole symbol for the TYPE if it existed, else
nil."
(let* ((sym (htype:symbol type type-category))
(exists (fboundp 'sym)))
(setplist sym nil)
+ (symtable:delete type (symtable:select type-category))
(symset:delete type type-category 'symbols)
(fmakunbound sym)
(run-hooks 'htype-delete-hook)
@@ -108,25 +229,25 @@ Return the Hyperbole symbol for the TYPE if it existed,
else nil."
(documentation type))
(defun htype:names (type-category &optional sym)
- "Return a list of the current names for TYPE-CATEGORY in priority order.
-Names do not contain the category component.
+ "Return a list of the current definition names for TYPE-CATEGORY in priority
order.
+Definition names do not contain the category prefix.
TYPE-CATEGORY should be 'actypes, 'ibtypes or nil for all.
When optional SYM is given, returns the name for that symbol only, if any."
(let ((types (symset:get type-category 'symbols))
- (sym-name (and sym (symbol-name sym))))
+ (sym-name (when sym (symbol-name sym))))
(if sym-name
;; Strip category from sym-name before looking for a match.
- (progn (if (string-match "::" sym-name)
- (setq sym (intern (substring sym-name (match-end 0)))))
- (if (memq sym types) (symbol-name sym)))
- (mapcar 'symbol-name types))))
+ (progn (when (string-match "::" sym-name)
+ (setq sym (make-symbol (substring sym-name (match-end 0)))))
+ (when (symtable:get sym (symtable:select type-category))
+ (symbol-name sym)))
+ (mapcar #'symbol-name types))))
;;; ------------------------------------------------------------------------
(defun htype:symbol (type type-category)
"Return Hyperbole type symbol composed from TYPE and TYPE-CATEGORY (both
symbols)."
- (intern (concat (symbol-name type-category) "::"
- (symbol-name type))))
+ (symtable:get type (symtable:select type-category)))
;;; ========================================================================
;;; action class
@@ -247,10 +368,14 @@ Other arguments are returned unchanged."
args-list))
(defun action:path-args-rel (args-list)
- "Return any paths in ARGS-LIST below current directory made relative.
+ "Return any paths in ARGS-LIST below button source loc directory made
relative.
Other paths are simply expanded. Non-path arguments are returned unchanged."
- (let ((dir (hattr:get 'hbut:current 'dir)))
- (mapcar (lambda (arg) (hpath:relative-to arg dir))
+ (let ((loc (hattr:get 'hbut:current 'loc)))
+ (mapcar (lambda (arg)
+ (hpath:relative-to arg
+ (if (stringp loc)
+ loc
+ (buffer-local-value 'default-directory
loc))))
args-list)))
@@ -282,7 +407,7 @@ performing ACTION."
;; string arguments like "tags" as a pathname, when it is not
;; being used as a path. So do this only if actype is a defact
;; and not a defun to limit any potential impact. RSW - 9/22/2017
- (and (symbolp action) (string-match "\\`actypes::" (symbol-name action))
+ (and (symbolp action) (symtable:actype-p action)
(setq args (action:path-args-abs args)))
(let ((hist-elt (hhist:element)))
(run-hooks 'action-act-hook)
@@ -295,6 +420,17 @@ performing ACTION."
t)
(hhist:add hist-elt))))))
+;; Return the full Elisp symbol for ACTYPE, which may be a string or symbol."
+(defalias 'actype:elisp-symbol 'symtable:actype-p)
+
+(defun actype:def-symbol (actype)
+ "Return the abbreviated symbol for ACTYPE used in its `defact'; ACTYPE may
be a string or symbol."
+ (let ((name (if (stringp actype)
+ actype
+ (symbol-name actype))))
+ (when (string-match "\\`actypes::" name)
+ (make-symbol (substring sym-name (match-end 0))))))
+
(defun actype:eval (actype &rest args)
"Performs action formed from ACTYPE and rest of ARGS and returns value.
ACTYPE may be a string containing a Lisp expression from which ACTYPE
@@ -317,16 +453,30 @@ performing ACTION."
(hhist:add hist-elt))))))
(defun actype:action (actype)
- "Return action part of ACTYPE (a symbol or symbol name).
+ "Return action part of ACTYPE (a bound function symbol, symbol name or
function body).
ACTYPE may be a Hyperbole actype or Emacs Lisp function."
+ (let (actname
+ action)
+ (if (stringp actype)
+ (setq actname actype
+ actype (intern actype))
+ (setq actname (symbol-name actype)))
+ (setq actype (or (symtable:actype-p actname) actype)
+ action (htype:body actype))
+ (if (fboundp actype)
+ actype
+ action)))
+
+(defun actype:action-body (actype)
+ "Return action body derived from ACTYPE (a symbol or symbol name).
+ACTYPE may be a Hyperbole actype or Emacs Lisp function.
+If no action body and actype is a bound function symbol, return that."
(let (actname)
(if (stringp actype)
(setq actname actype
actype (intern actype))
(setq actname (symbol-name actype)))
- (cond ((htype:body (if (string-match "\\`actypes::" actname)
- actype
- (intern-soft (concat "actypes::" actname)))))
+ (cond ((htype:body (or (symtable:actype-p actname) actype)))
((fboundp actype) actype))))
(defmacro actype:create (type params doc &rest default-action)
@@ -334,20 +484,22 @@ ACTYPE may be a Hyperbole actype or Emacs Lisp function."
The type uses PARAMS to perform DEFAULT-ACTION (list of the rest of the
arguments). A call to this function is syntactically the same as for
`defun', but a doc string is required.
-Returns symbol created when successful, else nil."
- (list 'htype:create type 'actypes doc params default-action nil))
+Return symbol created when successful, else nil."
+ (symtable:add type symtable:actypes)
+ (list 'htype:create type 'actypes doc params default-action
`'(definition-name ,type)))
(defalias 'defact 'actype:create)
(put 'actype:create 'lisp-indent-function 'defun)
(defun actype:delete (type)
"Delete an action TYPE (a symbol). Return TYPE's symbol if it existed."
+ (symtable:delete type symtable:actypes)
(htype:delete type 'actypes))
(defun actype:doc (hbut &optional full)
"Return first line of act doc for HBUT (a Hyperbole button symbol).
With optional FULL, returns full documentation string.
-Returns nil when no documentation."
+Return nil when no documentation."
(let* ((act (and (hbut:is-p hbut) (or (hattr:get hbut 'action)
(hattr:get hbut 'actype))))
(but-type (hattr:get hbut 'categ))
@@ -374,10 +526,9 @@ Used as the setting of `hrule:action' to inhibit action
evaluation."
(defun actype:interact (actype)
"Interactively call default action for ACTYPE.
ACTYPE is a symbol that was previously defined with `defact'.
-Returns nil only when no action is found or the action has no interactive
+Return nil only when no action is found or the action has no interactive
calling form."
- (let ((action (htype:body
- (intern-soft (concat "actypes::" (symbol-name actype))))))
+ (let ((action (htype:body (symtable:actype-p actype))))
(and action (action:commandp action) (or (call-interactively action) t))))
(defun actype:params (actype)
diff --git a/hactypes.el b/hactypes.el
index e0790ef..a4b0fc8 100644
--- a/hactypes.el
+++ b/hactypes.el
@@ -122,33 +122,36 @@ kill the last output to the shell buffer before executing
SHELL-CMD."
default2)))))
(require 'comint)
(let ((buf-name "*Hyperbole Shell*")
- (owind (selected-window)))
+ (obuf (current-buffer)))
(unwind-protect
(progn
(if (not (hpath:remote-p default-directory))
(setq shell-cmd
(concat "cd " default-directory "; " shell-cmd)))
- (unless (and (get-buffer buf-name)
- (get-buffer-process (get-buffer buf-name)))
- (save-excursion
- (hpath:display-buffer (current-buffer))
- (if (eq (minibuffer-window) (selected-window))
- (other-window 1))
- (setq buf-name (buffer-name (shell buf-name)))
- ;; Wait for shell to startup before sending it input.
- (sit-for 1)
- (setq comint-last-input-start (point-marker)
- comint-last-input-end (point-marker))))
- (hpath:display-buffer buf-name)
- (goto-char (point-max))
- (and kill-prev comint-last-input-end
- (not (equal comint-last-input-start comint-last-input-end))
- (comint-delete-output))
- (insert shell-cmd)
- (comint-send-input)
- (comint-show-output)
- (or internal-cmd (scroll-down 1)))
- (select-window owind))))
+ (if (and (get-buffer buf-name)
+ (get-buffer-process (get-buffer buf-name)))
+ (hpath:display-buffer buf-name)
+ ;; (hpath:display-buffer (current-buffer))
+ (if (eq (minibuffer-window) (selected-window))
+ (other-window 1))
+ ;; 'shell' calls pop-to-buffer which normally displays in
+ ;; another window
+ (setq buf-name (buffer-name (shell buf-name))))
+ (while (not (and (buffer-live-p (get-buffer buf-name))
+ (buffer-modified-p (get-buffer buf-name))))
+ ;; Wait for shell to startup before sending it input.
+ (sit-for 1))
+ (setq comint-last-input-start (point-marker)
+ comint-last-input-end (point-marker)))
+ (goto-char (point-max))
+ (and kill-prev comint-last-input-end
+ (not (equal comint-last-input-start comint-last-input-end))
+ (comint-delete-output))
+ (insert shell-cmd)
+ (comint-send-input)
+ (comint-show-output)
+ (or internal-cmd (scroll-down 1)))
+ (select-window (or (get-buffer-window obuf t) (selected-window)))))
(defact exec-window-cmd (shell-cmd)
"Asynchronously execute an external window-based SHELL-CMD string."
@@ -280,12 +283,14 @@ KEY-FILE defaults to the current buffer's file name."
(beep))
(ebut:label-to-key but-lbl))
but-file)))
+ (let (but
+ normalized-file)
(if key-file
(unless (called-interactively-p 'interactive)
- (setq key-file (hpath:validate (hpath:substitute-value key-file))))
- (setq key-file buffer-file-name))
- (let ((but (and key-file (ebut:get key (find-file-noselect key-file)))))
- (if but
+ (setq normalized-file (hpath:normalize key-file)))
+ (setq normalized-file buffer-file-name))
+
+ (if (setq but (and key-file (ebut:get key normalized-file)))
(hbut:act but)
(hypb:error "(link-to-ebut): No button `%s' in `%s'"
(ebut:key-to-label key)
@@ -311,16 +316,31 @@ the window."
(existing-buf t)
path-buf)
(unwind-protect
- (let* ((file-path (car defaults))
+ (let* ((default-directory (or (hattr:get 'hbut:current 'dir)
default-directory))
+ (file-path (or (car defaults) default-directory))
(file-point (cadr defaults))
(hargs:reading-p 'file)
- (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)
+ ;; If reading interactive inputs from a key series
+ ;; (puts key events into the unread queue), then don't
+ ;; insert default-directory into the minibuffer
+ ;; prompt, allowing time to remove any extra pathname
+ ;; quotes added in the key series.
+ (insert-default-directory (not unread-command-events))
+ ;; Remove any double quotes and whitespace at the
+ ;; start and end of the path that interactive use may
+ ;; have introduced.
+ (path (hpath:trim (read-file-name "Path to link to: "
+ file-path file-path)))
+ ;; Ensure any variables and heading suffixes following
+ ;; [#,] are removed before doing path matching.
+ (normalized-path (hpath:is-p path)))
+ (when (not (or (file-name-absolute-p path)
+ (string-match "\\`\\$\{" path)))
+ (setq path (concat default-directory path)))
+ (setq existing-buf (get-file-buffer normalized-path)
path-buf (or existing-buf
- (and (file-readable-p expanded-path)
- (prog1 (set-buffer (find-file-noselect
expanded-path t))
+ (and (file-readable-p normalized-path)
+ (prog1 (set-buffer (find-file-noselect
normalized-path t))
(when (integerp file-point)
(goto-char (min (point-max)
file-point)))))))
(if path-buf
@@ -335,6 +355,9 @@ the window."
(setq hargs:reading-p prev-reading-p)
(when (and path-buf (not existing-buf))
(kill-buffer path-buf)))))
+ ;; Remove any double quotes and whitespace at the start and end of
+ ;; the path that use within a key series may have introduced.
+ (setq path (hpath:trim path))
(and (hpath:find path)
(integerp point)
(progn (goto-char (min (point-max) point))
@@ -343,6 +366,9 @@ the window."
(defact link-to-file-line (path line-num)
"Display a file given by PATH scrolled to LINE-NUM."
(interactive "fPath to link to: \nnDisplay at line number: ")
+ ;; Remove any double quotes and whitespace at the start and end of
+ ;; the path that interactive use may have introduced.
+ (setq path (hpath:trim path))
(if (condition-case ()
(setq path (smart-tags-file-path path))
(error t))
@@ -354,6 +380,9 @@ the window."
(defact link-to-file-line-and-column (path line-num column-num)
"Display a file given by PATH scrolled to LINE-NUM with point at COLUMN-NUM."
(interactive "fPath to link to: \nnDisplay at line number: \nnand column
number: ")
+ ;; Remove any double quotes and whitespace at the start and end of
+ ;; the path that interactive use may have introduced.
+ (setq path (hpath:trim path))
(when (condition-case ()
(setq path (smart-tags-file-path path))
(error t))
@@ -366,7 +395,7 @@ the window."
(defact link-to-gbut (key &optional key-file)
"Perform an action given by an existing global button, specified by KEY.
Optional second arg, KEY-FILE, is not used but is for calling
-compatibility from the `hlink' function."
+compatibility with the `hlink' function."
(interactive
(let ((gbut-file (hpath:validate (hpath:substitute-value gbut:file)))
but-lbl)
@@ -420,15 +449,16 @@ and its buffer must have a file attached."
(if (and (boundp 'defaults) (listp defaults))
defaults
(list nil nil nil)))))
- (if key-file
- (unless (called-interactively-p 'interactive)
- (setq key-file (hpath:validate (hpath:substitute-value key-file))))
- (setq key-file buffer-file-name))
- (let (but)
+ (let (but
+ normalized-file)
+ (if key-file
+ (unless (called-interactively-p 'interactive)
+ (setq normalized-file (hpath:normalize key-file)))
+ (setq normalized-file buffer-file-name))
(save-excursion
(save-restriction
(when key-file
- (set-buffer (find-file-noselect key-file)))
+ (set-buffer (get-file-buffer normalized-file)))
(widen)
(if (integerp point) (goto-char (min point (point-max))))
(setq but (ibut:to key))))
@@ -598,3 +628,4 @@ Optional OPOINT is point to return to in BUF-NAME after
displaying summary."
(provide 'hactypes)
;;; hactypes.el ends here
+
diff --git a/hargs.el b/hargs.el
index f896677..9d19871 100644
--- a/hargs.el
+++ b/hargs.el
@@ -34,7 +34,7 @@
;;; ************************************************************************
(defvar hargs:reading-p nil
- "Is t only when Hyperbole is prompting user for input, else nil.")
+ "Is either a symbol representing the type of object Hyperbole is prompting
the user to input or nil.")
(add-hook 'completion-setup-hook #'hargs:set-string-to-complete)
(add-hook 'minibuffer-exit-hook #'hargs:unset-string-to-complete)
@@ -281,7 +281,7 @@ that point is within is returned or nil if none."
(defun hargs:actype-get (actype &optional modifying)
"Interactively gets and return list of arguments for ACTYPE's parameters.
Current button is being modified when MODIFYING is non-nil."
- (hargs:action-get (actype:action actype) modifying))
+ (hargs:action-get (actype:action-body actype) modifying))
(defun hargs:at-p (&optional no-default)
"Return thing at point, if of hargs:reading-p type, or default.
diff --git a/hbdata.el b/hbdata.el
index 2716e4b..1765263 100644
--- a/hbdata.el
+++ b/hbdata.el
@@ -162,7 +162,8 @@ Nil BUT-SYM means use 'hbut:current'. If successful,
returns a cons of
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)))
+ (setq lbl-instance (concat ebut:instance-sep
+ (int-to-string (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.
diff --git a/hbut.el b/hbut.el
index f0b80f4..ee668ad 100644
--- a/hbut.el
+++ b/hbut.el
@@ -82,9 +82,9 @@ If successful, leaves point in button data buffer, so caller
should use
lbl-instance))
(defun ebut:delete (&optional but-sym)
- "Deletes Hyperbole explicit button based on optional BUT-SYM.
+ "Delete Hyperbole explicit button based on optional BUT-SYM.
Default is `hbut:current'.
-Returns entry deleted (a list of attribute values) or nil."
+Return entry deleted (a list of attribute values) or nil."
(if (null but-sym) (setq but-sym 'hbut:current))
(if (ebut:is-p but-sym)
(let* ((but-key (hattr:get but-sym 'lbl-key))
@@ -272,7 +272,7 @@ If successful, leaves point in button data buffer, so
caller should use
(defun ebut:next-occurrence (lbl-key &optional buffer)
"Move point to next occurrence of 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.
+Return 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."
@@ -288,7 +288,11 @@ move to the first occurrence of the button."
"Operate on and modify properties of a new or existing explicit 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 a per-buffer unique
+
+If CURR-LABEL is nil, the text in the active region is used as the
+button label, if any, otherwise, an error is signaled.
+
+Return instance string appended to label to form a per-buffer unique
label; nil if label is already unique. Signals an error when no such
button is found in the current buffer."
(let* ((lbl-key (ebut:label-to-key curr-label))
@@ -303,7 +307,7 @@ button is found in the current buffer."
(if (hmail:editor-p) (hmail:msg-narrow))))
(if instance-flag
(progn
- ;; Rename all occurrences of button - those with same label.
+ ;; Rename all occurrences of button - those with same label
(if modify
(let* ((but-key-and-pos (ebut:label-p nil nil nil 'pos))
(at-but (equal (car but-key-and-pos)
@@ -322,9 +326,11 @@ button is found in the current buffer."
lbl-regexp 'include-delims))
(at-but)
((hypb:error "(ebut:operate): No button matching: %s"
curr-label))))
- ;; Add a new button.
+ ;; Add a new button recording its start and end positions
(let (start end buf-lbl)
- (cond ((and (marker-position (hypb:mark-marker t))
+ (cond ((and (not curr-label)
+ (hmouse-use-region-p)
+ (marker-position (hypb:mark-marker t))
(setq start (region-beginning)
end (region-end)
buf-lbl (buffer-substring start end))
@@ -435,8 +441,8 @@ enables partial matches."
total))
(defun ebut:to (lbl-key)
- "Finds the nearest explicit button with LBL-KEY (a label or label key)
within the visible portion of the current buffer.
-Leaves point inside the button label. Returns the symbol for the button, else
nil."
+ "Find the nearest explicit button with LBL-KEY (a label or label key) within
the visible portion of the current buffer.
+Leave point inside the button label. Return the symbol for the button, else
nil."
;; Handle a label given rather than a label key
(if (string-match-p "\\s-" lbl-key)
(setq lbl-key (ebut:label-to-key lbl-key)))
@@ -541,9 +547,9 @@ the button that point is within or nil."
"Displays help for Hyperbole global button with LABEL."
(interactive (list (hargs:read-match "Report on global button labeled: "
(mapcar 'list (gbut:label-list))
- nil t nil 'ebut)))
+ nil t nil 'hbut)))
(let* ((lbl-key (hbut:label-to-key label))
- (but (ebut:get lbl-key nil gbut:file)))
+ (but (hbut:get lbl-key nil gbut:file)))
(if but
(hbut:report but)
(error "(gbut:help): No global button labeled: %s" label))))
@@ -554,9 +560,9 @@ the button that point is within or nil."
(defun gbut:to (lbl-key)
- "Finds the global button with LBL-KEY (a label or label key) within the
visible portion of the global button file.
-Leaves point inside the button label, if it has one.
-Returns the symbol for the button, else nil."
+ "Find the global button with LBL-KEY (a label or label key) within the
visible portion of the global button file.
+Leave point inside the button label, if it has one.
+Return the symbol for the button, else nil."
(when (file-readable-p gbut:file)
(let ((obuf (current-buffer))
(opoint (point))
@@ -624,8 +630,8 @@ Returns the symbol for the button, else nil."
)))
(defun hattr:copy (from-hbut to-hbut)
- "Copies attributes FROM-HBUT TO-HBUT, overwriting TO-HBUT attribute values.
-Returns TO-HBUT."
+ "Copy attributes FROM-HBUT TO-HBUT, overwriting TO-HBUT attribute values.
+Return TO-HBUT."
(mapc (lambda (hbut)
(or (and hbut (symbolp hbut))
(error "(hattr:clear): Argument not a Hyperbole button: %s"
hbut)))
@@ -659,7 +665,7 @@ Each pair of elements is: <attrib-name> <attrib-value>."
(defun hattr:report (attrib-list)
"Pretty print to `standard-output' attribute-value pairs from ATTRIB-LIST.
-Ignores nil valued attributes. Returns t unless no attributes are printed."
+Ignore nil valued attributes. Return t unless no attributes are printed."
(let ((has-attr) attr val len)
(unless (or (null attrib-list) (not (listp attrib-list))
;; odd number of elements?
@@ -681,7 +687,7 @@ Ignores nil valued attributes. Returns t unless no
attributes are printed."
((and (setq str (if (stringp val) val
(prin1-to-string val)))
(string-match "\\`actypes::" str))
- (intern (substring str (match-end 0))))
+ (make-symbol (substring str (match-end 0))))
(t val)))))))
has-attr)))
@@ -817,12 +823,12 @@ Ignores email-related buffers."
label)
(defun hbut:get (&optional lbl-key buffer key-src)
- "Returns explicit or labeled implicit Hyperbole button symbol given by
LBL-KEY and BUFFER.
+ "Return explicit or labeled implicit Hyperbole button symbol given by
LBL-KEY and BUFFER.
KEY-SRC is given when retrieving global buttons and is the full source
pathname.
-Returns a symbol which references the button.
+Return a symbol which references the button.
-All arguments are optional. When none are given, returns a
+All arguments are optional. When none are given, return a
symbol for the button or button label that point is within or
nil. BUFFER defaults to the current buffer."
(or (ebut:get lbl-key buffer key-src) (ibut:get lbl-key buffer key-src)))
@@ -879,7 +885,7 @@ With optional FULL when source is a pathname, the full
pathname is returned."
(hbut:key-src-set-buffer src)))
(defun hbut:key-src-fmt ()
- "Returns unformatted filename associated with formatted current buffer.
+ "Return unformatted filename associated with formatted current buffer.
This is used to obtain the source of Hyperbole buttons for buffers that
represent the output of particular document formatters."
(and (or (eq major-mode 'Info-mode)
@@ -1168,7 +1174,7 @@ source file for the buttons in the menu, if any.")
;;; ========================================================================
(defun ibut:alist (&optional file)
- "Returns alist of labeled ibuts in FILE or the current buffer.
+ "Return alist of labeled ibuts in FILE or the current buffer.
Each element is a list of just an implicit button label. For use
as a completion table."
(mapcar 'list (ibut:list file)))
@@ -1207,7 +1213,7 @@ excluding delimiters, not just one."
(hattr:clear 'hbut:current))
(while (and (not is-type) types)
(setq itype (car types))
- (if (setq args (funcall itype))
+ (if (and itype (setq args (funcall itype)))
(setq is-type itype)
(setq types (cdr types))))
(when is-type
@@ -1224,8 +1230,7 @@ excluding delimiters, not just one."
(hattr:set 'hbut:current 'actype
(or
;; Hyperbole action type
- (intern-soft (concat "actypes::"
- (symbol-name (car
args))))
+ (symtable:actype-p (car args))
;; Regular Emacs Lisp function symbol
(car args)))
(hattr:set 'hbut:current 'args (cdr args))))
@@ -1252,7 +1257,7 @@ associated arguments from the button."
"Return implicit Hyperbole button symbol given by LBL-KEY and BUFFER.
KEY-SRC is given when retrieving global buttons and is the full source
pathname.
-Returns a symbol which references the button.
+Return 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
@@ -1285,9 +1290,9 @@ nil. BUFFER defaults to the current buffer."
(defun ibut:is-p (object)
"Return non-nil if OBJECT denotes an implicit Hyperbole button."
- (if (symbolp object)
- (let ((categ (hattr:get object 'categ)))
- (and categ (string-match "^ibtypes::" (symbol-name categ))))))
+ (when (symbolp object)
+ (let ((categ (hattr:get object 'categ)))
+ (and categ (string-match "\\`ibtypes::" (symbol-name categ))))))
(defun ibut:label-map (but-func &optional start-delim end-delim
regexp-match include-delims)
@@ -1345,7 +1350,7 @@ Optional NO-DELIM leaves off delimiters and leading and
trailing space."
(defun ibut:label-set (label &optional start end)
"Set current implicit button attributes from LABEL and optional START, END
positions.
-Returns label. When START and END are given, they specify the
+Return 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."
@@ -1361,8 +1366,8 @@ is assumed to contain all arguments."
label)
(defun ibut:list (&optional file loc-p)
- "Returns list of labels of labeled ibuts in FILE or the current buffer.
-Removes duplicate labels if optional LOC-P is omitted. With LOC-P, returns
+ "Return list of labels of labeled ibuts in FILE or the current buffer.
+Remove duplicate labels if optional LOC-P is omitted. With LOC-P, return
list of elements (label start end) where start and end are the buffer
positions at which the button label delimiter begins and ends."
(interactive)
@@ -1387,7 +1392,7 @@ positions at which the button label delimiter begins and
ends."
(defun ibut:map (but-func &optional start-delim end-delim
regexp-match include-delims)
- "Applies BUT-FUNC to the labeled implicit buttons in the visible part of the
current buffer.
+ "Apply BUT-FUNC to the labeled implicit buttons in the visible part of the
current buffer.
If REGEXP-MATCH is non-nil, only buttons which match this argument are
considered.
@@ -1399,7 +1404,7 @@ include delimiters when INCLUDE-DELIMS is non-nil)."
(defun ibut:next-occurrence (lbl-key &optional buffer)
"Move 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.
+Return 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."
@@ -1414,9 +1419,9 @@ move to the first occurrence of the button."
(defalias 'ibut:summarize 'hbut:report)
(defun ibut:to (lbl-key)
- "Finds the nearest implicit button with LBL-KEY (a label or label key)
within the visible portion of the current buffer.
-Leaves point inside the button text or its optional label, if it has one.
-Returns the symbol for the button, else nil."
+ "Find the nearest implicit button with LBL-KEY (a label or label key) within
the visible portion of the current buffer.
+Leave point inside the button text or its optional label, if it has one.
+Return the symbol for the button, 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)))
@@ -1431,7 +1436,11 @@ Returns the symbol for the button, else nil."
;; re-search forward
(while (and (not found) (re-search-forward regexp nil t))
(setq pos (match-beginning 0)
- found (equal (ibut:label-p nil nil nil nil t) lbl-key)))
+ ;; Point might be on closing delimiter of ibut in which
+ ;; case ibut:label-p returns nil; move back one
+ ;; character to prevent this.
+ found (progn (goto-char (1- (point)))
+ (equal (ibut:at-p t) lbl-key))))
;; re-search backward
(while (and (not found) (re-search-backward regexp nil t))
(setq pos (match-beginning 0)
@@ -1477,17 +1486,19 @@ label start-pos end-pos), or nil when none is found.
Optional STYLE is a display style specification to use when highlighting
buttons of this type; most useful when TO-P is also given.
-Returns symbol created when successful, else nil. Nil indicates that action
+Return symbol created when successful, else nil. Nil indicates that action
type for ibtype is presently undefined."
- (if type
- (let ((to-func (if to-p (action:create nil (list to-p))))
- (at-func (list at-p)))
- `(htype:create ,type ibtypes ,doc nil ,at-func
- (list 'to-p ,to-func 'style ,style)))))
+ (when type
+ (symtable:add type symtable:ibtypes)
+ (let ((to-func (when to-p (action:create nil (list to-p))))
+ (at-func (list at-p)))
+ `(htype:create ,type ibtypes ,doc nil ,at-func
+ (list 'to-p ,to-func 'style ,style)))))
(defun ibtype:delete (type)
- "Deletes an implicit button TYPE (a symbol).
-Returns TYPE's symbol if it existed, else nil."
+ "Delete an implicit button TYPE (a symbol).
+Return TYPE's symbol if it existed, else nil."
+ (symtable:delete type symtable:ibtypes)
(htype:delete type 'ibtypes))
(provide 'hbut)
diff --git a/hib-debbugs.el b/hib-debbugs.el
index aee2857..916353c 100644
--- a/hib-debbugs.el
+++ b/hib-debbugs.el
@@ -83,10 +83,10 @@
;;; ************************************************************************
(defib debbugs-gnu-query ()
- "Displays the results of a Gnu debbugs query based on the string at point.
-If the query includes a single id number, displays the original message
-submission for that id and allows browsing of the followup discussion.
-The following buffer text formats are accepted (with point prior to any
+ "Display the results of a Gnu debbugs query based on the string at point.
+If the query includes a single id number, display the original message
+submission for that id and allow browsing of the followup discussion.
+Accept the following buffer text formats (with point prior to any
attribute):
bug#id-number or bug# id-number or bug #id-number
@@ -111,7 +111,7 @@ Note that `issue' or `debbugs' may be used as well in place
of `bug'."
(defun debbugs-gnu-query:help (but)
"Make a Gnu debbugs id number at point (optionally prefixed with a # sign)
display the pretty pretted status of the bug id.
-Ignores other types of Gnu debbugs query strings."
+Ignore other types of Gnu debbugs query strings."
(if (and (debbugs-version-sufficient-p)
(debbugs-query:at-p)
(match-beginning 2))
@@ -120,7 +120,7 @@ Ignores other types of Gnu debbugs query strings."
(hkey-help t)))
(defib debbugs-gnu-mode ()
- "Makes a Gnu Debbugs listing entry at point display the discussion on the
issue."
+ "Make a Gnu Debbugs listing entry at point display the discussion on the
issue."
(if (eq major-mode 'debbugs-gnu-mode)
(hact 'smart-debbugs-gnu)))
@@ -179,7 +179,7 @@ severity, and package."
(debbugs-gnu-show-reports))
(defun smart-debbugs-gnu ()
- "An Action Key press on a Gnu Debbugs listing entry, displays the discussion
on the issue."
+ "Display the discussion on the issue at point when the Action Key is pressed
on a Gnu Debbugs listing entry ."
(debbugs-gnu-show-discussion))
;; (let ((entries (cdar tabulated-list-entries)))
@@ -194,8 +194,10 @@ severity, and package."
;;; ************************************************************************
(defun debbugs-query:at-p ()
- "Return t if point appear to be within a debbugs id. Id number is
(match-string 2).
-If this is a query with attributes, then (match-string 3) = \"?\" and
(match-string 4) is the query attributes."
+ "Return t if point appear to be within a debbugs id.
+Id number is (match-string 2). If this is a query with attributes,
+then (match-string 3) = \"?\" and (match-string 4) is the query
+attributes."
;; Point must be before one of the bug#222 characters to match.
(let ((case-fold-search t))
(if (string-match "[bugise#0-9]" (char-to-string (following-char)))
@@ -213,7 +215,7 @@ If this is a query with attributes, then (match-string 3) =
\"?\" and (match-str
(defun debbugs-query:status (id)
"Pretty print to `standard-output' the status attributes of debbugs ID (a
positive integer).
-Ignores nil valued attributes. Returns t unless no attributes are printed."
+Ignore nil valued attributes. Return t unless no attributes are printed."
(require 'debbugs-gnu)
;; The (car (debbugs-get-status id)) is a list of (attribute . value) pairs
which we sort below.
(let ((attrib-list
diff --git a/hib-kbd.el b/hib-kbd.el
index c4b9984..40166f3 100644
--- a/hib-kbd.el
+++ b/hib-kbd.el
@@ -35,19 +35,19 @@
;;; ************************************************************************
(defact kbd-key (key-series)
- "Executes a normalized key sequence without curly braces, {}.
+ "Execute a normalized key sequence without curly braces, {}.
KEY-SERIES must be a string of one of the following:
a Hyperbole minibuffer menu item key sequence,
a HyControl key sequence,
a M-x extended command,
or a valid key sequence together with its interactive arguments.
-Returns t if the sequence appears to be valid, else nil."
+Return t if the sequence appears to be valid, else nil."
(interactive "kKey sequence to execute (no {}): ")
(kbd-key:act key-series))
(defib kbd-key ()
- "Executes a key sequence found around point, delimited by curly braces, {},
if any.
+ "Execute a key sequence found around point, delimited by curly braces, {},
if any.
Key sequences should be in human readable form, e.g. {C-x C-b}, or what
`key-description' returns.
Forms such as {\C-b}, {\^b}, and {^b} will not be recognized.
@@ -58,7 +58,9 @@ Any key sequence must be a string of one of the following:
or a valid key sequence together with its interactive arguments."
(unless (or (br-in-browser)
(and (looking-at "[{}]") (/= ?\\ (preceding-char))))
- (let* ((seq-and-pos (or (hbut:label-p t "{`" "'}" t)
+ ;; handle long series, e.g. eval-elisp actions
+ (let* ((ebut:max-len (max 3000 ebut:max-len))
+ (seq-and-pos (or (hbut:label-p t "{`" "'}" t)
(hbut:label-p t "{" "}" t)
;; Regular dual single quotes (Texinfo smart quotes)
(hbut:label-p t "``" "''" t)
diff --git a/hibtypes.el b/hibtypes.el
index 51d5f3a..7423a17 100644
--- a/hibtypes.el
+++ b/hibtypes.el
@@ -19,6 +19,7 @@
;;; Other required Elisp libraries
;;; ************************************************************************
+(require 'subr-x) ;; For string-trim
(require 'hactypes)
;;; ************************************************************************
@@ -125,7 +126,7 @@ any buffer attached to a file in `hyrolo-file-list', or any
buffer with
;;; ========================================================================
(defib pathname ()
- "Makes a valid pathname display the path entry.
+ "Make a valid pathname display the path entry.
Also works for delimited and non-delimited remote pathnames,
Texinfo @file{} entries, and hash-style link references to HTML,
Markdown or Emacs outline headings, and MSWindows paths (see
@@ -179,37 +180,6 @@ display options."
))))))
;;; ========================================================================
-;;; Displays files at specific lines and optional column number
-;;; locations.
-;;; ========================================================================
-
-(defconst hibtypes-path-line-and-col-regexp
- ;; 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.
-Also works for remote pathnames.
-
-See `hpath:at-p' function documentation for possible delimiters.
-See `hpath:suffixes' variable documentation for suffixes that are added to or
-removed from pathname when searching for a valid match.
-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 (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
- (hact 'link-to-file-line-and-column file line-num col-num)
- (hact 'link-to-file-line file line-num)))))))
-
-;;; ========================================================================
;;; Use the XEmacs func-menu library to jump to a function referred to
;;; in the same file in which it is defined. Function references
;;; across files are handled separately by clauses within the
@@ -217,8 +187,8 @@ See `hpath:find' function documentation for special file
display options."
;;; ========================================================================
(defib function-in-buffer ()
- "Displays the in-buffer definition of a function name that point is within
or after, else nil.
-This triggers only when the \"func-menu.el\" library has been loaded and the
+ "Display the in-buffer definition of a function name that point is within or
after, else nil.
+Trigger only when the \"func-menu.el\" library has been loaded and the
current major mode is one handled by func-menu."
(if (and (boundp 'fume-function-name-regexp-alist)
(assq major-mode fume-function-name-regexp-alist)
@@ -255,7 +225,7 @@ current major mode is one handled by func-menu."
;;; ========================================================================
(defib annot-bib ()
- "Displays annotated bibliography entries referenced internally.
+ "Display annotated bibliography entries referenced internally.
References must be delimited by square brackets, must begin with a word
constituent character, not contain @ or # characters, must not be
in buffers whose names begin with a space or asterisk character, and
@@ -330,7 +300,8 @@ Return t if jump and nil otherwise."
nil))
(defib markdown-internal-link ()
- "Displays any in-file Markdown link referent. Pathnames and urls are
handled elsewhere."
+ "Display any in-file Markdown link referent at point.
+Pathnames and urls are handled elsewhere."
(when (and (eq major-mode 'markdown-mode)
(not (hpath:www-at-p)))
(let ((opoint (point))
@@ -353,83 +324,13 @@ Return t if jump and nil otherwise."
(ibut:label-set (match-string-no-properties 0) (match-beginning 0)
(match-end 0))
(hpath:display-buffer (current-buffer))
(hact 'markdown-follow-wiki-link-at-point))))))
-
-
-;;; ========================================================================
-;;; Executes an angle bracket delimited Hyperbole action, Elisp
-;;; function call or display of an Elisp variable and its value.
-;;; ========================================================================
-
-;; Allow for parameterized action-types surrounded by angle brackets.
-;; For example, <man-show "grep"> should display grep's man page
-;; (since man-show is an action type).
-
-(defconst action:start "<"
- "Regexp matching the start of a Hyperbole Emacs Lisp expression to
evaluate.")
-
-(defconst action:end ">"
- "Regexp matching the end of a Hyperbole Emacs Lisp expression to evaluate.")
-
-(defib action ()
- "At point, activate any of: an Elisp variable, a Hyperbole action-type, or
an Elisp function call surrounded by <> rather than ().
-If an Elisp variable, display a message showing its value.
-
-There may not be any <> characters within the expression. The
-first identifier in the expression must be an Elisp variable,
-action type or a function symbol to call, i.e. '<'actype-or-elisp-symbol
-arg1 ... argN '>'. For example, <mail address@hidden>."
- (let* ((label-key-start-end (ibut:label-p nil action:start action:end t t))
- (ibut-key (nth 0 label-key-start-end))
- (start-pos (nth 1 label-key-start-end))
- (end-pos (nth 2 label-key-start-end))
- actype action args lbl var-flag)
- ;; Continue only if start-delim is either:
- ;; at the beginning of the buffer
- ;; or preceded by a space character or a grouping character
- ;; and that character after start-delim is:
- ;; not a whitespace character
- ;; and end-delim is either:
- ;; at the end of the buffer
- ;; or is followed by a space, punctuation or grouping character.
- (when (and ibut-key (or (null (char-before start-pos))
- (memq (char-syntax (char-before start-pos)) '(?\
?\> ?\( ?\))))
- (not (memq (char-syntax (char-after (1+ start-pos))) '(?\ ?\>)))
- (or (null (char-after end-pos))
- (memq (char-syntax (char-after end-pos)) '(?\ ?\> ?. ?\(
?\)))
- ;; Some of these characters may have symbol-constituent
syntax
- ;; rather than punctuation, so check them individually.
- (memq (char-after end-pos) '(?. ?, ?\; ?: ?! ?\' ?\"))))
- (setq lbl (ibut:key-to-label ibut-key))
- ;; Handle $ preceding var name in cases where same name is
- ;; bound as a function symbol
- (when (string-match "\\`\\$" lbl)
- (setq var-flag t
- lbl (substring lbl 1)))
- (setq actype (if (string-match-p " " lbl) (car (split-string lbl)) lbl)
- actype (or (intern-soft (concat "actype::" actype))
- (intern-soft actype)))
- (when actype
- (ibut:label-set lbl start-pos end-pos)
- (setq action (read (concat "(" lbl ")"))
- args (cdr action))
- (when (and (null args) (symbolp actype) (boundp actype)
- (or var-flag (not (fboundp actype))))
- ;; Is a variable, display its value as the action
- (setq args `(',actype)
- action `(display-variable ',actype)
- actype 'display-variable))
- ;; Necessary so can return a null value, which actype:act cannot.
- (let ((hrule:action (if (eq hrule:action #'actype:identity)
- hrule:action
- 'actype:eval)))
- (apply hrule:action actype (mapcar #'eval args)))))))
;;; ========================================================================
;;; Summarizes an Internet rfc for random access browsing by section.
;;; ========================================================================
(defib rfc-toc ()
- "Summarizes the contents of an Internet rfc from anywhere within an rfc
buffer.
+ "Summarize the contents of an Internet rfc from anywhere within an rfc
buffer.
Each line in the summary may be selected to jump to a section."
(let ((case-fold-search t)
(toc)
@@ -450,8 +351,8 @@ Each line in the summary may be selected to jump to a
section."
;;; ========================================================================
(defib id-cflow ()
- "Expands or collapses C call trees and jumps to code definitions.
-Requires cross-reference tables built by the external `cxref' program of
Cflow."
+ "Expand or collapse C call trees and jump to code definitions.
+Require cross-reference tables built by the external `cxref' program of Cflow."
(if (and (eq major-mode 'id-cflow-mode)
(not (eolp)))
(let ((pnt (point)))
@@ -497,7 +398,7 @@ Requires cross-reference tables built by the external
`cxref' program of Cflow."
;;; ========================================================================
(defib ctags ()
- "Jumps to the source line associated with a ctags file entry in any buffer."
+ "Jump to the source line associated with a ctags file entry in any buffer."
(save-excursion
(beginning-of-line)
(cond
@@ -523,9 +424,9 @@ Requires cross-reference tables built by the external
`cxref' program of Cflow."
;;; ========================================================================
(defib etags ()
- "Jumps to the source line associated with an etags file entry in a TAGS
buffer.
-If on a tag entry line, jumps to the source line for the tag. If on a
-pathname line or line preceding it, jumps to the associated file."
+ "Jump to the source line associated with an etags file entry in a TAGS
buffer.
+If on a tag entry line, jump to the source line for the tag. If on a
+pathname line or line preceding it, jump to the associated file."
(if (let (case-fold-search) (string-match "^TAGS" (buffer-name)))
(save-excursion
(beginning-of-line)
@@ -560,10 +461,11 @@ pathname line or line preceding it, jumps to the
associated file."
;;; ========================================================================
(defib cscope ()
- "Jumps to C/C++ source line associated with Cscope C analyzer output line.
-Requires pre-loading of the cscope.el Lisp library available from the Emacs
-Lisp archives and the open source cscope program available from
-http://cscope.sf.net. Otherwise, does nothing."
+ "Jump to C/C++ source line associated with Cscope C analyzer output line.
+The cscope.el Lisp library available from the Emacs package manager
+must be loaded and the open source cscope program available from
+http://cscope.sf.net must be installed for this button type to do
+anything."
(and (boundp 'cscope:bname-prefix) ;; (featurep 'cscope)
(stringp cscope:bname-prefix)
(string-match (regexp-quote cscope:bname-prefix)
@@ -586,7 +488,7 @@ http://cscope.sf.net. Otherwise, does nothing."
;;; ========================================================================
(defib text-toc ()
- "Jumps to the text file section referenced by a table of contents entry at
point.
+ "Jump to the text file section referenced by a table of contents entry at
point.
File name must contain DEMO, README or TUTORIAL and there must be a `Table
of Contents' or `Contents' label on a line by itself (it may begin with
an asterisk), preceding the table of contents. Each toc entry must begin
@@ -612,8 +514,8 @@ the very beginning of the line."
;;; ========================================================================
(defib dir-summary ()
- "Detects filename buttons in files named \"MANIFEST\" or \"DIR\".
-Displays selected files. Each file name must be at the beginning of the line
+ "Detect filename buttons in files named \"MANIFEST\" or \"DIR\".
+Display selected files. Each file name must be at the beginning of the line
or may be preceded by some semicolons and must be followed by one or more
spaces and then another non-space, non-parenthesis, non-brace character."
(if buffer-file-name
@@ -643,7 +545,7 @@ spaces and then another non-space, non-parenthesis,
non-brace character."
;;; ========================================================================
(defib rfc ()
- "Retrieves and displays an Internet rfc referenced at point.
+ "Retrieve and display an Internet rfc referenced at point.
The following formats are recognized: RFC822, rfc-822, and RFC 822. The
`hpath:rfc' variable specifies the location from which to retrieve RFCs.
Requires the Emacs builtin Tramp library for ftp file retrievals."
@@ -675,7 +577,7 @@ Requires the Emacs builtin Tramp library for ftp file
retrievals."
;;; ========================================================================
(defib man-apropos ()
- "Makes man apropos entries display associated man pages when selected."
+ "Make man apropos entries display associated man pages when selected."
(save-excursion
(beginning-of-line)
(let ((nm "[^ \t\n\r!@,][^ \t\n\r,]*")
@@ -709,11 +611,11 @@ Requires the Emacs builtin Tramp library for ftp file
retrievals."
lbl but-key lbl-key key-file)
(when label-and-file
(setq label-and-file (parse-label-and-file label-and-file)
- lbl (nth 0 label-and-file)
- but-key (hbut:label-to-key lbl)
+ partial-lbl (nth 0 label-and-file)
+ but-key (hbut:label-to-key partial-lbl)
key-file (nth 1 label-and-file)
lbl-key (when but-key (concat label-prefix but-key)))
- (ibut:label-set lbl start-pos end-pos)
+ (ibut:label-set (hbut:key-to-label lbl-key) start-pos end-pos)
(hact link-actype but-key key-file))))
(defun parse-label-and-file (label-and-file)
@@ -728,8 +630,8 @@ Requires the Emacs builtin Tramp library for ftp file
retrievals."
(when (= ?: (aref label-and-file i))
(when (zerop i)
(error "(parse-label-and-file): Missing label: '%s'" label-and-file))
- (setq label (string-trim (substring label-and-file 0 i))
- file (string-trim (substring label-and-file (1+ i))))
+ (setq label (hpath:trim (substring label-and-file 0 i))
+ file (hpath:trim (substring label-and-file (1+ i))))
(when (string-empty-p label) (setq label nil))
(when (string-empty-p file) (setq file nil))
(setq i len))
@@ -744,8 +646,8 @@ Requires the Emacs builtin Tramp library for ftp file
retrievals."
"String matching the end of a link to a Hyperbole explicit button.")
(defib elink ()
- "At point, activates a link to an explicit button.
-The explicit button's action is executed in the context of the current buffer.
+ "At point, activate a link to an explicit button.
+Execute The explicit button's action in the context of the current buffer.
Recognizes the format '<elink:' button_label [':' button_file_path] '>',
where : button_file_path is given only when the link is to another file,
@@ -759,7 +661,7 @@ e.g. <elink: project-list: ~/projs>."
(defib glink ()
"At point, activates a link to a global button.
-The global button's action is executed in the context of the current buffer.
+Execulte the global button's action in the context of the current buffer.
Recognizes the format '<glink:' button_label '>',
e.g. <glink: open todos>."
@@ -772,7 +674,7 @@ e.g. <glink: open todos>."
(defib ilink ()
"At point, activates a link to a labeled implicit button.
-The implicit button's action is executed in the context of the current buffer.
+Execute the implicit button's action in the context of the current buffer.
Recognizes the format '<ilink:' button_label [':' button_file_path] '>',
where button_file_path is given only when the link is to another file,
@@ -785,7 +687,7 @@ e.g. <ilink: my series of keys: ${hyperb:dir}/HYPB>."
;;; ========================================================================
(defib ipython-stack-frame ()
- "Jumps to line associated with an ipython stack frame line numbered msg.
+ "Jump to line associated with an ipython stack frame line numbered msg.
ipython outputs each pathname once followed by all matching lines in that
pathname.
Messages are recognized in any buffer (other than a helm completion
buffer)."
@@ -828,7 +730,7 @@ buffer)."
(hact 'link-to-file-line file line-num)))))))))
(defib ripgrep-msg ()
- "Jumps to line associated with a ripgrep (rg) line numbered msg.
+ "Jump to line associated with a ripgrep (rg) line numbered msg.
Ripgrep outputs each pathname once followed by all matching lines in that
pathname.
Messages are recognized in any buffer (other than a helm completion
buffer)."
@@ -871,7 +773,7 @@ buffer)."
(hact 'link-to-file-line file line-num)))))))))
(defib grep-msg ()
- "Jumps to line associated with line numbered grep or compilation error msgs.
+ "Jump to line associated with line numbered grep or compilation error msgs.
Messages are recognized in any buffer (other than a helm completion
buffer) except for grep -A<num> context lines which are matched only
in grep and shell buffers."
@@ -922,7 +824,7 @@ in grep and shell buffers."
;;; ========================================================================
(defib debugger-source ()
- "Jumps to source line associated with stack frame or breakpoint lines.
+ "Jump to source line associated with stack frame or breakpoint lines.
This works with JavaScript and Python tracebacks, gdb, dbx, and xdb. Such
lines are recognized in any buffer."
(save-excursion
(beginning-of-line)
@@ -1009,11 +911,42 @@ This works with JavaScript and Python tracebacks, gdb,
dbx, and xdb. Such lines
(hact 'link-to-file-line file line-num))))))
;;; ========================================================================
+;;; Displays files at specific lines and optional column number
+;;; locations.
+;;; ========================================================================
+
+(defconst hibtypes-path-line-and-col-regexp
+ ;; 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 ()
+ "Make a valid pathname:line-num[:column-num] pattern display the path at
line-num and optional column-num.
+Also works for remote pathnames.
+
+See `hpath:at-p' function documentation for possible delimiters.
+See `hpath:suffixes' variable documentation for suffixes that are added to or
+removed from pathname when searching for a valid match.
+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 (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 (when (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
+ (hact 'link-to-file-line-and-column file line-num col-num)
+ (hact 'link-to-file-line file line-num)))))))
+
+;;; ========================================================================
;;; Jumps to source of Emacs Lisp byte-compiler error messages.
;;; ========================================================================
(defib elisp-compiler-msg ()
- "Jumps to source code for definition associated with an Emacs Lisp
byte-compiler error message.
+ "Jump to source code for definition associated with an Emacs Lisp
byte-compiler error message.
Works when activated anywhere within an error line."
(if (or (member (buffer-name) '("*Compile-Log-Show*" "*Compile-Log*"
"*compilation*"))
@@ -1067,7 +1000,7 @@ Works when activated anywhere within an error line."
;;; ========================================================================
(defib patch-msg ()
- "Jumps to source code associated with output from the `patch' program.
+ "Jump to source code associated with output from the `patch' program.
Patch applies diffs to source code."
(if (save-excursion
(beginning-of-line)
@@ -1094,7 +1027,7 @@ Patch applies diffs to source code."
;;; ========================================================================
(defib texinfo-ref ()
- "Displays Texinfo, Info node or help associated with Texinfo node, menu
item, @xref, @pxref, @ref, @code, @findex, @var or @vindex at point.
+ "Display Texinfo, Info node or help associated with Texinfo node, menu item,
@xref, @pxref, @ref, @code, @findex, @var or @vindex at point.
If point is within the braces of a cross-reference, the associated
Info node is shown. If point is to the left of the braces but after
the @ symbol and the reference is to a node within the current
@@ -1173,7 +1106,7 @@ For @code, @findex, @var and @vindex references, the
associated documentation st
;;; ========================================================================
(defib gnus-push-button ()
- "Activates GNUS-specific article push-buttons, e.g. for hiding signatures.
+ "Activate GNUS-specific article push-buttons, e.g. for hiding signatures.
GNUS is a news and mail reader."
(and (fboundp 'get-text-property)
(get-text-property (point) 'gnus-callback)
@@ -1191,8 +1124,8 @@ GNUS is a news and mail reader."
;;; ========================================================================
(defib Info-node ()
- "Makes a \"(filename)nodename\" button display the associated Info node.
-Also makes a \"(filename)itemname\" button display the associated Info index
item.
+ "Make a \"(filename)nodename\" button display the associated Info node.
+Also make a \"(filename)itemname\" button display the associated Info index
item.
Examples are \"(hyperbole)Implicit Buttons\" and ``(hyperbole)C-c /''.
Activates only if point is within the first line of the Info-node name."
@@ -1218,7 +1151,7 @@ Activates only if point is within the first line of the
Info-node name."
;;; ========================================================================
(defib hyp-address ()
- "Within a mail or Usenet news composer window, makes a Hyperbole
support/discussion e-mail address insert Hyperbole environment and version
information.
+ "Within a mail or Usenet news composer window, make a Hyperbole
support/discussion e-mail address insert Hyperbole environment and version
information.
See also the documentation for `actypes::hyp-config'.
For example, an Action Mouse Key click on <address@hidden> in
@@ -1236,7 +1169,7 @@ a mail composer window would activate this implicit
button type."
;;; ========================================================================
(defib hyp-source ()
- "Turns source location entries in Hyperbole reports into buttons that jump
to the associated location.
+ "Turn source location entries in Hyperbole reports into buttons that jump to
the associated location.
For example, {C-h h d d C-h h e h o} summarizes the properties of
the explicit buttons in the DEMO file and each button in that
@@ -1252,11 +1185,80 @@ original DEMO file."
(hact 'hyp-source src)))))))
;;; ========================================================================
+;;; Executes an angle bracket delimited Hyperbole action, Elisp
+;;; function call or display of an Elisp variable and its value.
+;;; ========================================================================
+
+;; Allow for parameterized action-types surrounded by angle brackets.
+;; For example, <man-show "grep"> should display grep's man page
+;; (since man-show is an action type).
+
+(defconst action:start "<"
+ "Regexp matching the start of a Hyperbole Emacs Lisp expression to
evaluate.")
+
+(defconst action:end ">"
+ "Regexp matching the end of a Hyperbole Emacs Lisp expression to evaluate.")
+
+(defib action ()
+ "At point, activate any of: an Elisp variable, a Hyperbole action-type, or
an Elisp function call surrounded by <> rather than ().
+If an Elisp variable, display a message showing its value.
+
+There may not be any <> characters within the expression. The
+first identifier in the expression must be an Elisp variable,
+action type or a function symbol to call, i.e. '<'actype-or-elisp-symbol
+arg1 ... argN '>'. For example, <mail address@hidden>."
+ (let* ((label-key-start-end (ibut:label-p nil action:start action:end t t))
+ (ibut-key (nth 0 label-key-start-end))
+ (start-pos (nth 1 label-key-start-end))
+ (end-pos (nth 2 label-key-start-end))
+ actype action args lbl var-flag)
+ ;; Continue only if start-delim is either:
+ ;; at the beginning of the buffer
+ ;; or preceded by a space character or a grouping character
+ ;; and that character after start-delim is:
+ ;; not a whitespace character
+ ;; and end-delim is either:
+ ;; at the end of the buffer
+ ;; or is followed by a space, punctuation or grouping character.
+ (when (and ibut-key (or (null (char-before start-pos))
+ (memq (char-syntax (char-before start-pos)) '(?\
?\> ?\( ?\))))
+ (not (memq (char-syntax (char-after (1+ start-pos))) '(?\ ?\>)))
+ (or (null (char-after end-pos))
+ (memq (char-syntax (char-after end-pos)) '(?\ ?\> ?. ?\(
?\)))
+ ;; Some of these characters may have symbol-constituent
syntax
+ ;; rather than punctuation, so check them individually.
+ (memq (char-after end-pos) '(?. ?, ?\; ?: ?! ?\' ?\"))))
+ (setq lbl (ibut:key-to-label ibut-key))
+ ;; Handle $ preceding var name in cases where same name is
+ ;; bound as a function symbol
+ (when (string-match "\\`\\$" lbl)
+ (setq var-flag t
+ lbl (substring lbl 1)))
+ (setq actype (if (string-match-p " " lbl) (car (split-string lbl)) lbl)
+ actype (or (intern-soft (concat "actype::" actype))
+ (intern-soft actype)))
+ (when actype
+ (ibut:label-set lbl start-pos end-pos)
+ (setq action (read (concat "(" lbl ")"))
+ args (cdr action))
+ (when (and (null args) (symbolp actype) (boundp actype)
+ (or var-flag (not (fboundp actype))))
+ ;; Is a variable, display its value as the action
+ (setq args `(',actype)
+ action `(display-variable ',actype)
+ actype 'display-variable))
+ ;; Necessary so can return a null value, which actype:act cannot.
+ (let ((hrule:action (if (eq hrule:action #'actype:identity)
+ hrule:action
+ 'actype:eval)))
+ (apply hrule:action actype (mapcar #'eval args)))))))
+
+;;; ========================================================================
;;; Inserts completion into minibuffer or other window.
;;; ========================================================================
(defib completion ()
- "Inserts completion at point into minibuffer or other window."
+ "Insert completion at point into minibuffer or other window."
(let ((completion (hargs:completion t)))
(and completion
(ibut:label-set completion)
diff --git a/hmouse-tag.el b/hmouse-tag.el
index e52ae5e..9bfca06 100644
--- a/hmouse-tag.el
+++ b/hmouse-tag.el
@@ -352,7 +352,7 @@ If:
;; buffers, debugger buffers, and Help buffers.
(or (memq major-mode #'(emacs-lisp-mode lisp-interaction-mode debugger-mode))
(string-match "\\`\\*Compile-Log\\(-Show\\)?\\*" (buffer-name))
- (and (or (eq major-mode #'help-mode)
+ (and (or (memq major-mode #'(help-mode change-log-mode))
(string-match "\\`\\*Help\\|Help\\*\\'" (buffer-name)))
(smart-lisp-at-known-identifier-p))))
@@ -637,7 +637,7 @@ buffer."
(save-excursion
(beginning-of-line)
;; Exclude any define- lines.
- (and (looking-at "\\(;*[ \t]*\\)?(def[[:alnum:]]*[[:space:]]")
+ (and (looking-at "\\(;*[ \t]*\\)?(def[[:alnum:]]+[[:space:]]")
;; Ignore alias definitions since those typically have symbol tags
to lookup.
(not (looking-at "\\(;*[ \t]*\\)?(def[^ \t\n\r]*alias"))
;; Ignore lines that start with (default
@@ -660,26 +660,29 @@ Returns matching ELisp tag name that point is within,
else nil."
(defun smart-lisp-at-tag-p (&optional no-flash)
"Return Lisp tag name that point is within, else nil.
-Returns nil when point is on the first line of a non-alias Lisp definition."
+Return nil when point is on the first line of a non-alias Lisp definition."
(unless (smart-lisp-at-definition-p)
(save-excursion
(skip-chars-backward smart-lisp-identifier-chars)
- (if (and (looking-at smart-lisp-identifier)
- ;; Ignore any punctuation matches.
- (not (string-match "\\`[-<>*]+\\'" (match-string 0)))
- ;; Needed to set match string.
- (looking-at smart-lisp-identifier))
- (if no-flash
- (if (eq (char-after (1- (match-end 0))) ?:)
- (buffer-substring-no-properties (point) (1- (match-end 0)))
- (buffer-substring-no-properties (point) (match-end 0)))
+ (when (and (looking-at smart-lisp-identifier)
+ ;; Ignore any punctuation matches.
+ (save-match-data
+ (not (string-match "\\`[-<>*]+\\'" (match-string 0)))))
+ ;; Ignore any leading '<' character from action buttons or
+ ;; other links, i.e. only when followed by an alphabetic character.
+ (when (and (eq (following-char) ?\<) (eq ?w (char-syntax (1+ (point)))))
+ (goto-char (1+ (point))))
+ (if no-flash
(if (eq (char-after (1- (match-end 0))) ?:)
- (smart-flash-tag
- (buffer-substring-no-properties (point) (1- (match-end 0)))
- (point) (1- (match-end 0)))
+ (buffer-substring-no-properties (point) (1- (match-end 0)))
+ (buffer-substring-no-properties (point) (match-end 0)))
+ (if (eq (char-after (1- (match-end 0))) ?:)
(smart-flash-tag
- (buffer-substring-no-properties (point) (match-end 0))
- (point) (match-end 0))))))))
+ (buffer-substring-no-properties (point) (1- (match-end 0)))
+ (point) (1- (match-end 0)))
+ (smart-flash-tag
+ (buffer-substring-no-properties (point) (match-end 0))
+ (point) (match-end 0))))))))
;;;###autoload
(defun smart-lisp-mode-p ()
diff --git a/hpath.el b/hpath.el
index b941cf2..b79bac5 100644
--- a/hpath.el
+++ b/hpath.el
@@ -16,6 +16,7 @@
;;; Other required Elisp libraries
;;; ************************************************************************
+(require 'subr-x) ;; For string-trim
(require 'hversion) ;; for (hyperb:window-system) definition
(require 'hui-select) ;; for `hui-select-markup-modes'
@@ -494,15 +495,21 @@ use with `string-match'.")
(defconst hpath:markdown-anchor-id-pattern "^[ ]*%s: "
"Regexp matching a Markdown anchor id definition and containing a %s for
replacement of a specific anchor id.")
-(defconst hpath:markdown-section-pattern "^#+[ \t]+%s\\([ \t[:punct:]]*\\)$"
+(defconst hpath:markdown-section-pattern "^[ \t]*\\(#+\\|\\*+\\)[ \t]+%s\\([
\t[:punct:]]*\\)$"
"Regexp matching a Markdown section header and containing a %s for
replacement of a specific section name.")
(defconst hpath:markdown-suffix-regexp "\\.[mM][dD]"
"Regexp that matches to a Markdown file suffix.")
(defconst hpath:markup-link-anchor-regexp
- (concat "\\`\\(#?[^#]+\\)\\(#\\)\\([^\]\[#^{}<>\"`'\\\n\t\f\r]*\\)")
- "Regexp that matches a markup filename followed by a hash (#) and an
optional in-file anchor name.")
+ "\\`\\(#?[^#]+\\)\\(#\\)\\([^\]\[#^{}<>\"`'\\\n\t\f\r]*\\)"
+ "Regexp that matches a markup filename followed by a hash (#) and an
optional in-file anchor name.
+Group 3 is the anchor name.")
+
+(defconst hpath:line-and-column-regexp
+ ":\\([-+]?[0-9]+\\)\\(:\\([-+]?[0-9]+\\)\\)?\\s-*\\'"
+ "Regexp that matches a trailing colon separated line number folowed by an
optional column number.
+Group 1 is the line number. Group 3 is the column number.")
(defconst hpath:outline-section-pattern "^\*+[ \t]+%s\\([ \t[:punct:]]*\\)$"
"Regexp matching an Emacs outline section header and containing a %s for
replacement of a specific section name.")
@@ -518,6 +525,9 @@ These are used to indicate how to display or execute the
pathname.
"\\`/[^/:]+:\\|\\`ftp[:.]\\|\\`www\\.\\|\\`https?:"
"Regexp matching remote pathnames and urls which invoke remote file
handlers.")
+(defconst hpath:shell-modes '(sh-mode csh-mode shell-script:mode)
+ "List of modes for editing shell scripts where # is a comment character.")
+
(defconst hpath:texinfo-section-pattern "^@node+[ \t]+%s[ \t]*\\(,\\|$\\)"
"Regexp matching a Texinfo section header and containing a %s for
replacement of a specific section name.")
@@ -527,26 +537,30 @@ These are used to indicate how to display or execute the
pathname.
(defun hpath:absolute-to (path &optional default-dirs)
"Return PATH as an absolute path relative to one directory from optional
DEFAULT-DIRS or `default-directory'.
-Returns PATH unchanged when it is not a valid path or when DEFAULT-DIRS
+Return PATH unchanged when it is not a valid path or when DEFAULT-DIRS
is invalid. DEFAULT-DIRS when non-nil may be a single directory or a list of
directories. The first one in which PATH is found is used."
- (if (not (and (stringp path) (hpath:is-p path nil t)))
- path
- (if (not (cond ((null default-dirs)
- (setq default-dirs (cons default-directory nil)))
- ((stringp default-dirs)
- (setq default-dirs (cons default-dirs nil)))
- ((listp default-dirs))
- (t nil)))
- path
- (let ((rtn) dir)
- (while (and default-dirs (null rtn))
- (setq dir (expand-file-name
- (file-name-as-directory (car default-dirs)))
- rtn (expand-file-name path dir)
- default-dirs (cdr default-dirs))
- (or (file-exists-p rtn) (setq rtn nil)))
- (or rtn path)))))
+ (cond ((not (stringp path))
+ path)
+ ((and (setq path (hpath:trim path))
+ (not (hpath:is-p path nil t)))
+ path)
+ ((not (cond ((null default-dirs)
+ (setq default-dirs (cons default-directory nil)))
+ ((stringp default-dirs)
+ (setq default-dirs (cons default-dirs nil)))
+ ((listp default-dirs))
+ (t nil)))
+ path)
+ (t
+ (let ((rtn) dir)
+ (while (and default-dirs (null rtn))
+ (setq dir (expand-file-name
+ (file-name-as-directory (car default-dirs)))
+ rtn (expand-file-name path dir)
+ default-dirs (cdr default-dirs))
+ (or (file-exists-p rtn) (setq rtn nil)))
+ (or rtn path)))))
(defun hpath:tramp-file-name-regexp ()
"Return a modified `tramp-file-name-regexp' for matching to the beginning of
a remote file name.
@@ -743,7 +757,7 @@ end-pos) or nil."
BUFFER must be a buffer or a buffer name.
See the documentation of `hpath:display-buffer-alist' for valid
-values of DISPLAY-WHERE. Returns the window in which the buffer
+values of DISPLAY-WHERE. Return the window in which the buffer
is displayed or nil if not displayed because BUFFER is invalid."
(interactive "bDisplay buffer: ")
(if (stringp buffer) (setq buffer (get-buffer buffer)))
@@ -763,8 +777,8 @@ is displayed or nil if not displayed because BUFFER is
invalid."
"Display and select BUFFER, in another frame.
BUFFER must be a buffer or a buffer name.
-May create a new frame, or reuse an existing one. See
-the documentation of `hpath:display-buffer' for details. Returns the
+May create a new frame, or reuse an existing one. See the
+documentation of `hpath:display-buffer' for details. Return the
window in which the buffer is displayed."
(interactive "bDisplay buffer in other frame: ")
;; BW 4/30/2016 - Commented out in case interferes with Smart Key
@@ -778,103 +792,155 @@ window in which the buffer is displayed."
(switch-to-buffer buffer)
(selected-window))
-(defun hpath:find (filename &optional display-where)
+(defun hpath:to-line (line-num)
+ "Move point to the start of an absolute LINE-NUM or the last line of the
current buffer."
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (eq selective-display t)
+ (re-search-forward "[\n\r]" nil 'end (1- line-num))
+ (forward-line (1- line-num)))))
+
+(defun hpath:find-noselect (filename)
+ "Find but don't display file FILENAME using user customizable settings of
display program and location.
+Return the current buffer iff file is displayed within a buffer (not with an
external
+program), else nil.
+
+FILENAME may end with hash-style link references to HTML, Markdown or Emacs
+outline headings of the form, <file>#<anchor-name>."
+ (hpath:find filename nil t))
+
+(defun hpath:find (filename &optional display-where noselect)
"Edit file FILENAME using user customizable settings of display program and
location.
+Return the current buffer iff file is displayed within a buffer (not with an
external
+program), else nil.
-FILENAME may start with a special prefix character which is
-handled as follows:
+FILENAME may start with a special prefix character that is handled as follows:
!filename - execute as a non-windowed program within a shell;
&filename - execute as a windowed program;
-filename - load as an Emacs Lisp program.
-Otherwise, if FILENAME matches a regular expression in the alist returned by
-\(hpath:get-external-display-alist), the associated external display program
is invoked.
-If not, `hpath:internal-display-alist' is consulted for a specialized internal
-display function to use. If no matches are found there,
-`hpath:display-where-alist' is consulted using the optional argument,
-DISPLAY-WHERE (a symbol) or if that is nil, the value of
-`hpath:display-where', and the matching display function is used.
+If FILENAME does not start with a prefix character:
+
+ it may be followed by a hash-style link reference to HTML, Markdown
+ or Emacs outline headings of the form, <file>#<anchor-name>,
+ e.g. \"~/.bashrc#Alias Section\";
+
+ it may end with a line number and optional column number to which to go,
+ of the form, :<line-number>[:<column-number>], e.g. \"~/.bashrc:20:5\";
+ normally, this is an absolute line number (disabling buffer restriction),
+ but if preceded by a hash-style link reference, it is relative to the
+ location of the link anchor;
-Allows for hash-style link references to HTML, Markdown or Emacs outline
-headings of the form, <file>#<anchor-name>.
+ if it matches a regular expression in the alist returned by
+ \(hpath:get-external-display-alist), invoke the associated external
+ display program
-Returns non-nil iff file is displayed within a buffer (not with an external
-program)."
+ if not, consult `hpath:internal-display-alist' for a specialized internal
+ display function to use;
+
+ if no matches are found there, consult `hpath:display-where-alist'
+ using the optional second argument, DISPLAY-WHERE (a symbol);
+
+ if that is nil, consult the value of `hpath:display-where', and use the
+ matching display function.
+
+Optional third argument, NOSELECT, means simply find the file and return its
+buffer but don't display it."
(interactive "FFind file: ")
(let ((case-fold-search t)
(default-directory default-directory)
- modifier loc anchor hash path)
- (if (string-match hpath:prefix-regexp filename)
- (setq modifier (aref filename 0)
- filename (substring filename (match-end 0))))
- (setq path (hpath:substitute-value
- (if (string-match hpath:markup-link-anchor-regexp filename)
- (progn (setq hash t
- anchor (match-string 3 filename))
- (substring filename 0 (match-end 1)))
- filename))
- loc (hattr:get 'hbut:current 'loc)
- default-directory (file-name-directory
- ;; Loc may be a buffer without a file
- (if (stringp loc) loc default-directory))
+ modifier loc anchor hash path line-num col-num)
+ (setq loc (hattr:get 'hbut:current 'loc)
+ default-directory (or (hattr:get 'hbut:current 'dir)
+ ;; Loc may be a buffer without a file
+ (if (stringp loc)
+ loc
+ default-directory)))
+ (when (string-match hpath:prefix-regexp filename)
+ (setq modifier (aref filename 0)
+ filename (substring filename (match-end 0))))
+ (setq path filename) ;; default
+ (when (string-match hpath:line-and-column-regexp path)
+ (setq line-num (string-to-number (match-string 1 path))
+ col-num (when (match-string 3 path)
+ (string-to-number (match-string 3 path)))
+ path (substring path 0 (match-beginning 0))))
+ (when (string-match hpath:markup-link-anchor-regexp path)
+ (setq hash t
+ anchor (match-string 3 path)
+ path (substring path 0 (match-end 1))))
+ (setq path (hpath:substitute-value path)
filename (hpath:absolute-to path default-directory))
- (let ((remote-filename (hpath:remote-p path)))
- (or modifier remote-filename
- (file-exists-p filename)
- (error "(hpath:find): \"%s\" does not exist" filename))
- (or modifier remote-filename
- (file-readable-p filename)
- (error "(hpath:find): \"%s\" is not readable" filename))
- ;; If filename is a remote file (not a directory, we have to copy it to
- ;; a temporary local file and then display that.
- (when (and remote-filename (not (file-directory-p remote-filename)))
- (copy-file remote-filename
- (setq path (concat hpath:tmp-prefix
- (file-name-nondirectory remote-filename)))
- t t)
- (setq filename (cond (anchor (concat remote-filename "#" anchor))
- (hash (concat remote-filename "#"))
- (t path)))))
- (cond (modifier (cond ((= modifier ?!)
- (hact 'exec-shell-cmd filename))
- ((= modifier ?&)
- (hact 'exec-window-cmd filename))
- ((= modifier ?-)
- (hact 'load filename)))
- nil)
- (t (let ((display-executables (hpath:find-program path))
- executable)
- (cond ((stringp display-executables)
- (hact 'exec-window-cmd
- (hpath:command-string display-executables
- filename))
+ (if noselect
+ (prog1 (find-file-noselect filename)
+ (if (or hash anchor) (hpath:to-markup-anchor hash anchor)))
+ (let ((remote-filename (hpath:remote-p path)))
+ (or modifier remote-filename
+ (file-exists-p filename)
+ (error "(hpath:find): \"%s\" does not exist" filename))
+ (or modifier remote-filename
+ (file-readable-p filename)
+ (error "(hpath:find): \"%s\" is not readable" filename))
+ ;; If filename is a remote file (not a directory), we have to copy it to
+ ;; a temporary local file and then display that.
+ (when (and remote-filename (not (file-directory-p remote-filename)))
+ (copy-file remote-filename
+ (setq path (concat hpath:tmp-prefix
+ (file-name-nondirectory
remote-filename)))
+ t t)
+ (setq filename (cond (anchor (concat remote-filename "#" anchor))
+ (hash (concat remote-filename "#"))
+ (t path)))))
+ (cond (modifier (cond ((= modifier ?!)
+ (hact 'exec-shell-cmd filename))
+ ((= modifier ?&)
+ (hact 'exec-window-cmd filename))
+ ((= modifier ?-)
+ (hact 'load filename)))
nil)
- ((functionp display-executables)
- (funcall display-executables filename)
- t)
- ((and (listp display-executables) display-executables)
- (setq executable (hpath:find-executable
- display-executables))
- (if executable
- (hact 'exec-window-cmd
- (hpath:command-string executable
- filename))
- (error "(hpath:find): No available executable from: %s"
- display-executables)))
- (t (setq path (hpath:validate path))
- (if (null display-where)
+ (t (let ((display-executables (hpath:find-program path))
+ executable)
+ (cond ((stringp display-executables)
+ (hact 'exec-window-cmd
+ (hpath:command-string display-executables
+ filename))
+ nil)
+ ((functionp display-executables)
+ (funcall display-executables filename)
+ (current-buffer))
+ ((and (listp display-executables) display-executables)
+ (setq executable (hpath:find-executable
+ display-executables))
+ (if executable
+ (hact 'exec-window-cmd
+ (hpath:command-string executable
+ filename))
+ (error "(hpath:find): No available executable from:
%s"
+ display-executables)))
+ (t (setq path (hpath:validate path))
+ (when (null display-where)
(setq display-where hpath:display-where))
- (funcall
- (car (cdr (or (assq display-where
- hpath:display-where-alist)
- (assq 'other-window
- hpath:display-where-alist))))
- path)
- (if (or hash anchor) (hpath:to-markup-anchor hash
anchor))
- t)))))))
+ (funcall
+ (car (cdr (or (assq display-where
+ hpath:display-where-alist)
+ (assq 'other-window
+ hpath:display-where-alist))))
+ path)
+ (when (or hash anchor) (hpath:to-markup-anchor hash
anchor))
+ (when line-num
+ ;; With an anchor, goto line relative to
+ ;; anchor location, otherwise use absolute
+ ;; line number within the visible buffer
+ ;; portion.
+ (if (or hash anchor)
+ (forward-line line-num)
+ (hpath:to-line line-num)))
+ (when col-num (move-to-column col-num))
+ (current-buffer)))))))))
(defun hpath:to-markup-anchor (hash anchor)
- "Move point to the definition of ANCHOR if found or if only HASH is non-nil,
move to the beginning of the buffer."
+ "Move point to the beginning of the buffer if only HASH is non-nil;
otherwise, move point to the definition of ANCHOR if found."
(cond ((and (stringp anchor) (not (equal anchor "")))
(cond ((memq major-mode hui-select-markup-modes)
;; In HTML-like mode where link ids are case-sensitive.
@@ -885,7 +951,8 @@ program)."
(progn (forward-line 0)
(recenter 0))
(goto-char opoint)
- (error "(hpath:to-markup-anchor): Anchor `%s' not found in
the visible buffer portion"
+ (error "(hpath:to-markup-anchor): %s - Anchor `%s' not
found in the visible buffer portion"
+ (buffer-name)
anchor))))
(t
(let ((opoint (point))
@@ -896,7 +963,8 @@ program)."
(anchor-name (subst-char-in-string ?- ?\ anchor)))
(goto-char (point-min))
(if (re-search-forward (format
- (cond ((string-match
hpath:markdown-suffix-regexp buffer-file-name)
+ (cond ((or (string-match
hpath:markdown-suffix-regexp buffer-file-name)
+ (memq major-mode
hpath:shell-modes))
hpath:markdown-section-pattern)
((eq major-mode 'texinfo-mode)
hpath:texinfo-section-pattern)
@@ -905,7 +973,8 @@ program)."
(progn (forward-line 0)
(recenter 0))
(goto-char opoint)
- (error "(hpath:to-markup-anchor): Section `%s' not found in
the visible buffer portion"
+ (error "(hpath:to-markup-anchor): %s - Section `%s' not
found in the visible buffer portion"
+ (buffer-name)
anchor-name))))))
(hash (goto-char (point-min)))))
@@ -924,35 +993,30 @@ program)."
nil))
(defun hpath:find-line (filename line-num &optional display-where)
- "Edits file FILENAME with point placed at LINE-NUM.
+ "Edit file FILENAME with point placed at LINE-NUM.
-`hpath:display-where-alist' is consulted using the optional argument,
-DISPLAY-WHERE (a symbol) or if that is nil, the value of
-`hpath:display-where', and the matching display function is used to determine
-where to display the file, e.g. in another frame.
-Always returns t."
+`hpath:display-where-alist' is consulted using the optional
+argument, DISPLAY-WHERE (a symbol) or if that is nil, the value
+of `hpath:display-where', and the matching display function is
+used to determine where to display the file, e.g. in another
+frame. Always return t."
(interactive "FFind file: ")
- ;; Just delete any special Hyperbole command characters preceding the
filename, ignoring them.
+ ;; Just delete any special Hyperbole command characters preceding
+ ;; the filename, ignoring them.
(if (string-match hpath:prefix-regexp filename)
(setq filename (substring filename (match-end 0))))
- (setq filename (hpath:substitute-value filename)
- filename (hpath:validate filename))
- (if (null display-where)
- (setq display-where hpath:display-where))
- (funcall (car (cdr (or (assq display-where
- hpath:display-where-alist)
- (assq 'other-window
- hpath:display-where-alist))))
- filename)
- (if (integerp line-num)
- (progn (widen) (goto-char (point-min)) (forward-line (1- line-num))))
+ (hpath:find
+ (if (integerp line-num)
+ (concat filename ":" (int-to-string line-num))
+ filename)
+ display-where)
t)
(defun hpath:find-other-frame (filename)
- "Edits file FILENAME, in another frame.
-May create a new frame, or reuse an existing one.
+ "Edit file FILENAME in another frame.
+May create a new frame or reuse an existing one.
See documentation of `hpath:find' for details.
-Returns the buffer of displayed file."
+Return the buffer of displayed file."
(interactive "FFind file in other frame: ")
(if (= (length (frame-list)) 1)
(if (fboundp 'id-create-frame)
@@ -1001,11 +1065,12 @@ of existing pathnames, but not at the start or end.
Before the pathname is checked for existence, tabs and newlines
are converted to a single space, `hpath:prefix-regexp' matches at
the start are temporarily stripped, link anchors at the end
-following a # or , character are stripped, and path variables are
-expanded with `hpath:substitute-value'. This normalized path
-form is what is returned for PATH."
+following a # or , character are temporarily stripped, and path
+variables are expanded with `hpath:substitute-value'. This normalized
+path form is what is returned for PATH."
(when (stringp path)
- (let (modifier)
+ (let (modifier
+ suffix)
(when (string-match hpath:prefix-regexp path)
(setq modifier (substring path 0 1)
path (substring path (match-end 0))))
@@ -1017,21 +1082,29 @@ form is what is returned for PATH."
(or (not (string-match "[()]" path))
(string-match "\\`([^ \t\n\r\)]+)[ *A-Za-z0-9]" path))
(if (string-match "\\$\{[^\}]+}" path)
- (setq path (hpath:substitute-value path))
+ ;; Path may be a link reference with a suffix component
+ ;; following a comma or # symbol, so temporarily strip
+ ;; these, if any, before expanding any embedded variables.
+ (if (string-match "[ \t\n\r]*[#,]" path)
+ (progn (setq suffix (substring path (match-beginning 0))
+ path (substring path 0 (match-beginning 0))
+ path (concat (hpath:substitute-value path)
+ suffix)
+ suffix nil)
+ t)
+ (setq path (hpath:substitute-value path)))
t)
(not (string-match "[\t\n\r\"`'|{}\\]" path))
- (let ((rtn-path path)
- (suffix))
- ;; Path may be a link reference with components other than a
- ;; pathname. These components always follow a comma or # symbol,
so
- ;; strip them, if any, before checking path.
+ (let ((rtn-path path))
+ ;; Strip any path suffix component before checking path.
(and (if (string-match "\\`[^#][^#,]*\\([ \t\n\r]*[#,]\\)" path)
(setq rtn-path (concat (substring path 0 (match-beginning
1))
"%s" (substring path
(match-beginning 1)))
path (substring path 0 (match-beginning 1)))
(setq rtn-path (concat rtn-path "%s")))
;; If path is just a local reference that begins with #,
- ;; prepend the file name to it.
+ ;; prepend the file name to it. Remove # and
+ ;; everything after for path checking.
(cond ((and buffer-file-name
;; ignore HTML color strings
(not (string-match
"\\`#[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]\\'"
path))
@@ -1109,29 +1182,34 @@ Is a no-op if the function `push-tag-mark' is not
available."
(defun hpath:relative-to (path &optional default-dir)
"Return PATH relative to optional DEFAULT-DIR or `default-directory'.
-Returns PATH unchanged when it is not a valid path."
- (if (not (and (stringp path) (hpath:is-p path)))
- path
- (setq default-dir
- (expand-file-name
- (file-name-as-directory (or default-dir default-directory)))
- path (expand-file-name path))
- (and path default-dir
- (if (string-equal "/" default-dir)
- path
- (let ((end-dir (min (length path) (length default-dir))))
- (cond
- ((string-equal (substring path 0 end-dir) default-dir)
- (concat "./" (substring path end-dir)))
- ((progn (setq default-dir (file-name-directory
(directory-file-name default-dir))
- end-dir (min (length path) (length default-dir)))
- (string-equal (substring path 0 end-dir) default-dir))
- (concat "../" (substring path end-dir)))
- ((progn (setq default-dir (file-name-directory
(directory-file-name default-dir))
- end-dir (min (length path) (length default-dir)))
- (string-equal (substring path 0 end-dir) default-dir))
- (concat "../../" (substring path end-dir)))
- (t path)))))))
+Expand any other valid path. Return PATH unchanged when it is not a
+valid path."
+ (cond ((not (stringp path))
+ path)
+ ((and (setq path (hpath:trim path))
+ (not (hpath:is-p path)))
+ path)
+ (t
+ (setq default-dir
+ (expand-file-name
+ (file-name-as-directory (or default-dir default-directory)))
+ path (expand-file-name path))
+ (and path default-dir
+ (if (string-equal "/" default-dir)
+ path
+ (let ((end-dir (min (length path) (length default-dir))))
+ (cond
+ ((string-equal (substring path 0 end-dir) default-dir)
+ (concat "./" (substring path end-dir)))
+ ((progn (setq default-dir (file-name-directory
(directory-file-name default-dir))
+ end-dir (min (length path) (length
default-dir)))
+ (string-equal (substring path 0 end-dir)
default-dir))
+ (concat "../" (substring path end-dir)))
+ ((progn (setq default-dir (file-name-directory
(directory-file-name default-dir))
+ end-dir (min (length path) (length
default-dir)))
+ (string-equal (substring path 0 end-dir)
default-dir))
+ (concat "../../" (substring path end-dir)))
+ (t path))))))))
(defun hpath:rfc (rfc-num)
"Return pathname to textual rfc document indexed by RFC-NUM.
@@ -1177,19 +1255,21 @@ in-buffer path will not match."
(let* ((var-group (substring path match start))
(var-name (substring path (+ match 2) (1- start)))
(rest-of-path (substring path start))
+ (trailing-dir-sep-flag (and (not (string-empty-p rest-of-path))
+ (memq (aref rest-of-path 0) '(?/
?\\))))
(sym (intern-soft var-name)))
(when (file-name-absolute-p rest-of-path)
(setq rest-of-path (substring rest-of-path 1)))
(if (or (and sym (boundp sym)) (getenv var-name))
- (directory-file-name
- ;; hpath:substitute-dir triggers an error when given an
- ;; invalid local path but this may be called when
- ;; testing for implicit button matches where no error
- ;; should occur, so catch the error and ignore variable
- ;; expansion in such a case. -- RSW, 8/26/2019
- (condition-case nil
- (hpath:substitute-dir var-name rest-of-path)
- (error rest-of-path)))
+ (funcall (if trailing-dir-sep-flag #'directory-file-name
#'identity)
+ ;; hpath:substitute-dir triggers an error when given an
+ ;; invalid local path but this may be called when
+ ;; testing for implicit button matches where no error
+ ;; should occur, so catch the error and ignore variable
+ ;; expansion in such a case. -- RSW, 8/26/2019
+ (condition-case nil
+ (hpath:substitute-dir var-name rest-of-path)
+ (error rest-of-path)))
var-group)))
t)))
@@ -1273,6 +1353,15 @@ Returns LINKNAME unchanged if it is not a symbolic link
but is a pathname."
(setq referent (expand-file-name referent dirname))))
referent)
+(defun hpath:trim (path)
+ "Return PATH with any [\" \t\n\r] characters trimmed from its start and end."
+ (string-trim path "[\" \t\n\r]+" "[\" \t\n\r]+"))
+
+(defun hpath:normalize (filename)
+ "Normalize and return PATH if PATH is a valid, readable path, else signal
error."
+ (hpath:validate (hpath:substitute-value
+ (buffer-file-name (hpath:find-noselect filename)))))
+
(defun hpath:validate (path)
"Return PATH if PATH is a valid, readable path, else signal error.
Info and remote pathnames are considered readable without any
@@ -1533,19 +1622,19 @@ from path or t."
;; Next function from: 2006-11-02 Mats Lidell
(defun hpath:find-file-mailcap (file-name)
"Find command to view FILE-NAME according to the mailcap file."
- (if (featurep 'mailcap)
- (progn (mailcap-parse-mailcaps)
- (let (mime-type method)
- (if (and (string-match "\\.[^\\.]+$" file-name)
- (setq mime-type
- (mailcap-extension-to-mime
- (match-string-no-properties 0 file-name)))
- (stringp
- (setq method
- (cdr (assoc 'viewer
- (car (mailcap-mime-info mime-type
- 'all)))))))
- (mm-mailcap-command method file-name nil))))))
+ (when (featurep 'mailcap)
+ (mailcap-parse-mailcaps)
+ (let (mime-type method)
+ (when (and (string-match "\\.[^\\.]+$" file-name)
+ (setq mime-type
+ (mailcap-extension-to-mime
+ (match-string-no-properties 0 file-name)))
+ (stringp
+ (setq method
+ (cdr (assoc 'viewer
+ (car (mailcap-mime-info mime-type
+ 'all)))))))
+ (mm-mailcap-command method file-name nil)))))
(defun hpath:find-program (filename)
"Return one or a list of shell or Lisp commands to execute to display
FILENAME or nil.
@@ -1600,42 +1689,28 @@ local pathname."
((string-match "path" var-name)
(split-string (getenv var-name) ":"))
(t (getenv var-name))))))
- (if (hpath:validate (expand-file-name rest-of-path val))
- val))
+ (when (hpath:validate (expand-file-name rest-of-path val))
+ val))
((listp val)
(let* ((path (locate-file rest-of-path val (cons "" hpath:suffixes)))
(dir (if path (file-name-directory path))))
(if dir
(hpath:validate (directory-file-name dir))
(error "(hpath:substitute-dir): Can't find match for \"%s\""
- (concat "$\{" var-name "\}/" rest-of-path))))
- ;; Code prior to utilizing locate-file.
-;; (let (dir path)
-;; (while (and val (not dir))
-;; (setq dir (car val) val (cdr val))
-;; (or (and (stringp dir)
-;; (file-name-absolute-p dir)
-;; (setq path (hpath:exists-p (expand-file-name
rest-of-path dir)))
-;; (file-readable-p path))
-;; (setq dir nil)))
-;; (if dir
-;; (hpath:validate (directory-file-name dir))
-;; (error "(hpath:substitute-dir): Can't find match for \"%s\""
-;; (concat "$\{" var-name "\}/" rest-of-path))))
- )
+ (concat "$\{" var-name "\}/" rest-of-path)))))
(t (error "(hpath:substitute-dir): Value of VAR-NAME, \"%s\", must be
a string or list" var-name)))))
(defun hpath:substitute-var-name (var-symbol var-dir-val path)
"Replace with VAR-SYMBOL any occurrences of VAR-DIR-VAL in PATH.
Replacement is done iff VAR-DIR-VAL is an absolute path.
If PATH is modified, returns PATH, otherwise returns nil."
- (if (and (stringp var-dir-val) (file-name-absolute-p var-dir-val))
- (let ((new-path (hypb:replace-match-string
- (regexp-quote (file-name-as-directory
- (or var-dir-val default-directory)))
- path (concat "$\{" (symbol-name var-symbol) "\}/")
- t)))
- (if (equal new-path path) nil new-path))))
+ (when (and (stringp var-dir-val) (file-name-absolute-p var-dir-val))
+ (let ((new-path (hypb:replace-match-string
+ (regexp-quote (file-name-as-directory
+ (or var-dir-val default-directory)))
+ path (concat "$\{" (symbol-name var-symbol) "\}/")
+ t)))
+ (if (equal new-path path) nil new-path))))
(provide 'hpath)
diff --git a/hui.el b/hui.el
index 43599d4..37af604 100644
--- a/hui.el
+++ b/hui.el
@@ -303,16 +303,19 @@ To create an implicit global button, add the text for an
implicit
button to `gbut:file` and then with point on the implicit button,
invoke: {C-h h i l}, to label/name it."
(interactive "sCreate explicit global button labeled: ")
- (let (but-buf actype)
+ (let (but-buf actype src-dir)
(save-excursion
- (setq actype (hui:actype))
- (setq but-buf (set-buffer (find-file-noselect gbut:file)))
+ (setq src-dir default-directory
+ actype (hui:actype)
+ but-buf (set-buffer (find-file-noselect gbut:file)))
(hui:buf-writable-err but-buf "ebut-create")
;; This prevents movement of point which might be useful to user.
(save-excursion
(goto-char (point-max))
+ ;; loc = Directory of the global button file
(hattr:set 'hbut:current 'loc (hui:key-src but-buf))
- (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
+ ;; dir = default-directory of current buffer when button is created
+ (hattr:set 'hbut:current 'dir src-dir)
(hattr:set 'hbut:current 'actype actype)
(hattr:set 'hbut:current 'args (hargs:actype-get actype))
(hattr:set 'hbut:current 'action
@@ -337,6 +340,7 @@ Signals an error when no such button is found."
(mapcar 'list (gbut:label-list))
nil t nil 'ebut)))))
(let ((lbl (hbut:key-to-label lbl-key))
+ (src-dir default-directory)
(but-buf (find-file-noselect gbut:file))
actype but new-lbl)
(save-excursion
@@ -361,7 +365,7 @@ Signals an error when no such button is found."
(progn
;; Explicit buttons
(hattr:set 'hbut:current 'loc (hui:key-src but-buf))
- (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
+ (hattr:set 'hbut:current 'dir src-dir)
(setq actype (hui:actype (hattr:get but 'actype)))
(hattr:set 'hbut:current 'actype actype)
(hattr:set 'hbut:current 'args (hargs:actype-get actype 'modifying))
@@ -369,7 +373,7 @@ Signals an error when no such button is found."
(and hui:ebut-prompt-for-action (hui:action actype)))
(set-buffer but-buf)
(ebut:operate lbl new-lbl))
- ;; Ixplicit buttons
+ ;; Implicit buttons
(save-excursion
(set-buffer but-buf)
(ibut:rename lbl new-lbl)
@@ -593,9 +597,7 @@ See also documentation for `hui:link-possible-types'."
item (match-end 0)))
item))
type-and-args
- (documentation
- (intern (concat "actypes::"
- (symbol-name type))))))
+ (documentation (htype:actype-p type))))
link-types)))
type-and-args (hui:list-remove-text-properties
type-and-args))
(hui:link-create
@@ -666,17 +668,15 @@ See also documentation for `hui:link-possible-types'."
(defun hui:actype (&optional default-actype prompt)
"Using optional DEFAULT-ACTYPE, PROMPTs for a button action type.
DEFAULT-ACTYPE may be a valid symbol or `symbol-name'."
- (and default-actype (symbolp default-actype)
- (progn
- (setq default-actype (symbol-name default-actype))
- (if (string-match "actypes::" default-actype)
- (setq default-actype (substring default-actype (match-end 0))))))
+ (when (and default-actype (symbolp default-actype))
+ (setq default-actype (symbol-name default-actype)
+ default-actype (actype:def-symbol default-actype)
+ default-actype (when default-actype (symbol-name default-actype))))
(if (or (null default-actype) (stringp default-actype))
- (intern-soft
- (concat "actypes::"
- (hargs:read-match (or prompt "Button's action type: ")
- (mapcar 'list (htype:names 'actypes))
- nil t default-actype 'actype)))
+ (actype:elisp-symbol
+ (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")))
(defun hui:buf-writable-err (but-buf func-name)
@@ -757,8 +757,7 @@ within."
(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)))))
+ (setq actype (actype:def-symbol actype))
(message "%s%s%s %s %S"
ebut:start
(hbut:key-to-label (hattr:get 'hbut:current 'lbl-key))
@@ -918,8 +917,7 @@ Optional NO-SORT means display in decreasing priority order
(natural order)."
(defun hui:ibut-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)))))
+ (setq actype (actype:def-symbol actype))
(message "%s%s%s %s %S"
ibut:label-start
(hbut:key-to-label (hattr:get 'hbut:current 'lbl-key))
@@ -955,10 +953,7 @@ TYPE-AND-ARGS is the action type for the button followed
by any
arguments it requires. Any text properties are removed from string arguments."
(hattr:set 'hbut:current 'loc but-loc)
(hattr:set 'hbut:current 'dir but-dir)
- (hattr:set 'hbut:current 'actype (intern-soft
- (concat "actypes::"
- (symbol-name
- (car type-and-args)))))
+ (hattr:set 'hbut:current 'actype (actype:elisp-symbol (car type-and-args)))
(hattr:set 'hbut:current 'args (cdr type-and-args))
(select-window but-window)
(let ((label (ebut:key-to-label lbl-key)))
diff --git a/hyperbole.el b/hyperbole.el
index e0d4d4f..7088ad4 100644
--- a/hyperbole.el
+++ b/hyperbole.el
@@ -253,13 +253,13 @@ Entry format is: (key-description key-sequence
key-binding)."
;; Binds {C-c @} to created a user-specified sized grid of windows
;; displaying different buffers.
;;
- ;; Don't override local bindings of this key.
+ ;; Don't override prior global bindings of this key.
(hkey-maybe-global-set-key "\C-c@" 'hycontrol-windows-grid t)
;;
;; Binds {C-c C-r} as a site standard way of performing explicit
;; button renames without invoking the Hyperbole menu.
;;
- ;; Don't override local bindings of this key.
+ ;; Don't override prior global bindings of this key.
(hkey-maybe-global-set-key "\C-c\C-r" 'hui:ebut-rename t)
;;
;; Binds {C-c RET} to select larger and larger synctactical units in a
@@ -274,7 +274,7 @@ Entry format is: (key-description key-sequence
key-binding)."
(hkey-maybe-global-set-key "\C-c/" 'hui-search-web)
;;
;; Binds {C-c .} to jump between the start and end of an delimited thing.
- ;; Don't override local bindings of this key.
+ ;; Don't override prior global bindings of this key.
(hkey-maybe-global-set-key "\C-c." 'hui-select-goto-matching-delimiter t)
;;
;; This initializes the Smart Mouse Key bindings. Shifted mouse buttons
diff --git a/man/hyperbole.texi b/man/hyperbole.texi
index aa69dbc..8cf1b2e 100644
--- a/man/hyperbole.texi
+++ b/man/hyperbole.texi
@@ -1826,15 +1826,25 @@ you may simply type the label and delimiters manually.
@cindex ibtypes, list of
@cindex implicit button types
-Below, standard implicit button types are listed in the order in which
+Below is a list of standard implicit button types in the order in which
Hyperbole tries to match to the types when looking for an implicit
button; @bkbd{C-h h i t @key{RET}} provides similar information. See
-the Hyperbole file, @file{hibtypes.el}, for complete examples of
-implicit button types (they are listed in increasing order of
-priority).
+the Hyperbole file, @file{hibtypes.el}, for examples of how to define
+implicit button types (they are listed in increasing order of priority).
@table @code
+@findex ibtypes doc-id
+@cindex online library
+@cindex document identifier
+@item doc-id
+Display a document from a local document library given its id. Ids must be
+delimited by @code{doc-id-start} and @code{doc-id-end} and must match the
+function given by @code{doc-id-p}. (Note that this implicit button type is
+not installed by default. You must manually configure it and load it from
+the file, @file{@code{$@{hyperb:dir@}}/hib-doc-id.el}). See the commentary
+at the top of that file for more information.
+
@findex ibtypes completion
@cindex completion
@item completion
@@ -1975,7 +1985,12 @@ Messages are recognized in any buffer.
@cindex ilink
@item link-to-ibut <ilink>
At point, activate a link to an implicit button within the current buffer.
-Recognizes the format ’<ilink:’ <button label> ’>’, e.g. <ilink: my key
sequence>.
+Execute the implicit button's action in the context of the current buffer.
+
+Recognizes the format '<ilink:' button_label [':' button_file_path] '>',
+where button_file_path is given only when the link is to another file,
+e.g. <ilink: my series of keys: ${hyperb:dir}/HYPB>.
+
@findex ibtypes glink
@cindex global button link
@@ -1983,8 +1998,9 @@ Recognizes the format ’<ilink:’ <button label> ’>’, e.g.
<ilink: my key
@cindex glink
@item link-to-gbut <glink>
At point, activate 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>.
+Execulte the global button's action in the context of the current buffer.
+
+Recognizes the format '<glink:' button_label '>', e.g. <glink: open todos>.
@findex ibtypes elink
@cindex explicit button link
@@ -1992,7 +2008,11 @@ Recognizes the format ’<glink:’ <button label> ’>’, e.g.
<glink: open to
@cindex elink
@item link-to-ebut <elink>
At point, activate a link to an explicit button within the current buffer.
-Recognizes the format ’<elink:’ <button label> ’>’, e.g. <elink: project-list>.
+Execute The explicit button's action in the context of the current buffer.
+
+Recognizes the format '<elink:' button_label [':' button_file_path] '>',
+where : button_file_path is given only when the link is to another file,
+e.g. <elink: project-list: ~/projs>."
@findex ibtypes klink
@cindex klink
@@ -2069,9 +2089,10 @@ very beginning of the line.
@cindex Cscope
@item cscope
Jump to a C/C++ source line associated with a Cscope C analyzer output line.
-Requires pre-loading of the cscope.el Lisp library available from the Emacs
-Lisp archives and the open source cscope program available from
-http://cscope.sf.net. Otherwise, does nothing.
+The cscope.el Lisp library available from the Emacs package manager
+must be loaded and the open source cscope program available from
+http://cscope.sf.net must be installed for this button type to do
+anything.
@findex ibtypes etags
@cindex etags entry
@@ -2362,6 +2383,7 @@ for special file display options.
@cindex Org mode
@cindex radio target
@cindex code block
+@cindex links
@kindex C-c C-c
@kindex M-@key{RET}
@findex org-ctrl-c-ctrl-c
@@ -2389,17 +2411,6 @@ of @bkbd{C-c C-c}, @code{org-ctrl-c-ctrl-c}.
In any other context besides the end of a line, the Action Key invokes
the Org mode standard binding of @bkbd{M-@key{RET}}, @code{org-meta-return}.
-
-@findex ibtypes doc-id
-@cindex online library
-@cindex document identifier
-@item doc-id
-Display a document from a local document library given its id. Ids must be
-delimited by @code{doc-id-start} and @code{doc-id-end} and must match the
-function given by @code{doc-id-p}. (Note that this implicit button type is
-not installed by default. You must manually configure it and load it from
-the file, @file{@code{$@{hyperb:dir@}}/hib-doc-id.el}). See the commentary
-at the top of that file for more information.
@end table
@node Action Buttons, , Implicit Button Types, Implicit Buttons
diff --git a/set.el b/set.el
index 1ab32f5..c164964 100644
--- a/set.el
+++ b/set.el
@@ -16,6 +16,9 @@
;; but this may be overidden by changing the function bound to
;; the `set:equal-op' variable. The empty set is equivalent to nil.
+;; (set:create) creates an empty set and (set:add 'element nil) creates
+;; a new set with the single member, 'element.
+
;;; Code:
;; ************************************************************************
;; Public variables
@@ -31,7 +34,7 @@ the arguments are equivalent.")
;; ************************************************************************
(defun set:member (elt set)
- "Returns non-nil if ELT is an element of SET.
+ "Return non-nil if ELT is an element of SET.
The value is actually the tail of SET whose car is ELT.
Uses `set:equal-op' for comparison."
(while (and set (not (funcall set:equal-op elt (car set))))
@@ -39,7 +42,7 @@ Uses `set:equal-op' for comparison."
set)
(defmacro set:add (elt set)
- "Adds element ELT to SET and then returns SET.
+ "Add element ELT to SET and then return SET, even if SET is nil.
Uses `set:equal-op' for comparison.
Use (setq set (set:add elt set)) to assure set is always properly modified."
`(cond ((set:member ,elt ,set) ,set)
@@ -47,8 +50,8 @@ Use (setq set (set:add elt set)) to assure set is always
properly modified."
(t (list ,elt))))
(defmacro set:remove (elt set)
- "Removes element ELT from SET and returns new set.
-Assumes SET is a valid set. Uses `set:equal-op' for comparison.
+ "Remove element ELT from SET and return new set.
+Assume SET is a valid set. Uses `set:equal-op' for comparison.
Use (setq set (set:remove elt set)) to assure set is always properly modified."
`(let ((rest (set:member ,elt ,set))
(rtn ,set))
@@ -65,8 +68,8 @@ Use (setq set (set:remove elt set)) to assure set is always
properly modified."
;; ************************************************************************
(defun set:combinations (set &optional arity)
- "Returns all possible combinations (subsets) of SET including the empty set
and the SET itself.
-Assumes SET is a valid set. With optional ARITY, returns only subsets with
+ "Return all possible combinations (subsets) of SET including the empty set
and the SET itself.
+Assumes SET is a valid set. With optional ARITY, return only subsets with
ARITY members."
(cond ((null arity)
(setq arity 0)
@@ -88,8 +91,9 @@ ARITY members."
;;;###autoload
(defun set:create (&rest elements)
- "Returns a new set created from any number of ELEMENTS.
-If no ELEMENTS are given, returns the empty set. Uses `set:equal-op' for
comparison."
+ "Return a new set created from any number of ELEMENTS.
+If no ELEMENTS are given, return the empty set. Uses `set:equal-op'
+for comparison."
(let ((set))
(mapc (lambda (elt) (or (set:member elt set) (setq set (cons elt set))))
elements)
@@ -97,7 +101,7 @@ If no ELEMENTS are given, returns the empty set. Uses
`set:equal-op' for compar
(defalias 'set:delete 'set:remove)
(defun set:difference (&rest sets)
- "Returns difference of any number of SETS.
+ "Return difference of any number of SETS.
Difference is the set of elements in the first set that are not in any of the
other sets. Uses `set:equal-op' for comparison."
(let ((rtn-set (set:members (car sets))))
@@ -109,21 +113,25 @@ other sets. Uses `set:equal-op' for comparison."
(defalias 'set:size 'length)
+(defun set:empty (set)
+ "Return t if SET is empty."
+ (null set))
+
(defun set:equal (set1 set2)
- "Returns t iff SET1 contains the same members as SET2. Both must be sets.
+ "Return t iff SET1 contains the same members as SET2. Both must be sets.
Uses `set:equal-op' for comparison."
(and (listp set1) (listp set2)
(= (set:size set1) (set:size set2))
(set:subset set1 set2)))
(defun set:get (key set)
- "Returns the value associated with KEY in SET or nil.
+ "Return the value associated with KEY in SET or nil.
Assumes elements of SET are of the form (key . value)."
(cdr (car (let ((set:equal-op (lambda (key elt) (equal key (car elt)))))
(set:member key set)))))
(defun set:intersection (&rest sets)
- "Returns intersection of all SETS given as arguments.
+ "Return intersection of all SETS given as arguments.
Uses `set:equal-op' for comparison."
(let (rtn-set)
(mapc (lambda (elt) (or (memq nil (mapcar (lambda (set) (set:member elt
set))
@@ -133,7 +141,7 @@ Uses `set:equal-op' for comparison."
(nreverse rtn-set)))
(defun set:is (obj)
- "Returns t if OBJ is a set (a list with no repeated elements).
+ "Return t if OBJ is a set (a list with no repeated elements).
Uses `set:equal-op' for comparison."
(and (listp obj)
(let ((lst obj))
@@ -144,7 +152,7 @@ Uses `set:equal-op' for comparison."
(defalias 'set:map 'mapcar)
(defun set:members (list)
- "Returns set of unique elements of LIST.
+ "Return set of unique elements of LIST.
Uses `set:equal-op' for comparison. See also `set:create'."
(let ((set))
(mapc (lambda (elt) (or (set:member elt set) (setq set (cons elt set))))
@@ -152,8 +160,8 @@ Uses `set:equal-op' for comparison. See also `set:create'."
set))
(defun set:replace (key value set)
- "Replaces or adds element whose car matches KEY with element (KEY . VALUE)
in SET.
-Returns set if modified, else nil.
+ "Replace or add element whose car matches KEY with element (KEY . VALUE) in
SET.
+Return set if modified, else nil.
Use (setq set (set:replace elt set)) to assure set is always properly modified.
Uses `set:equal-op' to match against KEY. Assumes each element in the set
@@ -167,7 +175,7 @@ has a car and a cdr."
(cons (cons key value) set))))
(defun set:subset (sub set)
- "Returns t iff set SUB is a subset of SET.
+ "Return t iff set SUB is a subset of SET.
Uses `set:equal-op' for comparison."
;; The empty set, nil, is a subset of every set, including
;; itself. Each set includes it once as a subset.
@@ -177,7 +185,7 @@ Uses `set:equal-op' for comparison."
(and is t)))
(defun set:union (&rest sets)
- "Returns union of all SETS given as arguments.
+ "Return union of all SETS given as arguments.
Uses `set:equal-op' for comparison."
(let (rtn-set)
(mapc (lambda (set) (mapc (lambda (elt) (setq rtn-set (set:add elt
rtn-set)))
- [elpa] externals/hyperbole 8c64af9 06/21: Merge pull request #12 from matsl/merge-with-elpa, (continued)
- [elpa] externals/hyperbole 8c64af9 06/21: Merge pull request #12 from matsl/merge-with-elpa, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole b155e83 01/21: 7.0.3.3 test release: Flash pathname implicit buttons; improve doc, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole bf789e0 18/21: Merge pull request #18 from matsl/add-hyperbole-banner, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole 5cb81a3 09/21: Merge pull request #15 from matsl/use-shell-with-buf-name, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole 519a7fc 14/21: Update pdf version of the manual, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole 6b44594 13/21: Add src and bin targets for test release setup, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole 966628e 20/21: Merge new logo from branch 'master' of github.com:rswgnu/hyperbole, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole 0ed7d26 10/21: Merge pull request #16 from matsl/set-up-hyperbole-for-use-from-src-folder, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole 298fd12 15/21: Add optional key file path argument to e/ilinks, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole a9620d1 16/21: 7.0.5 test release: add Action Buttons section to Hyperbole manual, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole 8792e1c 19/21: Large changeset: add action ibtype, symtables to speed ibtype lookup,
Stefan Monnier <=
- [elpa] externals/hyperbole 62a9db3 21/21: 7.0.6 test release: many changes, new logo; ibtypes speedups, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole b4a2623 12/21: 7.0.4 test release: add Action Buttons and Implicit Button Names, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole 985399e 17/21: New hyperbole banner, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole 8f1f770 04/21: Apply some easy to fix flycheck suggestions, Stefan Monnier, 2019/10/04
- [elpa] externals/hyperbole 713aca8 08/21: Merge pull request #13 from matsl/easy-to-fix-flycheck-issues, Stefan Monnier, 2019/10/04