Add racket-align and racket-unalign

Greg Hendershott · Greg Hendershott · commit c980131a5773 · 2015-07-13T14:32:05.000-04:00
diff --git a/Reference.md b/Reference.md
@@ -19,7 +19,7 @@
 ## Run
 
 ### racket-run
-<kbd>C-c C-k</kbd>
+<kbd>C-c C-k</kbd> or <kbd>C-c C-c</kbd>
 
 Save and evaluate the buffer in REPL, much like DrRacket's Run.
 
@@ -540,6 +540,74 @@ If you don’t like the highlighting of partially matching tokens you
 can turn it off by setting `input-method-highlight-flag` to nil via
 `M-x customize-variable`.
 
+### racket-align
+<kbd>M-[</kbd>
+
+Align values in the same column.
+
+Useful for binding forms like `let` and `parameterize`,
+conditionals like `cond` and `match`, association lists, and any
+series of couples like the arguments to `hash`.
+
+Before choosing this command, put point on the first of a series
+of "couples". A couple is:
+
+- A list of two or more sexprs: `[sexpr val sexpr ...]`
+- Two sexprs: `sexpr val`.
+
+Each `val` moves to the same column and is `indent-sexp`-ed (in
+case it is a multi-line form).
+
+For example with point on the `[` before `a`:
+
+    Before             After
+
+    (let ([a 12]       (let ([a   12]
+          [bar 23])          [bar 23])
+      ....)              ....)
+
+    '([a . 12]         '([a   . 12]
+      [bar . 23])        [bar . 23])
+
+    (cond [a? #t]      (cond [a?   #t]
+          [b? (f x           [b?   (f x
+                 y)]                  y)]
+          [else #f])         [else #f])
+
+Or with point on the `'` before `a`:
+
+    (list 'a 12        (list 'a   12
+          'bar 23)           'bar 23)
+
+If more than one couple is on the same line, none are aligned,
+because it is unclear where the value column should be. For
+example the following form will not change; [`racket-align`](#racket-align) will
+display an error message:
+
+    (let ([a 0][b 1]
+          [c 2])       error; unchanged
+      ....)
+
+When a couple's sexprs start on different lines, that couple is
+ignored. Other, single-line couples in the series are aligned as
+usual. For example:
+
+    (let ([foo         (let ([foo
+           0]                 0]
+          [bar 1]            [bar 1]
+          [x 2])             [x   2])
+      ....)              ....)
+
+See also: [`racket-unalign`](#racket-unalign).
+
+### racket-unalign
+<kbd>M-{</kbd>
+
+The opposite of [`racket-align`](#racket-align).
+
+Effectively does M-x `just-one-space` and `indent-sexp` for each
+couple's value.
+
 ## Macro expand
 
 ### racket-expand-region
diff --git a/racket-edit.el b/racket-edit.el
@@ -873,6 +873,125 @@ special commands to navigate among the definition and its uses.
     (racket--unhighlight-all)
     (setq buffer-read-only nil)))
 
+
+;;; align
+
+(defun racket-align ()
+  "Align values in the same column.
+
+Useful for binding forms like `let` and `parameterize`,
+conditionals like `cond` and `match`, association lists, and any
+series of couples like the arguments to `hash`.
+
+Before choosing this command, put point on the first of a series
+of \"couples\". A couple is:
+
+- A list of two or more sexprs: `[sexpr val sexpr ...]`
+- Two sexprs: `sexpr val`.
+
+Each `val` moves to the same column and is `indent-sexp'-ed (in
+case it is a multi-line form).
+
+For example with point on the `[` before `a`:
+
+    Before             After
+
+    (let ([a 12]       (let ([a   12]
+          [bar 23])          [bar 23])
+      ....)              ....)
+
+    '([a . 12]         '([a   . 12]
+      [bar . 23])        [bar . 23])
+
+    (cond [a? #t]      (cond [a?   #t]
+          [b? (f x           [b?   (f x
+                 y)]                  y)]
+          [else #f])         [else #f])
+
+Or with point on the `'` before `a`:
+
+    (list 'a 12        (list 'a   12
+          'bar 23)           'bar 23)
+
+If more than one couple is on the same line, none are aligned,
+because it is unclear where the value column should be. For
+example the following form will not change; `racket-align' will
+display an error message:
+
+    (let ([a 0][b 1]
+          [c 2])       error; unchanged
+      ....)
+
+When a couple's sexprs start on different lines, that couple is
+ignored. Other, single-line couples in the series are aligned as
+usual. For example:
+
+    (let ([foo         (let ([foo
+           0]                 0]
+          [bar 1]            [bar 1]
+          [x 2])             [x   2])
+      ....)              ....)
+
+See also: `racket-unalign'."
+  (interactive)
+  (save-excursion
+    (let ((listp (eq ?\( (char-syntax (char-after))))
+          (prev-line 0)
+          (max-col 0))
+      (racket--for-each-couple listp
+                               (lambda ()
+                                 (setq max-col (max max-col (current-column)))
+                                 (let ((this-line (line-number-at-pos)))
+                                   (when (= prev-line this-line)
+                                     (user-error
+                                      "Can't align if any couples are on same line"))
+                                   (setq prev-line this-line))))
+      (racket--for-each-couple listp
+                               (lambda ()
+                                 (indent-to max-col)
+                                 (indent-sexp))))))
+
+(defun racket-unalign ()
+  "The opposite of `racket-align'.
+
+Effectively does M-x `just-one-space' and `indent-sexp' for each
+couple's value."
+  (interactive)
+  (save-excursion
+    (let ((listp (eq ?\( (char-syntax (char-after)))))
+      (racket--for-each-couple listp
+                               (lambda ()
+                                 (just-one-space)
+                                 (indent-sexp))))))
+
+(defun racket--for-each-couple (listp f)
+  "Move point to each value sexp of a couple, and `funcall' F.
+
+Only call F when the couple's sexprs are on the same line.
+
+When LISTP is true, expects couples to be `[id val]`, else `id val`."
+  (save-excursion
+    (condition-case ()
+        (while t
+          (when listp
+            (down-list))
+          (forward-sexp)
+          (let ((line (line-number-at-pos)))
+            (forward-sexp)
+            (backward-sexp)
+            (when (= line (line-number-at-pos))
+              ;; Defensive: Backup over any prefix or punctuation
+              ;; chars just in case backward-sexp didn't (although it
+              ;; should have if our syntax table is correct).
+              (while (memq (char-syntax (char-before)) '(?\' ?\.))
+                (goto-char (1- (point))))
+              (funcall f)))
+          ;; On to the next couple...
+          (if listp
+              (up-list)
+            (forward-sexp)))
+      (scan-error nil))))
+
 
 ;;; misc
 
diff --git a/racket-make-doc.el b/racket-make-doc.el
@@ -82,6 +82,8 @@
     racket-backward-up-list
     racket-check-syntax-mode
     racket-unicode-input-method-enable
+    racket-align
+    racket-unalign
     "Macro expand"
     racket-expand-region
     racket-expand-definition
diff --git a/racket-mode.el b/racket-mode.el
@@ -55,8 +55,8 @@ http://www.gnu.org/licenses/ for details.")
 
 (defvar racket-mode-map
   (racket--easy-keymap-define
-   '((("C-c C-k"
-       "C-c C-c")   racket-run)
+   '((("C-c C-c"
+       "C-c C-k")   racket-run)
      ("C-c C-z"     racket-repl)
      ("<f5>"        racket-run-and-switch-to-repl)
      ("M-C-<f5>"    racket-racket)
@@ -86,7 +86,9 @@ http://www.gnu.org/licenses/ for details.")
      ("M-C-."       racket-visit-module)
      ("M-,"         racket-unvisit)
      ("C-c C-f"     racket-fold-all-tests)
-     ("C-c C-u"     racket-unfold-all-tests)))
+     ("C-c C-u"     racket-unfold-all-tests)
+     ("M-["         racket-align)
+     ("M-{"         racket-unalign)))
   "Keymap for Racket mode. Inherits from `lisp-mode-shared-map'.")
 
 (easy-menu-define racket-mode-menu racket-mode-map
@@ -118,6 +120,8 @@ http://www.gnu.org/licenses/ for details.")
     ["Insert λ" racket-insert-lambda]
     ["Indent Region" indent-region]
     ["Cycle Paren Shapes" racket-cycle-paren-shapes]
+    ["Align" racket-align]
+    ["Unalign" racket-unalign]
     "---"
     ["Visit Definition" racket-visit-definition]
     ["Visit Module" racket-visit-module]
