;;; desktop-plus.el (desktop+.el) --- Handle special buffers when saving & restoring sessions

;; Copyright (C) 2014-2015 François Févotte
;; Author:  François Févotte <fevotte@gmail.com>
;; 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-plus' 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-plus-create': create a new session and give it a name.
;;
;;     `desktop-plus-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-plus-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-plus-base-dir'.

;; Handling of special buffers:
;;
;;     Desktop sessions by default save only buffers associated to "real" files.
;;     Desktop-Plus 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-plus-base-dir "~/.emacs.d/desktops/"
  "Base directory for desktop files.")

(defvar desktop-plus-frame-title-function 'desktop-plus-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-plus-create (name)
  "Create a new session, identified by a name.
The session is created in a subdirectory of `desktop-plus-base-dir'.
It can afterwards be reloaded using `desktop-plus-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-plus-dirname name))
  (make-directory desktop-dirname 'parents)
  (desktop-save desktop-dirname)
  (desktop-plus-set-frame-title)
  (desktop-save-mode 1))

;;;###autoload
(defun desktop-plus-create-auto ()
  "Create a new session, identified by the current working directory.
The session is created in a subdirectory of `desktop-plus-base-dir'.
It can afterwards be reloaded using `desktop-plus-load'."
  (interactive)
  (desktop-plus-create ""))

;;;###autoload
(defun desktop-plus-load (name)
  "Load a session previously created using `desktop-plus-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-plus-base-dir))))))
  (desktop-change-dir (desktop-plus-dirname name))
  (desktop-plus-set-frame-title)
  (desktop-save-mode 1))

;;;###autoload
(defun desktop-plus-load-auto ()
  "Load a session previously created using `desktop-plus-create-auto'.
The session is identified by the current working directory."
  (interactive)
  (desktop-plus-load ""))

;; ** Inner workings

(defun desktop-plus-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-plus-base-dir'."
  (f-join desktop-plus-base-dir
          (if (string= "" name)
              (replace-regexp-in-string "/" "-" (f-canonical default-directory))
            name)))

(defun desktop-plus-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-plus-set-frame-title ()
  "Set the frame title to show the currently active session."
  (setq frame-title-format
        (funcall desktop-plus-frame-title-function
                 (file-name-nondirectory (directory-file-name desktop-dirname)))))


;; * Special buffers

;; ** Customizable options

(defvar desktop-plus-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-plus-advice--desktop-save (&rest args)
  "Also save special buffers."
  (desktop-plus-buffers-save))
;;;###autoload
(advice-add 'desktop-save :before #'desktop-plus-advice--desktop-save)

;;;###autoload
(defun desktop-plus-advice--desktop-restore-frameset (&rest args)
  "Restore special buffers."
  (desktop-plus-buffers-load))
;;;###autoload
(advice-add 'desktop-restore-frameset :before #'desktop-plus-advice--desktop-restore-frameset)

;; ** Mode-specific handlers for special buffers

(defvar desktop-plus-special-buffer-handlers-alist nil
  "Alist of handlers for special buffers.")

(defun desktop-plus-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-plus-special-buffer-handlers-alist))

;; *** Terminals

(defun desktop-plus-term-mode-hook ()
  (setq desktop-save-buffer #'desktop-plus-terminal-save-buffer))

(defun desktop-plus-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-plus-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-plus-special-buffer-handlers)
  (add-hook 'term-mode-hook 'desktop-plus-term-mode-hook)
  (add-to-list 'desktop-buffer-mode-handlers
               '(term-mode . desktop-plus-terminal-restore-buffer)))

;; *** Compilation buffers

(defun desktop-plus-compilation-mode-hook ()
  (setq desktop-save-buffer #'desktop-plus-compilation-save-buffer))

(defun desktop-plus-compilation-save-buffer (dirname)
  "Return relevant parameters for saving a compilation buffer."
  (list :command compilation-arguments
        :dir     compilation-directory))

(defun desktop-plus-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-plus-special-buffer-handlers)
  (add-hook 'compilation-mode-hook 'desktop-plus-compilation-mode-hook)
  (add-to-list 'desktop-buffer-mode-handlers
               '(compilation-mode . desktop-plus-compilation-restore-buffer)))

;; *** Org Agenda buffers

(defun desktop-plus-org-agenda-mode-hook ()
  (setq desktop-save-buffer #'desktop-plus-org-agenda-save-buffer))

(defun desktop-plus-org-agenda-save-buffer (dirname)
  "Return relevant parameters for saving an org agenda buffer."
  (list :dir  default-directory
        :type org-agenda-type))

(defun desktop-plus-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-plus-special-buffer-handlers)
  (add-hook 'org-agenda-mode-hook 'desktop-plus-org-agenda-mode-hook)
  (add-to-list 'desktop-buffer-mode-handlers
               '(org-agenda-mode . desktop-plus-org-agenda-restore-buffer)))

;; *** Clones (indirect buffers)

(desktop-plus-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-plus-Man-mode-hook ()
  (setq desktop-save-buffer #'desktop-plus-Man-save-buffer))

(defun desktop-plus-Man-save-buffer (dirname)
  "Return relevant parameters for saving a `Man-mode' buffer."
  (list :arguments Man-arguments))

(defun desktop-plus-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-plus-special-buffer-handlers)
  (add-hook 'Man-mode-hook 'desktop-plus-Man-mode-hook)
  (add-to-list 'desktop-buffer-mode-handlers
               '(Man-mode . desktop-plus-Man-restore-buffer)))

;; *** shell-mode

(defun desktop-plus-shell-mode-hook ()
  (setq desktop-save-buffer #'desktop-plus-shell-save-buffer))

(defun desktop-plus-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-plus-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-plus-special-buffer-handlers)
  (add-hook 'shell-mode-hook 'desktop-plus-shell-mode-hook)
  (add-to-list 'desktop-buffer-mode-handlers
               '(shell-mode . desktop-plus-shell-restore-buffer)))

;; ** Inner workings

(defun desktop-plus-buffers-file ()
  "Name of the file where special buffers configuration will be saved."
  (f-join desktop-dirname ".emacs-buffers"))

(defun desktop-plus-create-buffer (key name &rest args)
  "Recreate a special buffer from saved parameters.

KEY identifies the special buffer type, as registered in
`desktop-plus-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-plus-special-buffer-handlers-alist)))
    (when handler
      (apply (nth 3 handler) name args))))

(defun desktop-plus-buffers-save ()
  "Persistently save special buffers.
Information is kept in the file pointed to by `desktop-plus-buffers-file'."
  (with-temp-buffer
    (mapc (lambda (b)
            (let ((data
                   (with-current-buffer b
                     (let ((handler
                            (--first
                             (and (memq (nth 0 it) desktop-plus-special-buffer-handlers)
                                  (funcall (nth 1 it)))
                             desktop-plus-special-buffer-handlers-alist)))
                       (when handler
                         (append `(desktop-plus-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-plus-buffers-file) nil 'quiet)))

(defun desktop-plus-buffers-load ()
  "Load special buffers from the persistent session file.
Information is kept in the file pointed to by
`desktop-plus-desktop-plus-buffers-file'."
  (when (file-exists-p (desktop-plus-buffers-file))
    (load-file (desktop-plus-buffers-file))))

(provide 'desktop-plus)

;;; desktop-plus.el ends here