From e0f91d4a006831141afe18ce4eec67d5fe473d45 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Thu, 19 Mar 2009 02:18:50 +0300 Subject: [PATCH] added demo-text-editor --- gtk/demo/text-editor.glade | 241 ++++++++++++++++++++++++++++++++++++++++++++ gtk/demo/text-editor.ui | 224 ++++++++++++++++++++++++++++++++++++++++ gtk/gtk.demo.lisp | 97 +++++++++++++++++- 3 files changed, 560 insertions(+), 2 deletions(-) create mode 100644 gtk/demo/text-editor.glade create mode 100644 gtk/demo/text-editor.ui diff --git a/gtk/demo/text-editor.glade b/gtk/demo/text-editor.glade new file mode 100644 index 0000000..cbdae12 --- /dev/null +++ b/gtk/demo/text-editor.glade @@ -0,0 +1,241 @@ + + + + + + Text Editor + GTK_WIN_POS_CENTER + 300 + 200 + accessories-text-editor + + + True + + + True + + + True + _File + True + + + True + + + True + gtk-new + True + True + + + + + + True + gtk-open + True + True + + + + + + True + gtk-save + True + True + + + + + + True + gtk-save-as + True + True + + + + + + True + + + + + True + gtk-quit + True + True + + + + + + + + + + True + _Edit + True + + + True + + + True + gtk-cut + True + True + + + + + + True + gtk-copy + True + True + + + + + + True + gtk-paste + True + True + + + + + + True + gtk-delete + True + True + + + + + + + + + + True + _View + True + + + + + True + _Help + True + + + True + + + True + gtk-about + True + True + + + + + + + + + + False + + + + + True + GTK_TOOLBAR_ICONS + + + True + New + gtk-new + + + + True + + + + + True + Open + gtk-open + + + + True + + + + + True + Save + gtk-save + + + + True + + + + + True + Save as + gtk-save-as + + + + + + False + 1 + + + + + True + True + GTK_POLICY_AUTOMATIC + GTK_POLICY_AUTOMATIC + + + True + True + + + + + 2 + + + + + True + 2 + + + False + 3 + + + + + + diff --git a/gtk/demo/text-editor.ui b/gtk/demo/text-editor.ui new file mode 100644 index 0000000..841b1d8 --- /dev/null +++ b/gtk/demo/text-editor.ui @@ -0,0 +1,224 @@ + + + + + + + + + menuitem1 + _File + + + + + gtk-new + imagemenuitem1 + + + + + + gtk-open + imagemenuitem2 + + + + + + gtk-save + imagemenuitem3 + + + + + + gtk-save-as + imagemenuitem4 + + + + + + gtk-quit + imagemenuitem5 + + + + + + menuitem2 + _Edit + + + + + gtk-cut + imagemenuitem6 + + + + + + gtk-copy + imagemenuitem7 + + + + + + gtk-paste + imagemenuitem8 + + + + + + gtk-delete + imagemenuitem9 + + + + + + menuitem3 + _View + + + + + menuitem4 + _Help + + + + + gtk-about + imagemenuitem10 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Text Editor + GTK_WIN_POS_CENTER + 300 + 200 + accessories-text-editor + + + True + + + True + + + False + + + + + True + GTK_TOOLBAR_ICONS + + + True + New + gtk-new + + + + True + + + + + True + Open + gtk-open + + + + True + + + + + True + Save + gtk-save + + + + True + + + + + True + Save as + gtk-save-as + + + + + + False + 1 + + + + + True + True + GTK_POLICY_AUTOMATIC + GTK_POLICY_AUTOMATIC + + + True + True + + + + + 2 + + + + + True + 2 + + + False + 3 + + + + + + diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp index 68e0a54..75f2bcd 100644 --- a/gtk/gtk.demo.lisp +++ b/gtk/gtk.demo.lisp @@ -21,7 +21,8 @@ #:test-notebook #:test-calendar #:test-box-child-property - #:test-builder)) + #:test-builder + #:demo-text-editor)) (in-package :gtk-demo) @@ -515,4 +516,96 @@ (g-signal-connect (builder-get-object builder "window1") "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit))) (status-bar-push (builder-get-object builder "statusbar1") "times" "0 times") (widget-show (builder-get-object builder "window1")) - (gtk-main))) \ No newline at end of file + (gtk-main))) + +(defun read-text-file (file-name) + (with-output-to-string (str) + (with-open-file (file file-name) + (loop + for line = (read-line file nil nil) + while line + do (fresh-line str) + do (write-string line str))))) + +(defun demo-text-editor () + (let* ((builder (aprog1 (make-instance 'builder) + (builder-add-from-file it (namestring (merge-pathnames "demo/text-editor.ui" *src-location*))))) + (window (builder-get-object builder "window1")) + (text-view (builder-get-object builder "textview1")) + (status-bar (builder-get-object builder "statusbar1")) + (file-name nil) + (modified-p t)) + (status-bar-push status-bar "filename" "Untitled *") + (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) + (setf file-name nil + modified-p t + (text-buffer-text (text-view-buffer text-view)) "") + (set-properties)) + (cb-open (&rest 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) + (dialog-add-button d "gtk-cancel" :cancel) + (when (eq :accept (dialog-run d)) + (setf file-name (file-chooser-filename d) + (text-buffer-text (text-view-buffer text-view)) (read-text-file file-name) + modified-p nil) + (set-properties)) + (object-destroy d))) + (save (&rest args) + (if file-name + (progn + (with-open-file (file file-name :direction :output :if-exists :supersede) + (write-string (text-buffer-text (text-view-buffer text-view)) file)) + (setf modified-p nil) + (set-properties)) + (save-as))) + (save-as (&rest 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) + (dialog-add-button d "gtk-cancel" :cancel) + (if (eq :accept (dialog-run d)) + (progn + (setf file-name (file-chooser-filename d)) + (object-destroy d) + (save)) + (object-destroy d)))) + (cut (&rest args) + (text-buffer-cut-clipboard (text-view-buffer text-view) (get-clipboard "CLIPBOARD"))) + (copy (&rest args) + (text-buffer-copy-clipboard (text-view-buffer text-view) (get-clipboard "CLIPBOARD"))) + (paste (&rest args) + (text-buffer-paste-clipboard (text-view-buffer text-view) (get-clipboard "CLIPBOARD"))) + (cb-delete (&rest 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) + (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) + :authors '("Kalyanov Dmitry") + :license "Public Domain" + :logo-icon-name "accessories-text-editor"))) + (dialog-run d) + (object-destroy d))) + (quit (&rest args) (object-destroy window))) + (builder-connect-signals-simple builder `(("new" ,#'new) + ("open" ,#'cb-open) + ("save" ,#'save) + ("save-as" ,#'save-as) + ("cut" ,#'cut) + ("copy" ,#'copy) + ("paste" ,#'paste) + ("delete" ,#'cb-delete) + ("about" ,#'about) + ("quit" ,#'quit))) + (g-signal-connect window "destroy" (lambda (w) (declare (ignore w)) (gtk-main-quit))) + (g-signal-connect (text-view-buffer text-view) "changed" (lambda (b) (declare (ignore b)) (setf modified-p t) (set-properties))) + (widget-show window) + (gtk-main)))) \ No newline at end of file -- 1.7.10.4