Coverage report: /home/ellis/comp/core/lib/cli/ed.lisp

KindCoveredAll%
expression0189 0.0
branch06 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; lib/cli/ed.lisp --- Editor functions
2
 
3
 ;;
4
 
5
 ;;; Code:
6
 (in-package :cli/ed)
7
 
8
 (defvar *user-emacs-directory* (merge-pathnames ".emacs.d/" (user-homedir-pathname)))
9
 
10
 (defmacro with-emacs-printer (&body body)
11
   "Eval BODY with Emacs Lisp printer settings."
12
   `(let ((*print-case* :downcase)
13
          (*print-readably* nil))
14
      ,@body))
15
 
16
 (defun run-emacs (args &key file create-frame eval client wait batch function)
17
   (if (or client (not batch))
18
       (run-emacsclient args :file file :create-frame create-frame :eval eval :wait wait)
19
       (let ((keys))
20
         (when file (push (format nil "~S" file) keys))
21
         (when create-frame (push "-c" keys))
22
         (when function (appendf keys (list "-f" (string-downcase function))))
23
         (when batch (push "--batch" keys))
24
         (when eval 
25
           (with-emacs-printer
26
             (appendf keys (list "-e" (format nil "~S" eval)))))
27
         (sb-ext:run-program (find-exe "emacs") (append keys args)))))
28
 
29
 (defun run-emacsclient (args &key file (create-frame t) function eval wait)
30
   (let ((keys))
31
     (when file (push (format nil "~S" file) keys))
32
     (when create-frame (push "-c" keys))
33
     (when function (appendf keys (list "-f" (string-downcase function))))
34
     (push "-a=" keys)
35
     (when eval
36
       (with-emacs-printer
37
         (appendf keys (list "-e" (format nil "~S" eval)))))
38
     (sb-ext:run-program (find-exe "emacsclient")
39
                         (append keys args)
40
                         :wait wait
41
                         :output nil)))
42
 
43
 (defun eval-emacs (form &key (client t) args file wait create-frame batch function)
44
   (run-emacs args :eval form 
45
                   :file file 
46
                   :client client 
47
                   :wait wait 
48
                   :create-frame create-frame 
49
                   :batch batch
50
                   :function function))
51
 
52
 (defun ielm (&optional buf-name)
53
   (eval-emacs `(ielm ,@(when buf-name `(,buf-name)))))
54
 
55
 (defun slime (&optional command coding-system)
56
   (eval-emacs `(slime ,command ,coding-system)))
57
 
58
 (defun ediff (a b)
59
   (eval-emacs `(ediff ,(namestring a) ,(namestring b))))
60
 
61
 (defun ediff3 (a b c)
62
   (eval-emacs `(ediff ,(namestring a) ,(namestring b) ,(namestring c))))
63
 
64
 (defun vc-ediff (&optional rev-a rev-b)
65
   "Show differences between REV1 and REV2 of FILES using ediff.
66
 This compares two revisions of the files in FILES.  Currently,
67
 only a single file's revisions can be compared, i.e. FILES can
68
 specify only one file name.
69
 If REV1 is nil, it defaults to the current revision, i.e. revision
70
 of the last commit.
71
 If REV2 is nil, it defaults to the work tree, i.e. the current
72
 state of each file in FILES."
73
   (eval-emacs
74
    (if (or rev-a rev-b)
75
        `(vc-version-ediff nil ,rev-a ,rev-b)
76
        `(vc-ediff t))
77
    :wait t
78
    :create-frame t))
79
 
80
 (push #'run-emacsclient sb-ext:*ed-functions*)
81
 (push #'run-emacs sb-ext:*ed-functions*)
82
 
83
 ;;; Config
84
 (defconfig editor-config (ast) ())
85
 
86
 (defmethod make-config ((fmt (eql :editor)) &rest initargs &key type &allow-other-keys)
87
   (if type
88
       (progn
89
         (remf initargs :type)
90
         (apply 'make-config type initargs))
91
       (make-instance 'editor-config)))
92
 
93
 (defconfig emacs-config (editor-config) 
94
   ((path :initform *user-emacs-directory* :initarg :path :accessor path)))
95
 
96
 (defun load-emacs-config (&optional (path *user-emacs-directory*))
97
   (make-config :emacs :path path))
98
 
99
 (defmethod make-config ((fmt (eql :emacs)) &key ast path)
100
   (make-instance 'emacs-config :ast ast :path path))
101
 
102
 ;;; Org Protocol
103
 ;; ref: https://orgmode.org/worg/org-contrib/org-protocol.html
104
 
105
 ;; On GNU/Linux, Emacs is now the default application for
106
 ;; 'org-protocol'. (startup change in Emacs 30.1)
107
 (defun org-store-link (url title)
108
   (run-emacsclient (format nil "org-protocol://store-link?url=~a&title=~a"
109
                            url title)))
110
 
111
 (defun emacs-find-file (path &key (position 0) (wait t) create-frame (client t))
112
   (eval-emacs `(progn (find-file ,path) (goto-char ,position)) :wait wait :create-frame create-frame :client client))
113
 
114
 ;;; Macros
115
 (defmacro with-emacs ((var &key (eval t) (client t) create-frame file (wait t) batch function args) &body body)
116
   (if (eql t eval)
117
       `(progn (eval-emacs '(progn ,@body) :client ,client :args ,args :wait ,wait :batch ,batch :function ,function))
118
       `(let ((,var (run-emacs ,args :eval ,eval 
119
                                     :file ,file 
120
                                     :create-frame ,create-frame 
121
                                     :wait ,wait 
122
                                     :batch ,batch
123
                                     :function ,function)))
124
          ,@body)))