Files @ ac2f8cd7a056
Branch filter:

Location: workgroups2/src/workgroups-session.el

Sergey Pashinin
moved var
;;; workgroups-session.el --- Top level structure "session"
;;; Commentary:
;; Main function are: `wg-write-session-file'
;;; Code:

(require 'workgroups-variables)
(require 'workgroups-workgroup)



;;
;; Variables
;;

(defcustom wg-session-load-on-start (not (daemonp))
  "Load a session file on Workgroups start.
But only if Emacs is not started as daemon.  You don't want any
promts while Emacs is being started as daemon."
  :type 'boolean
  :group 'workgroups)
(defvaralias 'wg-use-default-session-file 'wg-session-load-on-start)

(defcustom wg-session-file "~/.emacs_workgroups"
  "Default filename to be used to save workgroups."
  :type 'file
  :group 'workgroups)
(defvaralias 'wg-default-session-file 'wg-session-file)

(defvar wg-incorrectly-restored-bufs nil
  "FIXME: docstring this.")
;; TODO: check it on switching WG

(defvar wg-record-incorrectly-restored-bufs nil
  "FIXME: docstring this.")

(defcustom wg-emacs-exit-save-behavior 'save
  "Determines save behavior on Emacs exit.
Possible values:

`ask'           Ask the user whether to save if there are unsaved changes

`save'          Call `wg-save-session' when there are unsaved changes

Anything else   Exit Emacs without saving changes"
  :type 'symbol
  :group 'workgroups)

(defcustom wg-workgroups-mode-exit-save-behavior 'save
  "Determines save behavior on `workgroups-mode' exit.
Possible values:

`ask'           Ask the user whether to saveif there are unsaved changes

`save'          Call `wg-save-session' when there are unsaved changes

Anything else   Exit `workgroups-mode' without saving changes"
  :type 'symbol
  :group 'workgroups)



;;
;; Function
;;

(defun wg-session-uids-consistent-p ()
  "Return t if there are no duplicate bufs or buf uids in the wrong places.
nil otherwise."
  (and (not (wg-dups-p (wg-buf-list) :key 'wg-buf-uid :test 'string=))
       (not (wg-dups-p (wg-workgroup-list) :key 'wg-workgroup-uid :test 'string=))))


(defun wg-find-session-file (filename)
  "Load a session visiting FILENAME, creating one if none already exists."
  (interactive "FFind session file: ")
  (cond ((file-exists-p filename)
         (let ((session (wg-read-sexp-from-file filename)))
           (unless (wg-session-p session)
             (error "%S is not a Workgroups session file." filename))
           (setf (wg-session-file-name session) filename)
           (wg-reset-internal (wg-unpickel-session-parameters session)))
         (wg-awhen (and wg-switch-to-first-workgroup-on-find-session-file
                        (wg-workgroup-list))
           (if (and wg-open-this-wg
                    (member wg-open-this-wg (wg-workgroup-names)))
               (wg-switch-to-workgroup wg-open-this-wg)
             (if (and wg-load-last-workgroup
                      (member (wg-session-parameter (wg-current-session t) 'last-workgroup)
                              (wg-workgroup-names)))
                 (wg-switch-to-workgroup
                  (wg-session-parameter (wg-current-session t) 'last-workgroup))
               (wg-switch-to-workgroup (car it)))
             ))
         (if wg-control-frames
             (wg-restore-frames))
         (wg-fontified-message (:cmd "Loaded: ") (:file filename)))
        (t
         (wg-query-and-save-if-modified)
         (wg-reset-internal (wg-make-session :file-name filename))
         (wg-fontified-message
           (:cmd "(New Workgroups session file)")))))
(defalias 'wg-open-session 'wg-find-session-file)

(defun wg-write-session-file (filename &optional confirm)
  "Write the current session into file FILENAME.
This makes the session visit that file, and marks it as not modified.

If optional second arg CONFIRM is non-nil, this function asks for
confirmation before overwriting an existing file.  Interactively,
confirmation is required unless you supply a prefix argument.

Think of it as `write-file' for Workgroups sessions."
  (interactive (list (read-file-name "Save session as: ")
                     (not current-prefix-arg)))
  (when (and confirm (file-exists-p filename))
    (unless (y-or-n-p (format "File `%s' exists; overwrite? " filename))
      (error "Cancelled")))
  (unless (file-writable-p filename)
    (error "File %s can't be written to" filename))
  (wg-perform-session-maintenance)
  (setf (wg-session-file-name (wg-current-session)) filename)
  (setf (wg-session-version (wg-current-session)) wg-version)
  (if wg-control-frames
      (wg-save-frames))
  (wg-write-sexp-to-file
   (wg-pickel-all-session-parameters (wg-current-session))
   filename)
  (wg-mark-everything-unmodified)
  (wg-fontified-message (:cmd "Wrote: ") (:file filename)))
(defalias 'wg-save-session-as 'wg-write-session-file)

(defun wg-determine-session-save-file-name ()
  "Return the filename in which to save the session."
  (or (wg-session-file-name (wg-current-session))
      (and wg-session-load-on-start wg-session-file)))

(defun wg-save-session (&optional force)
  "Save the current Workgroups session if it's been modified.
Think of it as `save-buffer' for Workgroups sessions.  Optional
argument FORCE non-nil, or interactively with a prefix arg, save
the session regardless of whether it's been modified."
  (interactive "P")
  (if (and (not (wg-modified-p)) (not force))
      (wg-message "(The session is unmodified)")
    (wg-write-session-file
     (or (wg-determine-session-save-file-name)
         (read-file-name "Save session as: ")))))

(defun wg-reset-internal (&optional session)
  "Reset Workgroups, setting `wg-current-session' to SESSION.
Resets all frame parameters, buffer-local vars, current
Workgroups session object, etc.  SESSION nil defaults to a new,
blank session object."
  (mapc 'wg-reset-frame (frame-list))
  (mapc 'wg-reset-buffer (wg-buffer-list-emacs))
  (setq wg-wconfig-kill-ring nil)
  (setq wg-current-session (or session (wg-make-session))))



(defun wg-session-all-buf-uids (&optional session)
  "Return a new list of all unique buf uids in SESSION.
SESSION nil defaults to `wg-current-session'."
  (cl-reduce 'wg-string-list-union
             (wg-session-workgroup-list (or session (wg-current-session)))
             :key 'wg-workgroup-all-buf-uids))

(defun wg-buffer-list-all-uids (&optional buffer-list)
  "Return a list of the uids of all buffers in BUFFER-LIST in
which `wg-buffer-uid' is locally bound.
BUFFER-LIST nil defaults to `buffer-list'."
  (delq nil (mapcar 'wg-buffer-uid (or buffer-list (wg-buffer-list-emacs)))))

(defun wg-all-buf-uids (&optional session buffer-list)
  "Return the union of `wg-session-all-buf-uids' and `wg-buffer-list-all-uids'."
  (cl-union (wg-session-all-buf-uids session)
            (wg-buffer-list-all-uids buffer-list)
            :test 'string=))

(defun wg-gc-bufs ()
  "gc bufs from `wg-buf-list' that are no longer needed."
  (let ((all-buf-uids (wg-all-buf-uids)))
    (wg-asetf (wg-buf-list)
              (cl-remove-if-not (lambda (uid) (member uid all-buf-uids)) it
                                :key 'wg-buf-uid))))



;; FIXME: Duplicate buf names probably shouldn't be allowed.  An unrelated error
;; causes two *scratch* buffers to be present, triggering the "uids don't match"
;; error.  Write something to remove bufs with duplicate names.


(defun wg-perform-session-maintenance ()
  "Perform various maintenance operations on the current Workgroups session."
  (wg-update-current-workgroup-working-wconfig)

  ;; Update every workgroup's base wconfig with `wg-workgroup-update-base-wconfig'
  (dolist (workgroup (wg-workgroup-list))
    (wg-awhen (wg-workgroup-selected-frame-wconfig workgroup)
      (setf (wg-workgroup-base-wconfig workgroup) it
            (wg-workgroup-selected-frame-wconfig workgroup) nil)))

  (wg-gc-bufs)
  (wg-gc-buf-uids)
  (wg-update-buf-list))


;; session consistency testing


(defun wg-modified-p ()
  "Return t when the current session or any of its workgroups are modified."
  (or (wg-session-modified (wg-current-session))
      (cl-some 'wg-workgroup-modified (wg-workgroup-list))))

(defun wg-mark-everything-unmodified ()
  "Mark the session and all workgroups as unmodified."
  (setf (wg-session-modified (wg-current-session)) nil)
  (dolist (workgroup (wg-workgroup-list))
    (setf (wg-workgroup-modified workgroup) nil)))


(defun wg-workgroup-names (&optional noerror)
  "Return a list of workgroup names or scream unless NOERROR."
  (mapcar 'wg-workgroup-name (wg-workgroup-list-or-error noerror)))


;;; session parameters

(defun wg-session-parameter (session parameter &optional default)
  "Return SESSION's value for PARAMETER.
If PARAMETER is not found, return DEFAULT which defaults to nil.
SESSION nil defaults to the current session."
  (wg-aget (wg-session-parameters (or session (wg-current-session)))
           parameter default))

(defun wg-set-session-parameter (session parameter value)
  "Set SESSION's value of PARAMETER to VALUE.
SESSION nil means use the current session.
Return value."
  (let ((session (or session (wg-current-session))))
    (wg-set-parameter (wg-session-parameters session) parameter value)
    (setf (wg-session-modified session) t)
    value))

(defun wg-remove-session-parameter (session parameter)
  "Remove parameter PARAMETER from SESSION's parameters."
  (let ((session (or session (wg-current-session))))
    (wg-asetf (wg-session-parameters session) (wg-aremove it parameter))
    (setf (wg-session-modified session) t)))

(defun wg-session-local-value (variable &optional session)
  "Return the value of VARIABLE in SESSION.
SESSION nil defaults to the current session.  If VARIABLE does
not have a session-local binding in SESSION, the value is
resolved by Emacs."
  (let* ((undefined (cl-gensym))
         (value (wg-session-parameter session variable undefined)))
    (if (not (eq value undefined)) value
      (symbol-value variable))))


(defun wg-reset-frame (frame)
  "Reset Workgroups' frame-parameters in FRAME to nil."
  (set-frame-parameter frame 'wg-workgroup-state-table nil)
  (set-frame-parameter frame 'wg-current-workgroup-uid nil)
  (set-frame-parameter frame 'wg-previous-workgroup-uid nil))



(defun wg-save-session-on-exit (behavior)
  "Perform session-saving operations based on BEHAVIOR."
  (cl-case behavior
    (ask (wg-query-and-save-if-modified))
    (save
     (if (wg-determine-session-save-file-name)
         (wg-save-session)
       (wg-query-and-save-if-modified)))))

(defun wg-save-frames ()
  "Save opened frames as a session parameter.
Exclude `selected-frame' and daemon one (if any).
http://stackoverflow.com/questions/21151992/why-emacs-as-daemon-gives-1-more-frame-than-is-opened"
  (interactive)
  (let ((fl (frame-list)))
    (mapc (lambda (frame)
            (if (string-equal "initial_terminal" (terminal-name frame))
                (delete frame fl))) fl)
    (setq fl (delete (selected-frame) fl))
    (if (wg-current-session t)
        (wg-set-session-parameter (wg-current-session t)
                                  'frame-list
                                  (mapcar 'wg-frame-to-wconfig fl)))))


(defun wg-reload-session ()
  "Reload current workgroups session."
  (interactive)
  (let ((file (or (wg-determine-session-save-file-name)
                  wg-session-file)))
    (when (file-exists-p file)
      (condition-case err
          (wg-open-session wg-session-file)
        (progn
          (wg-create-first-wg)
          (error (message "Error finding session-file: %s" err)))))
    (wg-create-first-wg)))

(defun wg-save-session-on-emacs-exit ()
  "Call `wg-save-session-on-exit' with `wg-emacs-exit-save-behavior'.
Added to `kill-emacs-query-functions'."
  (wg-save-session-on-exit wg-emacs-exit-save-behavior) t)

(defun wg-save-session-on-workgroups-mode-exit ()
  "Call `wg-save-session-on-exit' with `wg-workgroups-mode-exit-save-behavior'.
Called when `workgroups-mode' is turned off."
  (wg-save-session-on-exit wg-workgroups-mode-exit-save-behavior) t)


(defun wg-pickel-all-session-parameters (session)
  "Return a copy of SESSION after pickeling its
parameters and the parameters of all its workgroups."
  (let ((copy (wg-copy-session session)))
    (when (wg-session-parameters copy)
      (wg-asetf (wg-session-parameters copy) (wg-pickel it)))
    (wg-asetf (wg-session-workgroup-list copy)
              (cl-mapcar 'wg-pickel-workgroup-parameters it))
    copy))

(defun wg-unpickel-session-parameters (session)
  "Return a copy of SESSION after unpickeling its
parameters and the parameters of all its workgroups."
  (let ((copy (wg-copy-session session)))
    (when (wg-session-parameters copy)
      (wg-asetf (wg-session-parameters copy) (wg-unpickel it)))
    (wg-asetf (wg-session-workgroup-list copy)
              (cl-mapcar 'wg-unpickel-workgroup-parameters it))
    copy))


(provide 'workgroups-session)
;;; workgroups-session.el ends here