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

  ViewVC Help
Powered by ViewVC 1.1.5