[graphic-forms-cvs] r185 - in trunk: . src/demos/textedit
junrue at common-lisp.net
junrue at common-lisp.net
Sat Jul 8 19:43:22 UTC 2006
Author: junrue
Date: Sat Jul 8 15:43:21 2006
New Revision: 185
Modified:
trunk/graphic-forms-tests.asd
trunk/src/demos/textedit/textedit-document.lisp
trunk/src/demos/textedit/textedit-window.lisp
Log:
implemented basic text file I/O
Modified: trunk/graphic-forms-tests.asd
==============================================================================
--- trunk/graphic-forms-tests.asd (original)
+++ trunk/graphic-forms-tests.asd Sat Jul 8 15:43:21 2006
@@ -60,6 +60,7 @@
((:module "demos"
:components
((:module "textedit"
+ :serial t
:components
((:file "textedit-document")
(:file "textedit-window")))
Modified: trunk/src/demos/textedit/textedit-document.lisp
==============================================================================
--- trunk/src/demos/textedit/textedit-document.lisp (original)
+++ trunk/src/demos/textedit/textedit-document.lisp Sat Jul 8 15:43:21 2006
@@ -41,4 +41,24 @@
(content-modified
:cell :ephemeral
:accessor content-modified
+ :initform (cells:c-in nil))
+ (file-path
+ :accessor file-path
:initform (cells:c-in nil))))
+
+(defvar *textedit-model* (make-instance 'textedit-document))
+
+(defun load-textedit-doc (path)
+ (let ((buffer ""))
+ (with-open-file (input path)
+ (do ((line (read-line input nil)
+ (read-line input nil)))
+ ((null line))
+ (if (zerop (length line))
+ (setf buffer (concatenate 'string buffer (format nil "~c~c" #\Return #\Newline)))
+ (setf buffer (concatenate 'string buffer (format nil "~a~c~c" line #\Return #\Newline))))))
+ (setf (content-replaced *textedit-model*) buffer)))
+
+(defun save-textedit-doc (path buffer)
+ (with-open-file (output path :direction :output :if-exists :supersede)
+ (format output buffer)))
Modified: trunk/src/demos/textedit/textedit-window.lisp
==============================================================================
--- trunk/src/demos/textedit/textedit-window.lisp (original)
+++ trunk/src/demos/textedit/textedit-window.lisp Sat Jul 8 15:43:21 2006
@@ -33,41 +33,53 @@
(in-package :graphic-forms.uitoolkit.tests)
-(defvar *textedit-control* nil)
-(defvar *textedit-win* nil)
-(defvar *textedit-startup-dir* nil)
+(defvar *textedit-control* nil)
+(defvar *textedit-win* nil)
+(defvar *textedit-startup-dir* nil)
+
+(defvar *textedit-file-filters* '(("Text Files (*.txt)" . "*.txt")
+ ("All Files (*.*)" . "*.*")))
(defun manage-textedit-file-menu (disp menu time)
(declare (ignore disp time))
(gfw:enable (elt (gfw:items menu) 2) (gfw:text-modified-p *textedit-control*)))
-(defun new-textedit-doc (disp item time rect)
+(defun textedit-file-new (disp item time rect)
(declare (ignore disp item time rect))
(when *textedit-control*
(setf (gfw:text *textedit-control*) "")
- (setf (gfw:text-modified-p *textedit-control*) nil)))
+ (setf (gfw:text-modified-p *textedit-control*) nil)
+ (setf (file-path *textedit-model*) nil)))
-(defun open-textedit-doc (disp item time rect)
+(defun textedit-file-open (disp item time rect)
(declare (ignore disp item time rect))
(gfw:with-file-dialog (*textedit-win*
'(:open :add-to-recent :path-must-exist)
paths
- :filters '(("Text Files (*.txt)" . "*.txt")
- ("All Files (*.*)" . "*.*")))))
-
-(defun save-textedit-doc (disp item time rect)
- (declare (ignore disp item time rect)))
+ :filters *textedit-file-filters*)
+ (when paths
+ (load-textedit-doc (first paths))
+ (setf (file-path *textedit-model*) (namestring (first paths))))))
+
+(defun textedit-file-save (disp item time rect)
+ (if (file-path *textedit-model*)
+ (save-textedit-doc (file-path *textedit-model*) (gfw:text *textedit-control*))
+ (textedit-file-save-as disp item time rect))
+ (setf (gfw:text-modified-p *textedit-control*) nil))
-(defun save-as-textedit-doc (disp item time rect)
+(defun textedit-file-save-as (disp item time rect)
(declare (ignore disp item time rect))
(gfw:with-file-dialog (*textedit-win*
'(:save :add-to-recent)
paths
- :filters '(("Text Files (*.txt)" . "*.txt")
- ("All Files (*.*)" . "*.*"))
- :text "Save As")))
+ :filters *textedit-file-filters*
+ :text "Save As")
+ (when paths
+ (save-textedit-doc (first paths) (gfw:text *textedit-control*))
+ (setf (file-path *textedit-model*) (namestring (first paths)))
+ (setf (gfw:text-modified-p *textedit-control*) nil))))
-(defun quit-textedit (disp item time rect)
+(defun textedit-file-quit (disp item time rect)
(declare (ignore disp item time rect))
(setf *textedit-control* nil)
(gfs:dispose *textedit-win*)
@@ -85,7 +97,7 @@
(defmethod gfw:event-close ((disp textedit-win-events) window time)
(declare (ignore window time))
- (quit-textedit disp nil nil nil))
+ (textedit-file-quit disp nil nil nil))
(defmethod gfw:event-focus-gain ((self textedit-win-events) window time)
(declare (ignore window time))
@@ -162,18 +174,23 @@
(cells:defobserver content-modified ((self textedit-document)))
+(cells:defobserver file-path ((self textedit-document))
+ (if *textedit-win*
+ (setf (gfw:text *textedit-win*) (format nil "~s - GraphicForms TextEdit" (file-path self)))
+ (setf (gfw:text *textedit-win*) "new file - GraphicForms TextEdit")))
+
(defun textedit-startup ()
#+clisp
(setf *textedit-startup-dir* (ext:cd))
#+lispworks
(setf *textedit-startup-dir* (hcl:get-working-directory))
(let ((menubar (gfw:defmenu ((:item "&File" :callback #'manage-textedit-file-menu
- :submenu ((:item "&New" :callback #'new-textedit-doc)
- (:item "&Open..." :callback #'open-textedit-doc)
- (:item "&Save" :callback #'save-textedit-doc :disabled)
- (:item "Save &As..." :callback #'save-as-textedit-doc)
+ :submenu ((:item "&New" :callback #'textedit-file-new)
+ (:item "&Open..." :callback #'textedit-file-open)
+ (:item "&Save" :callback #'textedit-file-save :disabled)
+ (:item "Save &As..." :callback #'textedit-file-save-as)
(:item "" :separator)
- (:item "E&xit" :callback #'quit-textedit)))
+ (:item "E&xit" :callback #'textedit-file-quit)))
(:item "&Edit"
:submenu ((:item "&Undo")
(:item "" :separator)
@@ -202,6 +219,7 @@
:want-return)))
(setf (gfw:menu-bar *textedit-win*) menubar)
(setf (gfw:size *textedit-win*) (gfs:make-size :width 500 :height 500))
+ (setf (gfw:text *textedit-win*) "new file - GraphicForms TextEdit")
(gfw:show *textedit-win* t)))
(defun textedit ()
More information about the Graphic-forms-cvs
mailing list