← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lisp/sawfish/ui/widgets/frame-style.jl

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2005-02-23 16:16:46 UTC
  • mfrom: (1.2.1 upstream) (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050223161646-4id6qyw4h9lkvb0v
Tags: 1:1.3+cvs20050222-1
http://bugs.debian.org/295290
* New cvs release.
* Add an emacs initialisation script to load sawfish.el (Closes: #295290)
* Updated sawfish.el to 1.32

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/sawfish/ui/widgets/frame-style.jl
1
1
#| nokogiri-widgets/frame-style.jl -- theme chooser widget
2
2
 
3
 
   $Id: frame-style.jl,v 1.7 2000/11/27 18:13:51 jsh Exp $
 
3
   $Id: frame-style.jl,v 1.9 2003/01/12 20:30:49 jsh Exp $
4
4
 
5
5
   Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
6
6
 
24
24
(define-structure sawfish.ui.widgets.frame-style ()
25
25
 
26
26
    (open rep
27
 
          gui.gtk
 
27
          gui.gtk-2.gtk
28
28
          rep.regexp
29
29
          rep.io.files
 
30
          rep.io.timers
30
31
          sawfish.gtk.widget
31
32
          sawfish.ui.i18n)
32
33
 
36
37
          (hbox (gtk-hbox-new nil 0))
37
38
          (combo (gtk-combo-new))
38
39
          (doc-label (gtk-label-new doc))
39
 
          (readme-text (gtk-text-new))
 
40
          (readme-text-view (gtk-text-view-new))
40
41
          (readme-scroller (gtk-scrolled-window-new))
41
 
          (value (car options)))
 
42
          (value (car options))
 
43
          (last-value nil)
 
44
          (timer nil))
 
45
 
 
46
      (define (timer-callback)
 
47
        (setq timer nil)
 
48
        (setq value (intern (gtk-entry-get-text (gtk-combo-entry combo))))
 
49
        ;; ugh. the gtk2 combo seems pretty fucked; this
 
50
        ;; didn't used to be necessary
 
51
        (when (and (not (eq value last-value)) (memq value options))
 
52
          (setq last-value value)
 
53
          (update-readme value readme-text-view path)
 
54
          (call-callback changed-callback)))
42
55
 
43
56
      (gtk-box-set-spacing hbox box-spacing)
44
57
      (gtk-box-set-spacing vbox box-spacing)
45
 
      (gtk-container-add readme-scroller readme-text)
 
58
      (gtk-container-add readme-scroller readme-text-view)
46
59
      (gtk-box-pack-start hbox doc-label)
47
60
      (gtk-box-pack-start hbox combo t t)
48
61
      (gtk-box-pack-start vbox readme-scroller t t)
49
62
      (gtk-box-pack-start vbox hbox nil nil)
50
63
      (gtk-label-set-justify doc-label 'left)
51
 
      ;;(gtk-text-set-word-wrap readme-text 1)
52
 
      (gtk-editable-set-editable readme-text nil)
53
 
      (gtk-entry-set-editable (gtk-combo-entry combo) nil)
 
64
      ;;(gtk-text-view-set-wrap-mode readme-text-view 'word)
 
65
      (gtk-text-view-set-editable readme-text-view nil)
 
66
      (gtk-editable-set-editable (gtk-combo-entry combo) nil)
54
67
      (gtk-scrolled-window-set-policy readme-scroller 'automatic 'automatic)
55
68
 
56
69
      (gtk-combo-set-popdown-strings combo (mapcar symbol-name options))
57
70
      (when value
58
71
        (gtk-entry-set-text (gtk-combo-entry combo) (symbol-name value)))
59
72
 
60
 
      (gtk-signal-connect (gtk-combo-entry combo) "changed"
61
 
                          (lambda ()
62
 
                            (setq value (intern (gtk-entry-get-text
63
 
                                                 (gtk-combo-entry combo))))
64
 
                            (update-readme value readme-text path)
65
 
                            (call-callback changed-callback)))
 
73
      (g-signal-connect (gtk-combo-entry combo) "changed"
 
74
                        (lambda ()
 
75
                          (if timer
 
76
                              (set-timer timer)
 
77
                            (setq timer (make-timer timer-callback nil 200)))))
66
78
 
67
 
      (update-readme value readme-text path)
 
79
      (update-readme value readme-text-view path)
68
80
      (gtk-widget-show-all vbox)
69
81
 
70
82
      (lambda (op)
80
92
  (define-widget-type 'frame-style make-frame-style-item)
81
93
  (widget-accepts-doc-string 'frame-style)
82
94
 
83
 
  (define (gtk-text-set widget string)
84
 
    (gtk-text-set-point widget 0)
85
 
    (gtk-text-forward-delete widget (gtk-text-get-length widget))
86
 
    (gtk-text-insert widget nil nil nil string (length string))
87
 
    (gtk-text-set-point widget 0))
 
95
  (define (text-view-set view string)
 
96
    (let ((buffer (gtk-text-view-get-buffer view))
 
97
          (iter (gtk-text-iter-new)))
 
98
      (gtk-text-buffer-set-text buffer string (length string))
 
99
      (gtk-text-buffer-get-start-iter buffer iter)
 
100
      (gtk-text-buffer-place-cursor buffer iter)))
88
101
 
89
 
  (define (update-readme value text-widget theme-path)
 
102
  (define (update-readme value text-view theme-path)
90
103
    (catch 'out
91
104
      (let ((theme (symbol-name value)))
92
105
        (mapc (lambda (dir)
113
126
                                (setq text (get-output-stream-string text))
114
127
                                (when (string-match "\\s+$" text)
115
128
                                  (setq text (substring text 0 (match-start))))
116
 
                                (gtk-text-set text-widget text))
 
129
                                (text-view-set text-view text))
117
130
                            (close-file file)))
118
 
                      (gtk-text-set text-widget ""))
 
131
                      (text-view-set text-view ""))
119
132
                    (throw 'out t))))
120
133
              theme-path)
121
 
        (gtk-text-set text-widget "")))))
 
134
        (text-view-set text-view "")))))