[graphic-forms-cvs] r193 - in trunk: docs/manual src src/demos/textedit src/uitoolkit/system src/uitoolkit/widgets

junrue at common-lisp.net junrue at common-lisp.net
Thu Jul 13 06:38:03 UTC 2006


Author: junrue
Date: Thu Jul 13 02:38:01 2006
New Revision: 193

Modified:
   trunk/docs/manual/api.texinfo
   trunk/docs/manual/miscellaneous.texinfo
   trunk/src/demos/textedit/textedit-window.lisp
   trunk/src/packages.lisp
   trunk/src/uitoolkit/system/user32.lisp
   trunk/src/uitoolkit/widgets/edit.lisp
   trunk/src/uitoolkit/widgets/widget-generics.lisp
   trunk/src/uitoolkit/widgets/widget-utils.lisp
   trunk/src/uitoolkit/widgets/widget.lisp
Log:
implemented select-all and select-span for edit controls

Modified: trunk/docs/manual/api.texinfo
==============================================================================
--- trunk/docs/manual/api.texinfo	(original)
+++ trunk/docs/manual/api.texinfo	Thu Jul 13 02:38:01 2006
@@ -128,9 +128,9 @@
 @end defun
 
 @anchor{location}
- at deffn Macro location rect
+ at defmac location rect
 This macro returns the @var{location} slot of a @ref{rectangle}.
- at end deffn
+ at end defmac
 
 @deffn Function make-point :x :y :z
 This function creates a new @ref{point} object.
@@ -148,9 +148,9 @@
 This function creates a new @ref{span} object.
 @end deffn
 
- at deffn Macro size rect
+ at defmac size rect
 This macro returns the @code{size} slot of a @ref{rectangle}.
- at end deffn
+ at end defmac
 
 
 @node system conditions
@@ -1282,17 +1282,6 @@
 Returns T if the object is in the checked state; nil otherwise.
 @end deffn
 
- at deffn GenericFunction clear-selection self
-Sets the selection status of @code{self} (or @ref{item}s within
- at var{self}) to the @samp{unselected} state.
- at end deffn
-
- at deffn GenericFunction clear-selection-span self @ref{span}
-Sets the selection status of @ref{item}s within @var{self}, whose
-zero-based indices lie within @var{span}, to the @samp{unselected}
-state.
- at end deffn
-
 @deffn GenericFunction client-size self
 Returns a size object that describes the region of the object that can
 be drawn within or can display data.
@@ -1618,10 +1607,31 @@
 decorations are modified appropriately.
 @end deffn
 
+ at deffn GenericFunction select-all self flag
+Sets the entire content of @code{self} to the selected state if
+ at var{flag} is not @sc{nil} or to the unselected state if @sc{nil}.
+ at end deffn
+
+ at anchor{select-items}
+ at deffn GenericFunction select-items self indices flag
+Sets the @ref{item}s of @var{self}, each identified by a zero-based
+index from the @var{indices} @sc{list}, to the selected state if
+ at var{flag} is not @sc{nil} or to the unselected state if @sc{nil}.
+This is the function to use when not all of the items in question
+are contiguous.
+ at end deffn
+
+ at anchor{select-span}
+ at deffn GenericFunction select-span self span
+Sets the @ref{item}s of @var{self} that lie within @var{span} to
+the selected state. An existing selection's extent is modified
+to match the new @var{span}.
+ at end deffn
+
 @deffn GenericFunction selection-span self => @ref{span}
-Returns a span object describing the start and end of the selection
-within @var{self}. If there is no selection, this function returns
- at sc{nil}.
+Returns a span object describing the @var{start} and @var{end} of the
+selection within @var{self}. If there is no selection, this function
+returns @sc{nil}.
 @end deffn
 
 @anchor{show}
@@ -1701,30 +1711,37 @@
 @end deffn
 @end html
 
+ at defmac with-drawing-disabled (widget) &body body
+This macro executes @var{body} while updates of @var{widget} are
+disabled. Drawing operations attempted while @var{body}
+is executing will be queued so that when the lock is lifted
+ at var{widget} will be repainted.
+ at end defmac
+
 @anchor{with-file-dialog}
- at deffn Macro with-file-dialog (owner style paths &key default-extension filters initial-directory initial-filename text) &body body
+ at defmac with-file-dialog (owner style paths &key default-extension filters initial-directory initial-filename text) &body body
 This macro wraps the instantiation of a standard file open/save dialog
-and the subsequent retrieval of the user's file selections (supplied to @code{body}
-via @code{paths}). @xref{file-dialog}.
- at end deffn
+and the subsequent retrieval of the user's file selections (supplied to @var{body}
+via @var{paths}). @xref{file-dialog}.
+ at end defmac
 
 @anchor{with-font-dialog}
- at deffn Macro with-font-dialog (owner style font color &key gc initial-color initial-font) &body body
+ at defmac with-font-dialog (owner style font color &key gc initial-color initial-font) &body body
 This macro wraps the instantiation of a standard font dialog and binds
- at code{font} to a font object, and @code{color} to a @ref{color} object,
+ at var{font} to a font object, and @var{color} to a @ref{color} object,
 corresponding to the attributes selected by the user. If the user cancels
-the dialog, @code{font} will be @sc{nil}. In addition, @code{color} will also
+the dialog, @var{font} will be @sc{nil}. In addition, @var{color} will also
 be @sc{nil} if the dialog was created with the @code{:no-effects} style
 keyword. @xref{font-dialog}.
- at end deffn
+ at end defmac
 
 @anchor{with-graphics-context}
- at deffn Macro with-graphics-context (gc &optional thing) &body body
+ at defmac with-graphics-context (gc &optional thing) &body body
 This macro manages a @ref{graphics-context} representing the underlying
-device context of @code{thing}, which can be a @ref{widget} or an
- at ref{image}. If @code{thing} is not specified, then the macro creates
+device context of @var{thing}, which can be a @ref{widget} or an
+ at ref{image}. If @var{thing} is not specified, then the macro creates
 a graphics-context compatible with the @ref{display}.
- at end deffn
+ at end defmac
 
 
 @node layout functions

Modified: trunk/docs/manual/miscellaneous.texinfo
==============================================================================
--- trunk/docs/manual/miscellaneous.texinfo	(original)
+++ trunk/docs/manual/miscellaneous.texinfo	Thu Jul 13 02:38:01 2006
@@ -20,8 +20,8 @@
 
 This chapter documents terminology conventions observed in
 Graphic-Forms. These conventions should be interpreted with the
-traditional Common Lisp conventions in mind (such as
- at url{http://www.cliki.net/Naming%20conventions}). 
+traditional Common Lisp conventions in mind (some of which are
+documented here: @url{http://www.cliki.net/Naming%20conventions}). 
 
 @table @option
 
@@ -29,6 +29,41 @@
 For clearer identification of accessors, Graphic-Forms
 uses the suffix @samp{-of} whenever possible.
 
+ at item @samp{check} versus @samp{select}
+Admittedly, these two concepts are similar. They can be used as verbs
+and they both describe a state of being (@samp{checked} and
+ at samp{selected}). Yet they need to remain separate due to the fact
+that certain @ref{widget}s can exist in both states simultaneously,
+like a tri-state @ref{button}, or a table or tree whose items are
+checkboxes. The choice of which best describes an action or state
+amounts to a judgement call. In Graphic-Forms, the author chooses to
+use @samp{select} when a user gesture causes a widget to issue its
+primary notification event, such as a menu item or button being
+clicked. Hence, the verb @samp{select} aligns with the
+ at ref{event-select} function. at footnote{This topic gets muddier when
+edit controls come into the picture. Text in an edit control is
+selected despite there being no notification event; yet there is a
+notification (event-modify) then the user types text. I'm choosing to
+live with this inconsistency, partly because otherwise my
+categorization scheme seems to work well; and one can refer to the act
+of retrieving edit control selection, confident that developers will
+know this means obtaining highlighted text.} And so the
+ at samp{selection} state is associated with highlighting of an
+ at ref{item}. Graphic-Forms uses @samp{check} to identify an operation
+that flags or annotates a widget; the @samp{checked} state means being
+annotated.
+
+ at c @item @samp{clear} versus @samp{delete}
+ at c There is a distinction between @samp{clear} and @samp{delete} which
+ at c hinges on the difference between the primary content of a @ref{widget}
+ at c and secondary state information. An example of primary content is text
+ at c within an @ref{edit} @ref{control}. An example of secondary state
+ at c information (relevant to this topic at least) is the @ref{span} of
+ at c selected text in an edit control. With that in mind, Graphic-Forms
+ at c functions @samp{delete} content but @samp{clear} secondary state. This
+ at c choice aligns with the semantics of @sc{CL:delete}, including the
+ at c notion of that function being a destructive operation.
+
 @item function and method names
 Functions and methods should be named using a verb to suggest
 action. It may be tempting (especially for former Java programmers) to
@@ -39,25 +74,14 @@
 functions, the author suggests @samp{available-p}, such as
 @ref{undo-available-p}.
 
- at item @samp{clear} versus @samp{delete}
-Related to the @samp{function and method names} issues, there is
-a distinction between @samp{clear} and @samp{delete} which hinges on
-the difference between the primary content of a @ref{widget} and
-secondary state information. An example of primary content is text
-within an @ref{edit} @ref{control}. An example of secondary state
-information (relevant to this topic at least) is the @ref{span} of
-selected text in an edit control. With that in mind, Graphic-Forms
-functions @samp{delete} content but @samp{clear} secondary state. This
-choice is intended in part to align with the semantics of
- at sc{CL:delete}, including the notion of that function being a
-destructive operation.
-
 @item macro names
 Macros should be named consistent with established Common Lisp
 practice, with an exception being allowed for convenience wrappers
-around structure accessors (see @ref{location}). Otherwise, the
-temptation to define an unorthodox macro name is a symptom that maybe
-the code in question should not be a macro in the first place.
+around structure accessors (see for example
+ at ref{location}). Otherwise, the temptation to define an unorthodox
+macro name is a symptom that maybe the code in question should not be
+a macro in the first place. The rule of thumb is: if something can
+be a function, then let it be a function; in general, think carefully
+before creating a new macro.
 
 @end table
-

Modified: trunk/src/demos/textedit/textedit-window.lisp
==============================================================================
--- trunk/src/demos/textedit/textedit-window.lisp	(original)
+++ trunk/src/demos/textedit/textedit-window.lisp	Thu Jul 13 02:38:01 2006
@@ -96,7 +96,11 @@
     (gfw:enable (elt items 2) text-sel)
     (gfw:enable (elt items 3) text-sel)
     (gfw:enable (elt items 4) (gfw:text-for-pasting-p *textedit-control*))
-    (gfw:enable (elt items 5) text-sel)))
+    (gfw:enable (elt items 5) text-sel)
+    (gfw:enable (elt items 12) (or (null text-sel)
+                                   (> (gfs:span-start text-sel) 0)
+                                   (< (gfs:span-end text-sel)
+                                      (length (gfw:text *textedit-control*)))))))
 
 (defun textedit-edit-copy (disp item)
   (declare (ignore disp item))
@@ -114,6 +118,10 @@
   (declare (ignore disp item))
   (gfw:paste-text *textedit-control*))
 
+(defun textedit-edit-selall (disp item)
+  (declare (ignore disp item))
+  (gfw:select-all *textedit-control* t))
+
 (defun textedit-edit-undo (disp item)
   (declare (ignore disp item)))
 
@@ -234,7 +242,7 @@
                                           (:item "&Replace..."                                      :disabled)
                                           (:item "&Go To...")
                                           (:item "" :separator)
-                                          (:item "Select &All")))
+                                          (:item "Select &All"     :callback #'textedit-edit-selall)))
                                (:item "F&ormat"
                                 :submenu ((:item "&Font..."        :callback #'textedit-font)))
                                (:item "&Help"

Modified: trunk/src/packages.lisp
==============================================================================
--- trunk/src/packages.lisp	(original)
+++ trunk/src/packages.lisp	Thu Jul 13 02:38:01 2006
@@ -465,6 +465,7 @@
     #:scroll
     #:select
     #:select-all
+    #:select-items
     #:selected-p
     #:selection-count
     #:selection-index
@@ -502,6 +503,7 @@
     #:vertical-scrollbar
     #:visible-item-count
     #:visible-p
+    #:with-drawing-disabled
     #:with-file-dialog
     #:with-font-dialog
     #:with-graphics-context

Modified: trunk/src/uitoolkit/system/user32.lisp
==============================================================================
--- trunk/src/uitoolkit/system/user32.lisp	(original)
+++ trunk/src/uitoolkit/system/user32.lisp	Thu Jul 13 02:38:01 2006
@@ -497,6 +497,11 @@
   (fu-load UINT))
 
 (defcfun
+  ("LockWindowUpdate" lock-window-update)
+  BOOL
+  (hwnd HANDLE))
+
+(defcfun
   ("MapVirtualKeyA" map-virtual-key)
   UINT
   (code UINT)

Modified: trunk/src/uitoolkit/widgets/edit.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/edit.lisp	(original)
+++ trunk/src/uitoolkit/widgets/edit.lisp	Thu Jul 13 02:38:01 2006
@@ -130,6 +130,17 @@
                                       (* +vertical-edit-text-margin+ 2))))
     size))
 
+(defmethod select-all ((self edit) flag)
+  (if flag
+    (gfs::send-message (gfs:handle self) gfs::+em-setsel+ 0 (length (text self)))
+    (gfs::send-message (gfs:handle self) gfs::+em-setsel+ 0 0)))
+
+(defmethod select-span ((self edit) (span gfs:span))
+  (with-drawing-disabled (self)
+    (let ((hwnd (gfs:handle self)))
+      (gfs::send-message hwnd gfs::+em-setsel+ 1 1)
+      (gfs::send-message hwnd gfs::+em-setsel+ (gfs:span-start span) (gfs:span-end span)))))
+
 (defmethod selection-span ((self edit))
   (cffi:with-foreign-object (start-ptr :unsigned-long)
     (cffi:with-foreign-object (end-ptr :unsigned-long)

Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/widget-generics.lisp	(original)
+++ trunk/src/uitoolkit/widgets/widget-generics.lisp	Thu Jul 13 02:38:01 2006
@@ -84,12 +84,6 @@
 (defgeneric checked-p (self)
   (:documentation "Returns T if the object is in the checked state; nil otherwise."))
 
-(defgeneric clear-selection (self)
-  (:documentation "The set of selected items in self is made empty."))
-
-(defgeneric clear-selection-span (self span)
-  (:documentation "Sets a subset of self's current selection to the unselected state."))
-
 (defgeneric client-size (self)
   (:documentation "Returns a size object that describes the region of the object that can be drawn within or can display data."))
 
@@ -303,11 +297,14 @@
 (defgeneric scroll (self dest-pnt src-rect children-too)
   (:documentation "Scrolls a rectangular region (optionally including children) by copying the source area, then causing the uncovered area of the source to be marked as needing repainting."))
 
-(defgeneric select (self flag)
-  (:documentation "Set this object into (or take it out of) the selected state."))
-
 (defgeneric select-all (self flag)
-  (:documentation "Set all items of this object into (or take them out of) the selected state."))
+  (:documentation "Set all items of this object into (or out of) the selected state."))
+
+(defgeneric select-items (self indices flag)
+  (:documentation "Set items of self, each identified by a zero-based index, into (or out of) the selected state."))
+
+(defgeneric select-span (self span)
+  (:documentation "Set items of self that lie within span into the selected state."))
 
 (defgeneric selected-p (self)
   (:documentation "Returns T if the object is in the selected state; nil otherwise."))

Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/widget-utils.lisp	(original)
+++ trunk/src/uitoolkit/widgets/widget-utils.lisp	Thu Jul 13 02:38:01 2006
@@ -50,7 +50,16 @@
        (unwind-protect
            (progn
              , at body)
-         (gfs:dispose ,gc)))))
+         (gfs:dispose ,gc))))
+
+  (defmacro with-drawing-disabled ((widget) &body body)
+    `(unwind-protect
+         (progn
+           (unless (gfs:disposed-p ,widget)
+             (error 'gfs:disposed-error))
+           (gfs::lock-window-update (gfs:handle ,widget))
+           , at body)
+       (gfs::lock-window-update (cffi:null-pointer)))))
 
 (defun translate-and-dispatch (msg-ptr)
   (gfs::translate-message msg-ptr)

Modified: trunk/src/uitoolkit/widgets/widget.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/widget.lisp	(original)
+++ trunk/src/uitoolkit/widgets/widget.lisp	Thu Jul 13 02:38:01 2006
@@ -133,15 +133,6 @@
   (declare (ignore self))
   nil)
 
-(defmethod clear-selection :before ((self widget))
-  (if (gfs:disposed-p self)
-    (error 'gfs:disposed-error)))
-
-(defmethod clear-selection-span :before ((self widget) span)
-  (declare (ignore span))
-  (if (gfs:disposed-p self)
-    (error 'gfs:disposed-error)))
-
 (defmethod client-size :before ((self widget))
   (if (gfs:disposed-p self)
     (error 'gfs:disposed-error)))
@@ -296,7 +287,7 @@
 (defmethod print-object ((self widget) stream)
   (print-unreadable-object (self stream :type t)
     (format stream "handle: ~x " (gfs:handle self))
-    (format stream "dispatcher: ~a " (dispatcher self))))
+    (format stream "dispatcher: ~a~%" (dispatcher self))))
 
 (defmethod redo-available-p :before ((self widget))
   (if (gfs:disposed-p self)
@@ -321,12 +312,31 @@
 (defmethod resizable-p ((self widget))
   nil)
 
+(defmethod select :before ((self widget) flag)
+  (declare (ignore flag))
+  (if (gfs:disposed-p self)
+    (error 'gfs:disposed-error)))
+
+(defmethod select-all :before ((self widget) flag)
+  (declare (ignore flag))
+  (if (gfs:disposed-p self)
+    (error 'gfs:disposed-error)))
+
+(defmethod select-items :before ((self widget) items flag)
+  (declare (ignore items flag))
+  (if (gfs:disposed-p self)
+    (error 'gfs:disposed-error)))
+
+(defmethod select-span :before ((self widget) span)
+  (declare (ignore span))
+  (if (gfs:disposed-p self)
+    (error 'gfs:disposed-error)))
+
 (defmethod selected-p :before ((self widget))
   (if (gfs:disposed-p self)
     (error 'gfs:disposed-error)))
 
 (defmethod selected-p ((self widget))
-  (declare (ignore self))
   nil)
 
 (defmethod selection-span :before ((self widget))



More information about the Graphic-forms-cvs mailing list