Author: junrue Date: Fri Jul 7 18:37:45 2006 New Revision: 184

Added: trunk/src/demos/textedit/textedit-document.lisp Modified: trunk/docs/manual/api.texinfo trunk/graphic-forms-tests.asd trunk/src/demos/textedit/textedit-window.lisp trunk/src/packages.lisp trunk/src/uitoolkit/widgets/edit.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp trunk/src/uitoolkit/widgets/widget.lisp Log: defined text-modified-p generic function and implemented it for edit controls; added initial model definition for textedit demo

Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Fri Jul 7 18:37:45 2006 @@ -1316,6 +1316,15 @@ the custom control will be managed by a @ref{layout-manager}. @end deffn

+@anchor{text-modified-p} +@deffn GenericFunction text-modified-p self +Returns T if the text component of @code{self} has been modified by +the user; @sc{nil} otherwise. The corresponding @sc{setf} function +updates the dirty state flag. This function is not implemented for all +widgets, since in some cases there are multiple text components and in +other cases there is no text component at all. +@end deffn + @deffn GenericFunction update self Forces all outstanding paint requests for the object to be processed before this function returns.

Modified: trunk/graphic-forms-tests.asd ============================================================================== --- trunk/graphic-forms-tests.asd (original) +++ trunk/graphic-forms-tests.asd Fri Jul 7 18:37:45 2006 @@ -61,7 +61,8 @@ :components ((:module "textedit" :components - ((:file "textedit-window"))) + ((:file "textedit-document") + (:file "textedit-window"))) (:module "unblocked" :components ((:file "tiles")

Added: trunk/src/demos/textedit/textedit-document.lisp ============================================================================== --- (empty file) +++ trunk/src/demos/textedit/textedit-document.lisp Fri Jul 7 18:37:45 2006 @@ -0,0 +1,44 @@ +;;;; +;;;; textedit-document.lisp +;;;; +;;;; Copyright (C) 2006, Jack D. Unrue +;;;; All rights reserved. +;;;; +;;;; Redistribution and use in source and binary forms, with or without +;;;; modification, are permitted provided that the following conditions +;;;; are met: +;;;; +;;;; 1. Redistributions of source code must retain the above copyright +;;;; notice, this list of conditions and the following disclaimer. +;;;; +;;;; 2. Redistributions in binary form must reproduce the above copyright +;;;; notice, this list of conditions and the following disclaimer in the +;;;; documentation and/or other materials provided with the distribution. +;;;; +;;;; 3. Neither the names of the authors nor the names of its contributors +;;;; may be used to endorse or promote products derived from this software +;;;; without specific prior written permission. +;;;; +;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND ANY +;;;; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DIS- +;;;; CLAIMED. IN NO EVENT SHALL THE AUTHORS AND CONTRIBUTORS BE LIABLE FOR ANY +;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +;;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +;;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +;;;; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +;;;; + +(in-package :graphic-forms.uitoolkit.tests) + +(cells:defmodel textedit-document () + ((content-replaced + :cell :ephemeral + :accessor content-replaced + :initform (cells:c-in nil)) + (content-modified + :cell :ephemeral + :accessor content-modified + :initform (cells:c-in nil))))

Modified: trunk/src/demos/textedit/textedit-window.lisp ============================================================================== --- trunk/src/demos/textedit/textedit-window.lisp (original) +++ trunk/src/demos/textedit/textedit-window.lisp Fri Jul 7 18:37:45 2006 @@ -37,10 +37,35 @@ (defvar *textedit-win* nil) (defvar *textedit-startup-dir* nil)

+(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) (declare (ignore disp item time rect)) - (if *textedit-control* - (setf (gfw:text *textedit-control*) ""))) + (when *textedit-control* + (setf (gfw:text *textedit-control*) "") + (setf (gfw:text-modified-p *textedit-control*) nil))) + +(defun open-textedit-doc (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))) + +(defun save-as-textedit-doc (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")))

(defun quit-textedit (disp item time rect) (declare (ignore disp item time rect)) @@ -131,16 +156,22 @@ (gfw:center-on-owner dlg) (gfw:show dlg t)))

+(cells:defobserver content-replaced ((self textedit-document)) + (if *textedit-control* + (setf (gfw:text *textedit-control*) (content-replaced self)))) + +(cells:defobserver content-modified ((self textedit-document))) + (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" + (let ((menubar (gfw:defmenu ((:item "&File" :callback #'manage-textedit-file-menu :submenu ((:item "&New" :callback #'new-textedit-doc) - (:item "&Open...") - (:item "&Save") - (:item "Save &As...") + (:item "&Open..." :callback #'open-textedit-doc) + (:item "&Save" :callback #'save-textedit-doc :disabled) + (:item "Save &As..." :callback #'save-as-textedit-doc) (:item "" :separator) (:item "E&xit" :callback #'quit-textedit))) (:item "&Edit"

Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Fri Jul 7 18:37:45 2006 @@ -486,6 +486,7 @@ #:text-baseline #:text-height #:text-limit + #:text-modified-p #:thumb-size #:tooltip-text #:top-child-of

Modified: trunk/src/uitoolkit/widgets/edit.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/edit.lisp (original) +++ trunk/src/uitoolkit/widgets/edit.lisp Fri Jul 7 18:37:45 2006 @@ -126,3 +126,9 @@

(defmethod text-baseline ((self edit)) (widget-text-baseline self +vertical-edit-text-margin+)) + +(defmethod text-modified-p ((self edit)) + (/= (gfs::send-message (gfs:handle self) gfs::+em-getmodify+ 0 0) 0)) + +(defmethod (setf text-modified-p) (flag (self edit)) + (gfs::send-message (gfs:handle self) gfs::+em-setmodify+ (if flag 1 0) 0))

Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Fri Jul 7 18:37:45 2006 @@ -357,6 +357,9 @@ (defgeneric text-limit (self) (:documentation "Returns the number of characters that the object's text field is capable of holding."))

+(defgeneric text-modified-p (self) + (:documentation "Returns true if the text component has been modified; nil otherwise.")) + (defgeneric thumb-size (self) (:documentation "Returns an integer representing the width (or height) of this object's thumb."))

Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Fri Jul 7 18:37:45 2006 @@ -319,18 +319,27 @@ (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

+(defmethod (setf text-modified-p) :before (flag (self widget)) + (declare (ignore flag)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod text-modified-p :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + (defmethod update :before ((w widget)) (if (gfs:disposed-p w) (error 'gfs:disposed-error)))

-(defmethod update ((w widget)) - (let ((hwnd (gfs:handle w))) +(defmethod update ((self widget)) + (let ((hwnd (gfs:handle self))) (unless (gfs:null-handle-p hwnd) (gfs::update-window hwnd))))

-(defmethod visible-p :before ((w widget)) - (if (gfs:disposed-p w) +(defmethod visible-p :before ((self widget)) + (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

-(defmethod visible-p ((w widget)) - (not (zerop (gfs::is-window-visible (gfs:handle w))))) +(defmethod visible-p ((self widget)) + (not (zerop (gfs::is-window-visible (gfs:handle self)))))