-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathvisual-line.lisp
150 lines (136 loc) · 6 KB
/
visual-line.lisp
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
;; Copyright (c) 2024, April & May
;; SPDX-License-Identifier: 0BSD
;; This is the Visual Line Mode for LispWorks Editor.
;; Sometimes we use the Editor with serif font, and sometimes we want
;; to work with truncated lines, then such a mode will be necessary.
;; It uses the existing "cursorpos" system of LW Editor, which can
;; positioning lines pixelwise horizontally, and character-wise
;; vertically. The commands and behaviours are just like the
;; visual-line-mode of Emacs.
;; Usage: Load this file, enable "Visual Line" minor mode (with
;; command "Visual Line Mode")
(in-package editor)
(defcommand "Beginning of Visual Line" (p)
"Same with \"Beginning of Line\", but works with visual line."
"Same with \"Beginning of Line\", but works with visual line."
(let* ((point (current-point))
(window (current-window))
(y (second (multiple-value-list
(point-to-cursorpos point window)))))
(call-with-window-and-buffer-locked
window 2
(lambda (&rest args)
(declare (ignore args))
(unless (cursorpos-to-point 0 (if p (+ y p) y) window point)
(editor-error "No such line."))))))
(defcommand "End of Visual Line" (p)
"Same with \"End of Line\", but works with visual line."
"Same with \"End of Line\", but works with visual line."
(let* ((point (current-point))
(window (current-window))
(px (window-width window))
(y (second (multiple-value-list
(point-to-cursorpos point window)))))
(call-with-window-and-buffer-locked
window 2
(lambda (&rest args)
(declare (ignore args))
(unless (cursorpos-to-point px (if p (+ y p) y) window point)
(editor-error "No such line."))))))
(defcommand "Kill Visual Line" (p)
"Same with \"Kill Line\", but works with visual line."
"Same with \"Kill Line\", but works with visual line."
(let* ((buffer (current-buffer))
(point (buffer-point buffer))
(window (current-window))
(px-end (window-width window))
(y (second (multiple-value-list
(point-to-cursorpos point window))))
(error-string nil))
(call-with-window-and-buffer-locked
window 2
(lambda (&rest args)
(declare (ignore args))
(with-point ((tpoint point))
(cond
(p
(when (and (not (start-line-p point)) (minusp p))
(incf p))
(unless (cursorpos-to-point px-end (+ y p) window tpoint)
(if (plusp p)
(%kill-region point (buffer-%end buffer)
:kill-forward)
(%kill-region (buffer-%start buffer) point
:kill-backward))
(editor-error))
(if (plusp p)
(%kill-region point tpoint :kill-forward)
(%kill-region tpoint point :kill-backward)))
(t
(unless (and (blank-after-p tpoint)
(line-offset tpoint 1 0))
(cursorpos-to-point px-end (1+ y) window tpoint))
(if (point= point tpoint)
(setq error-string "Kill Line attempted at end of buffer")
(%kill-region point tpoint :kill-forward)))))))
(when error-string (editor-error error-string))))
(defvar *target-x-position* 0)
(defun set-target-x-position (point)
(if (eq (last-command-type) :line-motion)
*target-x-position*
(setq *target-x-position* (point-to-xy-pixels (current-window) point))))
(defcommand "Previous Visual Line" (p)
"Same with \"Previous Line\", but works with visual line."
"Same with \"Previous Line\", but works with visual line."
(let* ((point (current-point))
(window (current-window))
(height (get-window-height window))
(px (set-target-x-position point))
(y (second (multiple-value-list (point-to-cursorpos point window))))
(offset (or p -1)))
(when (or (< (+ y offset) 0)
(> (+ y offset) height))
(refresh-screen-command nil)
(setq y (second (multiple-value-list (point-to-cursorpos point window)))))
(call-with-window-and-buffer-locked
window 2
(lambda (&rest args)
(declare (ignore args))
(unless (cursorpos-to-point px (if p (- y p) (1- y)) window point)
(editor-error "No previous line."))))
(setf (last-command-type) :line-motion)))
(defcommand "Next Visual Line" (p)
"Same with \"Next Line\", but works with visual line."
"Same with \"Next Line\", but works with visual line."
(let* ((point (current-point))
(window (current-window))
(height (get-window-height window))
(px (set-target-x-position point))
(y (second (multiple-value-list (point-to-cursorpos point window))))
(offset (or p -1)))
(when (or (< (+ y offset) 0)
(> (+ y offset) height))
(refresh-screen-command nil)
(setq y (second (multiple-value-list (point-to-cursorpos point window)))))
(call-with-window-and-buffer-locked
window 2
(lambda (&rest args)
(declare (ignore args))
(unless (cursorpos-to-point px (if p (+ y p) (1+ y)) window point)
(editor-error "No previous line."))))
(setf (last-command-type) :line-motion)))
(defmode "Visual Line"
:key-bindings '(("Beginning of Visual Line" "Control-a")
("End of Visual Line" "Control-e")
("Kill Visual Line" "Control-k")
("Previous Visual Line" "Control-p")
("Next Visual Line" "Control-n")))
(defcommand "Visual Line Mode" (p)
"Toggle the Visual Line Mode. If P is supplied, turn on the mode
if P is positive, turn off if not."
"Toggle the Visual Line Mode. If P is supplied, turn on the mode
if P is positive, turn off if not."
(let ((buffer (current-buffer)))
(setf (buffer-minor-mode buffer "Visual Line")
(if p (plusp p)
(not (buffer-minor-mode buffer "Visual Line"))))))