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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
|
;;; -*- lexical-binding: t -*-
(require 'cl-lib)
(defmacro default (expr default)
"If `expr' evaluates to non-null then return the result, otherwise give `default'."
(let ((e (gensym)))
`(let ((,e ,expr))
(if ,e ,e ,default))))
;; =============================================================================
;; File stuff
(defun acme--file-p (str)
(and (file-exists-p str)
(file-readable-p str)
(not (car (file-attributes str)))))
(defun acme--recursive-locate-file (regexp start-dir depth)
(let ((dirs (list start-dir)) found)
(cl-loop
while (and (not found) (/= depth 0)) do
(let (ndirs)
(cl-loop for dir in dirs unless found do
(let ((candidates (directory-files-and-attributes
dir t
directory-files-no-dot-files-regexp)))
(cl-loop for file in candidates unless found do
(let ((name (nth 0 file))
(is-dir (nth 1 file)))
(if is-dir (add-to-list 'ndirs name nil nil)
(when (string-match-p regexp name)
(setq found name) nil))))))
(setq depth (1- depth))
(setq dirs ndirs)))
found))
(defun acme--as-pos-natural (arg)
(when arg
(if (stringp arg)
(unless (string-match-p "[^0-9]" arg)
(let ((n (string-to-number arg)))
(when (and (> n 0) (integerp n)) n)))
(when (and (integerp arg) (> arg 0)) arg))))
(defun acme--parse-as-file (str dir)
"Attempt to interpret a string as <head>[:<line>[:<column>]] or
:[<line>][:<column>] where at least one of <line> or <column> is
given, and find a file that best represents the string by processing the
following in order:
0. if <head> is not given, assume current file
1. <head> as a file in dir
2. <head> as an absolute path to a file
3. If at least <line> is given, take <head> as a regexp against
which to match a file in dir, of which the first match
(alphabetically) is taken"
(let* ((spl (split-string str ":+?" nil))
(line-s (nth 1 spl)) (col-s (nth 2 spl))
(line (if line-s (acme--as-pos-natural line-s) 1))
(col (if col-s (acme--as-pos-natural col-s) 1))
(fn (nth 0 spl)))
(when (and line col (> 4 (length spl))
(not (string-match-p ".*/$" fn)))
(cl-flet ((found (f) (when f (list :LINE line :COL col :FILE f))))
(let ((rfn (concat dir fn)))
(cond
((or (and line-s line) (and col-s col)) (list :LINE line :COL col :FILE nil))
((acme--file-p rfn) (found rfn))
((acme--file-p fn) (found fn))
((or col-s line-s) (found (acme--recursive-locate-file
fn dir
acme-find-file-recursive-depth)))
))))))
(defun acme--process-file (file)
(let ((fname (plist-get file :FILE))
(line (plist-get file :LINE))
(col (plist-get file :COL)))
(when fname (find-file fname))
(when line (goto-line line))
(when col (forward-char col))))
;; =============================================================================
;; General magic
(defmacro return-first (first &rest body)
"Execute `first' first, then `body', return whatever `first' did."
(let ((val (gensym)))
`(let ((,val ,first))
,@body
,val)))
(defun acme--extract-string (&optional count)
"Extract a string from the buffer as follows:
1. If there is a region, use it
2. If point is at the start of the line, then use the whole line.
3. Take the previous (count)?count:1 words
After this, place the point at the end of the appropriate block"
(let ((n (default count 1))
(p (point))
(b (line-beginning-position))
(e (line-end-position)))
(assert (/= n 0) t)
(cond
((use-region-p)
(return-first
(buffer-substring-no-properties (region-beginning) (region-end))
(goto-char (region-end))))
((= p b) (return-first
(buffer-substring-no-properties b e)
(end-of-line)))
(t (let* ((re (default (search-forward " " e t) e))
(rs (default (search-backward " " b t n) b)))
(return-first
(buffer-substring-no-properties rs re)
(goto-char re)))))))
;; =============================================================================
;; Tag window and buffers
(defun* acme--load-tags (&key (buffer nil) (init nil))
"Retrieve or create the tags associated to `buffer' (or
current-buffer), saving the old tags if we are _changing_
buffers."
(assert (window-live-p acme--tag-window))
(assert (buffer-live-p acme--tag-buffer))
(let* ((cur-buff (current-buffer))
(new-buff (default buffer cur-buff))
(existing-tags (assoc new-buff acme--tag-buffers-alist))
)
(set-buffer acme--tag-buffer)
(if (and existing-tags (not init))
(setf (cdr (assoc cur-buff acme--tag-buffers-alist))
(buffer-string)))
(erase-buffer)
(if existing-tags (insert (cdr existing-tags))
(let ((new-tags (concat default-directory " "
(buffer-name new-buff)
acme-tag-default-string)))
(insert new-tags)
(add-to-list 'acme--tag-buffers-alist
`(,new-buff . ,new-tags))))))
(defun acme--init-tag-window ()
"Initialise the tag window and tag buffer."
(when acme--tag-buffer
(unless (buffer-live-p acme--tag-buffer)
(setq acme--tag-buffer nil)))
(when acme--tag-window
(unless (window-live-p acme--tag-window)
(setq acme--tag-window nil)))
(when acme-delete-other-windows (delete-other-windows))
(let* ((tag-win (selected-window))
(content-win (split-window-vertically 2)))
(setq acme--tag-window tag-win
;;window-size-fixed t
acme--tag-buffer (find-file acme-tag-buffer-name))
(set-window-dedicated-p acme--tag-window t)
(select-window content-win)))
(defun acme--get-nth-from-tag (n)
"Get the n'th field from the tag, only really useful n<3."
(save-current-buffer
(set-buffer (cdr (acme--get-tag-buffer)))
(nth n (split-string-and-unquote (buffer-string)))))
(defun acme--get-directory-from-tag ()
(acme--get-nth-from-tag 0))
(defun acme--get-buffer-name-from-tag ()
(acme--get-nth-from-tag 1))
;; =============================================================================
;; Marking input and output locations
(defun acme-mark-input (&optional arg)
"When the region is active, mark it as the ACME input field,
otherwise take the current buffer as input. Any argument causes
the input to be marked as blank."
(interactive "P")
(setq acme--input-pointer
(if arg 'EMPTY
(if (region-active-p)
(list :BUFFER (current-buffer)
:START (region-beginning)
:END (region-end))
(list :BUFFER (current-buffer)
:START 0
:END (buffer-size))))))
(defun acme-mark-output (&optional arg)
"When the region is active, mark it as the ACME output
field (thereby consigning it to be replaced by any output),
otherwise take the current buffer as output. Any argument causes
the output to be sent to `acme-error-buffer-name' for the
current directory."
(interactive "P")
(setq acme--output-pointer
(if arg 'EMPTY
(if (region-active-p)
(list :BUFFER (current-buffer)
:START (region-beginning)
:END (region-end))
(list :BUFFER (current-buffer)
:START (point)
:END nil)))))
(defun acme-mark-io ()
"Mark the current buffer/region as a location for ACME
I/O (useful for piping through commands, for example)."
(interactive)
(acme-input-mark)
(acme-output-mark))
;; TODO: Overlays so you can see what is what?
(defun acme--execute-command (command)
(let* ((list (split-string command))
(cmd (car list))
(args (combine-and-quote-strings (cdr list)))
(out-file (make-temp-file "acme--execute-command-output")))
(save-excursion
(if (eq acme--input-pointer 'EMPTY)
(call-process cmd nil `(:file ,out-file) nil args)
(let ((in-file (make-temp-file "acme--execute-command-input")))
(set-buffer (plist-get acme--input-pointer :BUFFER))
(write-region (plist-get acme--input-pointer :START)
(plist-get acme--input-pointer :END)
in-file)
(call-process cmd in-file `(:file ,out-file) nil args)
(delete-file in-file)))
(if (eq acme--output-pointer 'EMPTY)
(progn
(find-file (concat default-directory acme-error-buffer-name))
(end-of-buffer))
(let ((out-buffer (plist-get acme--output-pointer :BUFFER))
(s (plist-get acme--output-pointer :START))
(e (plist-get acme--output-pointer :END)))
(set-buffer out-buffer)
(beginning-of-buffer)
(when e (delete-region s e))
(goto-char s)))
(insert-file out-file)
(delete-file out-file))))
$date +%H/%M
$ls .
;; Output should start here:
;; 2
;; 1
;; 4
;; 3
;; 5
;; 9
;; $sort
$sort
;; =============================================================================
;; General interface
(defun acme-do ()
"A generic wrapper around opening files, directories, man-pages,
URLS and other things"
(interactive)
;; For now,
(acme--process-file
(acme--parse-as-file
(acme--extract-string)
(acme--get-directory-from-tag)))
)
(defun acme-execute ()
"A DWIM executor. The command to execute is retrieved with
`acme--extract-string'.
If the command begins with a $, then it is interpreted as a shell
command in the following ways:
1. If there is neither input nor output marked then it is
executed and the output and errors sent to the buffer
`acme-error-buffer-name' for the current directory.
2. Using whatever input is marked (whole buffer or region)
a. If output is marked as a region, is it overwritten with the
result of the command on the input
b. If output is marked as a buffer, then the result of command
on the input is inserted in that buffer at the marked
position.
NOTE: When input and output buffers are set to be the same, the
input region is first sent to the command, and then the output
region is overwritten.
If the command does not start with a $, then it shipped off to
eshell where more magic happens.
"
(interactive)
(let ((str (acme--extract-string)))
(if (string-prefix-p "$" str)
(acme--execute-command (subseq str 1))
(eshell-command str))))
(defun acme-init ()
;; TODO: Potentially advise window-deletable-p
(acme--init-tag-window)
(acme--load-tags :init t)
;;(add-hook 'buffer-list-update-hook 'acme--load-tags)
;;(add-hook 'find-file-hook 'acme--load-tags)
)
;; =============================================================================
;; Variables and customisable stuff
(defcustom acme-delete-other-windows t
"Delete all other windows when starting ACME mode so that the
tag window is above all others.")
(defcustom acme-find-file-recursive-depth 3
"Maximum folder depth to recursively seek files for `acme-do'")
(defcustom acme-tag-default-string "Snarf Look Put"
"Default tags for new buffers")
(defcustom acme-tag-buffer-name "+tags"
"Name for tags buffer")
(defcustom acme-error-buffer-name "+errors"
"Name for error buffer used for general output")
;; (defvar acme--tag-windows-alist nil)
(defvar acme--tag-buffers-alist nil)
(defvar acme--tag-window nil)
(defvar acme--tag-buffer nil)
(defvar acme--input-pointer nil)
(defvar acme--output-pointer nil)
;; =============================================================================
;; Keymap
(defvar acme-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c d") 'acme-do)
(define-key map (kbd "C-c e") 'acme-execute)
(define-key map (kbd "C-c m i") 'acme-mark-input)
(define-key map (kbd "C-c m o") 'acme-mark-output)
(define-key map (kbd "C-c m b") 'acme-mark-io)
map))
;; =============================================================================
;; Mode definition
(define-minor-mode acme-mode
"ACME-esque magic, but key driven"
:lighter " ACME" :keymap acme-mode-map
:global t
(acme-init))
(provide 'acme-mode)
|
