-
Notifications
You must be signed in to change notification settings - Fork 13
/
desktop+.el
398 lines (311 loc) · 13.4 KB
/
desktop+.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
;;; desktop+.el --- Handle special buffers when saving & restoring sessions
;; Copyright (C) 2014-2015 François Févotte
;; Author: François Févotte <[email protected]>
;; URL: https://github.com/ffevotte/desktop-plus
;; Version: 0.1.1
;; Package-Requires: ((emacs "24.4") (dash "2.11.0") (f "0.17.2"))
;; This file is NOT part of Emacs
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; `desktop+' extends `desktop' by providing more features related to
;; sessions persistance.
;; Centralized directory storing all desktop sessions:
;;
;; Instead of relying on Emacs' starting directory to choose the session
;; Emacs restarts, two functions are provided to manipulate sessions by
;; name.
;;
;; `desktop+-create': create a new session and give it a name.
;;
;; `desktop+-load': change the current session; the new session to be loaded
;; is identified by its name, as given during session creation using
;; `desktop-create'.
;;
;; The currently active session is identified in the title bar. You can
;; customize `desktop+-frame-title-function' to change the way the active
;; session is displayed.
;;
;; All sessions managed this way are stored in the directory given by
;; `desktop+-base-dir'.
;; Handling of special buffers:
;;
;; Desktop sessions by default save only buffers associated to "real" files.
;; Desktop+ extends this by handling also "special buffers", such as those
;; in `compilation-mode' or `term-mode', or indirect buffers (aka clones).
;;; Code:
(eval-when-compile
(require 'dash))
(require 'desktop)
(require 'f)
;; * Named sessions
;; ** Customizable options
(defvar desktop+-base-dir "~/.emacs.d/desktops/"
"Base directory for desktop files.")
(defvar desktop+-frame-title-function 'desktop+--frame-title
"Function returning the frame title when a desktop session is loaded.
This function must accept the desktop name as a string argument
and return a frame title format suitable for setting
`frame-title-format'")
;; ** Entry points
;;;###autoload
(defun desktop+-create (name)
"Create a new session, identified by a name.
The session is created in a subdirectory of `desktop+-base-dir'.
It can afterwards be reloaded using `desktop+-load'.
As a special case, if NAME is left blank, the session is
automatically named after the current working directory."
(interactive "MDesktop name: ")
(desktop-kill)
(setq desktop-dirname (desktop+--dirname name))
(make-directory desktop-dirname 'parents)
(desktop-save desktop-dirname)
(desktop+--set-frame-title)
(desktop-save-mode 1))
;;;###autoload
(defun desktop+-create-auto ()
"Create a new session, identified by the current working directory.
The session is created in a subdirectory of `desktop+-base-dir'.
It can afterwards be reloaded using `desktop+-load'."
(interactive)
(desktop+-create ""))
;;;###autoload
(defun desktop+-load (name)
"Load a session previously created using `desktop+-create'.
NAME is the name which was given at session creation. When
called interactively, it is asked in the minibuffer with
auto-completion.
As a special case, if NAME is left blank, the session is
automatically named after the current working directory."
(interactive
(list
(completing-read "Desktop name: "
(remove "."
(remove ".."
(directory-files desktop+-base-dir))))))
(desktop-change-dir (desktop+--dirname name))
(desktop+--set-frame-title)
(desktop-save-mode 1))
;;;###autoload
(defun desktop+-load-auto ()
"Load a session previously created using `desktop+-create-auto'.
The session is identified by the current working directory."
(interactive)
(desktop+-load ""))
;; ** Inner workings
(defun desktop+--dirname (name)
"Path to the desktop identified by NAME.
As a special case, if NAME is blank, the directory is identified
by the current working directory.
This path is located under `desktop+-base-dir'."
(f-join desktop+-base-dir
(if (string= "" name)
(replace-regexp-in-string "/" "-" (f-canonical default-directory))
name)))
(defun desktop+--frame-title (desktop-name)
"Default frame title function for sessions.
Returns the following frame title format:
'%b - Emacs [DESKTOP-NAME]'"
(list (concat "%b - Emacs [" desktop-name "]")))
(defun desktop+--set-frame-title ()
"Set the frame title to show the currently active session."
(setq frame-title-format
(funcall desktop+-frame-title-function
(file-name-nondirectory (directory-file-name desktop-dirname)))))
;; * Special buffers
;; ** Customizable options
(defvar desktop+-special-buffer-handlers
'(term-mode
compilation-mode
org-agenda-mode
indirect-buffer
Man-mode
shell-mode)
"List of special buffers to handle.")
;; ** Entry point
;;;###autoload
(defun desktop+--advice--desktop-save (&rest args)
"Also save special buffers."
(desktop+--buffers-save))
;;;###autoload
(advice-add 'desktop-save :before #'desktop+--advice--desktop-save)
;;;###autoload
(defun desktop+--advice--desktop-restore-frameset (&rest args)
"Restore special buffers."
(desktop+--buffers-load))
;;;###autoload
(advice-add 'desktop-restore-frameset :before #'desktop+--advice--desktop-restore-frameset)
;; ** Mode-specific handlers for special buffers
(defvar desktop+--special-buffer-handlers-alist nil
"Alist of handlers for special buffers.")
(defun desktop+-add-handler (name pred save-fn load-fn)
"Add handlers for special buffers.
NAME is a symbol identifying the handler for later activation or
deactivation.
PRED should be a unary function used as a predicate to determine
whether a buffer should be handled specially. When called in a
buffer which should be handled, PRED should return non-nil.
SAVE-FN should be a function taking no parameter, returning a
list of all relevant parameters for the current buffer, which is
assumed to be in the given major mode.
LOAD-FN should be a function of the following form:
(lambda (name &rest args) ...)
allowing to restore a buffer named NAME in major mode MODE,
from information stored in ARGS, as determined by SAVE-FN."
(declare (indent 1))
(push (list name pred save-fn load-fn)
desktop+--special-buffer-handlers-alist))
;; *** Terminals
(defun desktop+--term-mode-hook ()
(setq desktop-save-buffer #'desktop+--terminal-save-buffer))
(defun desktop+--terminal-save-buffer (dirname)
"Return relevant parameters for saving a terminal buffer."
(list :dir default-directory
:command (car (last (process-command
(get-buffer-process (current-buffer)))))))
(defun desktop+--terminal-restore-buffer (file-name buffer-name misc)
"Restore a terminal buffer."
(when (null (get-buffer buffer-name))
(let ((default-directory (plist-get misc :dir)))
(with-current-buffer (term (plist-get misc :command))
(rename-buffer buffer-name)
(current-buffer)))))
(when (memq 'term-mode desktop+-special-buffer-handlers)
(add-hook 'term-mode-hook 'desktop+--term-mode-hook)
(add-to-list 'desktop-buffer-mode-handlers
'(term-mode . desktop+--terminal-restore-buffer)))
;; *** Compilation buffers
(defun desktop+--compilation-mode-hook ()
(setq desktop-save-buffer #'desktop+--compilation-save-buffer))
(defun desktop+--compilation-save-buffer (dirname)
"Return relevant parameters for saving a compilation buffer."
(list :command compilation-arguments
:dir compilation-directory))
(defun desktop+--compilation-restore-buffer (file-name buffer-name misc)
"Restore a compilation buffer."
(with-current-buffer (get-buffer-create buffer-name)
(compilation-mode)
(set (make-local-variable 'compilation-arguments) (plist-get misc :command))
(set (make-local-variable 'compilation-directory) (plist-get misc :dir))
(current-buffer)))
(when (memq 'compilation-mode desktop+-special-buffer-handlers)
(add-hook 'compilation-mode-hook 'desktop+--compilation-mode-hook)
(add-to-list 'desktop-buffer-mode-handlers
'(compilation-mode . desktop+--compilation-restore-buffer)))
;; *** Org Agenda buffers
(defun desktop+--org-agenda-mode-hook ()
(setq desktop-save-buffer #'desktop+--org-agenda-save-buffer))
(defun desktop+--org-agenda-save-buffer (dirname)
"Return relevant parameters for saving an org agenda buffer."
(list :dir default-directory
:type org-agenda-type))
(defun desktop+--org-agenda-restore-buffer (file-name buffer-name misc)
"Restore an org agenda buffer."
(let ((default-directory (plist-get misc :dir)))
(save-window-excursion
(cond
((eq (plist-get misc :type) 'todo)
(org-todo-list))
((eq (plist-get misc :type) 'agenda)
(org-agenda-list))
(t
(error "unknown org-agenda-type")))
(rename-buffer buffer-name)
(current-buffer))))
(when (memq 'org-agenda-mode desktop+-special-buffer-handlers)
(add-hook 'org-agenda-mode-hook 'desktop+--org-agenda-mode-hook)
(add-to-list 'desktop-buffer-mode-handlers
'(org-agenda-mode . desktop+--org-agenda-restore-buffer)))
;; *** Clones (indirect buffers)
(desktop+-add-handler 'indirect-buffer
#'buffer-base-buffer
(lambda ()
`(:base ,(buffer-name (buffer-base-buffer))))
(lambda (name &rest args)
(with-current-buffer (get-buffer (plist-get args :base))
(clone-indirect-buffer name nil))))
;; *** Man-mode buffers
(defun desktop+--Man-mode-hook ()
(setq desktop-save-buffer #'desktop+--Man-save-buffer))
(defun desktop+--Man-save-buffer (dirname)
"Return relevant parameters for saving a `Man-mode' buffer."
(list :arguments Man-arguments))
(defun desktop+--Man-restore-buffer (file-name buffer-name misc)
"Restore a `Man-mode' buffer."
(with-current-buffer (man (plist-get misc :arguments))
(rename-buffer buffer-name)))
(when (memq 'Man-mode desktop+-special-buffer-handlers)
(add-hook 'Man-mode-hook 'desktop+--Man-mode-hook)
(add-to-list 'desktop-buffer-mode-handlers
'(Man-mode . desktop+--Man-restore-buffer)))
;; *** shell-mode
(defun desktop+--shell-mode-hook ()
(setq desktop-save-buffer #'desktop+--shell-save-buffer))
(defun desktop+--shell-save-buffer (dirname)
"Return relevant parameters for saving a `shell-mode' buffer.
Currently, it saves and restores the current working directory.
The text in the buffer, as well as environment variables, shell
variables and other state are lost."
(list :dir default-directory))
(defun desktop+--shell-restore-buffer (file-name buffer-name misc)
"Restore a `shell-mode' buffer."
(let* ((dir (plist-get misc :dir))
(default-directory (if (file-directory-p dir) dir "/")))
(with-current-buffer (shell)
(rename-buffer buffer-name))))
(when (memq 'shell-mode desktop+-special-buffer-handlers)
(add-hook 'shell-mode-hook 'desktop+--shell-mode-hook)
(add-to-list 'desktop-buffer-mode-handlers
'(shell-mode . desktop+--shell-restore-buffer)))
;; ** Inner workings
(defun desktop+--buffers-file ()
"Name of the file where special buffers configuration will be saved."
(f-join desktop-dirname ".emacs-buffers"))
(defun desktop+--create-buffer (key name &rest args)
"Recreate a special buffer from saved parameters.
KEY identifies the special buffer type, as registered in
`desktop+-special-buffer-handlers'.
NAME is the name of the buffer.
ARGS is the relevant buffer parameters, as determined by the
registered save handler. These parameters will be restored by
calling the load handler."
(let ((handler (assq key desktop+--special-buffer-handlers-alist)))
(when handler
(apply (nth 3 handler) name args))))
(defun desktop+--buffers-save ()
"Persistently save special buffers.
Information is kept in the file pointed to by `desktop+--buffers-file'."
(with-temp-buffer
(mapc (lambda (b)
(let ((data
(with-current-buffer b
(let ((handler
(--first
(and (memq (nth 0 it) desktop+-special-buffer-handlers)
(funcall (nth 1 it)))
desktop+--special-buffer-handlers-alist)))
(when handler
(append `(desktop+--create-buffer
(quote ,(nth 0 handler))
,(buffer-name))
(funcall (nth 2 handler))))))))
(if data
(pp data (current-buffer)))))
(buffer-list))
(write-region nil nil (desktop+--buffers-file) nil 'quiet)))
(defun desktop+--buffers-load ()
"Load special buffers from the persistent session file.
Information is kept in the file pointed to by
`desktop+-desktop+--buffers-file'."
(when (file-exists-p (desktop+--buffers-file))
(load-file (desktop+--buffers-file))))
(provide 'desktop+)
;;; desktop+.el ends here