~wklew/parcont

parcont/parcont.el -rw-r--r-- 5.5 KiB
1e2ba059wklew Add Racket bindings 2 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
;;; parcont.el --- Continuation-based sexp editing commands -*- lexical-binding: t -*-

;; Copyright (C) 2021 Walter Lewis

;; Author: Walter Lewis <wklew@mailbox.org>
;; Keywords: lisp
;; Url: https://git.sr.ht/~wklew/parcont
;; Version: 0.0.1

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This file provides a set of context-based commands for editing
;; s-expressions.  The idea of context is borrowed from the notion of
;; *continuation* in computer science.  A continuation represents "the
;; rest of the program" relative to some local expression.  The
;; ability to capture and restore the current continuation (possibly
;; up to some enclosing delimiter, in the case of delimited
;; continuations) makes possible a range of interesting computational
;; effects, such as exceptions, nondeterminism and dynamic state.

;; The commands `parcont-kill-context' and `parcont-yank' are used to
;; capture and restore the immediate context of an s-expression,
;; similarly to a program which captures and restores its
;; continuation.  Along with `parcont-yank-pop', these commands define
;; a contextual analog to the build-in killing and yanking interface.

;;; Code:

(defconst parcont-kill-ring-max 60
  "Maximum size of `parcont-kill-ring'.")

(defvar parcont-kill-ring (make-ring parcont-kill-ring-max)
  "Ring of killed continuations, analogous to `kill-ring'.")

(defvar parcont-start nil)
(defvar parcont-end nil)
(defvar parcont-mark nil)
(defvar parcont-count nil)

(defun parcont-start-of-sexp-after-point ()
  (save-excursion
    (forward-sexp)
    (backward-sexp)
    (point)))

(defun parcont-end-of-sexp-before-point ()
  (save-excursion
    (backward-sexp)
    (forward-sexp)
    (point)))

(defun parcont-kill-new (before after)
  (ring-insert parcont-kill-ring (cons before after)))

(defun parcont-kill-wrap (before after)
  (let ((cont (ring-remove parcont-kill-ring 0)))
    (ring-insert parcont-kill-ring
                 (cons (concat before (car cont))
                       (concat (cdr cont) after)))))

(defun parcont-kill-rotate (n)
  (while (> n 0)
    (ring-insert-at-beginning parcont-kill-ring
                              (ring-remove parcont-kill-ring 0))
    (setq n (- n 1))))

(defun parcont-clear ()
  "Clear `parcont-kill-ring'."
  (interactive)
  (setq parcont-kill-ring (make-ring parcont-kill-ring-max)))

(defun parcont-kill-context (n)
  "Kill the context around N sexps at point.
The killed context is pushed onto `parcont-kill-ring', or
appended to the most recent entry if invoked immediately after a
previous call to `parcont-kill-context'."
  (interactive "*p")
  (let* ((bound (scan-sexps (point) n))
         (start (if (< n 0) bound (parcont-start-of-sexp-after-point)))
         (end (if (> n 0) bound (parcont-end-of-sexp-before-point)))
         (sexps (buffer-substring start end)))
    (backward-up-list)
    (let* ((cont-start (point))
           (cont-end (scan-sexps (point) 1))
           (before (buffer-substring cont-start start))
           (after (buffer-substring end cont-end)))
      (delete-region cont-start cont-end)
      (insert sexps)
      (indent-region cont-start (point))
      (goto-char cont-start)
      (if (eq last-command 'parcont-kill-context)
          (parcont-kill-wrap before after)
        (parcont-kill-new before after)))))

(defun parcont-yank (n)
  "Yank the most recent killed context around N sexps at point."
  (interactive "*p")
  (let* ((bound (scan-sexps (point) n))
         (start (if (< n 0) bound (parcont-start-of-sexp-after-point)))
         (end (if (> n 0) bound (parcont-end-of-sexp-before-point)))
         (size (- end start))
         (cont (ring-ref parcont-kill-ring 0)))
    (push-mark (goto-char start))
    (insert (car cont))
    (let* ((hole-start (point))
           (hole-end (+ hole-start size)))
      (goto-char hole-end)
      (insert (cdr cont))
      (setq parcont-start start
            parcont-end (point)
            parcont-mark hole-end
            parcont-count n)
      (goto-char hole-start)
      (indent-region parcont-start parcont-end))))

(defun parcont-yank-pop (n)
  "Replace the last yanked context with the Nth next killed."
  (interactive "*p")
  (unless (eq last-command 'parcont-yank)
    (user-error "Previous command was not `parcont-yank'"))
  (setq this-command 'parcont-yank)
  (delete-region parcont-mark parcont-end)
  (delete-region parcont-start (point))
  (parcont-kill-rotate n)
  (parcont-yank parcont-count))

(defun parcont-define-keys (map)
  (define-key map (kbd "C-S-w") #'parcont-kill-context)
  (define-key map (kbd "C-S-y") #'parcont-yank)
  (define-key map (kbd "M-Y") #'parcont-yank-pop))

(parcont-define-keys emacs-lisp-mode-map)
(parcont-define-keys lisp-mode-map)
(with-eval-after-load 'scheme (parcont-define-keys scheme-mode-map))
(with-eval-after-load 'racket-mode (parcont-define-keys racket-mode-map))
(with-eval-after-load 'fennel-mode (parcont-define-keys fennel-mode-map))

(provide 'parcont)

;;; parcont.el ends here