;;; -*- 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 [:[:]] or :[][:] where at least one of or is given, and find a file that best represents the string by processing the following in order: 0. if is not given, assume current file 1. as a file in dir 2. as an absolute path to a file 3. If at least is given, take 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)