🚀 go-pugleaf

In an article bp@mips.com (Boris Putanec) writes:
   I want things like double-click on word, triple-click to get the
   sentence, with the selection extending at the current selection unit.
   Use the selected text as a large insertion point, so one can select
   something, and then type the replacement text. Etc.



Wasn't exactly a flood of replies to this request, so here is a bit of
code that seems to work for me.  May have some bugs, but should at
least get people started.  I bind these functions to my left and right
mouse buttons, works pretty much like xterm selection.  I particularly
like selecting s-expressions in lisp mode!


--- cut here ---
;;; mouse-select.el
;;; revised to support word and sentence selection, triple click
;;; blk@mitre.org - Wed Sep 11 09:39:15 1991
;;; revised to support timed double clicks
;;; blk@mitre.org - Tue Jan 22 15:35:05 1991

(require 'button)
(require 'mouse)
(provide 'multi-click)


;;; This code installs a mouse-button handler which checks for multi-clicks.
;;; Each up-click is time-stamped, and a subsequent down-click within the
;;; delay interval increments the mouse::clicks counter.
;;; Functions bound to the mouse must check the click counter if they care.
;;; Functions recognizing multi-clicks must be progressive, since the
;;; function will be dispatched first as single click, then double, etc.
;;; The code could be modified to wait for the delay period to see if
;;; any more clicks are coming, but this burns CPU and is very nasty.
;;;
;;; This file includes functions to replace the selection mechanism,
;;; allowing word and line selection.  (mouse::align) extends the region
;;; along object boundaries, char/word/sentence/line/sexp.  There is also 
;;; a function which selects the boundary to use by checking the mode name:
;;;  char/word/sentence for text, char/word/sexp for lisp, etc.
;;; Modify (mouse::boundary) if you don't like this arrangement.
;;;
;;; Copyright MITRE corporation and Brian L. Kahn, Thu Sep 12 13:43:39 1991
;;; Permission granted for any and all use, provided proper citation of 
;;; author and corporation is included in source and/or object.


;;; initialization of mouse selection
;;; =================================

(defvar mouse::style (make-style) 
  "Style used by mouse::attribute")
(defvar mouse::attribute (reserve-attribute) 
  "Attribute for mouse::selection")
(defvar mouse::selection (make-button) 
  "Mouse selection button")

(set-style-foreground mouse::style (background))
(set-style-background mouse::style (foreground))
(set-style-underline mouse::style (background))
(set-attribute-style mouse::attribute mouse::style)
(set-button-attribute mouse::selection mouse::attribute)



;;; mouse handler with multiple clicks
;;; ==================================

(defconst mouse::interval 200
  "The number of milliseconds allowed between multi-clicks
   - interval is clocked between a down-click and previous up-click")
(defvar mouse::time-stamp (the-time)
  "The millisecond time of last upclick")
(defvar mouse::clicks 1
  "The number of mouse button clicks, normally one")

(defvar mouse::old-handler (car (resume-event 'button)) 
  "Previous mouse handler")


(defun mouse::multi-click-handler (type value scr)
  "Calls the old handler after checking for multiple clicks."
  ;; value is a 5-tuple of form (PRESS/RELEASE X Y BUTTON MOD-STATE)
  (if (car value) 
      ;; down-click - do timing checks
      (let ((elapsed (- (the-time) mouse::time-stamp)))
	(if (< elapsed mouse::interval) ; multi-click!
	    (setq mouse::clicks (1+ mouse::clicks))
	  (setq mouse::clicks 1))
	)
    ;; up-click - update time stamp
    (setq mouse::time-stamp (the-time))
    )
  ;; handle as a normal mouse button event
  (funcall mouse::old-handler type value scr)
  )

(push-event 'button 'mouse::multi-click-handler)
(setq epoch::buttons-modify-buffer nil)




;;; selection
;;; =========

(defun mouse::start-select (&optional args)
  "Move mouse and cancel selection??"
  ;; args means mouse press
  (if args (mouse::set-point args))
  (let ((boundary (mouse::boundary mouse::clicks)))
    ;; store selection boundary in data field, for extending selection
    (set-button-data mouse::selection boundary)
    (if (null boundary)
	;; unselect
	(move-button mouse::selection (point) (point) (current-buffer))
      ;; do word/sentence expansion
      (mouse::align (point) (point) boundary)
      (move-button mouse::selection (mark) (point) (current-buffer))
      )
    (redisplay-screen)
    ))



(defun mouse::extend-select (&optional args)
  "Reset near end of selection to mouse pointer or point; adjust region."
  ;; set point if mouse button clicked
  (if args (mouse::set-point args))
  ;; start selection if none in this buffer
  (if (not (eq (current-buffer) (button-buffer mouse::selection)))
      (mouse::start-select)
    (let* ((start (button-start mouse::selection))
	   (end (button-end mouse::selection))
	   (center (/ (+ start end) 2))
	   )
      ;; extending which end?
      (if (> (point) center)
	  (set-mark start)
	(set-mark end))
      ;; check for word/line/etc expansion
      (let ((boundary (button-data mouse::selection)))
	(if boundary (mouse::align (mark) (point) boundary)))
      ;; reposition the selection
      (move-button mouse::selection (mark) (point) (current-buffer))
      (redisplay-screen)
      )))

    

(defun mouse::end-select (args)
  "Selection to cut buffer."
  (let ((text (button-text mouse::selection)))
    (if (not (equal "" text))
	(epoch::store-cut-buffer text))
    ))



(defun mouse::align (from to boundary)
  "Align the region FROM - TO along BOUNDARY; 
   word, line, sent, sexp;
   sets point and mark; returns new region as an apair."
  ;; ensure order of from, to
  (condition-case nil
      (progn
	;; do both ends
	(goto-char (min from to))
	(cond
	 ;; nil and 'char do nothing
	 ((null boundary))
	 ((eq 'char boundary))
	 ((eq 'word boundary) 
	  (re-search-backward "\\<"))
	 ((eq 'line boundary)
	  (beginning-of-line))
	 ((eq 'sent boundary) 
	  (re-search-backward sentence-end)
	  (goto-char (match-end 0)))
	 ((eq 'sexp boundary) 
	  (forward-char 1)
	  (up-list -1))
	 )
	(push-mark)

	;; do both ends
	(goto-char (max from to))
	(cond
	 ;; nil and 'char do nothing
	 ((null boundary))
	 ((eq 'char boundary))
	 ((eq 'word boundary) 
	  (re-search-forward "\\>"))
	 ((eq 'line boundary)
	  (end-of-line))
	 ((eq 'sent boundary) 
	  (re-search-forward sentence-end)
	  (goto-char (1+ (match-beginning 0))))
	 ((eq 'sexp boundary) 
	  (forward-char -1)
	  (up-list 1))
	 )
	(cons (mark) (point))
	)
    ;; if we can't match a search pattern, use 'line
    (error (mouse::align from to 'line)) ; this should always work
    ))



(defun mouse::boundary (&optional level)
  "Returns a suitable boundary, depending upon mode."
  ;; Get the first word from the mode name
  (let ((mode (if (string-match "\w*\\>" mode-name)
		  (substring mode-name 0 (match-end 0)))
	      ))
    (cond
     ;; level 2 is word, level >2 is mode dependent
     ((eq level 1) nil) ; defaults to 'char
     ((eq level 2) 'word)
     ((equal mode "Text") 'sent)
     ((equal mode "Lisp") 'sexp)
     ((equal mode "Tex") 'sent)
     (t 'line)
     )))

--
B<   Brian Kahn   blk@security.mitre.org   "may the farce be with you"