Function: strokes-read-complex-stroke

strokes-read-complex-stroke is an autoloaded and byte-compiled function defined in strokes.el.gz.

Signature

(strokes-read-complex-stroke &optional PROMPT EVENT)

Documentation

Read a complex stroke (interactively) and return the stroke.

Optional PROMPT in minibuffer displays before and during stroke reading. Note that a complex stroke allows the user to pen-up and pen-down. This is implemented by allowing the user to paint with button 1 or button 2 and then complete the stroke with button 3. Optional EVENT is acceptable as the starting event of the stroke.

Source Code

;; Defined in /usr/src/emacs/lisp/strokes.el.gz
;;;###autoload
(defun strokes-read-complex-stroke (&optional prompt event)
  "Read a complex stroke (interactively) and return the stroke.
Optional PROMPT in minibuffer displays before and during stroke reading.
Note that a complex stroke allows the user to pen-up and pen-down.  This
is implemented by allowing the user to paint with button 1 or button 2 and
then complete the stroke with button 3.
Optional EVENT is acceptable as the starting event of the stroke."
  (save-excursion
    (save-window-excursion
      (set-window-configuration strokes-window-configuration)
      (let ((pix-locs nil)
	    (grid-locs nil))
	(if prompt
	    (while (not (strokes-button-press-event-p event))
	      (message "%s" prompt)
	      (setq event (read--potential-mouse-event))))
	(unwind-protect
	    (track-mouse
	      (or event (setq event (read--potential-mouse-event)))
	      (while (not (and (strokes-button-press-event-p event)
			       (eq 'mouse-3
				   (car (get (car event)
					     'event-symbol-elements)))))
		(while (not (strokes-button-release-event-p event))
		  (if (strokes-mouse-event-p event)
		      (let ((point (strokes-event-closest-point event)))
			(when point
			  (goto-char point)
			  (subst-char-in-region point (1+ point)
						?\s strokes-character))
			(push (cdr (mouse-pixel-position))
			      pix-locs)))
		  (setq event (read--potential-mouse-event)))
		(push strokes-lift pix-locs)
		(while (not (strokes-button-press-event-p event))
		  (setq event (read--potential-mouse-event))))
	      ;; ### KLUDGE! ### sit and wait
	      ;; for some useless event to
	      ;; happen to fix the minibuffer bug.
	      (while (not (strokes-button-release-event-p
                           (read--potential-mouse-event))))
	      (setq pix-locs (nreverse (cdr pix-locs))
		    grid-locs (strokes-renormalize-to-grid pix-locs))
	      (strokes-fill-stroke
	       (strokes-eliminate-consecutive-redundancies grid-locs)))
	  ;; protected
	  (when (equal (buffer-name) strokes-buffer-name)
	    (subst-char-in-region (point-min) (point-max)
				  strokes-character ?\s)
	    (goto-char (point-min))
	    (bury-buffer)))))))