[Openmcl-devel] Fwd: How does Hemlock ...
Gary Byers
gb at clozure.com
Mon Jan 30 17:32:25 PST 2012
If I understand your question correctly:
Just about all of the event processing that happens in a Hemlock-based
text view between a mouse-down event and the corresponding mouse-up
happens at the Cocoa level. (This includes managing the selection,
scrolling the view as necessary, and other stuff that's fairly
complicated and comes "for free" with the Cocoa text system.)
There are only a few places in this mouse-tracking loop
where CCL code is involved at all:
- we override the #/mouseDown:method on HEMLOCK-TEXTSTORAGE-TEXT-VIEW
and pass a #k"leftdown" event to Hemlock (among other things, this
cancels any incrememtal searching in progress) before calling the
next method.
- we override #/selectionRangeForProposedRange:granularity: so that
double-clicks at certain buffer positions will select the preceding
or following s-expression
- we override #/setSelectedRange:affinity:stillSelecting: to update
Hemlock's notion of the selection whenever Cocoa's notion needs to
be updated. (This can happen frequently during mouse dragging.)
My best guess is that this is what you're interested in.
These methods are defined in "ccl:cocoa-ide;coca-editor.lisp".
Hemlock commands (usually invoked via key events) can of course also
modify the selection; they call the superclass's
#/setSelectedRange:affinity:stillSelecting: method to notify the Cocoa
text system of such changes.
On Sat, 28 Jan 2012, Arthur Cater wrote:
>
>
> Begin forwarded message:
>
> From: Arthur Cater <arthur.cater at ucd.ie>
> Date: 28 January 2012 12:23:56 GMT
> To: Glen Foy <lisp at clairvaux.org>
> Subject: Re: [Openmcl-devel] How does Hemlock ...
>
> Thank you Glen for that help. I've adapted it for my use by using the
> buffer-plist instead of parameter *process-down-mouse-p* and instead
> of
> rebinding the #k"LeftDown". It works now for the single-line case but
> not
> for the multi-line case. I think my claim that the invocation happens
> after
> mouse-up was wrong, the result of my code switching attention to
> another
> buffer - the listener's - in order to be seen to do something.
>
> So my problems a,b,c seem fixed, but not d.
>
> I still don't understand how the buffer-point gets to be set in the
> first place,
> nor why what I was doing previously caused it to be set only
> belatedly.
> And I like to understand.
>
> Arthur
>
>
> On 27 Jan 2012, at 01:19, Glen Foy wrote:
>
> Arthur,
>
>
> This is ugly as sin, but it will respond to
> left-down-mouse, ?and it will read point after it has been
> set to the new click position. ?There may be a cleaner way
> to do this (surely there is), but I couldn't find it:
>
>
> -- Glen
>
>
> (defConstant *left-mouse-down* 65535)
>
> (defParameter *process-down-mouse-p* nil)
>
>
> ;;; Redefintion of a Hemlock method in cocoa-editor.lisp
>
> (defMethod hi::handle-hemlock-event :around ((view
> hi:hemlock-view) event)
>
> (ccl::with-autorelease-pool
>
> ????(call-next-method))
>
> (let ((keysym (when (typep event 'hi::key-event)
> (hi::key-event-keysym event))))
>
> ??(when (and (numberp keysym) (= keysym
> *left-mouse-down*))
>
> ????(setf *process-down-mouse-p* t))))
>
>
> (defmethod gui::compute-temporary-attributes :around
> ((self gui::hemlock-textstorage-text-view))
>
> (call-next-method)
>
> (when *process-down-mouse-p*
>
> ??(let* ((view (gui::hemlock-view self))
>
> ?????????(hi::*current-buffer* (hi::hemlock-view-buffer
> view))
>
> ?????????(point (hi::current-point))
>
> ?????????(line (when point (hi::mark-line point)))
>
> ?????????(pos (when point (hi::mark-charpos point))))
>
> ????(format t "~%~%line: ~S" line)
>
> ????(format t "~%pos: ~S" pos))
>
> ??(setq *process-down-mouse-p* nil)))
>
>
>
> On Jan 26, 2012, at 5:52 AM, Arthur Cater wrote:
>
>
> I'm looking for some help because I'm
> floundering in trying to program Hemlock.
>
> I'm using a MacBook Pro, OS 10.6.8, ClozureCL
> Version 1.7-r15184M ?(DarwinX8664)
>
>
> What I'm trying to do is write a format
> directive that gives a behaviour rather like
>
> hyperlinks when used on a customised Hemlock
> view: text should be highlighted
>
> (underlined and printed in red) and clicking
> on it should invoke the function of choice.
>
>
> I can get the red and underlining, and get a
> function invoked. But
>
>
> a) the invocation of the function happens on
> mouse-up rather than mouse-down
>
>
> b) the invocation does happen on
> mouse-downwhen in the minibuffer
>
>
> c) when there is just one line of text with no
> terminating newline, the current-point
>
> ?of the buffer seems to correspond to the
> previous mouse-down-up sequence
>
> ?rather than the current one
>
>
> d) when there are many lines of text with a
> terminating newline, the current-point
>
> ?stubbornly stays at buffer end.
>
>
>
> I have searched the Hemlock sources for
> various things, but I do not understand
>
> how a mouse-click gets to move the buffer's
> buffer-point. Please can somebody
>
> explain to me how that is done, or tell me
> where to look more carefully?
>
>
>
> Below, if anyone cares to look, is the code I
> have. It will create a hemlock view,
>
> if in the listener you type (hemlock::two) you
> will see a line of text with two words
>
> in red and underlined. Clicking on them - or
> elsewhere - causes informative messages
>
> to be written to the listener. ?If you close
> the window, make a new one with
>
> (hemlock::my) and (hemlock::twentytwo) you see
> many lines of text each with one
>
> word red and underlined. I must be doing
> something wrong :( and would gratefully
>
> receive advice.
>
>
> (I am aware of difficulties ahead, eg
> interaction with justification directives. I'm
>
> not too concerned with those at the moment
> because I'm trying to build a tool to
>
> help with examining datastructures in an
> application I'm building.)
>
>
> Thanks in advance for any help I get!
>
> Arthur
>
>
>
>
> (in-package hemlock)
>
>
> (defmacro do-objc-array ((itemvar arrayexpr)
> &body body)
>
> "Perform BODY with ITEMVAR bound to successive
> elements of the ObjC array which
>
> is value of ARRAYEXPR, while allowing for the
> possibility it is a null pointer."
>
> (let ((arrayvar (gensym)) (countvar (gensym))
> (indexvar (gensym)))
>
> ?`(let ((,arrayvar ,arrayexpr))
>
> ????(unless (ccl::%null-ptr-p ,arrayvar)
>
> ??????(let ((,countvar (#/count ,arrayvar)))
>
> ????????(dotimes (,indexvar ,countvar)
>
> ??????????(let ((,itemvar (#/objectAtIndex:
> ,arrayvar ,indexvar))) , at body)))))))
>
>
> (defmacro write-listener (msg &rest args)
>
> (let ((p (gensym)))
>
> ?`(let ((,p (find 'gui::cocoa-listener-process
> (ccl:all-processes) :key #'type-of)))
>
> ????(if ,p
>
> ??????(format
> (gui::cocoa-listener-process-output-stream ,p)
> ,msg , at args)))))
>
>
>
> (defmethod gui::compute-temporary-attributes
> ((self gui::hemlock-textstorage-text-view))
>
> nil)
>
>
> (defparameter *my* nil "Gets set to a
> hemlock-view")
>
>
> (defparameter *mystream* nil "Gets set to an
> output stream for the hemlock-view in *MY*")
>
>
> (defparameter *click-color* nil)
>
>
> (defparameter *underlinedict* nil "Gets set to
> a ns-mutable-dictionary")
>
>
> (defparameter *info* nil "Accumulates some
> debug info")
>
>
> (defun underlinedict nil "Makes or reuses a
> ns-mutable-dictionary"
>
> (or *underlinedict*
>
> ???(prog1
>
> ????(setf *underlinedict*
>
> ??????????(make-instance
> 'ns:ns-mutable-dictionary :with-capacity 2))
>
> ????(setf *click-color*
> (#/colorWithCalibratedRed:green:blue:alpha:
> ns:ns-color 1.0 0.2 0.2 1.0))
>
> ????(#/setObject:forKey: *underlinedict*
> (#/numberWithInt: ns:ns-number 1)
>
> ?????????????????????????#&NSUnderlineStyleAttributeName)
>
> ????(#/setObject:forKey: *underlinedict*
> *click-color*
>
> ?????????????????????????#&NSForegroundColorAttributeName))))
>
>
> (defcommand "Invoke Click Response" (p)
> "Responds to 'CLICKABLE' text by invoking its
> associated function."
>
> (declare (ignore p))
>
> ;(write-listener "Invoking...~%")
>
> (gui::execute-in-gui
>
> (lambda nil
>
> ??(gui::assume-cocoa-thread)
>
> ??(let* ((point (current-point))
>
> ?????????(line (mark-line point))
>
> ?????????(pos (mark-charpos point))
>
> ?????????(pchange (find pos (slot-value line
> 'hi::charprops-changes) :from-end t :test #'>=
> :key #'hi::charprops-change-index))
>
> ?????????(props (when pchange
> (hi::charprops-change-plist pchange))))
>
> ????(write-listener
> "point=~s~%line=~s~%pos=~s~%LastKeyEvent=~s~%"
> point line pos (last-key-event-typed))
>
> ????(when (and props (<= pos (+ (getf props
> :length) (hi::charprops-change-index
> pchange))))
>
> ??????(write-listener "props are ~s, fn is ~s,
> arg is ~s~%"
>
> ??????????????????????props (getf props
> :clickfunction) (getf props :argument)))))))
>
>
> (defun my ()
>
> (gui::execute-in-gui ??; Makes the view
>
> #'(lambda nil
>
> ????(setf hemlock::*my*
> (gui::find-or-make-hemlock-view nil))
>
> ????(let ((buffer (hemlock-view-buffer
> hemlock::*my*)))
>
> ??????(underlinedict)
>
> ??????(bind-key "Invoke Click Response"
> #k"LeftDown" :buffer buffer)
>
> ??????(setf *mystream*
> (hi:make-hemlock-output-stream
> (buffer-start-mark buffer) :none)) ))))
>
>
> (my)
>
>
> (defun open-hemlock-output-stream-p (stream)
>
> (and (typep stream
> 'hemlock::hemlock-output-stream)
>
> ????(slot-value stream 'hi::mark)
>
> ????t))
>
>
> ;---------------------------------------------------------------------------
> -----
>
> ; Redefine methods given in
> ccl:cocoa-ide;hemlock;src;streams.lisp
>
> ; to ensure that hemlock buffer modification
> is done in the proper thread
>
> ;---------------------------------------------------------------------------
> -----
>
>
> (defmethod hi::stream-write-char ((stream
> hi::hemlock-output-stream) char)
>
> (gui::execute-in-gui
>
> (lambda nil
>
> ??(gui::assume-cocoa-thread)
>
> ??(funcall (hi::old-lisp-stream-out stream)
> stream char))))
>
>
> (defmethod hi::stream-write-string ((stream
> hi::hemlock-output-stream) string
>
> ?????????????????????????????&optional
>
> ?????????????????????????????(start 0)
>
> ?????????????????????????????(end (length
> string)))
>
> (gui::execute-in-gui
>
> (lambda nil
>
> ??(gui::assume-cocoa-thread)
>
> ??(funcall (hi::old-lisp-stream-sout stream)
> stream string start end))))
>
>
> ;---------------------------------------------------------------------------
> -----
>
> ; The ~V/CLICKABLE/ format directive
>
> ; Consumes one or two arguments from the
> format args list
>
> ; The principal argument is something to be
> output to the stream.
>
> ; By default it is printed as if by PRINC
> (~A), but the colon modifier causes it
>
> ; to be printed as if by PRIN1 (~S).
>
> ; The prefix argument (corresponding to V)
> should be a function of one argument
>
> ; or a symbol naming one.
>
> ; - If the stream is a hemlock-output-stream
> that has not been closed, then the
>
> ; ??text produced for the principal argument
> will be mouse-sensitive. Clicking on
>
> ; ??it will cause the function to be invoked
> with the argument that was printed.
>
> ; - On other streams, the prefix argument will
> be consumed but ignored.
>
> ; - If the V prefix is omitted, then no
> function will be invoked by clicking.
>
> ;---------------------------------------------------------------------------
> -----
>
>
> (defun clickable (stream arg colon atsign
> &optional prefix)
>
> (declare (ignorable atsign))
>
> (cond
>
> ((open-hemlock-output-stream-p stream)
>
> ?(let* ((mark (hi:copy-mark (slot-value stream
> 'hi::mark) :temporary))
>
> ????????(markabsolute
> (hi::mark-absolute-position mark))
>
> ????????(line (slot-value mark 'hi::line))
>
> ????????(charprops (when prefix
> `(:font-underline :single :font-color
> ,*click-color*
>
> ??????????????????????????????????:clickfunction
> ,prefix ?:argument ,arg)))
>
> ????????(start (when charprops (slot-value
> mark 'hi::charpos)))
>
> ????????end)
>
> ???(if colon (prin1 arg stream) (princ arg
> stream))
>
> ???(when charprops
>
> ?????(let* ((length (-
> (hi::mark-absolute-position (slot-value stream
> 'hi::mark)) markabsolute))
>
> ????????????(doc (hi::buffer-document
> (line-buffer line)))
>
> ????????????(store (when doc (slot-value doc
> 'gui::textstorage))))
>
> ???????(setf end (slot-value (slot-value
> stream 'hi::mark) 'hi::charpos))
>
> ???????(setf *info* `(:start ,start :end
> ,end))
>
> ???????(hi::set-line-charprops line (list*
> :length length charprops) :start start :end
> end)
>
> ???????(when doc
>
> ?????????(do-objc-array (layout
> (#/layoutManagers store))
>
> ???????????(ns:with-ns-range (range
> markabsolute length)
>
> ?????????????(#/addTemporaryAttributes:forCharacterRange:
> layout (underlinedict) range))))
>
> ???????(gui::perform-edit-change-notification
>
> ????????store
>
> ????????(objc:\@selector
> #/noteHemlockAttrChangeAtPosition:length:)
>
> ????????markabsolute length 0)
>
> ???????(setf *info* `(:changes
> ,(hi::line-charprops-changes line)
> ,@*info*))))))
>
> (t (if colon (prin1 arg stream) (princ arg
> stream)))))
>
>
> (defun twentytwo nil
>
> (dotimes (k 22)
>
> ?(format *mystream*
>
> ?????????"Try ~v/hemlock::clickable/ out.~%"
> :that (format nil "~5,'xD" k))))
>
>
> (defun two nil
>
> (format *mystream*
>
> ???????"Try ~v/hemlock::clickable/ or
> ~v/hemlock::clickable/ now."
>
> ???????:first :one :second :two))
>
>
> _______________________________________________
>
> Openmcl-devel mailing list
>
> Openmcl-devel at clozure.com
>
> http://clozure.com/mailman/listinfo/openmcl-devel
>
>
>
>
>
>
More information about the Openmcl-devel
mailing list