ambevar-dotfiles/.local/share/common-lisp/source/ambrevar/emacs.lisp

101 lines
3.5 KiB
Common Lisp

(uiop:define-package ambrevar/emacs
(:documentation "Communication with Emacs")
(:use #:common-lisp)
(:use #:trivia)
(:import-from #:serapeum #:export-always)
(:import-from #:ambrevar/shell))
(in-package ambrevar/emacs)
(eval-when (:compile-toplevel :load-toplevel :execute)
(trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
(trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))
;; TODO: Add helper to print list of objects / structs / plist / alist to an Emacs tabulated-mode buffer.
(export-always 'with-emacs-eval)
(defmacro with-emacs-eval (&body body)
"Evaluate BODY (s-expressions) with `emacsclient'.
Example:
(with-emacs-eval
(switch-to-buffer (get-buffer-create \"foobar\"))
(insert \"Hello\"))"
`(let ((*package* (find-package :ambrevar/emacs)))
(cmd:cmd "emacsclient" "-e"
(let ((*print-case* :downcase))
(format nil "'~s'" '(progn ,@body))))))
(defun %emacs-eval (caller &rest s-exp)
"See `emacs-eval'."
(let ((*package* (find-package :ambrevar/emacs)))
(funcall caller "emacsclient" "-e"
(let ((*print-case* :downcase))
(format nil "'~s'" `(progn
,@s-exp))))))
(export-always 'emacs-eval)
(defun emacs-eval (&rest s-exp)
"Evaluate (quoted) s-expressions with `emacsclient'.
Example:
(let ((buffer \"foobar\")
(content \" world!\"))
(emacs-eval
`(switch-to-buffer (get-buffer-create ,buffer))
`(insert ,conent)))"
(apply #'%emacs-eval #'cmd:cmd s-exp))
(export-always 'emacs-$eval)
(defun emacs-$eval (&rest s-exp)
"Like `emacs-eval' but return a string."
(apply #'%emacs-eval #'cmd:$cmd s-exp))
(export-always 'emacs-eval>)
(defun emacs-eval> (&rest s-exp)
"Like `emacs-eval' but return a stream."
(apply #'%emacs-eval #'ambrevar/shell:cmd> s-exp))
(export-always 'write-emacs-buffer)
(defun write-emacs-buffer (buffer-or-name thing)
"Write THING to Emacs' BUFFER-OR-NAME using `write-to-string'.
This means string double quotes are included.
See `princ-emacs-buffer'."
(emacs-eval
`(with-current-buffer (get-buffer-create ,buffer-or-name)
(insert ,(write-to-string thing)))))
(export-always 'princ-emacs-buffer)
(defun princ-emacs-buffer (buffer-or-name thing)
"Like `write-emacs-buffer' but using `princ-to-string'."
(emacs-eval
`(with-current-buffer (get-buffer-create ,buffer-or-name)
(insert ,(princ-to-string thing)))))
(defun emacs-unescape (string)
"Since Emacsclient returns escaped strings, return the string in a form
understood by Common Lisp."
(if (<= 2 (length string))
(str:replace-all "\\n" (string #\newline)
(subseq string 1 (1- (length string))))
string))
(export-always 'emacs-buffer-string)
(defun emacs-buffer-string (buffer-or-name)
"Return Emacs' BUFFER-OR-NAME content as a string."
(emacs-unescape
(emacs-$eval
`(with-current-buffer (get-buffer-create ,buffer-or-name)
(buffer-substring-no-properties (point-min) (point-max) )))))
;; (export-always 'emacs-buffer-stream)
(defun emacs-buffer-stream (buffer-or-name)
"Return Emacs' BUFFER-OR-NAME content as a stream."
(make-string-input-stream (emacs-buffer-string buffer-or-name)))
(export-always 'with-emacs-buffer-stream)
(defmacro with-emacs-buffer-stream ((in buffer-or-name) &body body)
"Evaluate BODY with IN bound to an input stream of the Emacs' BUFFER-OR-NAME."
`(with-input-from-string (,in (emacs-buffer-string ,buffer-or-name))
,@body))
;; TODO: Make Emacs buffer output stream.