From eaf29af477d716c17e1cbd713a29dc1a15d98298 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Thu, 26 Mar 2009 23:19:55 +0300 Subject: [PATCH] gtk/gtk.demo: fixed compilation warnings in demo-text-editor, changed eval behavior to append the result --- gtk/demo/text-editor.glade | 2 +- gtk/demo/text-editor.ui | 2 +- gtk/gtk.demo.lisp | 30 ++++++++++++++++-------------- 3 files changed, 18 insertions(+), 16 deletions(-) diff --git a/gtk/demo/text-editor.glade b/gtk/demo/text-editor.glade index 2a2929f..f19a2e3 100644 --- a/gtk/demo/text-editor.glade +++ b/gtk/demo/text-editor.glade @@ -3,7 +3,7 @@ - Text Editor + Lisp IDE :) GTK_WIN_POS_CENTER 300 200 diff --git a/gtk/demo/text-editor.ui b/gtk/demo/text-editor.ui index 3200db5..a4dce67 100644 --- a/gtk/demo/text-editor.ui +++ b/gtk/demo/text-editor.ui @@ -124,7 +124,7 @@ - Text Editor + Lisp IDE :) GTK_WIN_POS_CENTER 300 200 diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp index be3a412..87d813f 100644 --- a/gtk/gtk.demo.lisp +++ b/gtk/gtk.demo.lisp @@ -539,12 +539,12 @@ (labels ((set-properties () (status-bar-pop status-bar "filename") (status-bar-push status-bar "filename" (format nil "~A~:[~; *~]" (or file-name "Untitled") modified-p))) - (new (&rest args) + (new (&rest args) (declare (ignore args)) (setf file-name nil modified-p t (text-buffer-text (text-view-buffer text-view)) "") (set-properties)) - (cb-open (&rest args) + (cb-open (&rest args) (declare (ignore args)) (let ((d (make-instance 'file-chooser-dialog :action :open :title "Open file"))) (when file-name (setf (file-chooser-filename d) file-name)) (dialog-add-button d "gtk-open" :accept) @@ -555,7 +555,7 @@ modified-p nil) (set-properties)) (object-destroy d))) - (save (&rest args) + (save (&rest args) (declare (ignore args)) (if file-name (progn (with-open-file (file file-name :direction :output :if-exists :supersede) @@ -563,7 +563,7 @@ (setf modified-p nil) (set-properties)) (save-as))) - (save-as (&rest args) + (save-as (&rest args) (declare (ignore args)) (let ((d (make-instance 'file-chooser-dialog :action :save :title "Save file"))) (when file-name (setf (file-chooser-filename d) file-name)) (dialog-add-button d "gtk-save" :accept) @@ -574,18 +574,18 @@ (object-destroy d) (save)) (object-destroy d)))) - (cut (&rest args) + (cut (&rest args) (declare (ignore args)) (text-buffer-cut-clipboard (text-view-buffer text-view) (get-clipboard "CLIPBOARD"))) - (copy (&rest args) + (copy (&rest args) (declare (ignore args)) (text-buffer-copy-clipboard (text-view-buffer text-view) (get-clipboard "CLIPBOARD"))) - (paste (&rest args) + (paste (&rest args) (declare (ignore args)) (text-buffer-paste-clipboard (text-view-buffer text-view) (get-clipboard "CLIPBOARD"))) - (cb-delete (&rest args) + (cb-delete (&rest args) (declare (ignore args)) (let ((buffer (text-view-buffer text-view))) (multiple-value-bind (i1 i2) (text-buffer-get-selection-bounds buffer) (when (and i1 i2) (text-buffer-delete buffer i1 i2))))) - (about (&rest args) + (about (&rest args) (declare (ignore args)) (let ((d (make-instance 'about-dialog :program-name "Lisp Gtk+ Binding Demo Text Editor" :version (format nil "0.0.0.1 ~A" #\GREEK_SMALL_LETTER_ALPHA) @@ -594,17 +594,19 @@ :logo-icon-name "accessories-text-editor"))) (dialog-run d) (object-destroy d))) - (quit (&rest args) (object-destroy window)) - (cb-eval (&rest args) + (quit (&rest args) (declare (ignore args)) (object-destroy window)) + (cb-eval (&rest args) (declare (ignore args)) (let ((buffer (text-view-buffer text-view))) (multiple-value-bind (i1 i2) (text-buffer-get-selection-bounds buffer) (when (and i1 i2) (with-gtk-message-error-handler (let* ((text (text-buffer-slice buffer i1 i2)) (value (eval (read-from-string text))) - (value-str (format nil "~A" value))) - (text-buffer-delete buffer i1 i2) - (text-buffer-insert buffer value-str)))))))) + (value-str (format nil "~A" value)) + (pos (max (text-iter-offset i1) (text-iter-offset i2)))) + (text-buffer-insert buffer " => " :position (text-buffer-get-iter-at-offset buffer pos)) + (incf pos (length " => ")) + (text-buffer-insert buffer value-str :position (text-buffer-get-iter-at-offset buffer pos))))))))) (builder-connect-signals-simple builder `(("new" ,#'new) ("open" ,#'cb-open) ("save" ,#'save) -- 1.7.10.4