(eval-and-compile (mapc #'require '(bookmark hvar hsettings comint hbut hpath hargs hmail hsys-org hsys-www)))

(declare-function kcell-view:indent "kcell-view")

(declare-function kotl-mode:beginning-of-buffer "kotl-mode")

(declare-function kotl-mode:goto-cell "kotl-mode")

(declare-function kotl-mode:goto-cell-ref "kotl-mode")

(declare-function org-fold-show-context "org-fold")

(declare-function org-roam-id-find "‎ext:org-roam-id")

(declare-function rmail:msg-to-p "hrmail")

(declare-function smart-eobp "hui-mouse")

(declare-function smart-tags-file-path "hmouse-tag")

(defact annot-bib (key)

"Follow internal ref KEY within an annotated bibliography, delimiters=[]."

(interactive "sReference key (no []): ")

(let* ((key-regexp (concat "^[*]*[ \t]*\\[" (ebut:key-to-label key) "\\]"))

(lbl-start (hattr:get 'hbut:current 'lbl-start))

(lbl-end (hattr:get 'hbut:current 'lbl-end))

(citation (when (and lbl-start lbl-end)

(save-excursion

(goto-char (point-max))

(and (re-search-backward key-regexp nil t)

(or (< (point) (1- lbl-start))

(> (point) (1+ lbl-end)))

(point))))))

(if citation

(progn (hpath:display-buffer (current-buffer))

(goto-char citation)

(beginning-of-line))

(beep))))

(defact completion ()

"Insert completion at point into the minibuffer or a buffer.

(interactive)

(if (smart-eobp)

(progn (bury-buffer nil)

(delete-window))

(hargs:completion)))

(defact display-boolean (bool-expr)

"Evaluate BOOL-EXPR and display a message with the result value.

(interactive "xDisplay value of boolean expression: ")

(let ((result (hypb:eval bool-expr)))

(message "Result = %S; Boolean value = %s; Expr = %S"

result (if result "True" "False") bool-expr)

(or result t)))

(defact display-value (lisp-expr)

"Evaluate LISP-EXPR and display a message with the result value.

(interactive "SDisplay value of Lisp expression: ")

(let ((result (hypb:eval lisp-expr)))

(message "%S" result)

(or result t)))

(defact display-value-and-remove-region (lisp-expr start end)

"Evaluate LISP-EXPR and remove region from START to END.

(interactive "SDisplay value of Lisp expression: ")

(delete-region start end)

(let ((result (hypb:eval lisp-expr)))

(message "%S" result)

(or result t)))

(defact display-variable (var)

"Evaluate VAR (a symbol) and display a message with the result value.

(interactive "vDisplay value of variable: ")

(message "%s = %S" var (symbol-value var))

(or (symbol-value var) t))

(defact eval-elisp (lisp-expr)

"Evaluate a LISP-EXPR for its side-effects and return its value."

(interactive "xEval Lisp expression: ")

(hypb:eval lisp-expr))

(defact exec-kbd-macro (kbd-macro &optional repeat-count)

"Execute KBD-MACRO REPEAT-COUNT times.

(interactive

(let (macro repeat)

(setq macro (intern-soft

(hargs:read-match

"Unquoted macro name or nil for last one defined: "

obarray (lambda (sym)

(and (fboundp sym)

(stringp (hypb:indirect-function sym))))

nil "nil" 'symbol)))

(cond ((fboundp macro))

((null last-kbd-macro)

(hypb:error

"(exec-kbd-macro): Define a keyboard macro first"))

(t (defalias '$%macro last-kbd-macro)

(setq macro '$%macro)))

(save-excursion

(let ((standard-output (get-buffer-create "*macro-def*")))

(unwind-protect

(progn (set-buffer standard-output)

(setq buffer-read-only nil)

(erase-buffer)

(insert-kbd-macro macro)

(goto-char (point-min))

(setq macro (car (cdr (cdr (read (current-buffer)))))))

(kill-buffer standard-output))))

(fmakunbound '$%macro)

(setq repeat (hargs:read "Repeat count: "

(lambda (repeat)

(or (null repeat)

(and (integerp repeat) (>= repeat 0))))

1))

(list macro repeat)))

(unless (called-interactively-p 'interactive)

(or (and kbd-macro (or (stringp kbd-macro)

(and (symbolp kbd-macro) (fboundp kbd-macro))))

(hypb:error "(exec-kbd-macro): Bad macro: %s" kbd-macro))

(or (null repeat-count) (and (integerp repeat-count) (<= 0 repeat-count))

(hypb:error "(exec-kbd-macro): Bad repeat count: %s" repeat-count)))

(execute-kbd-macro kbd-macro repeat-count))

(defact exec-shell-cmd (shell-cmd &optional internal-cmd kill-prev)

"Execute a SHELL-CMD string asynchronously.

(interactive

(let ((default (nth 0 hargs:defaults))

(default1 (nth 1 hargs:defaults))

(default2 (nth 2 hargs:defaults)))

(list (hargs:read "Shell cmd: "

(lambda (cmd) (not (string-equal cmd "")))

default "Enter a shell command." 'string)

(y-or-n-p (format "Omit cmd from output (default = %s)? "

default1))

(y-or-n-p (format "Kill prior cmd's output (default = %s)? "

default2)))))

(require 'comint)

(let ((buf-name "*Hyperbole Shell*")

(obuf (current-buffer))

(default-dir (expand-file-name default-directory)))

(unwind-protect

(progn

(unless (hpath:remote-p default-dir)

(setq shell-cmd

(concat "cd " default-dir " && " shell-cmd)))

(if (and (get-buffer buf-name)

(get-buffer-process (get-buffer buf-name)))

(hpath:display-buffer buf-name)

;; (hpath:display-buffer (current-buffer))

(when (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."

(interactive

(let ((default (car hargs:defaults)))

(list (hargs:read "Shell cmd: "

(lambda (cmd) (not (string-equal cmd "")))

default "Enter a shell command." 'string))))

(require 'comint)

(let* ((buf-name "*Hyperbole Shell*")

(default-dir (expand-file-name default-directory))

(cmd (if (hpath:remote-p default-dir)

(concat "(" shell-cmd ") &")

(concat "(cd " default-dir " && " shell-cmd ") &")))

(msg (format "Executing: %s" shell-cmd)))

(message msg)

(save-excursion

(save-window-excursion

(unless (and (get-buffer buf-name)

(get-buffer-process (get-buffer buf-name)))

(save-excursion

(save-window-excursion

(setq buf-name (buffer-name (shell buf-name)))))

(message msg)

;; Wait for shell to startup before sending it input.

(sit-for 1)

(set-buffer buf-name)

(setq comint-last-input-start (point-marker)

comint-last-input-end (point-marker)))

(unless (equal (buffer-name (current-buffer)) buf-name)

(set-buffer buf-name))

(goto-char (point-max))

(insert cmd)

(comint-send-input)))

(message msg)))

(defact hyp-config (&optional out-buf)

"Insert Hyperbole configuration information at the end of the current buffer.

(hypb:configuration out-buf))

(defact hyp-request (&optional out-buf)

"Insert into optional OUT-BUF how to (un)subscribe from a Hyperbole mail list."

(save-excursion

(and out-buf (set-buffer out-buf))

;; Allows for insertion prior to user's email signature

(unless (search-forward "\n\n" nil t)

(goto-char (point-max)))

(delete-blank-lines) (delete-blank-lines)

(insert "Use one of the following formats in the To: <email-address> of your message:\n

For example: To: hyperbole-users-join@gnu.org\n")))

(defact hyp-source (buf-str-or-file)

"Display a buffer or file from a line beginning with `hbut:source-prefix'."

(interactive

(list (prin1-to-string (get-buffer-create

(read-buffer "Buffer to link to: "))

t)))

(if (stringp buf-str-or-file)

(cond ((string-match "\\`#<buffer \"?\\([^ \n\"]+\\)\"?>" buf-str-or-file)

(hpath:display-buffer

(substring buf-str-or-file (match-beginning 1) (match-end 1))))

(t (hpath:find buf-str-or-file)))

(hypb:error "(hyp-source): Non-string argument: %s" buf-str-or-file)))

(defact link-to-bookmark (bookmark)

"Display an Emacs BOOKMARK (a name).

(interactive

(list (bookmark-completing-read "Bookmark to link to"

(if (derived-mode-p 'bookmark-bmenu-mode)

(bookmark-bmenu-bookmark)

bookmark-current-bookmark))))

(bookmark-jump bookmark (hpath:display-buffer-function)))

(defact link-to-buffer-tmp (buffer &optional point)

"Display a BUFFER scrolled to optional POINT.

(interactive "bBuffer to link to: ")

(if (or (stringp buffer) (bufferp buffer))

(and (hpath:display-buffer buffer)

(integer-or-marker-p point)

(progn (goto-char (min (point-max) point))

(recenter 0)))

(hypb:error "(link-to-buffer-tmp): Not a current buffer: %s" buffer)))

(defact link-to-compose-mail (to &optional subject body &rest _ignore)

"Compose an email TO address with optional SUBJECT and BODY.

(if (eq mail-user-agent 'browse-url)

(www-url-compose-mail to subject body)

(compose-mail to subject nil nil #'hpath:display-buffer)))

(defact link-to-directory (directory)

"Display a DIRECTORY in Dired mode."

(interactive "DDirectory to link to: ")

(hpath:find directory))

(defact link-to-ebut (key &optional key-src)

"Perform explicit button action specified by KEY and optional KEY-SRC.

(interactive

(let (but-lbl

but-file)

(while (cond ((setq but-file

(read-file-name

"File of button to link to: " nil nil t))

(if (string-equal but-file "")

(progn (beep) t)))

((not (file-readable-p but-file))

(message "(link-to-ebut): You cannot read `%s'."

but-file)

(beep) (sit-for 3))))

(list (progn

(find-file-noselect but-file)

(while (string-equal "" (setq but-lbl

(hargs:read-match

"Button to link to: "

(ebut:alist but-file)

nil nil nil 'ebut)))

(beep))

(ebut:label-to-key but-lbl))

but-file)))

(let* ((key-src-buf-flag (or (bufferp key-src)

(and (stringp key-src) (get-buffer key-src))))

(but (if key-src-buf-flag

(ebut:get key key-src)

(ebut:get key nil key-src))))

(if but

(ebut:act but)

(unless key-src-buf-flag

(setq key-src (if key-src

(hpath:normalize key-src)

(hbut:get-key-src t))))

(hypb:error "(link-to-ebut): No button `%s' in `%s'"

(ebut:key-to-label key)

key-src))))

(defact link-to-elisp-doc (symbol)

"Display documentation for SYMBOL."

(interactive "SSymbol to display documentation for: ")

(cond ((not (symbolp symbol))

(hypb:error "(link-to-elisp-doc): `%s' not a symbol" symbol))

((not (or (boundp symbol) (fboundp symbol)))

(hypb:error "(link-to-elisp-doc): `%s' not defined" symbol))

(t (let ((temp-buffer-show-function 'switch-to-buffer))

(hpath:display-buffer (help-buffer))

(describe-symbol symbol)))))

(defun hactypes:link-to-file-interactively ()

"Get a path to link to and return it as a one item list.

(let ((prev-reading-p hargs:reading-type)

(existing-buf t)

path-buf)

(unwind-protect

(let* ((default-directory (or (hattr:get 'hbut:current 'dir)

(and (stringp (hattr:get 'hbut:current 'loc))

(file-name-directory (hattr:get 'hbut:current 'loc)))

default-directory))

(file-path (or (car hargs:defaults) default-directory))

(file-point (cadr hargs:defaults))

(hargs:reading-type 'file)

;; 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)))

(orig-path path)

path-line-and-col

line-num

column-num

normalized-path)

;; Handle if :line:column are included in path.

(setq path-line-and-col (hpath:file-line-and-column path))

(when path-line-and-col

(setq path (nth 0 path-line-and-col)

line-num (nth 1 path-line-and-col)

column-num (nth 2 path-line-and-col)))

;; Ensure any variables and heading suffixes following

;; [#,] are removed before doing path matching.

(setq normalized-path (or (hpath:is-p path) 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 normalized-path)

(prog1 (set-buffer (find-file-noselect normalized-path t))

(when (integerp file-point)

(goto-char (min (point-max) file-point)))))))

(if (and path-buf (not line-num))

(with-current-buffer path-buf

(setq hargs:reading-type 'character)

(if (y-or-n-p

(format "y = Display at present position (line %d); n = no position? "

(count-lines 1 (point))))

(list path (point))

(list path)))

(if path-buf

(delq nil (list path (save-excursion

(goto-char (point-min))

(forward-line (1- line-num))

(when column-num (move-to-column column-num))

(point))))

(list (or path orig-path)))))

(setq hargs:reading-type prev-reading-p)

(when (and path-buf (not existing-buf))

(kill-buffer path-buf)))))

(defact link-to-file (path &optional referent-start)

"Display a file given by PATH scrolled to optional REFERENT-START.

(interactive (hactypes:link-to-file-interactively))

(if (stringp path)

(let ((src-buf (current-buffer))

(src-start (point))

referent-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))

(when (and (setq referent-buf (hpath:find path))

(integer-or-marker-p referent-start)

(eq (current-buffer) referent-buf))

(goto-char (min (point-max) referent-start))

(recenter 0))

(when (string-match-p "\\.kotl\\([:#]\\|\\'\\)" path)

;; If is a koutline reference with an =idstamp, then update

;; reference relative label if need be; this may be in a different

;; buffer than the current one.

(save-window-excursion

(klink:update-label path src-start src-buf))))

(hypb:error "(link-to-file): Invalid file name: \"%s\"" path)))

(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))

(if (and (stringp path) (not (file-name-absolute-p path))

(compilation-buffer-p (current-buffer)))

(compile-goto-error)

(hpath:find-line path line-num))))

(defact link-to-file-line-and-column (path line-num col-num)

"Display a file given by PATH scrolled to LINE-NUM with point at COL-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))

(if (and (stringp path) (not (file-name-absolute-p path))

(compilation-buffer-p (current-buffer)))

(progn (compile-goto-error)

(move-to-column

(if (string-match "\\.kotl?\\(\\'\\|#\\)" path)

(+ (kcell-view:indent) col-num)

col-num)))

(hpath:find-line path line-num col-num))))

(defact link-to-gbut (key &optional _key-src)

"Perform an action given by an existing global button, specified by KEY.

(interactive

(let ((gbut-file (hpath:validate (hpath:substitute-value (gbut:file))))

but-lbl)

(if (not (file-readable-p gbut-file))

(hypb:error "(link-to-gbut): You cannot read `%s'" gbut-file)

(list (progn

(find-file-noselect gbut-file)

(while (string-equal "" (setq but-lbl

(hargs:read-match

"Global button to link to: "

(mapcar #'list (gbut:label-list))

nil t nil 'gbut)))

(beep))

(hbut:label-to-key but-lbl))))))

(gbut:act (hbut:key-to-label key)))

(defact link-to-Info-index-item (index-item)

"Display an Info index INDEX-ITEM cross-reference.

(interactive "+XInfo (file)index-item-name to link to: ")

(require 'info)

(when (stringp index-item)

;; Remove any tabs or newlines that might be in index-item.

(setq index-item (replace-regexp-in-string "[ \t\n\r\f]+" " " index-item t t)))

(if (and (stringp index-item) (string-match "^(\\([^\)]+\\))\\(.*\\)" index-item))

(id-info-item index-item)

(hypb:error "(link-to-Info-index-entry): Invalid Info index item: `%s'" index-item)))

(defact link-to-Info-node (string)

"Display an Info node, anchor or index position given by STRING.

(interactive "+IInfo (file)nodename to link to: ")

(require 'info)

(if (and (stringp string)

;; Remove any tabs or newlines that might be in string.

(setq string (replace-regexp-in-string "[ \t\n\r\f]+" " " string t t)

string (hpath:to-Info-ref string))

(string-match "\\`(\\([^\)]+\\))\\(.*\\)" string))

(id-info string)

(hypb:error "(link-to-Info-node): Invalid Info node: `%s'" string)))

(defact link-to-ibut (name-key &optional key-src _point)

"Activate implicit button given by NAME-KEY, optional KEY-SRC and _POINT.

(interactive

(let ((ibut-name-key (ibut:at-p t)))

(cond (ibut-name-key

(list ibut-name-key (or (hypb:buffer-file-name) (buffer-name)) (point)))

;; !! TODO: If default is null below and are creating, rather

;; than editing the link, it would be better to throw an error

;; than create an invalid link, but it is difficult to tell which

;; operation is in progress, so ignore this for now. -- RSW,

;; 01-25-2020

;; When not on an ibut and editing the link, use existing arguments

((and (bound-and-true-p hargs:defaults) (listp hargs:defaults) hargs:defaults)

hargs:defaults)

(t

(hypb:error "(link-to-ibut): Point must be on an implicit button to create a link-to-ibut")))))

(unless name-key

(hypb:error "(link-to-ibut): Point must be on an implicit button to create a link-to-ibut"))

(let* ((key-src-buf-flag (or (bufferp key-src)

(and (stringp key-src)

(setq key-src (or (get-buffer key-src)

key-src))

(bufferp key-src))))

(but (if key-src-buf-flag

(ibut:get name-key key-src)

(ibut:get name-key nil key-src)))

actype

;; normalized-file

)

(if but

(progn (setq actype (actype:def-symbol (hattr:get but 'actype)))

(if (eq actype 'link-to-ibut)

(hypb:error "(link-to-ibut): No button `%s' in `%s'"

(ibut:key-to-label name-key)

(or key-src (buffer-name)))

(ibut:act but)))

(unless key-src-buf-flag

(setq key-src (if key-src

(hpath:normalize key-src)

(hbut:get-key-src t))))

(hypb:error "(link-to-ibut): No button `%s' in `%s'"

(ibut:key-to-label name-key)

key-src))))

;; !! Left over code from an earlier version of `link-to-ibut' in case

;; is ever needed for reference. rsw - 2026-06-18

;;

;; (if key-src

;; (unless (and (get-buffer key-src)

;; (not (hypb:buffer-file-name (get-buffer key-src))))

;; (setq normalized-file (hpath:normalize key-src)))

;; (setq normalized-file (hpath:normalize (hypb:buffer-file-name))))

;; (when key-src

;; (set-buffer (or (get-buffer key-src) (get-file-buffer normalized-file))))

;; (widen)

;; (when (or (not normalized-file) (hmail:editor-p) (hmail:reader-p))

;; (hmail:msg-narrow))

;; (when (integerp point)

;; (goto-char (min point (point-max))))

;; (setq but (ibut:to-text name-key))

;; (cond (but

;; (setq actype (actype:def-symbol (hattr:get but 'actype)))

;; (if (eq actype 'link-to-ibut)

;; (hypb:error "(link-to-ibut): Failed to find implicit button named `%s' in `%s'"

;; (ibut:key-to-label name-key)

;; (or key-src (buffer-name)))

;; (apply #'actype:act (hattr:get but 'actype)

;; (hattr:get but 'args))))

;; (name-key

;; (hypb:error "(link-to-ibut): No implicit button named `%s' found in `%s'"

;; (ibut:key-to-label name-key)

;; (or key-src (buffer-name))))

;; (t

;; (hypb:error "(link-to-ibut): Link reference is null/empty")))))

(defact link-to-kcell (file cell-ref)

"Display FILE with kcell given by CELL-REF at window top.

(interactive (hargs:iform-read '(interactive "fKotl file to link to: \n+KKcell to link to: ")))

(require 'kfile)

;; May already be in an 'hpath:find' call where the referent buffer

;; has already been made current. In that case, skip a second

;; display of the buffer.

(unless (and (hyperb:stack-frame '(hpath:find))

;; Perform a loose test that the current buffer

;; file name matches the path file name since exact

;; matching of path is likely to be wrong in

;; certain cases, e.g. with mount point or os path

;; alterations.

(hypb:buffer-file-name)

file

(or (null file)

(string-empty-p file)

(equal (file-name-nondirectory file)

(file-name-nondirectory (hypb:buffer-file-name)))))

(when (or (null file) (string-empty-p file))

(setq file (hbut:get-key-src t)))

(if (stringp file)

(hpath:find file)

;; file can be a buffer from get-key-src call

(hpath:display-buffer (or file (current-buffer)))))

;;

;; `cell-ref' could have an extra trailing punctuation character that

;; needs removal, like: "3b=071.; if it includes a | character for a

;; viewspec, then don't remove final punctuation as it is part of the

;; viewspec." -- RSW, 2026-10-07

(when (and (stringp cell-ref)

(bound-and-true-p klink:cell-ref-regexp)

(not (string-match "|" cell-ref))

(string-match klink:cell-ref-regexp cell-ref)

(eq ?. (char-syntax (aref cell-ref (1- (length cell-ref))))))

(setq cell-ref (substring cell-ref 0 -1)))

(kotl-mode:goto-cell-ref cell-ref))

(defact link-to-mail (mail-msg-id &optional mail-file)

"Display mail msg with MAIL-MSG-ID from optional MAIL-FILE.

(interactive (hargs:iform-read '(interactive "+MMail Msg: ")))

(if (not (fboundp 'rmail:msg-to-p))

(hypb:error "(link-to-mail): Invoke mail reader before trying to follow a mail link")

(if (and (listp mail-msg-id) (null mail-file))

(setq mail-file (car (cdr mail-msg-id))

mail-msg-id (car mail-msg-id)))

(let ((wconfig (current-window-configuration)))

(hpath:display-buffer (current-buffer))

;; Initialize user-specified mail reader if need be.

(if (and (symbolp hmail:init-function)

(fboundp hmail:init-function)

(listp (symbol-function hmail:init-function))

(eq 'autoload (car (symbol-function hmail:init-function))))

(funcall hmail:init-function))

(unless (rmail:msg-to-p mail-msg-id mail-file)

;; Couldn't find message, restore old window config, report error

(set-window-configuration wconfig)

(hypb:error "(link-to-mail): No msg `%s' in file \"%s\""

mail-msg-id mail-file)))))

(defact link-to-org-id (id &optional _title)

"Display the Org entry, if any, for ID with optional _TITLE.

(when (stringp id)

(let* ((inhibit-message t) ;; Inhibit `org-id-find' status msgs

(m (org-id-find id 'marker)))

(when m

(hact 'link-to-org-id-marker m)))))

(defact link-to-org-id-marker (marker)

"Display the Org entry, if any, at MARKER.

(unless (markerp marker)

(error "(link-to-org-id-marker): Argument must be a marker, not %s" marker))

(org-mark-ring-push)

(hact 'link-to-buffer-tmp (marker-buffer marker) marker)

(move-marker marker nil)

(when (featurep 'org-fold) ;; newer Org versions

(org-fold-show-context)))

(defact link-to-regexp-match (regexp n source &optional buffer-p)

"Find REGEXP's Nth occurrence in SOURCE and display location at window top.

(interactive "sRegexp to match: \nnOccurrence number: \nfFile to search: ")

(let ((orig-src source))

(if buffer-p

(when (stringp source)

(setq source (get-buffer source)))

;; Source is a pathname.

(if (not (stringp source))

(hypb:error

"(link-to-regexp-match): Source parameter is not a filename: `%s'"

orig-src)

(setq source (hpath:find-noselect source))))

(if (not (bufferp source))

(hypb:error

"(link-to-regexp-match): Invalid source parameter: `%s'" orig-src)

(hpath:display-buffer source)

(widen)

(goto-char (point-min))

(if (re-search-forward regexp nil t n)

(progn (beginning-of-line) (recenter 0) t)

(hypb:error

"(link-to-regexp-match): Pattern not found: `%s'" regexp)))))

(defact link-to-rfc (rfc-num)

"Retrieve and display an Internet rfc given by RFC-NUM.

(interactive "nRFC number to retrieve: ")

(when (or (stringp rfc-num) (integerp rfc-num))

(browse-url-emacs (hpath:rfc rfc-num))))

(defact link-to-string-match (string n source &optional buffer-p)

"Find STRING's Nth occurrence in SOURCE and display location at window top.

(interactive "sString to match: \nnOccurrence number: \nfFile to search: ")

(funcall (actype:action 'link-to-regexp-match)

(regexp-quote string) n source buffer-p))

(defact link-to-texinfo-node (file node-or-anchor)

"Display the Texinfo FILE and NODE-OR-ANCHOR (a string).

(interactive "fTexinfo file to link to: \nsNode or anchor within file to link to: ")

(if (stringp node-or-anchor)

;; Remove any tabs or newlines that might be in node-or-anchor name.

(setq node-or-anchor (replace-regexp-in-string "[ \t\n\r\f]+" " " (string-trim node-or-anchor) t t))

(setq node-or-anchor "Top"))

(let (node-point)

(when (equal file "hyperbole.texi")

(setq file (expand-file-name file (hpath:expand "${hyperb:dir}/man/"))))

(if file

(set-buffer (find-file-noselect (hpath:substitute-value file)))

(setq file (hypb:buffer-file-name)))

(save-excursion

(goto-char (point-min))

(cond ((or (re-search-forward (format "^@node[ \t]+%s *[,\n\r]" node-or-anchor) nil t)

(re-search-forward (format "^@anchor{%s}" node-or-anchor) nil t))

(setq node-point (match-beginning 0)))

(t (hypb:error "(link-to-texinfo-node): Non-existent location: \"%s%s\""

(if file

(format "(%s)" (file-name-nondirectory file))

"")

node-or-anchor))))

(if file

(hact 'link-to-file file node-point)

(hypb:error "(link-to-texinfo-node): Non-existent location: \"%s\""

node-or-anchor))))

(defact link-to-web-search (service-name search-term)

"Search web SERVICE-NAME for SEARCH-TERM.

(interactive (hyperbole-read-web-search-arguments))

(hyperbole-web-search service-name search-term))

(defact man-show (topic)

"Display man page on TOPIC, which may be of the form <command>(<section>).

(interactive "sManual topic: ")

(require 'man)

(defvar Man-notify-method)

(let ((Man-notify-method 'meek))

(hpath:display-buffer (man topic))))

(defact rfc-toc (&optional buf-name opoint sections-start)

"Compute and display summary of an Internet rfc in BUF-NAME.

(interactive)

(let ((sect-regexp "^[ \t]*[1-9][0-9]*\\.[0-9.]*[ \t]+[^ \t\n\r]")

(rfc-buf-name (buffer-name))

(toc-buf-name (format "*toc %s*" buf-name)))

(when (get-buffer toc-buf-name)

(kill-buffer toc-buf-name))

(occur sect-regexp nil (list (cons sections-start (point-max))))

(select-window (get-buffer-window "*Occur*"))

(rename-buffer toc-buf-name)

(re-search-forward "^[ ]*[0-9]+:" nil t)

(beginning-of-line)

(let ((inhibit-read-only t)

(buffer-read-only))

(remove-text-properties (point-min) (point) '(read-only))

(delete-region (point-min) (point))

(insert "Sections of " rfc-buf-name ":\n")

(set-buffer-modified-p nil))

(when opoint

(switch-to-buffer buf-name)

(goto-char opoint))))

(defact text-toc (section)

"Jump to the text file SECTION referenced by a table of contents entry at point.

(interactive "sGo to section named: ")

(when (stringp section)

(let (leader-chars)

;; Move past the ibtype matched TOC entry so searches herein skip it

(forward-line 1)

(setq section (string-trim section))

(if (string-match "\\`\\([-+*o]+\\)[ \t]*" section)

(progn

(setq leader-chars (match-string 1 section))

(actypes::link-to-regexp-match

(concat "^[ \t]*\\("

(regexp-quote (make-string (length leader-chars) ?*))

"\\|"

(regexp-quote (make-string (length leader-chars) ?#))

"\\)[ \t]*"

(regexp-quote (substring section (match-end 0))))

1 (current-buffer) t))

(actypes::link-to-regexp-match (concat "^[ \t]*" (regexp-quote section))

1 (current-buffer) t))

(while (and (= (forward-line -1) 0)

(looking-at "[ \t]*[-=][-=]")))

(forward-line 1)

(recenter 0))))

(defun hactypes:buffer-button-list ()

"Return buttons available in current buffer."

(append

(unless (string= (buffer-file-name) (gbut:file))

(append (ebut:list) (ibut:list)))

(gbut:label-list)))

(defact button-series (but-names)

"Combine multiple buttons given by BUT-NAMES list into one series of buttons.

(interactive

(list (completing-read-multiple "Comma-separated Button labels: "

(hactypes:buffer-button-list)

nil t)))

(dolist (b but-names)

(let ((but (hbut:get (hbut:label-to-key b))))

(if but

(hbut:act but)

(gbut:act b)))))

(provide 'hactypes)