/[gtk-cffi]/gtk-cffi/examples/ex7.lisp
ViewVC logotype

Contents of /gtk-cffi/examples/ex7.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations)
Mon May 7 09:02:03 2012 UTC (23 months, 1 week ago) by rklochkov
Branch: MAIN
Changes since 1.3: +24 -23 lines
Added with-progress in extensions
Added GtkOrientable, GtkRange, GtkBuildable, & Cairo support in gdk (see examples/ex6)
Fixed all examples.
1 rklochkov 1.1 (asdf:oos 'asdf:load-op :gtk-cffi)
2     (declaim (optimize speed))
3 rklochkov 1.2 (defpackage #:ex7
4     (:use #:common-lisp #:gtk-cffi #:g-object-cffi))
5     (in-package #:ex7)
6    
7     (defvar *window*)
8     (defvar *cell-pix*)
9 rklochkov 1.1
10     (defun main ()
11     (gtk-init)
12     ;; (rc-parse-string "style \"my\" {
13     ;; GtkTreeView::even-row-color = \"#E7EDF6\"
14     ;; GtkTreeView::odd-row-color = \"#FBFBFB\"
15     ;; }
16     ;; widget \"*\" style \"my\"")
17    
18     (let ((window (make-instance 'window :width 400 :height 280)))
19     (setf (gsignal window :destroy) :gtk-main-quit)
20 rklochkov 1.2 (setf *window* window)
21 rklochkov 1.1
22     (let ((v-box (make-instance 'v-box))
23     (data '(("01-01-08" "Some event")
24     ("10-02-08" "Another event withe very long description.
25     Description of this event. And this description is very long")
26     ("15-02-08" "Чуть-чуть напишем по-русски"))))
27     (add window v-box)
28    
29     (let ((title (make-instance 'label :text "Use of GtkCellEditable")))
30     (setf (font title) "Times New Roman Italic 12"
31     (color title) "#0000ff"
32 rklochkov 1.3 (color title :type :bg) "#ff0000")
33 rklochkov 1.1 ;(setf (size-request title) '(-1 40))
34     (pack v-box title))
35    
36     (let* ((model (make-instance 'list-store :columns
37     '(:string :string)))
38     (frame (make-instance 'frame))
39     (view (make-instance 'tree-view :model model)))
40 rklochkov 1.3 (setf (color view :state :selected) "#ff0000")
41 rklochkov 1.1 (pack v-box frame :pack-fill nil :expand t)
42     (pack v-box (make-instance 'label) :pack-fill t :expand t)
43     (add frame view)
44     (let ((field-header '("Date" "Event")))
45     (loop :for col :from 0 :below (length field-header) :do
46     (let* ((cell-renderer (make-instance 'cell-renderer-text))
47     (column (make-instance 'tree-view-column
48     :title (nth col field-header);""
49     :cell cell-renderer
50     :text col)))
51     (let ((label (make-instance 'label
52     :text (nth col field-header))))
53     (setf (font label) "Arial")
54     ;(setf (color label) "#666666")
55     (setf (widget column) label) (show label))
56    
57     (when (= col 1)
58     (setf (property cell-renderer :editable) t)
59 rklochkov 1.2 (setf *cell-pix* (make-instance 'cell-renderer-pixbuf))
60 rklochkov 1.1 (pack column *cell-pix*)
61     (setf (property *cell-pix* :pixbuf)
62     (make-instance 'gdk-cffi:pixbuf
63     :file "list.png")))
64    
65     (setf (gsignal cell-renderer :edited)
66     (let ((%col col))
67     (lambda (cell path new-text)
68 rklochkov 1.2 (declare (ignore cell))
69 rklochkov 1.1 (path->iter model path)
70     (setf (model-values model
71     :col %col)
72     (list new-text)))))
73    
74     (append-column view column))))
75    
76     (setf
77     (gsignal view :button-press-event)
78     (lambda (view event)
79     (when (and (eq (gdk-cffi:get-slot event :type) :button-press)
80 rklochkov 1.2 (= (the integer (gdk-cffi:get-slot event :button)) 1))
81 rklochkov 1.1 (with-path-at-pos view
82     (round (gdk-cffi:get-slot event :x))
83     (round (gdk-cffi:get-slot event :y))
84     (on-click view %path))))
85     (gsignal view :cursor-changed)
86     (lambda (view)
87     (with-get-cursor-path view
88     (set-bold view (second %path)))))
89    
90     (setf (property view :enable-grid-lines) :both
91     (property view :rules-hint) t)
92     (loop :for row :below (length data) :do
93     (let ((values (nth row data)))
94     (append-values model values)))))
95     (show window :all t)
96     (gtk-main)))
97    
98     (defun set-bold (view column)
99     (format t "set ~A~%" column)
100     (loop :for col :in (columns view)
101 rklochkov 1.3 :for i :from 0 :to (length (columns view))
102 rklochkov 1.1 :do (progn
103     (setf (font (widget col))
104     (if (equal col column)
105     "Arial Bold" "Arial"))
106     (when (equal (column view i) column)
107     (setf (search-column view) i)))))
108    
109     (defun on-click (view path-list)
110 rklochkov 1.4 (when path-list
111     (destructuring-bind (path column x y) path-list
112     (declare (ignore y))
113     (let ((cell (get-cell-at column x)))
114     (format t "cell: ~A~%" cell)
115     (when (equal cell *cell-pix*)
116     (let ((dialog (make-instance 'dialog :title "Edit text"
117     :parent *window*
118     :buttons '((:gtk-ok :ok)
119     (:gtk-cancel :cancel)))))
120     (let ((text-view (make-instance 'text-view))
121     (iter (path->iter (model view) path)))
122     (setf (text (buffer text-view))
123     (car (model-values (model view) :columns '(1) :iter iter)))
124     (let ((top-area (content-area dialog)))
125     (pack top-area text-view :pack-fill t :expand t)
126     (show text-view))
127     (setf (window-position dialog) :center-on-parent)
128    
129     ;(pack top-area text-view :fill t :expand t))
130     (run dialog)
131     (setf (model-values (model view) :columns '(1) :iter iter)
132     (list (text (buffer text-view))))
133     (destroy dialog))))))))
134 rklochkov 1.1
135     (main)
136    
137    
138    

  ViewVC Help
Powered by ViewVC 1.1.5