fdump.lisp

;; fdump.lisp -- Layout save and restore routines.
;; Copyright (C) 2007-2008 Jonathan Liles, Shawn Betts
;;
;;  This file is part of stumpwm.
;;
;; stumpwm 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 2, or (at your option)
;; any later version.

;; stumpwm 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 software; see the file COPYING.  If not, see
;; <http://www.gnu.org/licenses/>.

;; Commentary:

;; Code:

(in-package #:stumpwm)

(export '(ddump
          ddump-current
          ddump-screens
          dump-desktop-to-file
          dump-group-to-file
          dump-screen-to-file
          fdump
          fdump-current
          fdump-height
          fdump-number
          fdump-width
          fdump-windows
          fdump-x
          fdump-y
          gdump
          gdump-current
          gdump-name
          gdump-number
          gdump-tree
          place-existing-windows
          restore
          sdump
          sdump-current
          sdump-groups
          sdump-number))

(defstruct fdump
  number x y width height windows current)

;; group dump
(defstruct gdump
  number name tree current)

;; screen dump
(defstruct sdump
  number groups current)

;; desktop dump
(defstruct ddump
  screens current)

(defun dump-group (group &optional (window-dump-fn 'window-id))
  (labels ((dump (f)
             (make-fdump
              :windows (mapcar window-dump-fn (frame-windows group f))
              :current (and (frame-window f)
                            (funcall window-dump-fn (frame-window f)))
              :number (frame-number f)
              :x (frame-x f)
              :y (frame-y f)
              :width (frame-width f)
              :height (frame-height f)))
           (copy (tree)
             (cond ((null tree) tree)
                   ((typep tree 'frame)
                    (dump tree))
                   (t
                    (mapcar #'copy tree)))))
    (make-gdump
     ;; we only use the name and number for screen and desktop restores
     :number (group-number group)
     :name (group-name group)
     :tree (copy (tile-group-frame-tree group))
     :current (frame-number (tile-group-current-frame group)))))

(defun dump-screen (screen)
  (make-sdump :number (screen-id screen)
              :current (group-number (screen-current-group screen))
              :groups (mapcar 'dump-group (sort-groups screen))))

(defun dump-desktop ()
  (make-ddump :screens (mapcar 'dump-screen *screen-list*)
              :current (screen-id (current-screen))))

(defun dump-pathname (name)
  "Convert NAME to a pathname for dump data. If NAME is an absolute path, then it will
be used as is. Otherwise, defaults to writing to \"FILE.dump\" in the XDG_DATA_HOME 
location."
  (if (uiop:absolute-pathname-p name)
      name
      (merge-pathnames (ensure-directories-exist (uiop:xdg-data-home #p"stumpwm/"))
                       (make-pathname :type "dump"
                                      :name name))))

(defun dump-to-file (foo name)
  (with-open-file (fp (dump-pathname name)
                      :direction :output
                      :if-exists :supersede
                      :if-does-not-exist :create)
    (with-standard-io-syntax
      (let ((*package* (find-package :stumpwm))
            (*print-pretty* t))
        (prin1 foo fp)))))

(defcommand dump-group-to-file (file) ((:rest "Dump To File: "))
  "Dumps the frames of the current group of the current screen to the named file.
If FILE is an absolute path, then the dump will be read written there.
Otherwise, defaults to writing to \"FILE.dump\" in the XDG_DATA_HOME location."
  (dump-to-file (dump-group (current-group)) file)
  (message "Group dumped."))

(defcommand-alias dump-group dump-group-to-file)

(defcommand dump-screen-to-file (file) ((:rest "Dump To File: "))
  "Dumps the frames of all groups of the current screen to the named file.
If FILE is an absolute path, then the dump will be read written there.
Otherwise, defaults to writing to \"FILE.dump\" in the XDG_DATA_HOME location."
  (dump-to-file (dump-screen (current-screen)) file)
  (message "Screen dumped."))

(defcommand-alias dump-screen dump-screen-to-file)

(defcommand dump-desktop-to-file (file) ((:rest "Dump To File: "))
  "Dumps the frames of all groups of all screens to the named file.
If FILE is an absolute path, then the dump will be read written there.
Otherwise, defaults to writing to \"FILE.dump\" in the XDG_DATA_HOME location."
  (dump-to-file (dump-desktop) file)
  (message "Desktop dumped."))

(defcommand-alias dump-desktop dump-desktop-to-file)


;;;

(defun read-dump-from-file (file)
  (with-open-file (fp file :direction :input)
    (with-standard-io-syntax
      (let ((*package* (find-package :stumpwm)))
        (read fp)))))

(defun restore-group (group gdump &optional auto-populate (window-dump-fn 'window-id))
  (let ((windows (group-windows group)))
    (labels ((give-frame-a-window (f)
               (unless (frame-window f)
                 (setf (frame-window f) (find f windows :key 'window-frame))))
             (restore (fd)
               (let ((f (make-frame
                         :number (fdump-number fd)
                         :x (fdump-x fd)
                         :y (fdump-y fd)
                         :width (fdump-width fd)
                         :height (fdump-height fd))))
                 ;; import matching windows
                 (if auto-populate
                     (choose-new-frame-window f group)
                     (progn
                       (dolist (w windows)
                         (when (equal (fdump-current fd) (funcall window-dump-fn w))
                           (setf (frame-window f) w))
                         (when (find (funcall window-dump-fn w) (fdump-windows fd) :test 'equal)
                           (setf (window-frame w) f)))))
                 (when (fdump-current fd)
                   (give-frame-a-window f))
                 f))
             (copy (tree)
               (cond ((null tree) tree)
                     ((typep tree 'fdump)
                      (restore tree))
                     (t
                      (mapcar #'copy tree)))))
      ;; clear references to old frames
      (dolist (w windows)
        (setf (window-frame w) nil))
      (setf (tile-group-frame-tree group) (copy (gdump-tree gdump))
            (tile-group-current-frame group) (find (gdump-current gdump) (group-frames group) :key 'frame-number))
      ;; give any windows still not in a frame a frame
      (dolist (w windows)
        (unless (window-frame w)
          (setf (window-frame w) (tile-group-current-frame group))))
      ;; FIXME: if the current window was blank in the dump, this does not honour that.
      (give-frame-a-window (tile-group-current-frame group))
      ;; raise the curtains
      (dolist (w windows)
        (if (eq (frame-window (window-frame w)) w)
            (unhide-window w)
            (hide-window w)))
      (sync-all-frame-windows group)
      (focus-frame group (tile-group-current-frame group)))))

(defun restore-screen (screen sdump)
  "Restore all frames in all groups of given screen. Create groups if
 they don't already exist."
  (dolist (gdump (sdump-groups sdump))
    (restore-group (or (find-group screen (gdump-name gdump))
                       ;; FIXME: if the group doesn't exist then
                       ;; windows won't be migrated from existing
                       ;; groups
                       (add-group screen (gdump-name gdump)))
                   gdump)))

(defun restore-desktop (ddump)
  "Restore all frames, all groups, and all screens."
  (dolist (sdump (ddump-screens ddump))
    (let ((screen (find (sdump-number sdump) *screen-list*
                        :key 'screen-id :test '=)))
      (when screen
        (restore-screen screen sdump)))))

(defcommand restore-from-file (file) ((:rest "Restore From File: "))
  "Restores screen, groups, or frames from named file, depending on file's
contents. If FILE is an absolute path, then the dump will be read from there.
Otherwise, defaults to reading from \"FILE.dump\" in the XDG_DATA_HOME location."
  (let ((dump (read-dump-from-file
               (dump-pathname file))))
    (typecase dump
      (gdump
       (restore-group (current-group) dump)
       (message "Group restored."))
      (sdump
       (restore-screen (current-screen) dump)
       (message "Screen restored."))
      (ddump
       (restore-desktop dump)
       (message "Desktop restored."))
      (t
       (message "Don't know how to restore ~a." dump)))))

(defcommand-alias restore restore-from-file)

(defcommand place-existing-windows () ()
  "Re-arrange existing windows according to placement rules."
  (sync-window-placement))

(defcommand place-current-window () ()
  "Re-arrange current window according to placement rules."
  (sync-single-window-placement (current-screen) (current-window) t))