>From a6a4d973b0905363ce7c560c2ddc7746d2758160 Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Thu, 12 May 2022 23:24:47 +0200 Subject: [PATCH] Improve cycle-spacing --- 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 @@ Deletion @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 b89771cdbd..bf459793d9 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 @@ esc-map (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..75bf465dbf 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1072,15 +1072,24 @@ delete-horizontal-space "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) (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 +1097,225 @@ just-one-space 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-space-after + delete-space-before + 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 ) 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. -- 2.36.1