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

junrue at common-lisp.net junrue at common-lisp.net
Fri Jul 7 06:34:12 UTC 2006


Author: junrue
Date: Fri Jul  7 02:34:12 2006
New Revision: 180

Modified:
   trunk/src/demos/textedit/textedit-window.lisp
   trunk/src/uitoolkit/system/system-constants.lisp
   trunk/src/uitoolkit/widgets/edit.lisp
   trunk/src/uitoolkit/widgets/event.lisp
Log:
some minor cleanup after a bunch of experimentation trying to use EditWordBreakProc to implement dynamically changing word wrap behavior in edit controls, which I have given up on for now

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 02:34:12 2006
@@ -49,18 +49,6 @@
   (setf *textedit-win* nil)
   (gfw:shutdown 0))
 
-(defun format-textedit (disp menu time)
-  (declare (ignore disp time))
-  (gfw:check (elt (gfw:items menu) 1)
-             (and *textedit-control* (gfw:auto-hscroll-p *textedit-control*))))
-
-(defun wordwrap-textedit (disp item time rect)
-  (declare (ignore disp item time rect))
-  (when *textedit-control*
-    (let ((flag (not (gfw:auto-hscroll-p *textedit-control*))))
-      ;(gfw:enable-auto-scrolling *textedit-control* flag t)
-      (gfw:enable-scrollbars *textedit-control* flag t))))
-
 (defclass textedit-win-events (gfw:event-dispatcher) ())
 
 (defmethod gfw:event-close ((disp textedit-win-events) window time)
@@ -162,9 +150,8 @@
                                           (:item "&Go To...")
                                           (:item "" :separator)
                                           (:item "Select &All")))
-                               (:item "F&ormat"                    :callback #'format-textedit
-                                :submenu ((:item "&Font...")
-                                          (:item "&Word Wrap"      :callback #'wordwrap-textedit)))
+                               (:item "F&ormat"
+                                :submenu ((:item "&Font...")))
                                (:item "&Help"
                                 :submenu ((:item "&About TextEdit" :callback #'about-textedit)))))))
     (setf *textedit-win* (make-instance 'gfw:top-level :dispatcher (make-instance 'textedit-win-events)
@@ -172,8 +159,7 @@
                                                        :style '(:frame)))
     (setf *textedit-control* (make-instance 'gfw:edit :parent *textedit-win*
                                                       :style '(:multi-line
-                                                               :auto-hscroll :auto-vscroll
-                                                               :horizontal-scrollbar
+                                                               :auto-vscroll
                                                                :vertical-scrollbar
                                                                :want-return)))
     (setf (gfw:menu-bar *textedit-win*) menubar)

Modified: trunk/src/uitoolkit/system/system-constants.lisp
==============================================================================
--- trunk/src/uitoolkit/system/system-constants.lisp	(original)
+++ trunk/src/uitoolkit/system/system-constants.lisp	Fri Jul  7 02:34:12 2006
@@ -889,6 +889,10 @@
 (defconstant +user-timer-maximum+      #x7FFFFFFF)
 (defconstant +user-timer-minimum+      #x0000000A)
 
+(defconstant +wb-left+                          0)
+(defconstant +wb-right+                         1)
+(defconstant +wb-isdelimiter+                   2)
+
 (defconstant +wm-create+                   #x0001)
 (defconstant +wm-destroy+                  #x0002)
 (defconstant +wm-move+                     #x0003)

Modified: trunk/src/uitoolkit/widgets/edit.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/edit.lisp	(original)
+++ trunk/src/uitoolkit/widgets/edit.lisp	Fri Jul  7 02:34:12 2006
@@ -74,10 +74,6 @@
       (setf std-flags (logior std-flags gfs::+es-autohscroll+)))
     (values std-flags (if (find :no-border style) 0 gfs::+ws-ex-clientedge+))))
 
-(defmethod enable-auto-scrolling ((self edit) horizontal vertical)
-  (declare (ignore horizontal vertical))
-  (error 'gfs:toolkit-error :detail "not yet implemented"))
-
 (defmethod enable-scrollbars ((self edit) horizontal vertical)
   (let ((bits (gfs::get-window-long (gfs:handle self) gfs::+gwl-style+)))
     (if horizontal
@@ -99,7 +95,9 @@
                                ex-style
                                (increment-widget-id (thread-context)))))
       (setf (slot-value self 'gfs:handle) hwnd)))
-  (init-control self))
+  (init-control self)
+  (if (find :auto-hscroll (style-of self))
+    (replace-edit-wordbreak-func self)))
 
 (defmethod line-count ((self edit))
   (if (gfs:disposed-p self)

Modified: trunk/src/uitoolkit/widgets/event.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event.lisp	(original)
+++ trunk/src/uitoolkit/widgets/event.lisp	Fri Jul  7 02:34:12 2006
@@ -114,8 +114,7 @@
 (defun subclass-wndproc (hwnd)
   (if (zerop (gfs::set-window-long hwnd
                                    gfs::+gwlp-wndproc+
-                                   (cffi:pointer-address
-                                   (cffi:get-callback 'subclassing_wndproc))))
+                                   (cffi:pointer-address (cffi:get-callback 'subclassing_wndproc))))
     (error 'gfs:win32-error :detail "set-window-long failed")))
 
 (defun dispatch-notification (widget wparam-hi)



More information about the Graphic-forms-cvs mailing list