Browse code

Added regex-replacement feature

Jenga Phoenix authored on 2019-03-30 22:32:11
Showing 5 changed files
... ...
@@ -67,6 +67,7 @@
67 67
 (defparameter *key-copy* "<Control-c>" "Copy the selected text")
68 68
 (defparameter *key-paste* "<Control-v>" "Paste the selected text")
69 69
 (defparameter *key-select-all* "<Control-a>" "Select all text in the file")
70
+(defparameter *key-replace* "<Control-t>" "Replace text with regexp")
70 71
 (defparameter *key-goto-line* "<Control-i>" "Goto line number")
71 72
 (defparameter *key-reformat* "<Control-j>" "Indent the current form")
72 73
 (defparameter *key-macro-expand* "<Control-m>" "Macroexpand form in listener")
... ...
@@ -120,3 +121,5 @@
120 121
 (setf translate:*language* 'en)
121 122
 
122 123
 
124
+
125
+
... ...
@@ -1,175 +1,185 @@
1
-(in-package :able)
2
-
3
-;; translate is nice, but sends a bunch of annoying
4
-;; and unnecessary text to stdout.
5
-(with-open-stream (*standard-output* (make-broadcast-stream))
6
-  (translate:add-translations
7
-    'en
8
-    "File"	"File"
9
-    ;; ----------
10
-    "New file"	"New file"
11
-    "Open file"	"Open file"
12
-    "Open file browser" "Open file browser"
13
-    "Save file"	"Save file"
14
-    "Save as file" "Save as file"
15
-    "Save as file browser" "Save as file browser"
16
-    "Exit"	"Exit"
17
-
18
-    "Edit"	"Edit"
19
-    ;; ----------
20
-    "Cut"  	"Cut"
21
-    "Copy"  	"Copy"
22
-    "Paste" 	"Paste"
23
-
24
-    "Select all"	"Select all"
25
-    "Reindent"	"Reindent"
26
-    "Find"  	"Find"
27
-    "Find again"	"Find again"
28
-    "Goto line"	"Goto line"
29
-
30
-    "Buffers"	"Buffers"
31
-    ;; ----------
32
-    "Next buffer" "Next buffer"
33
-    "Close buffer" "Close buffer"
34
-    "Select buffer" "Select buffer"
35
-
36
-    "Magic"	"Magic"
37
-    ;; ----------
38
-    "lisp" 	"lisp"
39
-    ;; ----------
40
-    "Macroexpand"	"Macroexpand"
41
-    "Copy to REPL" "Copy to REPL"
42
-    "Complete symbol" "Complete symbol"
43
-    "CLHS lookup"	"CLHS lookup"
44
-    "(Re)load buffer" "(Re)load buffer"
45
-    "Load file"	"Load file"
46
-    "Load ASDF"	"Load ASDF"
47
-    "Compile file" "Compile file"
48
-    "Invoke native debugger" "Invoke native debugger"
49
-    "Reset listener" "Reset listener"
50
-
51
-    "evaluating..." "evaluating..."
52
-    "highlighting..." "highlighting..."
53
-
54
-    ;; info messages
55
-    "search wrapped around file" "search wrapped around file"
56
-    "No Hyperspec entry or src location found"
57
-    "No Hyperspec entry or src location found"
58
-
59
-    ;; error messages
60
-    "no matches"  "no matches"
61
-    "non integer argument supplied to goto"
62
-    "non integer argument supplied to goto"
63
-    "file not found" "file not found"
64
-    "please save before loading" "please save before loading"
65
-    "unsaved files exist...quit anyway?"
66
-    "unsaved files exist...quit anyway?"
67
-
68
-
69
-    "please save before compiling" "please save before compiling"
70
-    "search reached end of file" "search reached end of file"
71
-
72
-    ;; misc
73
-    "untitled"	"untitled"
74
-    "untitled #"	"untitled #"
75
-    "find:"	"find:"
76
-
77
-    "y"   	"y"
78
-    "yes"  	"yes"
79
-    "n"   	"n"
80
-    "no"   	"no"
81
-
82
-    "open:"	"open:"
83
-    "goto:"	"goto:"
84
-    "system:"	"system:"
85
-    "buffer number:" "buffer number:"
86
-    "load:"	"load:"
87
-    "save:"	"save:"
88
-    "unsaved file...close anyway?" "unsaved file...close anyway?"
89
-    "unsaved files exist...quit anyway?" "unsaved files exist...quit anyway?")
90
-
91
-  (translate:add-translations
92
-    'eo
93
-    "File"	"Dosiero"
94
-    ;; ----------
95
-    "New file"	"Nova"
96
-    "Open file"	"Malfermi"
97
-    "Open file browser" "Malfermi per foliumilo"
98
-    "Save file"	"Konservi"
99
-    "Save as file" "Konservi kiel"
100
-    "Save as file browser" "Konservi per foliumilo"
101
-    "Exit"	"Ĉesi"
102
-
103
-    "Edit"	"Redakti"
104
-    ;; ----------
105
-    "Cut"  	"Eltondi"
106
-    "Copy"  	"Kopii"
107
-    "Paste" 	"Alglui"
108
-
109
-    "Select all"	"Elekti ĉion"
110
-    "Reindent"	"Rekrommarĝeni"
111
-    "Find"  	"Serĉi"
112
-    "Find again"	"Reserĉi"
113
-    "Goto line"	"Aliri linion"
114
-
115
-    "Buffers"	"Bufroj"
116
-    ;; ----------
117
-    "Next buffer" "Sekva bufro"
118
-    "Close buffer"
119
-    "Fermi bufron"
120
-    "Select buffer" "Elekti bufron"
121
-
122
-    "Magic"	"Sorĉeroj"
123
-    ;; ----------
124
-    "lisp" 	"lisp"
125
-    ;; ----------
126
-    "Macroexpand"	"Makrogeneradi"
127
-    "Copy to REPL" "Kopii al REPL"
128
-    "Complete symbol" "Kompletigi simbolon"
129
-    "CLHS lookup" "Serĉi en CLHS"
130
-    "(Re)load buffer" "(Re)ŝarĝi bufron"
131
-    "Load file"	"Ŝarĝi dosieron"
132
-    "Load ASDF"	"Ŝarĝi ASDF'on"
133
-    "Compile file" "Kompili dosieron"
134
-    "Invoke native debugger" "Alvoki erarserĉilon"
135
-    "Reset listener" "Restartigi aŭskultanton"
136
-
137
-    "evaluating..." "taksanta..."
138
-    "highlighting..." "prilumanta..."
139
-
140
-    ;; info messages
141
-    "search wrapped around file" "serĉado ĉirkaŭfluis en dosiero"
142
-    "No Hyperspec entry or src location found"
143
-    "Hyperspec enigo aŭ src loko netrovita"
144
-
145
-    ;; error messages
146
-    "no matches"  "sen rezultoj"
147
-    "non integer argument supplied to goto"
148
-    "argumento nenombra donita al aliri"
149
-    "file not found" "dosiero netrovita"
150
-    "please save before loading" "bonvolu, konservi antaŭ ŝarĝi"
151
-
152
-
153
-    "please save before compiling" "bonvolu, konservi antaŭ kompili"
154
-    "search reached end of file" "serĉado alvenis finon de doserion"
155
-
156
-    ;; misc
157
-    "untitled"	"sentitolo"
158
-    "untitled #"	"sentitolo #"
159
-    "find:"	"serĉi:"
160
-
161
-    "y"   	"j"
162
-    "yes"  	"jes"
163
-    "n"   	"n"
164
-    "no"   	"ne"
165
-
166
-    "open:"	"malfermi:"
167
-    "goto:"	"aliri:"
168
-    "system:"	"sistemo:"
169
-    "buffer number:" "bufrnombro:"
170
-    "load:"	"ŝarĝi:"
171
-    "save:"	"konservi:"
172
-    "unsaved file...close anyway?"
173
-    "nekonservita doserio...ĉu kvankam ĉesi?"
174
-    "unsaved files exist...quit anyway?"
175
-    "nekonservitaj dosieroj ekzistas...ĉu kvankam ĉesi?"))
1
+(in-package :able)
2
+
3
+;; translate is nice, but sends a bunch of annoying
4
+;; and unnecessary text to stdout.
5
+(with-open-stream (*standard-output* (make-broadcast-stream))
6
+  (translate:add-translations
7
+    'en
8
+    "File"	"File"
9
+    ;; ----------
10
+    "New file"	"New file"
11
+    "Open file"	"Open file"
12
+    "Open file browser" "Open file browser"
13
+    "Save file"	"Save file"
14
+    "Save as file" "Save as file"
15
+    "Save as file browser" "Save as file browser"
16
+    "Exit"	"Exit"
17
+
18
+    "Edit"	"Edit"
19
+    ;; ----------
20
+    "Cut"  	"Cut"
21
+    "Copy"  	"Copy"
22
+    "Paste" 	"Paste"
23
+
24
+    "Select all"	"Select all"
25
+    "Reindent"	"Reindent"
26
+    "Replace" "Replace"
27
+    "Find"  	"Find"
28
+    "Find again"	"Find again"
29
+    "Goto line"	"Goto line"
30
+
31
+    "Buffers"	"Buffers"
32
+    ;; ----------
33
+    "Next buffer" "Next buffer"
34
+    "Close buffer" "Close buffer"
35
+    "Select buffer" "Select buffer"
36
+
37
+    "Magic"	"Magic"
38
+    ;; ----------
39
+    "lisp" 	"lisp"
40
+    ;; ----------
41
+    "Macroexpand"	"Macroexpand"
42
+    "Copy to REPL" "Copy to REPL"
43
+    "Complete symbol" "Complete symbol"
44
+    "CLHS lookup"	"CLHS lookup"
45
+    "(Re)load buffer" "(Re)load buffer"
46
+    "Load file"	"Load file"
47
+    "Load ASDF"	"Load ASDF"
48
+    "Compile file" "Compile file"
49
+    "Invoke native debugger" "Invoke native debugger"
50
+    "Reset listener" "Reset listener"
51
+
52
+    "evaluating..." "evaluating..."
53
+    "highlighting..." "highlighting..."
54
+    "replacing..." "replacing..."
55
+
56
+    ;; info messages
57
+    "search wrapped around file" "search wrapped around file"
58
+    "No Hyperspec entry or src location found"
59
+    "No Hyperspec entry or src location found"
60
+
61
+    ;; error messages
62
+    "no matches"  "no matches"
63
+    "non integer argument supplied to goto"
64
+    "non integer argument supplied to goto"
65
+    "file not found" "file not found"
66
+    "please save before loading" "please save before loading"
67
+    "unsaved files exist...quit anyway?"
68
+    "unsaved files exist...quit anyway?"
69
+
70
+
71
+    "please save before compiling" "please save before compiling"
72
+    "search reached end of file" "search reached end of file"
73
+
74
+    ;; misc
75
+    "untitled"	"untitled"
76
+    "untitled #"	"untitled #"
77
+    "find:"	"find:"
78
+
79
+    "y"   	"y"
80
+    "yes"  	"yes"
81
+    "n"   	"n"
82
+    "no"   	"no"
83
+
84
+    "open:"	"open:"
85
+    "goto:"	"goto:"
86
+    "system:"	"system:"
87
+    "regex:" "regex:"
88
+    "replacement:" "replacement:"
89
+    "buffer number:" "buffer number:"
90
+    "load:"	"load:"
91
+    "save:"	"save:"
92
+    "unsaved file...close anyway?" "unsaved file...close anyway?"
93
+    "unsaved files exist...quit anyway?" "unsaved files exist...quit anyway?")
94
+
95
+  (translate:add-translations
96
+    'eo
97
+    "File"	"Dosiero"
98
+    ;; ----------
99
+    "New file"	"Nova"
100
+    "Open file"	"Malfermi"
101
+    "Open file browser" "Malfermi per foliumilo"
102
+    "Save file"	"Konservi"
103
+    "Save as file" "Konservi kiel"
104
+    "Save as file browser" "Konservi per foliumilo"
105
+    "Exit"	"Ĉesi"
106
+
107
+    "Edit"	"Redakti"
108
+    ;; ----------
109
+    "Cut"  	"Eltondi"
110
+    "Copy"  	"Kopii"
111
+    "Paste" 	"Alglui"
112
+
113
+    "Select all"	"Elekti ĉion"
114
+    "Reindent"	"Rekrommarĝeni"
115
+    "Replace" "Anstataŭigi"
116
+    "Find"  	"Serĉi"
117
+    "Find again"	"Reserĉi"
118
+    "Goto line"	"Aliri linion"
119
+
120
+    "Buffers"	"Bufroj"
121
+    ;; ----------
122
+    "Next buffer" "Sekva bufro"
123
+    "Close buffer"
124
+    "Fermi bufron"
125
+    "Select buffer" "Elekti bufron"
126
+
127
+    "Magic"	"Sorĉeroj"
128
+    ;; ----------
129
+    "lisp" 	"lisp"
130
+    ;; ----------
131
+    "Macroexpand"	"Makrogeneradi"
132
+    "Copy to REPL" "Kopii al REPL"
133
+    "Complete symbol" "Kompletigi simbolon"
134
+    "CLHS lookup" "Serĉi en CLHS"
135
+    "(Re)load buffer" "(Re)ŝarĝi bufron"
136
+    "Load file"	"Ŝarĝi dosieron"
137
+    "Load ASDF"	"Ŝarĝi ASDF'on"
138
+    "Compile file" "Kompili dosieron"
139
+    "Invoke native debugger" "Alvoki erarserĉilon"
140
+    "Reset listener" "Restartigi aŭskultanton"
141
+
142
+    "evaluating..." "taksanta..."
143
+    "highlighting..." "prilumanta..."
144
+    "replacing..." "anstataŭigata..."
145
+
146
+    ;; info messages
147
+    "search wrapped around file" "serĉado ĉirkaŭfluis en dosiero"
148
+    "No Hyperspec entry or src location found"
149
+    "Hyperspec enigo aŭ src loko netrovita"
150
+
151
+    ;; error messages
152
+    "no matches"  "sen rezultoj"
153
+    "non integer argument supplied to goto"
154
+    "argumento nenombra donita al aliri"
155
+    "file not found" "dosiero netrovita"
156
+    "please save before loading" "bonvolu, konservi antaŭ ŝarĝi"
157
+
158
+
159
+    "please save before compiling" "bonvolu, konservi antaŭ kompili"
160
+    "search reached end of file" "serĉado alvenis finon de doserion"
161
+
162
+    ;; misc
163
+    "untitled"	"sentitolo"
164
+    "untitled #"	"sentitolo #"
165
+    "find:"	"serĉi:"
166
+
167
+    "y"   	"j"
168
+    "yes"  	"jes"
169
+    "n"   	"n"
170
+    "no"   	"ne"
171
+
172
+    "open:"	"malfermi:"
173
+    "goto:"	"aliri:"
174
+    "system:"	"sistemo:"
175
+    "buffer number:" "bufrnombro:"
176
+    "load:"	"ŝarĝi:"
177
+    "save:"	"konservi:"
178
+    "regex:" "regulesprimo:"
179
+    "replacement:" "anstataŭo:"
180
+    "unsaved file...close anyway?"
181
+    "nekonservita doserio...ĉu kvankam ĉesi?"
182
+    "unsaved files exist...quit anyway?"
183
+    "nekonservitaj dosieroj ekzistas...ĉu kvankam ĉesi?"))
184
+
185
+
... ...
@@ -158,7 +158,7 @@
158 158
       (multiple-value-bind (token start end) (find-current-function str pos)
159 159
         (declare (ignore end))
160 160
         (when token
161
-          (setf indent (get-indent-level token))
161
+             (setf indent (get-indent-level token))
162 162
           (setf start (+ start indent))
163 163
           (ltk::insert-text txt (make-string start :initial-element #\Space)))))))
164 164
 
... ...
@@ -284,6 +284,20 @@
284 284
           ((equal event 'load)
285 285
            (with-status-msg #t"highlighting..." (apply-highlight txt "1.0" "end"))))))
286 286
 
287
+(defun regex-replace-selected-text (regex replacement)
288
+  "Replace selected text matching the given regex."
289
+  (let* ((selected-text (get-selected-text))
290
+         (replaced (regex-replace regex selected-text replacement)))
291
+    (if replaced
292
+        (replace-selected-text replaced))))
293
+
294
+(defun replace-selected-text (new-string)
295
+  "Replace selected text with the given string.
296
+  Right now it adds 2 actions in the undo-tree, which isn't ideal..."
297
+  (let* ((text (get-current-text-ctrl *buffer-manager*)))
298
+    (ltk::delete-text text "sel.first" "sel.last")
299
+    (ltk::insert-text text new-string)))
300
+
287 301
 (defmethod goto ((text ltk:text) line)
288 302
   (let ((cursor-pos (format nil "~a.0" line)))
289 303
     (ltk::scroll-to text cursor-pos)
... ...
@@ -505,10 +519,9 @@
505 519
      (list *key-paste* 'on-paste)
506 520
      (list *key-line-start* 'on-cursor-line-start)
507 521
      (list *key-line-end* 'on-cursor-line-end)
508
-     (list *key-forward* 'on-cursor-forward)
509
-     (list *key-backward* 'on-cursor-backward)
510 522
      (list *key-select-all* 'on-select-all t)
511 523
      (list *key-reformat* 'on-re-indent t)
524
+     (list *key-replace* 'on-regex-replace)
512 525
      (list *key-macro-expand* 'on-macro-expand t)
513 526
      (list *key-copy-to-repl* 'on-copy-sexp-to-repl t)
514 527
      ;; suppress code-complete; it needs special treatment
... ...
@@ -1100,6 +1113,7 @@
1100 1113
         (separator)
1101 1114
         (text-action #t"Select all" on-select-all)
1102 1115
         (text-action #t"Reindent" on-re-indent)
1116
+        (text-action #t"Replace" on-regex-replace)
1103 1117
         (separator)
1104 1118
         (action #t"Find" on-search)
1105 1119
         (action #t"Find again" on-search-again)
... ...
@@ -1404,18 +1418,30 @@
1404 1418
   (indent-block txt)
1405 1419
   (match-paren txt))
1406 1420
 
1421
+(defun on-regex-replace (&optional ignored)
1422
+  "Regex-replace on current buffer. Can accept an 'ignored' argument,
1423
+  since accepting text (from 'text-action' or what have) can sometimes
1424
+  mean the listener is passed, which would be invalid."
1425
+  (let* ((text (get-current-text-ctrl *buffer-manager*))
1426
+         (cur-cursor-pos (ltk::get-cursor-pos text))
1427
+         (regex (input-prompt *listener* #t"regex:"))
1428
+         (replacement (input-prompt *listener* #t"replacement:")))
1429
+    (with-status-msg #t"replacing..."
1430
+      (when (not (get-selected-text))
1431
+        (ltk::select-all text))
1432
+      
1433
+      (regex-replace-selected-text regex replacement)
1434
+      
1435
+      (highlight text 'load)
1436
+      (prompt *listener* :clear t)
1437
+      (ltk::set-cursor-pos text cur-cursor-pos))))
1438
+
1407 1439
 (defmethod on-cursor-line-start ((txt ltk:text))
1408 1440
     (ltk::set-to-start-current-line txt))
1409 1441
 
1410 1442
 (defmethod on-cursor-line-end ((txt ltk:text))
1411 1443
     (ltk::set-to-end-current-line txt))
1412 1444
 
1413
-(defmethod on-cursor-forward ((txt ltk:text))
1414
-    (ltk::move-cursor-pos txt 1))
1415
-
1416
-(defmethod on-cursor-backward ((txt ltk:text))
1417
-    (ltk::move-cursor-pos txt -1))
1418
-
1419 1445
 (defun focus-editor ()
1420 1446
   (ltk:focus (get-current-text-ctrl *buffer-manager*)))
1421 1447
 
... ...
@@ -1480,3 +1506,11 @@
1480 1506
   (parse-watch-systems)
1481 1507
   (create-widgets))
1482 1508
 
1509
+
1510
+
1511
+
1512
+
1513
+
1514
+
1515
+
1516
+
... ...
@@ -203,6 +203,23 @@
203 203
               (setf best (subseq this 0 len)))))
204 204
     best))
205 205
 
206
+(defun string-merge (string-list &optional (seperator ""))
207
+  "Merge a list of strings/items into a single string."
208
+  (reduce (lambda (string-a string-b)
209
+            (format nil "~A~A~A" string-a seperator string-b))
210
+      string-list))
211
+
212
+(defun regex-replace (regex string replacement)
213
+  "Replace all regex matches in a string with another string.
214
+  This only exists since using #'regex-replace-all directly doesn't always
215
+  handle regexes right on multi-lined strings (I.E., '^')."
216
+  (string-merge 
217
+    (mapcar (lambda (line) (cl-ppcre:regex-replace-all regex line replacement))
218
+      (split string #\newline))
219
+    #\newline))
220
+  
221
+  
222
+
206 223
 ;;;;;;;;;;;;;; environment ;;;;;;;;;;;;;;
207 224
 
208 225
 (defun shutdown ()
... ...
@@ -260,3 +277,5 @@
260 277
             (ccl:external-process-input-stream p))))
261 278
       (sleep 1))
262 279
     process))
280
+
281
+