/[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.1.1.1 - (hide annotations) (vendor branch)
Mon Apr 25 19:16:08 2011 UTC (2 years, 11 months ago) by rklochkov
Branch: slavsoft
CVS Tags: initial
Changes since 1.1: +0 -0 lines

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

  ViewVC Help
Powered by ViewVC 1.1.5