master 42e4d6b8ce: Improve cycle-spacing and bind it to M-SPC by default

[Tassilo Horn]

branch: master
commit 42e4d6b8ce238507193a563730d25e1d96e2ad3d
Author: Tassilo Horn <tsdh@gnu.org>
Commit: Tassilo Horn <tsdh@gnu.org>

    Improve cycle-spacing and bind it to M-SPC by default
    
    * lisp/bindings.el (esc-map): Bind M-SPC to cycle-spacing instead of
    just-one-space.
    * lisp/simple.el (delete-space--internal): New function.
    (delete-horizontal-space): Use it.
    (delete-all-space): New command.
    (just-one-space): Implement on its own instead of calling
    cycle-spacing with a special flag.
    (cycle-spacing--context): Make it a plist instead of a list.  Adapt
    docstring accordingly.
    (cycle-spacing-actions): New user option.
    (cycle-spacing): Rewrite so that it performs the actions in
    cycle-spacing-actions instead of the hard-coded ones.
    * doc/emacs/killing.texi (characters): Mention and add a variable
    index entry for cycle-spacing-actions.
    * etc/NEWS: Document that M-SPC is now cycle-spacing instead of
    just-one-space.
---
 doc/emacs/killing.texi |  25 +++--
 etc/NEWS               |   5 +
 lisp/bindings.el       |   2 +-
 lisp/simple.el         | 295 ++++++++++++++++++++++++++++++++++++++-----------
 4 files changed, 248 insertions(+), 79 deletions(-)

diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 2fd2d21dd3..30025134eb 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -111,24 +111,27 @@ active (@pxref{Using Region}).
 
 @kindex M-\
 @findex delete-horizontal-space
-@kindex M-SPC
-@findex just-one-space
-@findex cycle-spacing
-  The other delete commands are those that delete only whitespace
+The other delete commands are those that delete only whitespace
 characters: spaces, tabs and newlines.  @kbd{M-\}
 (@code{delete-horizontal-space}) deletes all the spaces and tab
 characters before and after point.  With a prefix argument, this only
-deletes spaces and tab characters before point.  @kbd{M-@key{SPC}}
-(@code{just-one-space}) does likewise but leaves a single space before
+deletes spaces and tab characters before point.
+
+@findex just-one-space
+@code{just-one-space} does likewise but leaves a single space before
 point, regardless of the number of spaces that existed previously
 (even if there were none before).  With a numeric argument @var{n}, it
 leaves @var{n} spaces before point if @var{n} is positive; if @var{n}
 is negative, it deletes newlines in addition to spaces and tabs,
-leaving @minus{}@var{n} spaces before point.  The command @code{cycle-spacing}
-acts like a more flexible version of @code{just-one-space}.  It
-does different things if you call it repeatedly in succession.
-The first call acts like @code{just-one-space}, the next removes
-all whitespace, and a third call restores the original whitespace.
+leaving @minus{}@var{n} spaces before point.
+
+@kindex M-SPC
+@findex cycle-spacing
+@vindex cycle-spacing-actions
+The command @code{cycle-spacing} (@kbd{M-@key{SPC}}) acts like a more
+flexible version of @code{just-one-space}.  It performs different
+space cleanup actions if you call it repeatedly in succession as
+defined by @code{cycle-spacing-actions}.
 
   @kbd{C-x C-o} (@code{delete-blank-lines}) deletes all blank lines
 after the current line.  If the current line is blank, it deletes all
diff --git a/etc/NEWS b/etc/NEWS
index a3ec2100e9..c53b896edd 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -677,6 +677,11 @@ recreate it anew next time 'imenu' is invoked.
 
 * Editing Changes in Emacs 29.1
 
++++
+** M-SPC is now bound to 'cycle-spacing' (formerly it was 'just-one-space').
+The actions performed by 'cycle-spacing' and their order can now be
+customized via 'cycle-spacing-actions'.
+
 ---
 ** 'scroll-other-window' and 'scroll-other-window-down' now respects remapping.
 These commands (bound to 'C-M-v' and 'C-M-V') used to scroll the other
diff --git a/lisp/bindings.el b/lisp/bindings.el
index bfe5ba8623..ed1325e326 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -990,7 +990,7 @@ if `inhibit-field-text-motion' is non-nil."
 (define-key esc-map "\\" 'delete-horizontal-space)
 (define-key esc-map "m" 'back-to-indentation)
 (define-key ctl-x-map "\C-o" 'delete-blank-lines)
-(define-key esc-map " " 'just-one-space)
+(define-key esc-map " " 'cycle-spacing)
 (define-key esc-map "z" 'zap-to-char)
 (define-key esc-map "=" 'count-words-region)
 (define-key ctl-x-map "=" 'what-cursor-position)
diff --git a/lisp/simple.el b/lisp/simple.el
index 3812f6d8c6..6cbc73e942 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1072,15 +1072,26 @@ Leave one space or none, according to the context."
   "Delete all spaces and tabs around point.
 If BACKWARD-ONLY is non-nil, delete them only before point."
   (interactive "*P")
+  (delete-space--internal " \t" backward-only))
+
+(defun delete-all-space (&optional backward-only)
+  "Delete all spaces, tabs, and newlines around point.
+If BACKWARD-ONLY is non-nil, delete them only before point."
+  (interactive "*P")
+  (delete-space--internal " \t\r\n" backward-only))
+
+(defun delete-space--internal (chars backward-only)
+  "Delete CHARS around point.
+If BACKWARD-ONLY is non-nil, delete them only before point."
   (let ((orig-pos (point)))
     (delete-region
      (if backward-only
-        orig-pos
+         orig-pos
        (progn
-        (skip-chars-forward " \t")
-        (constrain-to-field nil orig-pos t)))
+         (skip-chars-forward chars)
+         (constrain-to-field nil orig-pos t)))
      (progn
-       (skip-chars-backward " \t")
+       (skip-chars-backward chars)
        (constrain-to-field nil orig-pos)))))
 
 (defun just-one-space (&optional n)
@@ -1088,73 +1099,223 @@ If BACKWARD-ONLY is non-nil, delete them only before 
point."
 If N is negative, delete newlines as well, leaving -N spaces.
 See also `cycle-spacing'."
   (interactive "*p")
-  (cycle-spacing n nil 'single-shot))
+  (let ((orig-pos        (point))
+        (skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
+        (num             (abs (or n 1))))
+    (skip-chars-backward skip-characters)
+    (constrain-to-field nil orig-pos)
+    (let* ((num   (- num (skip-chars-forward " " (+ num (point)))))
+           (mid   (point))
+           (end   (progn
+                    (skip-chars-forward skip-characters)
+                    (constrain-to-field nil orig-pos t))))
+      (delete-region mid end)
+      (insert (make-string num ?\s)))))
 
 (defvar cycle-spacing--context nil
-  "Store context used in consecutive calls to `cycle-spacing' command.
-The first time `cycle-spacing' runs, it saves in this variable:
-its N argument, the original point position, and the original spacing
-around point.")
+  "Stored context used in consecutive calls to `cycle-spacing' command.
+The value is a property list with the following elements:
+- `:orig-pos'    The original position of point when starting the
+                 sequence.
+- `:whitespace-string' All whitespace characters around point
+                       including newlines.
+- `:n'            The prefix arg given to the initial invocation
+                  which is reused for all actions in this cycle.
+- `:last-action'  The last action performed in the cycle.")
+
+(defcustom cycle-spacing-actions
+  '( just-one-space
+     delete-all-space
+     restore)
+  "List of actions cycled through by `cycle-spacing'.
+Supported values are:
+- `just-one-space'      Delete all but N (prefix arg) spaces.
+                        See that command's docstring for details.
+- `delete-space-after'  Delete spaces after point keeping only N.
+- `delete-space-before' Delete spaces before point keeping only N.
+- `delete-all-space'    Delete all spaces around point.
+- `restore'             Restore the original spacing.
+
+All actions make use of the prefix arg given to `cycle-spacing'
+in the initial invocation, i.e., `just-one-space' keeps this
+amount of spaces deleting surplus ones.  `just-one-space' and all
+other actions have the contract that a positive prefix arg (or
+zero) only deletes tabs and spaces whereas a negative prefix arg
+also deletes newlines.
+
+The `delete-space-before' and `delete-space-after' actions handle
+the prefix arg \\[negative-argument] without a number provided
+specially: all spaces before/after point are deleted (as if N was
+0) including newlines (as if N was negative).
+
+In addition to the predefined actions listed above, any function
+which accepts one argument is allowed.  It receives the raw
+prefix arg of this cycle.
+
+In addition, an action may take the form (ACTION ARG) where
+ACTION is any action except for `restore' and ARG is either
+- an integer with the meaning that ACTION should always use this
+  fixed integer instead of the actual prefix arg or
+- the symbol `inverted-arg' with the meaning that ACTION should
+  be performed with the inverted actual prefix arg.
+- the symbol `-' with the meaning that ACTION should include
+  newlines but it's up to the ACTION to decide how to interpret
+  it as a number, e.g., `delete-space-before' and
+  `delete-space-after' treat it like 0 whereas `just-one-space'
+  treats it like -1 as is usual."
+  :group 'editing-basics
+  :type (let ((actions
+               '((const :tag "Just N (prefix arg) spaces" just-one-space)
+                 (const :tag "Delete spaces after point" delete-space-after)
+                 (const :tag "Delete spaces before point" delete-space-before)
+                 (const :tag "Delete all spaces around point" delete-all-space)
+                 (function :tag "Function receiving a numerig arg"))))
+          `(repeat
+            (choice
+             ,@actions
+             (list :tag "Action with modified arg"
+                   (choice ,@actions)
+                   (choice (const :tag "Inverted prefix arg" inverted-arg)
+                           (const :tag "Fixed numeric arg" integer)))
+             (const :tag "Restore the original spacing" restore))))
+  :version "29.1")
 
-(defun cycle-spacing (&optional n preserve-nl-back mode)
+(defun cycle-spacing (&optional n)
   "Manipulate whitespace around point in a smart way.
-In interactive use, this function behaves differently in successive
-consecutive calls.
-
-The first call in a sequence acts like `just-one-space'.
-It deletes all spaces and tabs around point, leaving one space
-\(or N spaces).  N is the prefix argument.  If N is negative,
-it deletes newlines as well, leaving -N spaces.
-\(If PRESERVE-NL-BACK is non-nil, it does not delete newlines before point.)
-
-The second call in a sequence deletes all spaces.
-
-The third call in a sequence restores the original whitespace (and point).
-
-If MODE is `single-shot', it performs only the first step in the sequence.
-If MODE is `fast' and the first step would not result in any change
-\(i.e., there are exactly (abs N) spaces around point),
-the function goes straight to the second step.
-
-Repeatedly calling the function with different values of N starts a
-new sequence each time."
-  (interactive "*p")
-  (let ((orig-pos       (point))
-       (skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
-       (num             (abs (or n 1))))
-    (skip-chars-backward (if preserve-nl-back " \t" skip-characters))
-    (constrain-to-field nil orig-pos)
-    (cond
-     ;; Command run for the first time, single-shot mode or different argument
-     ((or (eq 'single-shot mode)
-         (not (equal last-command this-command))
-         (not cycle-spacing--context)
-         (not (eq (car cycle-spacing--context) n)))
-      (let* ((start (point))
-            (num   (- num (skip-chars-forward " " (+ num (point)))))
-            (mid   (point))
-            (end   (progn
-                     (skip-chars-forward skip-characters)
-                     (constrain-to-field nil orig-pos t))))
-       (setq cycle-spacing--context  ;; Save for later.
-             ;; Special handling for case where there was no space at all.
-             (unless (= start end)
-                (cons n (cons orig-pos (buffer-substring start (point))))))
-       ;; If this run causes no change in buffer content, delete all spaces,
-       ;; otherwise delete all excess spaces.
-       (delete-region (if (and (eq mode 'fast) (zerop num) (= mid end))
-                          start mid) end)
-        (insert (make-string num ?\s))))
-
-     ;; Command run for the second time.
-     ((not (equal orig-pos (point)))
-      (delete-region (point) orig-pos))
-
-     ;; Command run for the third time.
-     (t
-      (insert (cddr cycle-spacing--context))
-      (goto-char (cadr cycle-spacing--context))
-      (setq cycle-spacing--context nil)))))
+Repeated calls perform the actions in `cycle-spacing-actions' one
+after the other, wrapping around after the last one.
+
+All actions are amendable using a prefix arg N.  In general, a
+zero or positive prefix arg allows only for deletion of tabs and
+spaces whereas a negative prefix arg also allows for deleting
+newlines.
+
+The prefix arg given at the first invocation starting a cycle is
+provided to all following actions, i.e.,
+    \\[negative-argument] \\[cycle-spacing] \\[cycle-spacing] \\[cycle-spacing]
+is equivalent to
+    \\[negative-argument] \\[cycle-spacing] \\[negative-argument] 
\\[cycle-spacing] \\[negative-argument] \\[cycle-spacing].
+
+A new sequence can be started by providing a different prefix arg
+than provided at the initial invocation (except for 1), or by
+doing any other command before the next \\[cycle-spacing]."
+  (interactive "*P")
+  ;; Initialize `cycle-spacing--context' if needed.
+  (when (or (not (equal last-command this-command))
+            (not cycle-spacing--context)
+            ;; With M-5 M-SPC M-SPC... we pass the prefix arg 5 to
+            ;; each action and only start a new cycle when a different
+            ;; prefix arg is given and which is not the default value
+            ;; 1.
+            (and n (not (equal (plist-get cycle-spacing--context :n)
+                               n))))
+    (let ((orig-pos (point))
+          (skip-characters " \t\n\r"))
+      (save-excursion
+        (skip-chars-backward skip-characters)
+        (constrain-to-field nil orig-pos)
+        (let ((start (point))
+              (end   (progn
+                       (skip-chars-forward skip-characters)
+                       (constrain-to-field nil orig-pos t))))
+          (setq cycle-spacing--context  ;; Save for later.
+                (list :orig-pos orig-pos
+                      :whitespace-string (buffer-substring start end)
+                      :n n
+                      :last-action nil))))))
+
+  ;; Cycle through the actions in `cycle-spacing-actions'.
+  (when cycle-spacing--context
+    (cl-labels ((next-action ()
+                  (let* ((l cycle-spacing-actions)
+                         (elt (plist-get cycle-spacing--context
+                                         :last-action)))
+                    (if (null elt)
+                        (car cycle-spacing-actions)
+                      (catch 'found
+                        (while l
+                          (cond
+                           ((null (cdr l))
+                            (throw 'found
+                                   (when (eq elt (car l))
+                                     (car cycle-spacing-actions))))
+                           ((and (eq elt (car l))
+                                 (cdr l))
+                            (throw 'found (cadr l)))
+                           (t (setq l (cdr l)))))))))
+                (skip-chars (chars max-dist direction)
+                  (if (eq direction 'forward)
+                      (skip-chars-forward
+                       chars
+                       (and max-dist (+ (point) max-dist)))
+                    (skip-chars-backward
+                     chars
+                     (and max-dist (- (point) max-dist)))))
+                (delete-space (n include-newlines direction)
+                  (let ((orig-point (point))
+                        (chars (if include-newlines
+                                   " \t\r\n"
+                                 " \t")))
+                    (when (or (zerop n)
+                              (= n (abs (skip-chars chars n direction))))
+                      (let ((start (point))
+                            (end (progn
+                                   (skip-chars chars nil direction)
+                                   (point))))
+                        (unless (= start end)
+                          (delete-region start end))
+                        (goto-char (if (eq direction 'forward)
+                                       orig-point
+                                     (+ n end)))))))
+                (restore ()
+                  (delete-all-space)
+                  (insert (plist-get cycle-spacing--context
+                                     :whitespace-string))
+                  (goto-char (plist-get cycle-spacing--context
+                                        :orig-pos))))
+      (let ((action (next-action)))
+        (atomic-change-group
+          (restore)
+          (unless (eq action 'restore)
+            ;; action can be some-action or (some-action <arg>) where
+            ;; arg is either an integer, the arg to be always used for
+            ;; this action or - to use the inverted context n for this
+            ;; action.
+            (let* ((actual-action (if (listp action)
+                                      (car action)
+                                    action))
+                   (arg (when (listp action)
+                          (nth 1 action)))
+                   (context-n (plist-get cycle-spacing--context :n))
+                   (actual-n (cond
+                              ((integerp arg) arg)
+                              ((eq 'inverted-arg arg)
+                               (* -1 (prefix-numeric-value context-n)))
+                              ((eq '- arg) '-)
+                              (t context-n)))
+                   (numeric-n (prefix-numeric-value actual-n))
+                   (include-newlines (and actual-n
+                                          (or (eq actual-n '-)
+                                              (< actual-n 0)))))
+              (cond
+               ((eq actual-action 'just-one-space)
+                (just-one-space numeric-n))
+               ((eq actual-action 'delete-space-after)
+                (delete-space (if (eq actual-n '-) 0 (abs numeric-n))
+                              include-newlines 'forward))
+               ((eq actual-action 'delete-space-before)
+                (delete-space (if (eq actual-n '-) 0 (abs numeric-n))
+                              include-newlines 'backward))
+               ((eq actual-action 'delete-all-space)
+                (if include-newlines
+                    (delete-all-space)
+                  (delete-horizontal-space)))
+               ((functionp actual-action)
+                (funcall actual-action actual-n))
+               (t
+                (error "Don't know how to handle action %S" action)))))
+          (setf (plist-get cycle-spacing--context :last-action)
+                action))))))
 
 (defun beginning-of-buffer (&optional arg)
   "Move point to the beginning of the buffer.