File: init.jl

package info (click to toggle)
sawfish 1%3A1.3.5.2-2
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 11,636 kB
  • ctags: 1,327
  • sloc: lisp: 22,765; ansic: 15,810; sh: 10,203; makefile: 675; perl: 19
file content (199 lines) | stat: -rw-r--r-- 6,504 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
;; sm-init.jl -- session manager code loaded on startup
;; $Id: init.jl,v 1.21 2003/08/15 08:09:30 jsh Exp $

;; Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>

;; This file is part of sawmill.

;; sawmill 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.

;; sawmill 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 sawmill; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

(define-structure sawfish.wm.session.init

    (export sm-find-file
	    sm-add-saved-properties
	    sm-add-restored-properties
	    sm-get-window-prop
	    sm-save-yourself
	    sm-init)

    (open rep
	  rep.regexp
	  rep.system
	  rep.io.files
	  rep.io.processes
	  sawfish.wm.misc
	  sawfish.wm.windows
	  sawfish.wm.session.util)

  (define sm-client-id nil
    "A string identifying the current session.")

  (define sm-prefix nil
    "A string used to uniquify the session file.")

  ;; this is before both the panel and gmc..?
  (defconst sm-gsm-priority 30)

  (defvar sm-save-directory "~/.sawfish/sessions")

  (defvar sm-saved-window-properties nil
    "List of window properties saved with the session.")

  (defvar sm-restored-window-properties nil
    "Extra window properties restored from the session.")

  (defvar sm-window-save-functions nil
    "List of functions called when the state of each window is saved. Each
function should return a list of alist elements that will be saved in
the state file.")

  (defvar sm-restore-window-hook nil
    "List of functions called when the state of a window is restored. Each is
called with args (WINDOW ALIST), where ALIST defines the state saved for
the window.")

  (defvar sm-after-restore-hook nil
    "Hook called after loading a saved session.")

  (defvar sm-sloppy-id-matching nil
    "When loading sessions, the algorithm that matches saved session data
to running clients requires that if one has a session id, then so must
the other, and they must match. Setting this variable to true turns
that feature off, allowing some broken clients to be session managed.")

;;; utilities

  ;; PREFIX may be null
  (define (sm-find-file id prefix)
    (if prefix
	(expand-file-name (format nil "%s-%s" prefix id) sm-save-directory)
      (expand-file-name id sm-save-directory)))

  (define (sm-add-saved-properties #!rest props)
    (mapc (lambda (p)
	    (or (memq p sm-saved-window-properties)
		(setq sm-saved-window-properties
		      (cons p sm-saved-window-properties))))
	  props))

  (define (sm-add-restored-properties #!rest props)
    (mapc (lambda (p)
	    (or (memq p sm-restored-window-properties)
		(setq sm-restored-window-properties
		      (cons p sm-restored-window-properties))))
	  props))

  ;; find PROP associated with W, or nil
  (define (sm-get-window-prop w prop)
    ;; first look in the window itself,
    (or (nth 2 (get-x-property w prop))
	;; else try the leader
	(let* (tem
	       (leader (cond ((and (setq tem (get-x-property
					      w 'WM_CLIENT_LEADER))
				   (eq (car tem) 'WINDOW)
				   (eq (nth 1 tem) 32)
				   (not (zerop (aref (nth 2 tem) 0))))
			      (aref (nth 2 tem) 0))
			     ((window-group-id w))
			     ((window-transient-p w)))))
	  (and leader (nth 2 (get-x-property leader prop))))))

  (define (make-unique-prefix) (number->string (current-utime) 36))

;; callback

  (define (sm-save-yourself)
    (require 'sawfish.wm.session.save)

    ;; We're not allowed to reuse the files used to save sessions.
    ;; So generate a new name each time.
    (setq sm-prefix (make-unique-prefix))

    (save-session (sm-find-file sm-client-id sm-prefix))
    (set-restart-command)
    (set-discard-command))

  ;; But the session manager doesn't delete files that we
  ;; leave around when we exit normally..

  (define (before-exit)
    (unless (or (eq (exit-type) 'session-quit)
		(not sm-client-id))
      (remove-sm-options)
      (let ((file (sm-find-file sm-client-id sm-prefix)))
	(when (file-exists-p file)
	  (delete-file file)))))

  (add-hook 'before-exit-hook before-exit)

;;; initialisation

  (define (remove-sm-options)
    ;; remove any sm options from saved-command-line-args
    (let loop ((args saved-command-line-args))
      (when (cdr args)
	(if (string-match "^(--sm-client-id|-clientId|--sm-prefix)" (cadr args))
	    (progn
	      (if (string-match "=" (cadr args))
		  (rplacd args (cddr args))
		(rplacd args (cdddr args)))
	      (loop args))
	  (loop (cdr args))))))

  (define (set-discard-command)
    (sm-set-property
     "DiscardCommand"
     (list "rm" "-f" (local-file-name (sm-find-file sm-client-id sm-prefix)))))

  (define (set-restart-command)
    (remove-sm-options)
    (if sm-prefix
	(rplacd saved-command-line-args (list* "--sm-client-id" sm-client-id
					       "--sm-prefix" sm-prefix
					       (cdr saved-command-line-args)))
      (rplacd saved-command-line-args (list* "--sm-client-id" sm-client-id
					     (cdr saved-command-line-args))))
    (sm-set-property "RestartCommand" saved-command-line-args))

  (define (sm-init id prefix)
    (when (setq sm-client-id (sm-connect id))

      ;; 1. setup all session manager properties
      (setq sm-prefix prefix)

      ;; XXX should I set this to SmRestartImmediately (2) instead
      ;; XXX of SmRestartIfRunning (0) ?
      (sm-set-property "RestartStyleHint" 0)

      (remove-sm-options)
      (sm-set-property "CloneCommand" saved-command-line-args)

      (set-restart-command)

      (sm-set-property "CurrentDirectory" (local-file-name default-directory))
      (sm-set-property "ProcessId" (format nil "%d" (process-id)))
      (sm-set-property "Program" (car saved-command-line-args))
      (sm-set-property "UserId" (user-login-name))

      ;; we need to start before gmc, otherwise it won't hint its icons
      (sm-set-property "_GSM_Priority" sm-gsm-priority)

      ;; 2. load the session if it exists
      (let ((file (sm-find-file sm-client-id sm-prefix)))
	(when (file-exists-p file)
	  (require 'sawfish.wm.session.load)
	  (load-session file)
	  (set-discard-command))))))