[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole 1fb36baed9 2/2: * hypb:assert-same-start-and-
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole 1fb36baed9 2/2: * hypb:assert-same-start-and-end-buffer: Debug on any buffer change |
|
Date: |
Sun, 6 Feb 2022 15:57:41 -0500 (EST) |
branch: externals/hyperbole
commit 1fb36baed961cc2327b90eb973338e7ca6a63c30
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>
* hypb:assert-same-start-and-end-buffer: Debug on any buffer change
hui.el (hui:ebut-buf): Don't filter any visible buffers out
since buttons can be in buffers without attached files now.
(hui:ignore-buffers-regexp): When prompting for a buffer
name, ignore any buffers whose names match to this.
---
ChangeLog | 14 ++
hui.el | 443 +++++++++++++++++++++++++------------------------
hypb.el | 17 +-
test/hibtypes-tests.el | 7 +-
test/hui-tests.el | 29 ++--
5 files changed, 278 insertions(+), 232 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index fbb2dda055..183b88f955 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,19 @@
2022-02-06 Bob Weiner <rsw@gnu.org>
+* test/hui-tests.el (hui-gbut-modify-link-to-file-button): Some
+ improvements but not yet fixed.
+
+* hui.el (hui:ebut-buf): Don't filter any visible buffers out
+ since buttons can be in buffers without attached files now.
+ (hui:ignore-buffers-regexp): When prompting for a buffer
+ name, ignore any buffers whose names match to this.")
+
+* hypb.el (hypb:assert-same-start-and-end-buffer): Add to ensure
+ current buffer name doesn't change in some Hyperbole calls.
+ hui.el (hui:ebut-create, hui:ebut-modify, hui:gbut-create,
+ hui:gbut-modify, hui:ibut-modify, hui:link-create):
+ Use new above macro.
+
* hpath.el (hpath:absolute-to, hpath:call): Add checks to ensure
path is a string.
(hpath:at-p): Call to 'hpath:mswindows-to-posix' may
diff --git a/hui.el b/hui.el
index 3a214a5172..de419b1e31 100644
--- a/hui.el
+++ b/hui.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Sep-91 at 21:42:03
-;; Last-Mod: 6-Feb-22 at 00:49:59 by Bob Weiner
+;; Last-Mod: 6-Feb-22 at 13:43:07 by Bob Weiner
;;
;; Copyright (C) 1991-2021 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -124,27 +124,28 @@ Indicate button creation by delimiting and adding any
necessary instance number
For programmatic creation, use `ebut:program' instead."
(interactive (list (when (use-region-p) (region-beginning))
(when (use-region-p) (region-end))))
- (let ((default-lbl) lbl but-buf actype)
- (save-excursion
- (setq default-lbl (hui:hbut-label-default start end (not
(called-interactively-p 'interactive)))
- lbl (hui:hbut-label default-lbl "ebut-create"))
- (unless (equal lbl default-lbl)
- (setq default-lbl nil))
-
- (setq but-buf (if default-lbl (current-buffer) (hui:ebut-buf)))
- (hui:buf-writable-err but-buf "ebut-create")
-
- (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
- (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
- (setq actype (hui:actype))
- (hattr:set 'hbut:current 'actype actype)
- (hattr:set 'hbut:current 'args (hargs:actype-get actype))
- (hattr:set 'hbut:current 'action
- (and hui:ebut-prompt-for-action (hui:action actype))))
- ;; Adds instance number to in-buffer label if necessary
- (ebut:operate lbl nil)
- (when (called-interactively-p 'interactive)
- (hui:ebut-message nil))))
+ (hypb:assert-same-start-and-end-buffer
+ (let ((default-lbl) lbl but-buf actype)
+ (save-excursion
+ (setq default-lbl (hui:hbut-label-default start end (not
(called-interactively-p 'interactive)))
+ lbl (hui:hbut-label default-lbl "ebut-create"))
+ (unless (equal lbl default-lbl)
+ (setq default-lbl nil))
+
+ (setq but-buf (if default-lbl (current-buffer) (hui:ebut-buf)))
+ (hui:buf-writable-err but-buf "ebut-create")
+
+ (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
+ (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
+ (setq actype (hui:actype))
+ (hattr:set 'hbut:current 'actype actype)
+ (hattr:set 'hbut:current 'args (hargs:actype-get actype))
+ (hattr:set 'hbut:current 'action
+ (and hui:ebut-prompt-for-action (hui:action actype)))
+ ;; Adds instance number to in-buffer label if necessary
+ (ebut:operate lbl nil)
+ (when (called-interactively-p 'interactive)
+ (hui:ebut-message nil))))))
(defun hui:ebut-delete (but-key &optional key-src)
"Delete explicit Hyperbole button given by BUT-KEY in optional KEY-SRC.
@@ -205,39 +206,40 @@ Signal an error when no such button is found in the
current buffer."
(error "(hui:ebut-modify): No explicit button to modify")
(error "(hui:ebut-modify): 'lbl-key' argument must be a string, not
'%s'" lbl-key)))
- (let ((lbl (ebut:key-to-label lbl-key))
- (but-buf (current-buffer))
- actype but new-lbl)
- (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
- (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
- (save-excursion
- (unless (called-interactively-p 'interactive)
- (hui:buf-writable-err but-buf "ebut-modify"))
-
- (unless (setq but (ebut:get lbl-key but-buf))
- (pop-to-buffer but-buf)
- (hypb:error "(ebut-modify): Invalid button, no data for '%s'" lbl))
-
- (setq new-lbl
- (hargs:read
- "Change button label to: "
- (lambda (lbl)
- (and (not (string-equal lbl "")) (<= (length lbl)
(hbut:max-len))))
- lbl
- (format "(ebut-modify): Enter a string of at most %s chars."
- (hbut:max-len))
- 'string))
-
- (setq actype (hui:actype (hattr:get but 'actype)))
- (hattr:set 'hbut:current 'actype actype)
- (hattr:set 'hbut:current 'args (hargs:actype-get actype t))
- (hattr:set 'hbut:current 'action
- (and hui:ebut-prompt-for-action (hui:action actype)))
- (set-buffer but-buf)
+ (hypb:assert-same-start-and-end-buffer
+ (let ((lbl (ebut:key-to-label lbl-key))
+ (but-buf (current-buffer))
+ actype but new-lbl)
+ (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
+ (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
(save-excursion
- (ebut:operate lbl new-lbl)))
- (when (called-interactively-p 'interactive)
- (hui:ebut-message t))))
+ (unless (called-interactively-p 'interactive)
+ (hui:buf-writable-err but-buf "ebut-modify"))
+
+ (unless (setq but (ebut:get lbl-key but-buf))
+ (pop-to-buffer but-buf)
+ (hypb:error "(ebut-modify): Invalid button, no data for '%s'" lbl))
+
+ (setq new-lbl
+ (hargs:read
+ "Change button label to: "
+ (lambda (lbl)
+ (and (not (string-equal lbl "")) (<= (length lbl)
(hbut:max-len))))
+ lbl
+ (format "(ebut-modify): Enter a string of at most %s chars."
+ (hbut:max-len))
+ 'string))
+
+ (setq actype (hui:actype (hattr:get but 'actype)))
+ (hattr:set 'hbut:current 'actype actype)
+ (hattr:set 'hbut:current 'args (hargs:actype-get actype t))
+ (hattr:set 'hbut:current 'action
+ (and hui:ebut-prompt-for-action (hui:action actype)))
+ (set-buffer but-buf)
+ (save-excursion
+ (ebut:operate lbl new-lbl)))
+ (when (called-interactively-p 'interactive)
+ (hui:ebut-message t)))))
(defun hui:ebut-rename (curr-label new-label)
"Rename explicit Hyperbole button given by CURR-LABEL to NEW-LABEL.
@@ -342,36 +344,37 @@ See `hui:gibut-create' for details."
current-prefix-arg))
(if ibut-flag
(call-interactively #'hui:gibut-create)
- (let (actype
- but-buf
- src-dir)
- (save-excursion
- (setq src-dir default-directory
- actype (hui:actype)
- but-buf (find-file-noselect (gbut:file)))
- (set-buffer but-buf)
- (hui:buf-writable-err (current-buffer) "gbut-create")
- ;; This prevents movement of point which might be useful to user.
- (save-excursion
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- ;; loc = Directory of the global button file
- (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
- ;; dir = default-directory of current buffer at the start of
- ;; this `hui:gbut-create' function call (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 (when hui:ebut-prompt-for-action
- (hui:action actype)))
- ;; Ensure ebut:operate is given but-buf as the current buffer
+ (hypb:assert-same-start-and-end-buffer
+ (let (actype
+ but-buf
+ src-dir)
+ (save-excursion
+ (setq src-dir default-directory
+ actype (hui:actype)
+ but-buf (find-file-noselect (gbut:file)))
(set-buffer but-buf)
- (setq lbl (concat lbl (ebut:operate lbl nil)))
- (goto-char (point-max))
- (insert "\n")
- (save-buffer))
- (message "`%s' global explicit button created." lbl)))))
+ (hui:buf-writable-err (current-buffer) "gbut-create")
+ ;; This prevents movement of point which might be useful to user.
+ (save-excursion
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ ;; loc = Directory of the global button file
+ (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
+ ;; dir = default-directory of current buffer at the start of
+ ;; this `hui:gbut-create' function call (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 (when hui:ebut-prompt-for-action
+ (hui:action actype)))
+ ;; Ensure ebut:operate is given but-buf as the current buffer
+ (set-buffer but-buf)
+ (setq lbl (concat lbl (ebut:operate lbl nil)))
+ (goto-char (point-max))
+ (insert "\n")
+ (save-buffer))
+ (message "`%s' global explicit button created." lbl))))))
(defun hui:gbut-delete (but-key)
"Delete global Hyperbole button given by BUT-KEY.
@@ -406,75 +409,76 @@ modification Signal an error when no such button is
found."
(error "(hui:gbut-modify): 'lbl-key' argument must be a string, not
'%s'" lbl-key)))
- (let ((lbl (hbut:key-to-label lbl-key))
- (interactive-flag (called-interactively-p 'interactive))
- (but-buf (find-file-noselect (gbut:file)))
- (src-dir (file-name-directory (gbut:file)))
- actype but new-lbl)
- (save-excursion
- (unless interactive-flag
- (hui:buf-writable-err but-buf "gbut-modify"))
-
- (unless (setq but (gbut:get lbl-key))
- (pop-to-buffer but-buf)
- (hypb:error "(gbut-modify): Invalid button, no data for '%s'" lbl))
-
- (setq new-lbl
- (hargs:read
- "Change global button label to: "
- (lambda (lbl)
- (and (not (string-equal lbl "")) (<= (length lbl)
(hbut:max-len))))
- lbl
- (format "(gbut-modify): Enter a string of at most %s chars."
- (hbut:max-len))
- 'string))
-
- (if (eq (hattr:get but 'categ) 'explicit)
- (progn
- ;; Explicit buttons
- (hattr:set 'hbut:current 'loc (hui:key-src 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 t))
- (hattr:set 'hbut:current 'action
- (and hui:ebut-prompt-for-action (hui:action actype)))
- ;; Ensure ebut:operate is given but-buf as the current buffer
- (set-buffer but-buf)
+ (hypb:assert-same-start-and-end-buffer
+ (let ((lbl (hbut:key-to-label lbl-key))
+ (interactive-flag (called-interactively-p 'interactive))
+ (but-buf (find-file-noselect (gbut:file)))
+ (src-dir (file-name-directory (gbut:file)))
+ actype but new-lbl)
+ (save-excursion
+ (unless interactive-flag
+ (hui:buf-writable-err but-buf "gbut-modify"))
+
+ (unless (setq but (gbut:get lbl-key))
+ (pop-to-buffer but-buf)
+ (hypb:error "(gbut-modify): Invalid button, no data for '%s'" lbl))
+
+ (setq new-lbl
+ (hargs:read
+ "Change global button label to: "
+ (lambda (lbl)
+ (and (not (string-equal lbl "")) (<= (length lbl)
(hbut:max-len))))
+ lbl
+ (format "(gbut-modify): Enter a string of at most %s chars."
+ (hbut:max-len))
+ 'string))
+
+ (if (eq (hattr:get but 'categ) 'explicit)
+ (progn
+ ;; Explicit buttons
+ (hattr:set 'hbut:current 'loc (hui:key-src 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 t))
+ (hattr:set 'hbut:current 'action
+ (and hui:ebut-prompt-for-action (hui:action actype)))
+ ;; Ensure ebut:operate is given but-buf as the current buffer
+ (set-buffer but-buf)
+ (save-excursion
+ (ebut:operate lbl new-lbl))
+ (when interactive-flag
+ (save-buffer)))
+ ;; Implicit buttons
+ (with-current-buffer but-buf
(save-excursion
- (ebut:operate lbl new-lbl))
- (when interactive-flag
- (save-buffer)))
- ;; Implicit buttons
- (with-current-buffer but-buf
- (save-excursion
- (ibut:to lbl-key)
- (if (and interactive-flag (ibut:at-p))
- (progn
- ;; lbl-start and lbl-end mark the text of the ibut, not
- ;; its name.
- (when (hattr:get 'hbut:current 'lbl-end)
- (let* ((start (hattr:get 'hbut:current 'lbl-start))
- (end (hattr:get 'hbut:current 'lbl-end))
- (old-text (buffer-substring start end))
- (new-text (read-string "Modify ibut text: "
old-text)))
- (save-excursion
- (goto-char start)
- (delete-region start end)
- (insert new-text))
- (hattr:set 'hbut:current 'lbl-key (ibut:label-to-key
new-lbl))))
- ;; Have to do name change after lbl-start/lbl-end are
- ;; used so buffer positions do not change.
- (ibut:rename lbl new-lbl)
- (save-buffer)
- (hui:ibut-message t))
- (when (and interactive-flag
- (ibut:rename lbl new-lbl))
- (save-buffer)
- (message "Button renamed to %s%s%s"
- ibut:label-start
- new-lbl
- ibut:label-end)))))))))
+ (ibut:to lbl-key)
+ (if (and interactive-flag (ibut:at-p))
+ (progn
+ ;; lbl-start and lbl-end mark the text of the ibut, not
+ ;; its name.
+ (when (hattr:get 'hbut:current 'lbl-end)
+ (let* ((start (hattr:get 'hbut:current 'lbl-start))
+ (end (hattr:get 'hbut:current 'lbl-end))
+ (old-text (buffer-substring start end))
+ (new-text (read-string "Modify ibut text: "
old-text)))
+ (save-excursion
+ (goto-char start)
+ (delete-region start end)
+ (insert new-text))
+ (hattr:set 'hbut:current 'lbl-key (ibut:label-to-key
new-lbl))))
+ ;; Have to do name change after lbl-start/lbl-end are
+ ;; used so buffer positions do not change.
+ (ibut:rename lbl new-lbl)
+ (save-buffer)
+ (hui:ibut-message t))
+ (when (and interactive-flag
+ (ibut:rename lbl new-lbl))
+ (save-buffer)
+ (message "Button renamed to %s%s%s"
+ ibut:label-start
+ new-lbl
+ ibut:label-end))))))))))
(defun hui:gbut-rename (label)
"Interactively rename a Hyperbole global button with LABEL.
@@ -721,60 +725,61 @@ Signal an error when no such button is found in the
current buffer."
(error "(hui:ibut-modify): No named implicit button to modify")
(error "(hui:ibut-modify): 'lbl-key' argument must be a string, not
'%s'" lbl-key)))
- (let ((lbl (ibut:key-to-label lbl-key))
- (interactive-flag (called-interactively-p 'interactive))
- (but-buf (current-buffer))
- new-lbl)
- (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
- (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
- (save-excursion
- (unless (called-interactively-p 'interactive)
- (hui:buf-writable-err but-buf "ibut-modify"))
-
- (unless (ibut:get lbl-key but-buf)
- (pop-to-buffer but-buf)
- (hypb:error "(ibut-modify): Invalid button, no data for '%s'" lbl))
-
- (setq new-lbl
- (hargs:read
- "Change button name to: "
- (lambda (lbl)
- (and (not (string-equal lbl "")) (<= (length lbl)
(hbut:max-len))))
- lbl
- (format "(ibut-modify): Enter a string of at most %s chars."
- (hbut:max-len))
- 'string))
-
- ;; Implicit buttons
- (with-current-buffer but-buf
- (save-excursion
- (ibut:to lbl-key)
- (if (and interactive-flag (ibut:at-p))
- (progn
- ;; lbl-start and lbl-end mark the text of the ibut, not
- ;; its name.
- (when (hattr:get 'hbut:current 'lbl-end)
- (let* ((start (hattr:get 'hbut:current 'lbl-start))
- (end (hattr:get 'hbut:current 'lbl-end))
- (old-text (buffer-substring start end))
- (new-text (read-string "Modify ibut text: "
old-text)))
- (save-excursion
- (goto-char start)
- (delete-region start end)
- (insert new-text))
- (hattr:set 'hbut:current 'lbl-key (ibut:label-to-key
new-lbl))))
- ;; Have to do name change after lbl-start/lbl-end are
- ;; used so buffer positions do not change.
- (ibut:rename lbl new-lbl)
- (save-buffer)
- (hui:ibut-message t))
- (when (and interactive-flag
- (ibut:rename lbl new-lbl))
- (save-buffer)
- (message "Button renamed to %s%s%s"
- ibut:label-start
- new-lbl
- ibut:label-end))))))))
+ (hypb:assert-same-start-and-end-buffer
+ (let ((lbl (ibut:key-to-label lbl-key))
+ (interactive-flag (called-interactively-p 'interactive))
+ (but-buf (current-buffer))
+ new-lbl)
+ (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
+ (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
+ (save-excursion
+ (unless (called-interactively-p 'interactive)
+ (hui:buf-writable-err but-buf "ibut-modify"))
+
+ (unless (ibut:get lbl-key but-buf)
+ (pop-to-buffer but-buf)
+ (hypb:error "(ibut-modify): Invalid button, no data for '%s'" lbl))
+
+ (setq new-lbl
+ (hargs:read
+ "Change button name to: "
+ (lambda (lbl)
+ (and (not (string-equal lbl "")) (<= (length lbl)
(hbut:max-len))))
+ lbl
+ (format "(ibut-modify): Enter a string of at most %s chars."
+ (hbut:max-len))
+ 'string))
+
+ ;; Implicit buttons
+ (with-current-buffer but-buf
+ (save-excursion
+ (ibut:to lbl-key)
+ (if (and interactive-flag (ibut:at-p))
+ (progn
+ ;; lbl-start and lbl-end mark the text of the ibut, not
+ ;; its name.
+ (when (hattr:get 'hbut:current 'lbl-end)
+ (let* ((start (hattr:get 'hbut:current 'lbl-start))
+ (end (hattr:get 'hbut:current 'lbl-end))
+ (old-text (buffer-substring start end))
+ (new-text (read-string "Modify ibut text: "
old-text)))
+ (save-excursion
+ (goto-char start)
+ (delete-region start end)
+ (insert new-text))
+ (hattr:set 'hbut:current 'lbl-key (ibut:label-to-key
new-lbl))))
+ ;; Have to do name change after lbl-start/lbl-end are
+ ;; used so buffer positions do not change.
+ (ibut:rename lbl new-lbl)
+ (save-buffer)
+ (hui:ibut-message t))
+ (when (and interactive-flag
+ (ibut:rename lbl new-lbl))
+ (save-buffer)
+ (message "Button renamed to %s%s%s"
+ ibut:label-start
+ new-lbl
+ ibut:label-end)))))))))
(defun hui:ibut-rename (lbl-key)
"Rename a label preceding a Hyperbole implicit button in the current buffer
given by LBL-KEY.
@@ -970,6 +975,9 @@ DEFAULT-ACTYPE may be a valid symbol or symbol name."
(pop-to-buffer but-buf)
(hypb:error err))))
+(defvar hui:ignore-buffers-regexp "\\`\\( \\|BLANK\\'\\|\\*Pp
\\|TAGS\\|*quelpa\\)"
+ "When prompting for a buffer name, ignore any buffers whose names match to
this.")
+
(defun hui:ebut-buf (&optional prompt)
"Prompt for and return a buffer in which to place a button."
(let ((buf-name))
@@ -980,12 +988,14 @@ DEFAULT-ACTYPE may be a valid symbol or symbol name."
(or prompt "Button's buffer: ")
(delq nil
(mapcar
+ ;; Filter only buffer whose names start with a
+ ;; space, are read-only or are known not to be
+ ;; editable, since buttons can be
+ ;; in buffers without attached files now.
(lambda (buf)
(let ((b (buffer-name buf)))
- (if (and (not (string-match "mail\\*" b))
- (not (string-match "\\*post-news\\*" b))
- (string-match "\\`[* ]" b))
- nil
+ (unless (or (string-match-p
hui:ignore-buffers-regexp b)
+ (buffer-local-value 'buffer-read-only
buf))
(cons b nil))))
(buffer-list)))
nil t (buffer-name) 'buffer))
@@ -1286,13 +1296,14 @@ in which to create button. BUT-DIR is the directory of
BUT-LOC.
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 (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)))
- (ebut:operate label (if modify label))))
+ (hypb:assert-same-start-and-end-buffer
+ (hattr:set 'hbut:current 'loc but-loc)
+ (hattr:set 'hbut:current 'dir but-dir)
+ (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)))
+ (ebut:operate label (if modify label)))))
(defun hui:link-possible-types ()
"Return list of possible link action types during editing of a Hyperbole
button.
diff --git a/hypb.el b/hypb.el
index 16233beff0..305906a9f4 100644
--- a/hypb.el
+++ b/hypb.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 6-Oct-91 at 03:42:38
-;; Last-Mod: 5-Feb-22 at 20:53:31 by Bob Weiner
+;; Last-Mod: 6-Feb-22 at 12:49:34 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -51,6 +51,21 @@ It must end with a space."
;;; Public functions
;;; ************************************************************************
+(defmacro hypb:assert-same-start-and-end-buffer (&rest body)
+ "Trigger an error with traceback if the buffer is not live or its name
differs at the start and end of BODY."
+ (declare (indent 0) (debug t))
+ `(let ((debug-on-error t)
+ (start-buffer (current-buffer)))
+ (unless (buffer-live-p start-buffer)
+ (error "Start buffer, '%s', is not live" (current-buffer)))
+ ;; `kill-buffer' can change current-buffer in some odd cases.
+ (unwind-protect
+ (progn ,@body)
+ (unless (eq start-buffer (current-buffer))
+ (error "Start buffer, '%s', differs from end buffer, '%s'"
start-buffer (current-buffer)))
+ (unless (buffer-live-p start-buffer)
+ (error "End buffer, '%s', is not live" (current-buffer))))))
+
(defun hypb:call-process-p (program &optional infile predicate &rest args)
"Call an external PROGRAM with INFILE for input.
If PREDICATE is given, it is evaluated in a buffer with the PROGRAM's
diff --git a/test/hibtypes-tests.el b/test/hibtypes-tests.el
index 538131e93e..a06a3b4393 100644
--- a/test/hibtypes-tests.el
+++ b/test/hibtypes-tests.el
@@ -187,11 +187,12 @@
(insert "\"/var/lib:/bar:/tmp:/foo\"")
(goto-char 16)
(ibtypes::pathname)
- (when (car (hattr:get 'hbut:current 'args))
- (set-buffer (find-file-noselect (car (hattr:get 'hbut:current
'args)))))
+ ;; (when (car (hattr:get 'hbut:current 'args))
+ ;; (set-buffer (find-file-noselect (car (hattr:get 'hbut:current
'args)))))
(should (string= "tmp" (buffer-name)))
(should (eq major-mode 'dired-mode)))
- (when (get-buffer "tmp")
+ (when (and (get-buffer "tmp")
+ (buffer-live-p (get-buffer "tmp")))
(kill-buffer (get-buffer "tmp")))))
;; Function in buffer XEmac functionality. Is there somethign similar in Emacs?
diff --git a/test/hui-tests.el b/test/hui-tests.el
index 190fb2615e..2fe42ad08b 100644
--- a/test/hui-tests.el
+++ b/test/hui-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <matsl@gnu.org>
;;
;; Orig-Date: 30-Jan-21 at 12:00:00
-;; Last-Mod: 6-Feb-22 at 00:59:55 by Bob Weiner
+;; Last-Mod: 6-Feb-22 at 13:40:46 by Bob Weiner
;;
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
@@ -20,6 +20,7 @@
(require 'with-simulated-input)
(require 'el-mock)
(require 'hy-test-helpers "test/hy-test-helpers")
+(require 'hib-kbd)
(require 'hui)
(declare-function hy-test-helpers:consume-input-events "hy-test-helpers")
@@ -36,30 +37,34 @@
;; (linked-file
"/var/folders/8s/b7pm6fms2nsc1x2651dpvrd00000gq/T/HHHH86evcO")
(linked-file (make-temp-file "HHHH")))
(unwind-protect
- (progn
+ (cl-letf (((symbol-function 'kbd)
+ (symbol-function 'kbd-key:kbd)))
(write-region "" nil linked-file) ;; Ensure linked file has been
created
- (let ((create-gbut (format "C-h h g c abcd RET link-to-file RET %s
RET y" linked-file))
- (modify-gbut (format "C-h h g e abcd RET RET RET M-:
(delete-minibuffer-contents) RET %s RET y" linked-file)))
+ (let ((create-gbut (format "abcd RET link-to-file RET %s RET y C-x
C-s" linked-file))
+ (modify-gbut (format "abcd RET RET RET M-:
(delete-minibuffer-contents) RET %s RET y" linked-file)))
(setenv "HOME" "/tmp")
- ;; Create using keys
- (hact 'kbd-key create-gbut)
- (hy-test-helpers:consume-input-events)
+
+ (set-buffer gbut-file-buffer)
+ (with-simulated-input create-gbut
+ (hact (lambda () (call-interactively 'hui:gbut-create))))
+
;; Create using program
;; (gbut:ebut-program "abcd" 'link-to-file linked-file)
- (set-buffer gbut-file-buffer)
(forward-char 2)
(should (eq (hattr:get (hbut:at-p) 'actype)
'actypes::link-to-file))
- (goto-char (point-max))
- (hact 'kbd-key modify-gbut)
- (hy-test-helpers:consume-input-events)
+ (goto-char (point-max)) ;; Move past button so does not prompt with
label
+ (with-simulated-input modify-gbut
+ (hact (lambda () (call-interactively 'hui:gbut-modify))))
+ ;; (set-buffer gbut-file-buffer)
(goto-char (+ (point-min) 2))
(should (eq (hattr:get (hbut:at-p) 'actype)
'actypes::link-to-file))
t))
(setenv "HOME" old-home)
- (delete-directory hbmap:dir-user t)
+ (when (file-writable-p hbmap:dir-user)
+ (delete-directory hbmap:dir-user t))
(save-some-buffers t))))
(ert-deftest hui-ibut-label-create ()