CLIM mail archive
[Prev][Next][Index][Thread]

Re: changing the mouse-glyph

fwhite says:
>
>;; Here's how I set the mouse cursor in clim 1.1 under xlib
>
>(in-package 'clim-user)
>
>(defun WATCH-CURSOR ()
>  ;; Do  "xfd -fn cursor -center" to see other chars in the cursor font.
>  (xlib:create-glyph-cursor :source-font clim::*cursor-font* :source-char #x96
>			    :mask-font clim::*cursor-font* :mask-char #x97
>			    :foreground (xlib:make-color :red 0 :green 0 :blue 0)
>			    :background (xlib:make-color :red 1 :green 1 :blue 1)))
>
>(defun SET-WINDOW-CURSOR (window cursor)
>  ;; window is a clim window.
>  (setf (xlib:window-cursor (slot-value window 'clim::window)) cursor))
>
>-Fred
>

[ CLIM 1.1; Sparc 1+; Allegro 4.1 ]

I tried this.  Here's how I use it (this is all in the KE package):

(defvar *watch-cursor* nil
  "The watch cursor.")

;; The idea here is to set *watch-cursor* once and re-use it when necessary.
(defun make-watch-cursor ()
  (unless *watch-cursor*
    (setf *watch-cursor*
      (xlib:create-glyph-cursor :source-font clim::*cursor-font* 
				:source-char #x96
				:mask-font clim::*cursor-font*
				:mask-char #x97
				:foreground (xlib:make-color :red 0 
							     :green 0 
							     :blue 0)
				:background (xlib:make-color :red 1
							     :green 1
							     :blue 1)) ))
  *watch-cursor*)

(defmacro with-watch-cursor (&body body)
  "Execute body while displaying the watch cursor."
  `(unwind-protect
       (progn
	 (setf (xlib:window-cursor (slot-value *ke-root* 'clim::window))
	   (ke::make-watch-cursor))
	 ,@body)
     (setf (xlib:window-cursor (slot-value *ke-root* 'clim::window))
       :none))
  )

I call with-watch-cursor whenever I'm saving a large data structure.  I define
a QUIT command that checks to see if all the data is saved.  If not, it calls
a function which saves the data structure (both of these are in KE as well):

(clim:define-command (com-quit :command-table ke-cmds
			       :menu t)
    ()
  (let ((stream *standard-output*))
    (when
	(and he:*generic-hierarchy-modified-p*
	     (confirm stream 
		      "The generic hierarchy has not been saved.~%Do you ~
                       wish to save it?"))
      (save-GH))
    (when 
	(and te:*case-library-modified-p*
	     (confirm stream "The current case library has not been saved.~%~
                              Do you wish to save it?"))
      (let ((loaded (loaded-task clim:*application-frame*)) )
	(save-task loaded)) )
    (clim:frame-exit clim:*application-frame*)
    )
  )

(defun save-GH ()
  "Save the generic hierarchy."
  (with-watch-cursor ()
    (save-permanent-objects))
  (setq *generic-hierarchy-modified-p* nil)
  )

When this happens, I get the following error:

Error: Attempt to call KE:WITH-WATCH-CURSOR which is defined as a macro.

The only reason I can see this happening is because apply is being called on
com-quit which calls save-gh which uses with-watch-cursor.  Is this the
desired behavior?  If so, what can I do to make it work?

Here's the stack trace:
[1] USER(2): :zoom :all t
Evaluation stack:

   (EXCL::INTERNAL-INVOKE-DEBUGGER "Error" #<PROGRAM-ERROR @ #xd7a34e> T NIL
                                   ...)
   (ERROR PROGRAM-ERROR :FORMAT-CONTROL
          "Attempt to call ~s which is defined as a macro." :FORMAT-ARGUMENTS
          ...)
   (EXCL::ERROR-FROM-CODE 27 KE:WITH-WATCH-CURSOR)
   (EXCL::ER-GENERAL-ERROR-HANDLER-ONE 27 KE:WITH-WATCH-CURSOR)
 ->(KE:WITH-WATCH-CURSOR NIL T)
   (KE::SAVE-GH)
   (KE::COM-QUIT)
   (APPLY KE::COM-QUIT NIL)
   ((METHOD CLIM:EXECUTE-FRAME-COMMAND (CLIM:APPLICATION-FRAME T))
      #<KE:AROMA-KE @ #xcf014e> (KE::COM-QUIT))

... more older frames ...

Thanks for any help,
Randy
-- 
Randy A. Coulman                |       ARIES Laboratory
                                |       Department of Computational Science
coulman@cs.Usask.ca             |       University of Saskatchewan
                                |       Saskatoon, SK   S7N 0W0             


0,,
Main Index | Thread Index