Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 227 lines (197 sloc) 8.029 kb
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
1 ;; fdump.lisp -- Layout save and restore routines.
c81a732 restructure almost all the code in core.lisp into seperate files.
Shawn authored
2 ;; Copyright (C) 2007-2008 Jonathan Liles, Shawn Betts
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
3 ;;
4 ;; This file is part of stumpwm.
5 ;;
6 ;; stumpwm is free software; you can redistribute it and/or modify
7 ;; it under the terms of the GNU General Public License as published by
8 ;; the Free Software Foundation; either version 2, or (at your option)
9 ;; any later version.
10
11 ;; stumpwm is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;; GNU General Public License for more details.
15
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with this software; see the file COPYING. If not, write to
18 ;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
19 ;; Boston, MA 02111-1307 USA
20
21 ;; Commentary:
22
23 ;; Code:
24
25 (in-package #:stumpwm)
26
31fb2eb export all relevant fdump related symbols
Shawn authored
27 (export '(ddump
28 ddump-current
29 ddump-screens
30 dump-desktop-to-file
31 dump-group-to-file
32 dump-screen-to-file
33 fdump
34 fdump-current
35 fdump-height
36 fdump-number
37 fdump-width
38 fdump-windows
39 fdump-x
40 fdump-y
41 gdump
42 gdump-current
43 gdump-name
44 gdump-number
45 gdump-tree
46 place-existing-windows
47 restore
48 sdump
49 sdump-current
50 sdump-groups
51 sdump-number))
52
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
53 (defstruct fdump
54 number x y width height windows current)
55
56 ;; group dump
57 (defstruct gdump
58 number name tree current)
59
60 ;; screen dump
61 (defstruct sdump
62 number groups current)
63
64 ;; desktop dump
65 (defstruct ddump
66 screens current)
67
68 (defun dump-group (group &optional (window-dump-fn 'window-id))
69 (labels ((dump (f)
70 (make-fdump
71 :windows (mapcar window-dump-fn (frame-windows group f))
72 :current (and (frame-window f)
73 (funcall window-dump-fn (frame-window f)))
74 :number (frame-number f)
75 :x (frame-x f)
76 :y (frame-y f)
77 :width (frame-width f)
78 :height (frame-height f)))
79 (copy (tree)
80 (cond ((null tree) tree)
81 ((typep tree 'frame)
82 (dump tree))
83 (t
84 (mapcar #'copy tree)))))
85 (make-gdump
86 ;; we only use the name and number for screen and desktop restores
87 :number (group-number group)
88 :name (group-name group)
89 :tree (copy (tile-group-frame-tree group))
90 :current (frame-number (tile-group-current-frame group)))))
91
92 (defun dump-screen (screen)
93 (make-sdump :number (screen-id screen)
93bbd4e Merge branch 'master' into test-merge
Jonathan Moore Liles authored
94 :current (group-number (screen-current-group screen))
95 :groups (mapcar 'dump-group (sort-groups screen))))
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
96
97 (defun dump-desktop ()
98 (make-ddump :screens (mapcar 'dump-screen *screen-list*)
93bbd4e Merge branch 'master' into test-merge
Jonathan Moore Liles authored
99 :current (screen-id (current-screen))))
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
100
101 (defun dump-to-file (foo name)
102 (with-open-file (fp name :direction :output :if-exists :supersede)
103 (with-standard-io-syntax
104 (let ((*package* (find-package :stumpwm))
105 (*print-pretty* t))
dfb1716 Get interactive commands in fdump.lisp working.
Istvan Marko authored
106 (prin1 foo fp)))))
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
107
9c01f86 Fixed typo in dump-group-to-file, dump-screen-to-file and dump-deskto…
Morgan Veyret authored
108 (defcommand dump-group-to-file (file) ((:rest "Dump To File: "))
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
109 "Dumps the frames of the current group of the current screen to the named file."
110 (dump-to-file (dump-group (current-group)) file)
111 (message "Group dumped"))
112
9e238c5 Fix recursive aliasing in restore command introduced by 90348be...
Jonathan Moore Liles authored
113 (defcommand-alias dump-group dump-group-to-file)
7d47c28 deprecate define-stumpwm-command in favor of defcommand
Shawn authored
114
9c01f86 Fixed typo in dump-group-to-file, dump-screen-to-file and dump-deskto…
Morgan Veyret authored
115 (defcommand dump-screen-to-file (file) ((:rest "Dump To File: "))
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
116 "Dumps the frames of all groups of the current screen to the named file"
dfb1716 Get interactive commands in fdump.lisp working.
Istvan Marko authored
117 (dump-to-file (dump-screen (current-screen)) file)
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
118 (message "Screen dumped"))
119
7d47c28 deprecate define-stumpwm-command in favor of defcommand
Shawn authored
120 (defcommand-alias dump-screen dump-screen-to-file)
121
9c01f86 Fixed typo in dump-group-to-file, dump-screen-to-file and dump-deskto…
Morgan Veyret authored
122 (defcommand dump-desktop-to-file (file) ((:rest "Dump To File: "))
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
123 "Dumps the frames of all groups of all screens to the named file"
dfb1716 Get interactive commands in fdump.lisp working.
Istvan Marko authored
124 (dump-to-file (dump-desktop) file)
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
125 (message "Desktop dumped"))
126
7d47c28 deprecate define-stumpwm-command in favor of defcommand
Shawn authored
127 (defcommand-alias dump-desktop dump-desktop-to-file)
128
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
129
130 ;;;
131
132 (defun read-dump-from-file (file)
133 (with-open-file (fp file :direction :input)
134 (with-standard-io-syntax
135 (let ((*package* (find-package :stumpwm)))
136 (read fp)))))
137
138 (defun restore-group (group gdump &optional auto-populate (window-dump-fn 'window-id))
139 (let ((windows (group-windows group)))
140 (labels ((give-frame-a-window (f)
141 (unless (frame-window f)
142 (setf (frame-window f) (find f windows :key 'window-frame))))
143 (restore (fd)
144 (let ((f (make-frame
145 :number (fdump-number fd)
146 :x (fdump-x fd)
147 :y (fdump-y fd)
148 :width (fdump-width fd)
149 :height (fdump-height fd))))
150 ;; import matching windows
151 (if auto-populate
152 (choose-new-frame-window f group)
153 (progn
154 (dolist (w windows)
155 (when (equal (fdump-current fd) (funcall window-dump-fn w))
156 (setf (frame-window f) w))
157 (when (find (funcall window-dump-fn w) (fdump-windows fd) :test 'equal)
158 (setf (window-frame w) f)))))
159 (when (fdump-current fd)
160 (give-frame-a-window f))
161 f))
162 (copy (tree)
163 (cond ((null tree) tree)
164 ((typep tree 'fdump)
165 (restore tree))
166 (t
167 (mapcar #'copy tree)))))
168 ;; clear references to old frames
169 (dolist (w windows)
170 (setf (window-frame w) nil))
171 (setf (tile-group-frame-tree group) (copy (gdump-tree gdump))
172 (tile-group-current-frame group) (find (gdump-current gdump) (group-frames group) :key 'frame-number))
173 ;; give any windows still not in a frame a frame
174 (dolist (w windows)
175 (unless (window-frame w)
176 (setf (window-frame w) (tile-group-current-frame group))))
93bbd4e Merge branch 'master' into test-merge
Jonathan Moore Liles authored
177 ;; FIXME: if the current window was blank in the dump, this does not honour that.
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
178 (give-frame-a-window (tile-group-current-frame group))
179 ;; raise the curtains
180 (dolist (w windows)
181 (if (eq (frame-window (window-frame w)) w)
182 (unhide-window w)
183 (hide-window w)))
184 (sync-all-frame-windows group)
185 (focus-frame group (tile-group-current-frame group)))))
186
187 (defun restore-screen (screen sdump)
188 "Restore all frames in all groups of given screen. Create groups if
189 they don't already exist."
190 (dolist (gdump (sdump-groups sdump))
191 (restore-group (or (find-group screen (gdump-name gdump))
93bbd4e Merge branch 'master' into test-merge
Jonathan Moore Liles authored
192 ;; FIXME: if the group doesn't exist then
193 ;; windows won't be migrated from existing
194 ;; groups
195 (add-group screen (gdump-name gdump)))
196 gdump)))
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
197
198 (defun restore-desktop (ddump)
199 "Restore all frames, all groups, and all screens."
dfb1716 Get interactive commands in fdump.lisp working.
Istvan Marko authored
200 (dolist (sdump (ddump-screens ddump))
93bbd4e Merge branch 'master' into test-merge
Jonathan Moore Liles authored
201 (let ((screen (find (sdump-number sdump) *screen-list*
202 :key 'screen-id :test '=)))
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
203 (when screen
93bbd4e Merge branch 'master' into test-merge
Jonathan Moore Liles authored
204 (restore-screen screen sdump)))))
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
205
9e238c5 Fix recursive aliasing in restore command introduced by 90348be...
Jonathan Moore Liles authored
206 (defcommand restore-from-file (file) ((:rest "Restore From File: "))
207 "Restores screen, groups, or frames from named file, depending on file's contents."
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
208 (let ((dump (read-dump-from-file file)))
209 (typecase dump
210 (gdump
211 (restore-group (current-group) dump)
212 (message "Group restored."))
213 (sdump
214 (restore-screen (current-screen) dump)
215 (message "Screen restored."))
216 (ddump
217 (restore-desktop dump)
218 (message "Desktop restored."))
219 (t
220 (message "Don't know how to restore ~a" dump)))))
221
90348be make restore an alias to restore-from-file
Shawn authored
222 (defcommand-alias restore restore-from-file)
223
7d47c28 deprecate define-stumpwm-command in favor of defcommand
Shawn authored
224 (defcommand place-existing-windows () ()
236a89f allow commands to belong to a class and tag commands appropriately
Shawn authored
225 "Re-arrange existing windows according to placement rules."
776a041 @sabetts minor patching up of window placement code and improved frame dumping
sabetts authored
226 (sync-window-placement))
Something went wrong with that request. Please try again.