← Back to branch summary

~ubuntu-branches/ubuntu/lucid/sawfish/lucid-updates

« back to all changes in this revision

Viewing changes to lisp/sawfish/wm/session/load.jl

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2002-01-20 17:42:28 UTC
  • Revision ID: james.westby@ubuntu.com-20020120174228-4q1ydztbkvfq1ht2
Tags: upstream-1.0.1.20020116
Import upstream version 1.0.1.20020116

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/sawfish/wm/session/load.jl
 
1
;; sm-load.jl -- session manager code to reload a saved session
 
2
;; $Id: load.jl,v 1.10 2001/01/29 01:34:37 jsh Exp $
 
3
 
 
4
;; Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
 
5
 
 
6
;; This file is part of sawmill.
 
7
 
 
8
;; sawmill is free software; you can redistribute it and/or modify it
 
9
;; under the terms of the GNU General Public License as published by
 
10
;; the Free Software Foundation; either version 2, or (at your option)
 
11
;; any later version.
 
12
 
 
13
;; sawmill is distributed in the hope that it will be useful, but
 
14
;; WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
16
;; GNU General Public License for more details.
 
17
 
 
18
;; You should have received a copy of the GNU General Public License
 
19
;; along with sawmill; see the file COPYING.  If not, write to
 
20
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
21
 
 
22
;; Commentary:
 
23
 
 
24
;; This currently assumes that load-session is called before any
 
25
;; windows are adopted. If this isn't the case apply-to-window
 
26
;; will need extra code to act on the restored state (which would
 
27
;; otherwise be done by functions in the add-window-hook)
 
28
 
 
29
(define-structure sawfish.wm.session.load
 
30
 
 
31
    (export load-session)
 
32
 
 
33
    (open rep
 
34
          rep.system
 
35
          rep.io.files
 
36
          sawfish.wm.windows
 
37
          sawfish.wm.misc
 
38
          sawfish.wm.session.init
 
39
          sawfish.wm.session.util)
 
40
 
 
41
  (define restored-session nil)
 
42
 
 
43
  (define (load-session filename)
 
44
    (setq restored-session nil)
 
45
    (when (file-exists-p filename)
 
46
      (let ((file (open-file filename 'read)))
 
47
        (when file
 
48
          (unwind-protect
 
49
              (condition-case nil
 
50
                  (while t
 
51
                    (setq restored-session (cons (read file)
 
52
                                                 restored-session)))
 
53
                (end-of-stream
 
54
                 (setq restored-session (nreverse restored-session))))
 
55
            (close-file file))
 
56
          (map-windows match-window)))))
 
57
 
 
58
  ;; Scan restored-session for window W
 
59
  (define (match-window w)
 
60
    (let ((item (catch 'found
 
61
                  (mapc (lambda (x)
 
62
                          (when (match-window-to-alist w x)
 
63
                            (throw 'found x)))
 
64
                        restored-session))))
 
65
      (when item
 
66
        (setq restored-session (delq item restored-session))
 
67
        (apply-to-window w item))))
 
68
 
 
69
  ;; Match window W to ALIST
 
70
  (define (match-window-to-alist w alist)
 
71
    (let ((client-id (sm-get-window-prop w 'SM_CLIENT_ID))
 
72
          (role (nth 2 (get-x-property w 'WM_WINDOW_ROLE)))
 
73
          (class (sm-get-window-prop w 'WM_CLASS))
 
74
          (command (sm-get-window-prop w 'WM_COMMAND)))
 
75
      (catch 'out
 
76
        (when (not (eq (not (cdr (assq 'client-id alist))) (not client-id)))
 
77
          ;; one has a client-id, the other doesn't -- no match
 
78
          (throw 'out nil))
 
79
 
 
80
        (cond (client-id
 
81
               (unless (string= client-id (cdr (assq 'client-id alist)))
 
82
                 ;; id's don't match
 
83
                 (throw 'out nil)))
 
84
              ;; no SM_CLIENT_ID, so try matching WM_COMMAND
 
85
              ((and command (cdr (assq 'command alist)))
 
86
               (unless (string= command (cdr (assq 'command alist)))
 
87
                 (throw 'out nil)))
 
88
              ;; no WM_COMMAND so no match
 
89
              (t
 
90
               (throw 'out nil)))
 
91
 
 
92
        (if (and role (cdr (assq 'role alist)))
 
93
            (unless (string= role (cdr (assq 'role alist)))
 
94
              (throw 'out nil))
 
95
          ;; no WM_WINDOW_ROLE, so try matching WM_CLASS
 
96
          (when (and class (cdr (assq 'class alist))
 
97
                     (not (string= class (cdr (assq 'class alist)))))
 
98
            (throw 'out nil)))
 
99
 
 
100
        ;; XXX match on WM_NAME and WM_CLIENT_MACHINE..?
 
101
 
 
102
        ;; if we got here it must be a match
 
103
        t)))
 
104
 
 
105
  ;; Apply saved state in ALIST to W. This assumes that the add window
 
106
  ;; hook hasn't been called yet
 
107
  (define (apply-to-window w alist)
 
108
    (let (tem)
 
109
      (when (setq tem (cdr (assq 'dimensions alist)))
 
110
        (resize-window-to w (car tem) (cdr tem)))
 
111
      (mapc (lambda (sym)
 
112
              (when (setq tem (cdr (assq sym alist)))
 
113
                (window-put w sym tem))) sm-saved-window-properties)
 
114
      (call-window-hook 'sm-restore-window-hook w (list alist))))
 
115
 
 
116
  (add-hook 'before-add-window-hook match-window))