← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lisp/sawfish/ui/config.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/ui/config.jl
 
1
#| nokogiri-config.jl -- options that affect the configurator, not the wm
 
2
 
 
3
   $Id: config.jl,v 1.3 2000/09/01 20:02:21 john Exp $
 
4
 
 
5
   Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
 
6
 
 
7
   This file is part of sawfish.
 
8
 
 
9
   sawfish is free software; you can redistribute it and/or modify it
 
10
   under the terms of the GNU General Public License as published by
 
11
   the Free Software Foundation; either version 2, or (at your option)
 
12
   any later version.
 
13
 
 
14
   sawfish is distributed in the hope that it will be useful, but
 
15
   WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
17
   GNU General Public License for more details.
 
18
 
 
19
   You should have received a copy of the GNU General Public License
 
20
   along with sawfish; see the file COPYING.  If not, write to
 
21
   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
22
|#
 
23
 
 
24
(define-structure sawfish.ui.config
 
25
 
 
26
    (export define-config-item
 
27
            initialize-configs)
 
28
 
 
29
    (open rep
 
30
          rep.data.tables
 
31
          sawfish.ui.apply
 
32
          sawfish.ui.slot
 
33
          sawfish.ui.group)
 
34
 
 
35
  (define done-init nil)
 
36
 
 
37
  ;; list of (NAME . THUNK) -- configs to initialize at some point
 
38
  (define pending-configs '())
 
39
 
 
40
  (define (define-config-item name var thunk)
 
41
    (let ((callback (lambda ()
 
42
                      (set var (custom-symbol-value name))
 
43
                      (thunk))))
 
44
      (if done-init
 
45
          (let ((slot (or (get-slot name)
 
46
                          (error "Unknown slot: %s" name))))
 
47
            (define-change-handler slot callback)
 
48
            (callback))
 
49
        (setq pending-configs (cons (cons name callback) pending-configs)))))
 
50
 
 
51
  (define (initialize-configs)
 
52
    (unless done-init
 
53
      ;; ensure that config group has been loaded
 
54
      (fetch-group (get-group root-group))
 
55
      (mapc (lambda (x)
 
56
              (let ((slot (or (get-slot (car x))
 
57
                              (error "Unknown slot: %s" (car x)))))
 
58
                (define-change-handler slot (cdr x))
 
59
                ((cdr x))))
 
60
            pending-configs)
 
61
      (setq pending-configs '())
 
62
      (setq done-init t))))