Permalink
Newer
Older
100644 373 lines (326 sloc) 11.8 KB
Jun 24, 2018
1
;;; eaf.el --- Emacs application framework
2
3
;; Filename: eaf.el
4
;; Description: Emacs application framework
5
;; Author: Andy Stewart <lazycat.manatee@gmail.com>
6
;; Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
7
;; Copyright (C) 2018, Andy Stewart, all rights reserved.
8
;; Created: 2018-06-15 14:10:12
9
;; Version: 0.1
10
;; Last-Updated: 2018-06-15 14:10:12
11
;; By: Andy Stewart
12
;; URL: http://www.emacswiki.org/emacs/download/eaf.el
13
;; Keywords:
14
;; Compatibility: GNU Emacs 27.0.50
15
;;
16
;; Features that might be required by this library:
17
;;
18
;;
19
;;
20
21
;;; This file is NOT part of GNU Emacs
22
23
;;; License
24
;;
25
;; This program is free software; you can redistribute it and/or modify
26
;; it under the terms of the GNU General Public License as published by
27
;; the Free Software Foundation; either version 3, or (at your option)
28
;; any later version.
29
30
;; This program is distributed in the hope that it will be useful,
31
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
32
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
33
;; GNU General Public License for more details.
34
35
;; You should have received a copy of the GNU General Public License
36
;; along with this program; see the file COPYING. If not, write to
37
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
38
;; Floor, Boston, MA 02110-1301, USA.
39
40
;;; Commentary:
41
;;
42
;; Emacs application framework
43
;;
44
45
;;; Installation:
46
;;
47
;; Put eaf.el to your load-path.
48
;; The load-path is usually ~/elisp/.
49
;; It's set in your ~/.emacs like this:
50
;; (add-to-list 'load-path (expand-file-name "~/elisp"))
51
;;
52
;; And the following to your ~/.emacs startup file.
53
;;
54
;; (require 'eaf)
55
;;
56
;; No need more.
57
58
;;; Customize:
59
;;
60
;;
61
;;
62
;; All of the above can customize by:
63
;; M-x customize-group RET eaf RET
64
;;
65
66
;;; Change log:
67
;;
68
;; 2018/06/15
69
;; * First released.
70
;;
71
72
;;; Acknowledgements:
73
;;
74
;;
75
;;
76
77
;;; TODO
78
;;
79
;;
80
;;
81
82
;;; Require
83
(require 'dbus)
84
85
;;; Code:
86
(defcustom eaf-mode-hook '()
87
"Eaf mode hook."
88
:type 'hook
89
:group 'eaf-mode)
90
91
(defvar eaf-mode-map
92
(let ((map (make-sparse-keymap)))
93
map)
94
"Keymap used by `eaf-mode'.")
95
96
(define-derived-mode eaf-mode text-mode "Eaf"
97
(interactive)
98
(kill-all-local-variables)
99
(setq major-mode 'eaf-mode)
100
(setq mode-name "EAF")
101
(set (make-local-variable 'buffer-id) (eaf-generate-id))
102
(use-local-map eaf-mode-map)
103
(run-hooks 'eaf-mode-hook))
104
105
(defvar eaf-python-file (expand-file-name "eaf.py" (concat (file-name-directory load-file-name) "core")))
106
107
(defvar eaf-process nil)
108
109
(defvar eaf-first-start-url nil)
110
111
(defvar eaf-title-length 30)
112
Jun 24, 2018
113
(defcustom eaf-name "*eaf*"
114
"Name of eaf buffer."
115
:type 'string
116
:group 'eaf)
117
118
(defun eaf-call (method &rest args)
119
(apply 'dbus-call-method
120
:session ; use the session (not system) bus
121
"com.lazycat.eaf" ; service name
122
"/com/lazycat/eaf" ; path name
123
"com.lazycat.eaf" ; interface name
124
method args))
125
126
(defun eaf-get-emacs-xid ()
127
(frame-parameter nil 'window-id))
128
129
(defun eaf-start-process ()
130
(interactive)
131
(if (process-live-p eaf-process)
132
(message "EAF process has started.")
133
(setq eaf-process
134
(apply 'start-process
135
eaf-name
136
eaf-name
137
"python" (append (list eaf-python-file (eaf-get-emacs-xid)) (eaf-get-render-size))
138
))
139
(set-process-query-on-exit-flag eaf-process nil)
140
(set-process-sentinel
141
eaf-process
142
#'(lambda (process event)
143
(message (format "%s %s" process event))
144
))
145
(message "EAF process starting...")))
146
147
(defun eaf-stop-process ()
148
(interactive)
149
(if (process-live-p eaf-process)
150
(delete-process eaf-process)
151
(message "EAF process has dead.")))
152
153
(defun eaf-restart-process ()
154
(interactive)
155
(eaf-stop-process)
156
(eaf-start-process))
157
158
(defun eaf-get-render-size ()
159
"Get allocation for render application in backend.
160
We need calcuate render allocation to make sure no black border around render content."
161
(let* (;; We use `window-inside-pixel-edges' and `window-absolute-pixel-edges' calcuate height of window header, such as tabbar.
162
(window-header-height (- (nth 1 (window-inside-pixel-edges)) (nth 1 (window-absolute-pixel-edges))))
163
(width (frame-pixel-width))
164
;; Render height should minus mode-line height, minibuffer height, header height.
165
(height (- (frame-pixel-height) (window-mode-line-height) (window-pixel-height (minibuffer-window)) window-header-height)))
166
(mapcar (lambda (x) (format "%s" x)) (list width height))))
167
168
(defun eaf-get-window-allocation (&optional window)
169
(let* ((window-edges (window-inside-pixel-edges window))
170
(x (nth 0 window-edges))
171
(y (nth 1 window-edges))
172
(w (- (nth 2 window-edges) x))
173
(h (- (nth 3 window-edges) y))
174
)
175
(list x y w h)))
176
177
(defun eaf-generate-id ()
178
(format "%04x%04x-%04x-%04x-%04x-%06x%06x"
179
(random (expt 16 4))
180
(random (expt 16 4))
181
(random (expt 16 4))
182
(random (expt 16 4))
183
(random (expt 16 4))
184
(random (expt 16 6))
185
(random (expt 16 6)) ))
186
187
(defun eaf-create-buffer (input-content)
188
(let ((eaf-buffer (generate-new-buffer (truncate-string-to-width input-content eaf-title-length))))
Jun 24, 2018
189
(with-current-buffer eaf-buffer
190
(eaf-mode)
191
(read-only-mode)
192
)
193
eaf-buffer))
194
195
(defun eaf-is-support (url)
196
(dbus-call-method
197
:session "com.lazycat.eaf"
198
"/com/lazycat/eaf"
199
"com.lazycat.eaf"
200
"is_support"
201
url))
202
203
(defun eaf-monitor-configuration-change (&rest _)
204
(ignore-errors
205
(let (view-infos)
206
(dolist (window (window-list))
207
(let ((buffer (window-buffer window)))
208
(with-current-buffer buffer
209
(if (string= "eaf-mode" (format "%s" major-mode))
210
(let* ((window-allocation (eaf-get-window-allocation window))
211
(x (nth 0 window-allocation))
212
(y (nth 1 window-allocation))
213
(w (nth 2 window-allocation))
214
(h (nth 3 window-allocation))
215
)
216
(add-to-list 'view-infos (format "%s:%s:%s:%s:%s" buffer-id x y w h))
217
)))))
218
;; I don't know how to make emacs send dbus-message with two-dimensional list.
219
;; So i package two-dimensional list in string, then unpack on server side. ;)
220
(eaf-call "update_views" (mapconcat 'identity view-infos ","))
221
)))
222
223
(defun eaf-monitor-buffer-kill ()
224
(ignore-errors
225
(with-current-buffer (buffer-name)
226
(when (string= "eaf-mode" (format "%s" major-mode))
227
(eaf-call "kill_buffer" buffer-id)
228
(message (format "Kill %s" buffer-id))
229
))))
230
231
(defun eaf-monitor-key-event ()
232
(ignore-errors
233
(with-current-buffer (buffer-name)
234
(when (string= "eaf-mode" (format "%s" major-mode))
235
(let* ((event last-command-event)
236
(key (make-vector 1 event))
237
(key-command (format "%s" (key-binding key)))
238
(key-desc (key-description key))
239
)
240
(cond
241
;; Just send event when user insert single character.
242
;; Don't send event 'M' if user press Ctrl + M.
243
((and
244
(or
245
(equal key-command "self-insert-command")
246
(equal key-command "completion-select-if-within-overlay")
247
)
Jun 24, 2018
248
(equal 1 (string-width (this-command-keys))))
249
(message (format "Send char: '%s" key-desc))
250
(eaf-call "send_key" (format "%s:%s" buffer-id key-desc)))
251
((or
252
(equal key-command "nil")
253
(equal key-desc "RET")
254
(equal key-desc "DEL")
255
(equal key-desc "TAB")
256
(equal key-desc "<home>")
257
(equal key-desc "<end>")
258
(equal key-desc "<left>")
259
(equal key-desc "<right>")
260
(equal key-desc "<up>")
261
(equal key-desc "<down>")
262
(equal key-desc "<prior>")
263
(equal key-desc "<next>")
264
)
265
(message (format "Send: '%s" key-desc))
266
(eaf-call "send_key" (format "%s:%s" buffer-id key-desc))
267
)
268
(t
269
(unless (or
270
(equal key-command "keyboard-quit")
271
(equal key-command "kill-this-buffer"))
272
(ignore-errors (call-interactively (key-binding key))))
273
(message (format "Got command: %s" key-command)))))
274
;; Set `last-command-event' with nil, emacs won't notify me buffer is ready-only,
275
;; because i insert nothing in buffer.
276
(setq last-command-event nil)
277
))))
278
279
(defun eaf-focus-buffer (msg)
280
(let* ((coordinate-list (split-string msg ","))
281
(mouse-press-x (string-to-number (nth 0 coordinate-list)))
282
(mouse-press-y (string-to-number (nth 1 coordinate-list))))
283
(catch 'find-window
284
(dolist (window (window-list))
285
(let ((buffer (window-buffer window)))
286
(with-current-buffer buffer
287
(if (string= "eaf-mode" (format "%s" major-mode))
288
(let* ((window-allocation (eaf-get-window-allocation window))
289
(x (nth 0 window-allocation))
290
(y (nth 1 window-allocation))
291
(w (nth 2 window-allocation))
292
(h (nth 3 window-allocation))
293
)
294
(when (and
295
(> mouse-press-x x)
296
(< mouse-press-x (+ x w))
297
(> mouse-press-y y)
298
(< mouse-press-y (+ y h)))
299
(select-window window)
300
(throw 'find-window t)
301
)
302
))))))))
303
304
(dbus-register-signal
305
:session "com.lazycat.eaf" "/com/lazycat/eaf"
306
"com.lazycat.eaf" "focus_emacs_buffer"
307
'eaf-focus-buffer)
308
309
(defun eaf-start-finish ()
310
;; Call `eaf-open-internal' after receive `start_finish' signal from server process.
311
(eaf-open-internal eaf-first-start-url))
312
313
(dbus-register-signal
314
:session "com.lazycat.eaf" "/com/lazycat/eaf"
315
"com.lazycat.eaf" "start_finish"
316
'eaf-start-finish)
317
318
(defun eaf-update-buffer-title (bid title)
319
(when (> (length title) 0)
320
(catch 'find-buffer
321
(dolist (window (window-list))
322
(let ((buffer (window-buffer window)))
323
(with-current-buffer buffer
324
(when (and
325
(string= "eaf-mode" (format "%s" major-mode))
326
(equal buffer-id bid))
327
(rename-buffer title)
328
(throw 'find-buffer t)
329
)))))))
330
331
(dbus-register-signal
332
:session "com.lazycat.eaf" "/com/lazycat/eaf"
333
"com.lazycat.eaf" "update_buffer_title"
334
'eaf-update-buffer-title)
335
336
(defun eaf-open-buffer-url (url)
337
(eaf-open url))
338
339
(dbus-register-signal
340
:session "com.lazycat.eaf" "/com/lazycat/eaf"
341
"com.lazycat.eaf" "open_buffer_url"
342
'eaf-open-buffer-url)
343
Jun 24, 2018
344
(add-hook 'window-configuration-change-hook #'eaf-monitor-configuration-change)
345
(add-hook 'pre-command-hook #'eaf-monitor-key-event)
346
(add-hook 'kill-buffer-hook #'eaf-monitor-buffer-kill)
347
348
(defun eaf-open-internal (url)
349
(let* ((buffer (eaf-create-buffer url))
350
buffer-result)
351
(with-current-buffer buffer
352
(setq buffer-result (eaf-call "new_buffer" buffer-id url)))
353
(if (equal buffer-result "")
354
;; Switch to new buffer if buffer create successful.
355
(switch-to-buffer buffer)
356
;; Kill buffer and show error message from python server.
357
(kill-buffer buffer)
358
(message buffer-result))
359
))
360
361
(defun eaf-open (url)
362
(interactive "sOpen with EAF: ")
363
(if (process-live-p eaf-process)
364
;; Call `eaf-open-internal' directly if server process has start.
365
(eaf-open-internal url)
366
;; Record user input, and call `eaf-open-internal' after receive `start_finish' signal from server process.
367
(setq eaf-first-start-url url)
368
(eaf-start-process)))
369
370
(provide 'eaf)
371
372
;;; eaf.el ends here