branch: externals/hyperbole
commit b8344d5987c0b75bd8118e9a4063d4c9601caa50
Author: Mats Lidell <[email protected]>
Commit: GitHub <[email protected]>
fix kotl mode delete char with active region (#842)
---
ChangeLog | 13 ++++
kotl/kotl-mode.el | 170 +++++++++++++++++++++++++++++-------------------
test/kotl-mode-tests.el | 170 +++++++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 285 insertions(+), 68 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index c082a0cf91..1192cb65a1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2026-01-19 Mats Lidell <[email protected]>
+
+* test/kotl-mode-tests.el (kotl-mode--delete-region)
+ (kotl-mode--delete-char): Add tests.
+
+* kotl/kotl-mode.el (kotl-mode:delete-char-acc): Accumulate deleted chars
+ to setup kill-ring.
+ (kotl-mode:delete-char, kotl-mode:delete-backward-char): Fix
+ inconsistencies with delete-char - Support transient mark mode. Use
+ kotl-mode:delete-char-acc for saving multiple chars to kill-ring when
+ called with kill-flag. (The latter is implicit when used interactively
+ with a prefix arg.)
+
2026-01-07 Mats Lidell <[email protected]>
* hywiki.el (hywiki-mode): Remove arg value :toggle, not an alternative to
diff --git a/kotl/kotl-mode.el b/kotl/kotl-mode.el
index 31eef3c8d0..76f4b08d53 100644
--- a/kotl/kotl-mode.el
+++ b/kotl/kotl-mode.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 6/30/93
-;; Last-Mod: 1-Jan-26 at 18:18:27 by Mats Lidell
+;; Last-Mod: 19-Jan-26 at 22:34:04 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -446,14 +446,17 @@ With optional prefix arg DELETE-FLAG, delete region."
Return number of characters deleted.
Optional KILL-FLAG non-nil means save in kill ring instead of deleting.
Do not delete across cell boundaries."
- (interactive "*P")
- (when (called-interactively-p 'interactive)
- (when current-prefix-arg
- (setq kill-flag t
- arg (prefix-numeric-value current-prefix-arg))))
- (unless arg
- (setq arg 1))
- (kotl-mode:delete-char (- arg) kill-flag))
+ (interactive "*p\nP")
+ (cond ((and (use-region-p)
+ delete-active-region
+ (= arg 1))
+ ;; If a region is active, kill or delete it.
+ (if (or kill-flag
+ (eq delete-active-region 'kill))
+ (kotl-mode:kill-region (region-beginning) (region-end))
+ (kotl-mode:delete-region (region-beginning) (region-end))))
+ (t
+ (kotl-mode:delete-char (- arg) kill-flag))))
(defun kotl-mode:delete-blank-lines ()
"On blank line in a cell, delete all surrounding blank lines, leaving just
one.
@@ -478,69 +481,95 @@ whitespace at the end of the cell."
(delete-region (max start (point)) end)))
(kotl-mode:to-valid-position))
+(defvar kotl-mode:delete-char-acc nil
+ "Accumulate deleted chars to populate `kill-ring'.")
+
+(defun kotl-mode:delete-char-acc (arg kill-flag)
+ "Delete one character and accumulate in the kill ring.
+Deletes (forward if ARG > 0, backward if ARG < 0).
+First call creates a new kill ring entry, subsequent calls appends.
+With KILL-FLAG nil just call `delete-char'."
+ (if (not kill-flag)
+ (delete-char arg)
+ (let ((char (char-to-string (if (< arg 0)
+ (char-before)
+ (char-after)))))
+ (delete-char arg)
+ (if kotl-mode:delete-char-acc
+ (kill-append char (< arg 0))
+ (kill-new char)
+ (setq kotl-mode:delete-char-acc t)))))
+
(defun kotl-mode:delete-char (arg &optional kill-flag)
"Delete up to prefix ARG characters following point.
Return number of characters deleted.
Optional KILL-FLAG non-nil means save in kill ring instead of deleting.
Do not delete across cell boundaries."
- (interactive "*P")
- (when (called-interactively-p 'interactive)
- (when current-prefix-arg
- (setq kill-flag t
- arg (prefix-numeric-value current-prefix-arg))))
- (unless arg
- (setq arg 1))
-
- (if (not (and (boundp 'kotl-kview) (kview:is-p kotl-kview)))
- ;; Support use within Org tables outside of the Koutliner
- (delete-char arg kill-flag)
- (let ((del-count 0)
- (indent (kcell-view:indent))
- count start end)
- (cond ((> arg 0)
- (if (kotl-mode:eocp)
- (error "(kotl-mode:delete-char): End of cell")
- (setq end (kcell-view:end)
- arg (min arg (- end (point))))
- (while (and (> arg 0) (not (kotl-mode:eocp)))
- (if (kotl-mode:eolp)
- (if (not (eq ?\ (char-syntax (following-char))))
- (setq arg 0
- del-count (1- del-count))
- (delete-char 1 kill-flag)
- ;; There may be non-whitespace characters in the
- ;; indent area. Don't delete them.
- (setq count indent)
- (while (and (> count 0)
- (eq ?\ (char-syntax (following-char))))
- (delete-char 1)
- (setq count (1- count))))
- (delete-char 1 kill-flag))
- (setq arg (1- arg)
- del-count (1+ del-count)))))
- ((< arg 0)
- (if (kotl-mode:bocp)
- (error "(kotl-mode:delete-char): Beginning of cell")
- (setq start (kcell-view:start)
- arg (max arg (- start (point))))
- (while (and (< arg 0) (not (kotl-mode:bocp)))
- (if (kotl-mode:bolp)
- (if (not (eq ?\ (char-syntax (preceding-char))))
- (setq arg 0
- del-count (1- del-count))
- ;; There may be non-whitespace characters in the
- ;; indent area. Don't delete them.
- (setq count indent)
- (while (and (> count 0)
- (eq ?\ (char-syntax (preceding-char))))
- (delete-char -1)
- (setq count (1- count)))
- (if (zerop count)
- (delete-char -1 kill-flag)))
- (delete-char -1 kill-flag))
- (setq arg (1+ arg)
- del-count (1+ del-count))))))
- del-count)))
+ (interactive "*p\nP")
+ (unless (integerp arg)
+ (signal 'wrong-type-argument (list 'integerp arg)))
+ (cond ((and (use-region-p)
+ delete-active-region
+ (= arg 1))
+ ;; If a region is active, kill or delete it.
+ (if (or kill-flag
+ (eq delete-active-region 'kill))
+ (kotl-mode:kill-region (region-beginning) (region-end))
+ (kotl-mode:delete-region (region-beginning) (region-end))))
+ (t
+ (if (not (and (boundp 'kotl-kview) (kview:is-p kotl-kview)))
+ ;; Support use within Org tables outside of the Koutliner
+ (delete-char arg kill-flag)
+ (let ((del-count 0)
+ (indent (kcell-view:indent))
+ count start end
+ kotl-mode:delete-char-acc)
+ (cl-flet ((delete-char (arg &optional kill-flag)
+ (kotl-mode:delete-char-acc arg kill-flag)))
+ (cond ((> arg 0)
+ (if (kotl-mode:eocp)
+ (error "(kotl-mode:delete-char): End of cell")
+ (setq end (kcell-view:end)
+ arg (min arg (- end (point))))
+ (while (and (> arg 0) (not (kotl-mode:eocp)))
+ (if (kotl-mode:eolp)
+ (if (not (eq ?\ (char-syntax (following-char))))
+ (setq arg 0
+ del-count (1- del-count))
+ (delete-char 1 kill-flag)
+ ;; There may be non-whitespace characters in the
+ ;; indent area. Don't delete them.
+ (setq count indent)
+ (while (and (> count 0)
+ (eq ?\ (char-syntax
(following-char))))
+ (delete-char 1)
+ (setq count (1- count))))
+ (delete-char 1 kill-flag))
+ (setq arg (1- arg)
+ del-count (1+ del-count)))))
+ ((< arg 0)
+ (if (kotl-mode:bocp)
+ (error "(kotl-mode:delete-char): Beginning of cell")
+ (setq start (kcell-view:start)
+ arg (max arg (- start (point))))
+ (while (and (< arg 0) (not (kotl-mode:bocp)))
+ (if (kotl-mode:bolp)
+ (if (not (eq ?\ (char-syntax (preceding-char))))
+ (setq arg 0
+ del-count (1- del-count))
+ ;; There may be non-whitespace characters in the
+ ;; indent area. Don't delete them.
+ (setq count indent)
+ (while (and (> count 0)
+ (eq ?\ (char-syntax
(preceding-char))))
+ (delete-char -1)
+ (setq count (1- count)))
+ (if (zerop count)
+ (delete-char -1 kill-flag)))
+ (delete-char -1 kill-flag))
+ (setq arg (1+ arg)
+ del-count (1+ del-count)))))))
+ del-count)))))
(defun kotl-mode:delete-horizontal-space ()
"Delete all spaces and tabs around point."
@@ -797,6 +826,13 @@ If a completion is active, this aborts the completion
only."
((mark t)
(indicate-copied-region)))))))
+(defun kotl-mode:delete-region (start end)
+ "Delete region between START and END within a single kcell.
+Delegates to `kotl-mode:kill-region' but does not store killed text in
+`kill-ring'."
+ (let (kill-ring kill-ring-yank-pointer)
+ (kotl-mode:kill-region start end)))
+
(defun kotl-mode:kill-or-copy-region (start end copy-flag &optional kill-str)
(when (and start end)
(let ((indent (kcell-view:indent))
diff --git a/test/kotl-mode-tests.el b/test/kotl-mode-tests.el
index 93d3636a64..2672d56e76 100644
--- a/test/kotl-mode-tests.el
+++ b/test/kotl-mode-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <[email protected]>
;;
;; Orig-Date: 18-May-21 at 22:14:10
-;; Last-Mod: 21-Dec-25 at 23:56:18 by Mats Lidell
+;; Last-Mod: 20-Jan-26 at 00:21:25 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1021,6 +1021,7 @@ optional DEPTH the number of sub cells are created to
that depth."
(make-kotl-mode-tests--func :func #'kotl-mode:delete-forward-char :args
'(-1))
(make-kotl-mode-tests--func :func #'kotl-mode:delete-horizontal-space)
(make-kotl-mode-tests--func :func #'kotl-mode:delete-indentation)
+ (make-kotl-mode-tests--func :func #'kotl-mode:delete-region :args '(130
131))
(make-kotl-mode-tests--func :func #'kotl-mode:demote-tree :ignore t)
(make-kotl-mode-tests--func :func #'kotl-mode:down-level :ignore t)
(make-kotl-mode-tests--func :func #'kotl-mode:end-of-buffer)
@@ -1321,6 +1322,173 @@ marked with :ignore t")
(should (= (kcell-view:level) 3))
(should (string= (kcell-view:label (point)) "1a2"))))))
+(ert-deftest kotl-mode--delete-region ()
+ "Verify `kotl-mode:delete-region'does not save to `kill-ring."
+ (with-temp-buffer
+ (let (kill-ring)
+ (kotl-mode)
+ (insert "0123")
+ (kotl-mode:delete-region (kcell-view:start) (kcell-view:end-contents))
+ (should (string-empty-p (kcell-view:contents)))
+ (should-not kill-ring))))
+
+(ert-deftest kotl-mode--delete-char ()
+ "Verify `kotl-mode:delete-char' and `kotl-mode:delete-backward-char'."
+ (cl-flet ((init ()
+ (progn (erase-buffer)
+ (kotl-mode)
+ (insert "0123")
+ (kotl-mode:beginning-of-cell))))
+ (with-temp-buffer
+ (ert-info ("Delete one char forward, nothing inserted in kill ring")
+ (init)
+ (let (kill-ring)
+ (kotl-mode:delete-char 1)
+ (should (looking-at-p "123"))
+ (should-not kill-ring)))
+ (ert-info ("Delete one char forward, deleted char insert in kill ring")
+ (init)
+ (let (kill-ring)
+ (kotl-mode:delete-char 1 t)
+ (should (looking-at-p "123"))
+ (should (string= (car kill-ring) "0"))))
+ (ert-info ("Delete one char forward - interactive")
+ (init)
+ (call-interactively #'kotl-mode:delete-char)
+ (should (looking-at-p "123")))
+ (ert-info ("Delete two char forward - interactive")
+ (init)
+ (let ((current-prefix-arg 2)
+ kill-ring)
+ (call-interactively #'kotl-mode:delete-char)
+ (should (looking-at-p "23"))
+ (should (string= (car kill-ring) "01"))))
+ (ert-info ("Delete many chars forward")
+ (init)
+ (kotl-mode:delete-char 2)
+ (should (looking-at-p "23")))
+ (ert-info ("Delete one char backward")
+ (init)
+ (kotl-mode:end-of-line)
+ (kotl-mode:delete-char -1)
+ (kotl-mode:beginning-of-line)
+ (should (looking-at-p "012")))
+ (ert-info ("Delete one char backward - using backward-char")
+ (init)
+ (kotl-mode:end-of-line)
+ (kotl-mode:delete-backward-char 1)
+ (kotl-mode:beginning-of-line)
+ (should (looking-at-p "012")))
+ (ert-info ("Delete two chars backward")
+ (init)
+ (kotl-mode:end-of-line)
+ (kotl-mode:delete-char -2)
+ (kotl-mode:beginning-of-line)
+ (should (looking-at-p "01")))
+ (ert-info ("Delete two char backward - interactive")
+ (init)
+ (let ((current-prefix-arg 2)
+ kill-ring)
+ (kotl-mode:end-of-line)
+ (call-interactively #'kotl-mode:delete-backward-char)
+ (kotl-mode:beginning-of-line)
+ (should (looking-at-p "01"))
+ (should (string= (car kill-ring) "23"))))
+ ;; Error cases
+ (ert-info ("Delete at cell end")
+ (init)
+ (kotl-mode:end-of-cell)
+ (let ((err (should-error (kotl-mode:delete-char 1) :type 'error)))
+ (should (string-match "(kotl-mode:delete-char): End of cell" (cadr
err)))))
+ (ert-info ("Delete at beginning of cell backwards")
+ (init)
+ (let ((err (should-error (kotl-mode:delete-char -1) :type 'error)))
+ (should (string-match "(kotl-mode:delete-char): Beginning of cell"
(cadr err)))))
+ ;; Region
+ (dolist (func '(kotl-mode:delete-char kotl-mode:delete-backward-char))
+ ;; Same behavior forward and backward
+ (ert-info ("Transient mark mode, delete region")
+ (let ((delete-active-region t)
+ kill-ring)
+ (init)
+ (kotl-mode:forward-char 1)
+ (set-mark (point))
+ (kotl-mode:forward-char 2)
+ (transient-mark-mode)
+ (funcall func 1)
+ (kotl-mode:beginning-of-line)
+ (should (looking-at-p "03"))
+ (should-not kill-ring)))
+ (ert-info ("Transient mark mode, kill region")
+ (let ((delete-active-region t)
+ kill-ring)
+ (init)
+ (kotl-mode:forward-char 1)
+ (set-mark (point))
+ (kotl-mode:forward-char 2)
+ (transient-mark-mode)
+ (funcall func 1 t)
+ (kotl-mode:beginning-of-line)
+ (should (looking-at-p "03"))
+ (should (string= (car kill-ring) "12")))))
+ (ert-info ("Transient mark mode, delete multiple chars ignores region")
+ (let ((delete-active-region t)
+ kill-ring)
+ (init)
+ (set-mark (point))
+ (kotl-mode:forward-char 2)
+ (transient-mark-mode)
+ (kotl-mode:delete-char 2)
+ (kotl-mode:beginning-of-line)
+ (should (looking-at-p "01"))
+ (should-not kill-ring)))
+ (ert-info ("Transient mark mode, delete multiple chars ignores region,
interactive")
+ (let ((delete-active-region t)
+ kill-ring)
+ (init)
+ (set-mark (point))
+ (kotl-mode:forward-char 2)
+ (transient-mark-mode)
+ (let ((current-prefix-arg 2)
+ kill-ring)
+ (call-interactively #'kotl-mode:delete-char)
+ (kotl-mode:beginning-of-line)
+ (should (looking-at-p "01"))
+ (should (string= (car kill-ring) "23")))))
+ (ert-info ("No transient mark mode, plain delete")
+ (let ((delete-active-region t)
+ kill-ring)
+ (init)
+ (kotl-mode:forward-char 1)
+ (set-mark (point))
+ (kotl-mode:forward-char 2)
+ (transient-mark-mode -1)
+ (kotl-mode:delete-char 1)
+ (kotl-mode:beginning-of-line)
+ (should (looking-at-p "012"))
+ (should-not kill-ring)))))
+ ;; Region Error cases
+ (cl-flet ((init ()
+ (progn (erase-buffer)
+ (kotl-mode)
+ (insert "0123")
+ (kotl-mode:add-cell)
+ (insert "4567")
+ (kotl-mode:beginning-of-buffer))))
+ (with-temp-buffer
+ (ert-info ("Delete region across cells")
+ ;; Same behavior forward and backward
+ (let ((delete-active-region t))
+ (dolist (func '(kotl-mode:delete-char
kotl-mode:delete-backward-char))
+ (init)
+ (set-mark (point))
+ (kotl-mode:end-of-buffer)
+ (transient-mark-mode)
+ (let ((err (should-error (funcall func 1) :type 'error)))
+ (should (string-match
+ "(kotl-mode:kill-region): Bad region or not within a
single Koutline cell"
+ (cadr err))))))))))
+
(provide 'kotl-mode-tests)
;; This file can't be byte-compiled without the `el-mock' package
