Changeset - 20ec9e5e67f0
[Not reviewed]
0 1 0
Sergey Pashinin - 11 years ago 2014-08-28 10:55:01
sergey@pashinin.com
Check session parameter
1 file changed with 2 insertions and 3 deletions:
0 comments (0 inline, 0 general)
src/workgroups2.el
Show inline comments
 
@@ -4069,446 +4069,445 @@ current and previous workgroups."
 
             (= (length (wg-workgroup-list)) 0))
 
    (wg-create-workgroup wg-first-wg-name)
 
    (wg-mark-everything-unmodified)))
 

	
 
(defun wg-pickel-workgroup-parameters (workgroup)
 
  "Return a copy of WORKGROUP after pickeling its parameters.
 
If WORKGROUP's parameters are non-nil, otherwise return
 
WORKGROUP."
 
  (if (not (wg-workgroup-parameters workgroup)) workgroup
 
    (let ((copy (wg-copy-workgroup workgroup)))
 
      (wg-asetf (wg-workgroup-parameters copy) (wg-pickel it))
 
      copy)))
 

	
 
(defun wg-unpickel-workgroup-parameters (workgroup)
 
  "If WORKGROUP's parameters are non-nil, return a copy of
 
WORKGROUP after unpickeling its parameters. Otherwise return
 
WORKGROUP."
 
  (if (not (wg-workgroup-parameters workgroup)) workgroup
 
    (let ((copy (wg-copy-workgroup workgroup)))
 
      (wg-asetf (wg-workgroup-parameters copy) (wg-unpickel it))
 
      copy)))
 

	
 
(defun wg-delete-workgroup (workgroup)
 
  "Remove WORKGROUP from `wg-workgroup-list'.
 
Also delete all references to it by `wg-workgroup-state-table',
 
`wg-current-workgroup' and `wg-previous-workgroup'."
 
  (dolist (frame (frame-list))
 
    (remhash (wg-workgroup-uid workgroup) (wg-workgroup-state-table frame))
 
    (when (wg-current-workgroup-p workgroup frame)
 
      (wg-set-current-workgroup nil frame))
 
    (when (wg-previous-workgroup-p workgroup frame)
 
      (wg-set-previous-workgroup nil frame)))
 
  (setf (wg-workgroup-list) (remove workgroup (wg-workgroup-list-or-error)))
 
  (wg-flag-session-modified)
 
  workgroup)
 

	
 
(defun wg-add-workgroup (workgroup &optional index)
 
  "Add WORKGROUP to `wg-workgroup-list' at INDEX or the end.
 
If a workgroup with the same name exists, overwrite it."
 
  (awhen (wg-find-workgroup-by :name (wg-workgroup-name workgroup) t)
 
    (unless index (setq index (cl-position it (wg-workgroup-list-or-error))))
 
    (wg-delete-workgroup it))
 
  (wg-asetf (wg-workgroup-list)
 
            (wg-insert-before workgroup it (or index (length it))))
 
  (wg-flag-session-modified)
 
  workgroup)
 

	
 
(defun wg-check-and-add-workgroup (workgroup)
 
  "Add WORKGROUP to `wg-workgroup-list'.
 
Ask to overwrite if a workgroup with the same name exists."
 
  (let ((name (wg-workgroup-name workgroup))
 
        (uid (wg-workgroup-uid workgroup)))
 
    (when (wg-find-workgroup-by :uid uid t)
 
      (error "A workgroup with uid %S already exists" uid))
 
    (when (wg-find-workgroup-by :name name t)
 
      (unless (or wg-no-confirm-on-destructive-operation
 
                  (y-or-n-p (format "%S exists. Overwrite? " name)))
 
        (error "Cancelled"))))
 
  (wg-add-workgroup workgroup))
 

	
 
(defun wg-make-and-add-workgroup (name &optional blank)
 
  "Create a workgroup named NAME with current `window-tree'.
 
If BLANK - then just scratch buffer.
 
Add it with `wg-check-and-add-workgroup'."
 
  (wg-check-and-add-workgroup
 
   (wg-make-workgroup
 
    :name name
 
    :base-wconfig (if blank (wg-make-blank-wconfig)
 
                    (wg-current-wconfig)))))
 

	
 
(defun wg-get-workgroup-create (workgroup)
 
  "Return the workgroup specified by WORKGROUP, creating a new one if needed.
 
If `wg-get-workgroup' on WORKGROUP returns a workgroup, return it.
 
Otherwise, if WORKGROUP is a string, create a new workgroup with
 
that name and return it.  Otherwise error."
 
  (or (wg-get-workgroup workgroup t)
 
      (if (stringp workgroup)
 
          (wg-make-and-add-workgroup workgroup)
 
        (wg-get-workgroup workgroup))))  ; Call this again for its error message
 

	
 
(defun wg-cyclic-offset-workgroup (workgroup n)
 
  "Offset WORKGROUP's position in `wg-workgroup-list' by N."
 
  (let ((workgroup-list (wg-workgroup-list-or-error)))
 
    (unless (member workgroup workgroup-list)
 
      (error "Workgroup isn't present in `wg-workgroup-list'."))
 
    (setf (wg-workgroup-list) (wg-cyclic-offset-elt workgroup workgroup-list n)
 
          (wg-session-modified (wg-current-session)) t)))
 

	
 
(defun wg-swap-workgroups-in-workgroup-list (workgroup1 workgroup2)
 
  "Swap the positions of WORKGROUP1 and WORKGROUP2 in `wg-workgroup-list'."
 
  (let ((workgroup-list (wg-workgroup-list-or-error)))
 
    (when (eq workgroup1 workgroup2)
 
      (error "Can't swap a workgroup with itself"))
 
    (unless (and (memq workgroup1 workgroup-list)
 
                 (memq workgroup2 workgroup-list))
 
      (error "Both workgroups aren't present in `wg-workgroup-list'."))
 
    (setf (wg-workgroup-list) (wg-util-swap workgroup1 workgroup2 workgroup-list)
 
          (wg-session-modified (wg-current-session)) t)))
 

	
 
(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)
 
         ;; TODO: handle errors when reading object
 
         (let ((session (read (f-read-text 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)))
 

	
 
         (if wg-control-frames (wg-restore-frames))
 

	
 
         (awhen (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 'last-workgroup) (wg-workgroup-names)))
 
                 (wg-switch-to-workgroup (wg-session-parameter 'last-workgroup))
 
               (wg-switch-to-workgroup (car it)))
 
             ))
 
         (wg-fontified-message (:cmd "Loaded: ") (:file filename))
 
         (wg-mark-everything-unmodified))
 
        (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-sexp-to-file (sexp file)
 
  "Write the printable representation of SEXP to FILE."
 
  (with-temp-buffer
 
    (let ((print-level nil)  (print-length nil))
 
      (insert (format "%S" sexp)))
 
    (write-file file)))
 

	
 
;; 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))
 
    (awhen (wg-workgroup-selected-frame-wconfig workgroup)
 
      (setf (wg-workgroup-base-wconfig workgroup) it
 
            (wg-workgroup-selected-frame-wconfig workgroup) nil)))
 

	
 
  ;; Garbage collection
 
  (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)))
 
  (mapc 'wg-workgroup-gc-buf-uids (wg-workgroup-list))  ; Remove buf uids that have no referent in `wg-buf-list'
 
  (mapc 'wg-update-buffer-in-buf-list (wg-buffer-list-emacs)))
 

	
 
(defun wg-save-session-as (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."
 
  (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)
 

	
 
  ;; Save opened frames as a session parameter "frame-list".
 
  ;; Exclude `selected-frame' and daemon one (if any).
 
  ;; http://stackoverflow.com/questions/21151992/why-emacs-as-daemon-gives-1-more-frame-than-is-opened
 
  (if wg-control-frames
 
      (let ((fl (frame-list)))
 
        ;; TODO: remove using dash
 
        (mapc (lambda (frame)
 
                (if (string-equal "initial_terminal" (terminal-name frame))
 
                    (delete frame fl))) fl)
 
        (setq fl (delete (selected-frame) fl))
 
        (let (wg-flag-modified)
 
          (if (wg-current-session t)
 
              (wg-set-session-parameter 'frame-list (mapcar 'wg-frame-to-wconfig fl))))))
 
          (wg-set-session-parameter 'frame-list (mapcar 'wg-frame-to-wconfig fl)))))
 
  (wg-write-sexp-to-file (wg-pickel-all-session-parameters) filename)
 
  (wg-fontified-message (:cmd "Wrote: ") (:file filename))
 
  (wg-mark-everything-unmodified))
 
(defalias 'wg-write-session-file 'wg-save-session-as)
 

	
 
(defun wg-get-session-file ()
 
  "Return the filename in which to save the session."
 
  (or (aif (wg-current-session t) (wg-session-file-name it))
 
      wg-session-file))
 
;;(read-file-name (format "Save session as [%s]: " wg-session-file))
 

	
 
(defun wg-save-session (&optional force)
 
  "Save the current Workgroups session if it's been modified.
 
When FORCE - save 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-save-session-as (wg-get-session-file))))
 

	
 
(defun wg-reset-internal (&optional session)
 
  "Reset Workgroups, setting `wg-current-session' to SESSION.
 
Resets all frame parameters, buffer-local vars, current session
 
object, etc.  SESSION nil defaults to a new, blank session."
 
  (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-all-buf-uids (&optional session buffer-list)
 
  "Return the union of all SESSION buf-uids and BUFFER-LIST uids."
 
  (cl-union (cl-reduce 'wg-string-list-union  ; (wg-session-all-buf-uids session)
 
                       (wg-session-workgroup-list (or session (wg-current-session)))
 
                       :key 'wg-workgroup-all-buf-uids)
 
            ;; (wg-buffer-list-all-uids buffer-list)
 
            (delq nil (mapcar 'wg-buffer-uid (or buffer-list (wg-buffer-list-emacs))))
 
            :test 'string=))
 

	
 
(defun wg-modified-p ()
 
  "Return t when the current session or any of its workgroups are modified."
 
  (aif (wg-current-session t)
 
      (or (wg-session-modified it)
 
          (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-session-parameter (parameter &optional default session)
 
  "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 (parameter value &optional session)
 
  "Set PARAMETER to VALUE in SESSION.
 
SESSION nil means use the current session.  Return value."
 
  (let ((session (or session (wg-current-session))))
 
  (-when-let (session (or session (wg-current-session t)))
 
    (wg-set-parameter (wg-session-parameters session) parameter value)
 
    (wg-flag-session-modified session)
 
    value))
 

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

	
 
(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 variable undefined session)))
 
    (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 (wg-save-session))))
 

	
 
(defun wg-reload-session ()
 
  "Reload current workgroups session."
 
  (interactive)
 
  (let* ((file (wg-get-session-file))
 
         (exists (file-exists-p file)))
 
    (condition-case err
 
        (wg-open-session file)
 
      (progn
 
        (wg-create-first-wg)
 
        (message "Error loading session-file: %s" err))))
 
        ;; TODO: print what exactly happened
 
  (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 (&optional session)
 
  "Return a copy of SESSION after pickeling its parameters.
 
And the parameters of all its workgroups."
 
  (let ((copy (wg-copy-session (or session (wg-current-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))
 

	
 
(defvar wg-buffer-workgroup nil
 
  "Associating each buffer with the workgroup.
 
In which it most recently appeared.")
 
(make-variable-buffer-local 'wg-buffer-workgroup)
 

	
 
(defun wg-workgroup-associated-buf-uids (&optional workgroup)
 
  "Return a new list containing all of WORKGROUP's associated buf uids."
 
  (awhen (or workgroup (wg-current-workgroup t))
 
    (append (wg-workgroup-strong-buf-uids it)
 
            (wg-workgroup-weak-buf-uids it))))
 

	
 
(defun wg-workgroup-associated-bufs (workgroup)
 
  "Return a new list containing all of WORKGROUP's associated bufs."
 
  (delete nil (mapcar 'wg-find-buf-by-uid
 
                      (wg-workgroup-associated-buf-uids workgroup))))
 

	
 
(defun wg-workgroup-associated-buffers (workgroup)
 
  "Return a new list containing all of WORKGROUP's associated buffer objects."
 
  (delete nil (mapcar 'wg-restore-buffer
 
                      (wg-workgroup-associated-bufs workgroup))))
 

	
 
(defun wg-workgroup-strongly-associate-bufobj (workgroup bufobj)
 
  "Strongly associate BUFOBJ with WORKGROUP."
 
  (let* ((uid (wg-bufobj-uid-or-add bufobj))
 
         (remp (wg-removef-p uid (wg-workgroup-weak-buf-uids workgroup)
 
                             :test 'string=))
 
         (addp (wg-pushnew-p uid (wg-workgroup-strong-buf-uids workgroup)
 
                             :test 'string=)))
 
    (when (or remp addp)
 
      (wg-flag-workgroup-modified workgroup)
 
      bufobj)))
 

	
 
(defun wg-workgroup-weakly-associate-bufobj (workgroup bufobj)
 
  "Weakly associate BUFOBJ with WORKGROUP."
 
  (let* ((uid (wg-bufobj-uid-or-add bufobj))
 
         (remp (wg-removef-p uid (wg-workgroup-strong-buf-uids workgroup)
 
                             :test 'string=))
 
         (addp (wg-pushnew-p uid (wg-workgroup-weak-buf-uids workgroup)
 
                             :test 'string=)))
 
    (when (or remp addp)
 
      (wg-flag-workgroup-modified workgroup)
 
      bufobj)))
 

	
 
(defun wg-workgroup-associate-bufobj (workgroup bufobj &optional weak)
 
  "Associate BUFOBJ with WORKGROUP.
 
WEAK non-nil means weakly associate it.  Otherwise strongly associate it."
 
  (if weak (wg-workgroup-weakly-associate-bufobj workgroup bufobj)
 
    (wg-workgroup-strongly-associate-bufobj workgroup bufobj)))
 

	
 
(defun wg-workgroup-dissociate-bufobj (workgroup bufobj)
 
  "Dissociate BUFOBJ from WORKGROUP."
 
  (let* ((uid (wg-bufobj-uid-or-add bufobj))
 
         (rem1p (wg-removef-p uid (wg-workgroup-strong-buf-uids workgroup)
 
                              :test 'string=))
 
         (rem2p (wg-removef-p uid (wg-workgroup-weak-buf-uids workgroup)
 
                              :test 'string=)))
 
    (when (or rem1p rem2p)
 
      (wg-flag-workgroup-modified workgroup)
 
      bufobj)))
 

	
 
(defun wg-workgroup-dissociate-weakly-associated-buffers (workgroup)
 
  "Dissociate from WORKGROUP all weakly associated buffers."
 
  (when (wg-workgroup-weak-buf-uids workgroup)
 
    (wg-flag-workgroup-modified workgroup)
 
    (setf (wg-workgroup-weak-buf-uids workgroup) nil)))
 

	
 
(defun wg-workgroup-dissociate-strongly-associated-buffers (workgroup)
 
  "Dissociate from WORKGROUP all strongly associated buffers."
 
  (when (wg-workgroup-strong-buf-uids workgroup)
 
    (wg-flag-workgroup-modified workgroup)
 
    (setf (wg-workgroup-strong-buf-uids workgroup) nil)))
 

	
 
(defun wg-workgroup-dissociate-all-buffers (workgroup)
 
  "Dissociate from WORKGROUP all its associated buffers."
 
  (wg-workgroup-dissociate-weakly-associated-buffers workgroup)
 
  (wg-workgroup-dissociate-strongly-associated-buffers workgroup))
 

	
 
(defun wg-auto-dissociate-buffer-hook ()
 
  "`kill-buffer-hook' that automatically dissociates buffers from workgroups."
 
  (when wg-dissociate-buffer-on-kill-buffer
 
    (awhen (wg-current-workgroup t)
 
      (wg-workgroup-dissociate-bufobj it (current-buffer)))))
 

	
 
(defun wg-associate-buffer-with-workgroup (&optional workgroup buffer weak)
 
  "Associate BUFFER with WORKGROUP.
 
WEAK non-nil means weakly associate BUFFER."
 
  (interactive (list nil nil current-prefix-arg))
 
  (let* ((workgroup (wg-get-workgroup workgroup))
 
         (buffer (or buffer (current-buffer)))
 
         (bname (buffer-name buffer))
 
         (wgname (wg-workgroup-name workgroup)))
 
    (if (wg-workgroup-associate-bufobj workgroup buffer weak)
 
        (wg-message "%s-associated %S with %s"
 
                    (if weak "Weakly" "Strongly") bname wgname)
 
      (wg-message "%S is already associated with %s" bname wgname))))
 

	
 
(defun wg-associate-visible-buffers-with-workgroup (&optional workgroup weak)
 
  "Associate all buffers visible in `selected-frame' with WORKGROUP.
 
WEAK non-nil means weakly associate them.  Otherwise strongly
 
associate them."
 
  (interactive (list nil current-prefix-arg))
 
  (let ((workgroup (wg-get-workgroup workgroup))
 
        (buffers (mapcar 'window-buffer (window-list))))
 
    (dolist (buffer buffers)
 
      (wg-workgroup-associate-bufobj workgroup buffer weak))
 
    (wg-fontified-message
 
      (:cmd (format "%s associated: " (if weak "Weakly" "Strongly")))
 
      (wg-display-internal 'wg-buffer-display buffers))))
 

	
 
(defun wg-dissociate-buffer-from-workgroup (&optional workgroup buffer)
 
  "Dissociate BUFFER from WORKGROUP."
 
  (interactive (list nil nil))
 
  (let ((workgroup (wg-get-workgroup workgroup))
 
        (buffer (or buffer (current-buffer))))
 
    (wg-message
 
     (if (wg-workgroup-dissociate-bufobj workgroup buffer)
 
         "Dissociated %S from %s" "%S isn't associated with %s")
0 comments (0 inline, 0 general)