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

L: <...> R: <...> in mouse doc line on Mac...

    Date: Thu, 5 Mar 1992 17:11 EST
    From: Curt Stevens <stevens@cs.colorado.edu>


    Is there some way to change the mouse doc line on the Mac from advertising
    choices as being available on Left and Right mouse clicks? I would like it
    to say Single: <...>, Double <...> or something like that. Thanks in
    advance for any help.

I guess I never really thought that this should be tailorable.  Oh well.

You can modify the following function if you would like.  Please be
aware that hacking this function won't work for CLIM 2.0.  Perhaps we
will come up with something that keeps you from having to do anything.

(in-package :clim)
(defun frame-document-highlighted-presentation-internal
       (frame presentation input-context window x y stream)
  (let ((shift-mask (window-shift-mask window)))
    (declare (fixnum shift-mask))
    (multiple-value-bind (left left-context middle middle-context right right-context)
	(find-applicable-translators-for-documentation presentation input-context
						       frame window x y shift-mask)
      (let* ((*print-length* 3)
	     (*print-level* 2)
	     (*print-circle* nil)
	     (*print-array* nil)
	     (*print-readably* nil)
	     (*print-pretty* nil))
	(flet ((document-translator (translator context-type button-name separator)
		 ;; Assumes 5 shifts and the reverse ordering of *POINTER-SHIFTS*
		 (let ((bit #o20)
		       (shift-name '("h-" "s-" "m-" "c-" "sh-")))
		   (declare (fixnum bit))
		   (dotimes (i 5)
		     #-excl (declare (ignore i))
		     (unless (zerop (logand bit shift-mask))
		       (write-string (car shift-name) stream))
		     (pop shift-name)
		     (setq bit (the fixnum (ash bit -1)))))
		 (write-string button-name stream)
		 (document-presentation-translator translator presentation context-type
						   frame nil window x y
						   :stream stream
						   :documentation-type :pointer)
		 (write-string separator stream)))
	  (declare (dynamic-extent #'document-translator))
	  (when left
	    (let ((button-name (cond ((and (eql left middle)
					   (eql left right))
				      (setq middle nil
					    right nil)
				      "L,M,R: ")
				     ((eql left middle) 
				      (setq middle nil)
				      "L,M: ")
				     (t "L: "))))
	      (document-translator left left-context button-name
				   (if (or middle right) "; " "."))))
	  (when middle
	    (let ((button-name (cond ((eql middle right)
				      (setq right nil)
				      "M,R: ")
				     (t "M: "))))
	      (document-translator middle middle-context button-name
				   (if right "; " "."))))
	  (when right
	    (document-translator right right-context "R: " "."))
	  ;; Return non-NIL if any pointer documentation was produced
	  (or left middle right))))))
References:
Main Index | Thread Index