Init

author: tslil clingman <> 2019-09-11 19:18:14 -0400
committer: tslil clingman <> 2019-09-11 19:18:14 -0400
commit: ac1a4884d03fc0495c773500d8a13f84b695fa43 (patch)
tree: 29e5ec49e0ce957d80d8f11a155b47840c74f488 /emacs/scripts/acquiesce.el
1 files changed, 351 insertions, 0 deletions
diff --git a/emacs/scripts/acquiesce.el b/emacs/scripts/acquiesce.el
new file mode 100644
index 0000000..0dcf9fc
--- /dev/null
+++ b/emacs/scripts/acquiesce.el
@@ -0,0 +1,351 @@
+(require 'cl)
+
+(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)
author	tslil clingman <>	2019-09-11 19:18:14 -0400
committer	tslil clingman <>	2019-09-11 19:18:14 -0400
commit	ac1a4884d03fc0495c773500d8a13f84b695fa43 (patch)
tree	29e5ec49e0ce957d80d8f11a155b47840c74f488 /emacs/scripts/acquiesce.el