;;; -*- Mode:1Common-*Lisp; Base: 10.; Package: 1zwei*; Fonts: (MEDFNT TR12B TR12BI) -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1987-1989 Texas Instruments Incorporated. All rights reserved.

;;;
;;; Mouse highlighting functions for VISIDOC
;;;
;;; Change History started 10/22/87
;;; -------------------------------
;;; 10/23/87   slm  Remove definition of FONT-CHAR-WIDTH.  The Disk-label-editor needed this
;;;                 code and Visidoc redefined it.  Now, this macro is defined by Zmacs, and
;;;                 any/all applications can use it.
;;; 11/9/87    slm  Add the characters "." and "," to the set of characters to exclude from
;;;                 the end of a fonted string when determining the bounds of mousable text
;;;                 in HIGHLIGHTED-STRING-UNDER-MOUSE.  (patch 1.8)


;1;;    (comtab-mouse-array *standard-comtab*) format*
;1;;      is an array of ART-Q 2 3 16.*
;1;;      Dimension 1 is (1- number of mouse clicks)*
;1;;      Dimension 2 is (1- which button) where L=0, M=1, R=2*
;1;;      Dimension 3 is meta-control characters*


(DEFVAR *bold-font-names* '(fonts:tr12b fonts:tr10b fonts:hl10b fonts:hl12b))

;;This macro was added to SYS:ZMACS;MACROS.LISP for 3.2+   10/23/87 slm
;;(DEFMACRO font-char-width (ind)
;;  `(OR (AND ft (AREF ft (CHAR-CODE (AREF line ,ind))))
;;       (tv:font-char-width (AREF (w:sheet-font-map window)
;;                                 (CHAR-FONT (AREF line ,ind))))))

(DEFUN highlighted-string-under-mouse (WINDOW 
                                       &AUX CHAR X Y FONT LINE INDEX WIDTH
                                       start-index end-index start-loc end-loc ft)
  "2Returns the symbol which the mouse is pointing at in WINDOW, if that symbol is in one of
the fonts listed in BOLD-FONTS.  NIL if not pointing at one.
The values are the string line pointed at,
and the start and end indices of the highlighted string as a substring in that line,
and the start and end pixel locations of the string.
All values are NIL if the position is not on a valid symbol.*"
  (DECLARE (VALUES LINE START END START-LOC end-loc start-y height))
  (MULTIPLE-VALUE-SETQ (CHAR X Y LINE INDEX WIDTH)
    (MOUSE-CHAR WINDOW))
  (WHEN
    (AND CHAR				   ;1CHAR is nil if mouse not pointing at char*
         (MEMBER (AREF (w:sheet-font-map window)
                                     (SETQ font (CHAR-FONT char))) *bold-font-names*)
         (not (EQL CHAR #\CR))
         (NOT (CHAR-EQUAL char #\space)))
    (SETQ ft (tv:font-char-width-table (AREF (w:sheet-font-map window) (CHAR-FONT char))))
    ;1;Search backward from mouse loc to find start of string*
    (DO* ((I INDEX (1- I))
          (loc x))
         ((OR (= I 0)
              (not (= font (CHAR-FONT (AREF line i)))))
          (SETQ start-index I
                start-loc   loc))
      (DECF loc (font-char-width (1- i))))
    ;1; Next step back forward over space and other odd characters.*
    (DO* ((II start-index (1+ II))
          (loc start-loc))
         ((OR (= II index) 
              (NOT (OR (CHAR-EQUAL #\space (AREF line II))  1;;Performance note... multiple AREFs is not *
		       (CHAR-EQUAL #\tab (AREF line II))    1;;substantially slower than MEMBER using *
		       (CHAR-EQUAL #\( (AREF line II))      1;;:test #'char-equal, but it does substantially *
		       (CHAR-EQUAL #\[ (AREF line II)))))   1;;less consing!*
          (SETQ start-index II
                start-loc   loc))
      (INCF loc (font-char-width II)))
    ;1Now search forward from mouse loc to end of string*
    (DO* ((j index (1+ j))
          (loc x)
          (END (LENGTH line)))
         ((OR (= j END)
              (NOT (= font (CHAR-FONT (AREF line j)))))
          (SETQ end-index (1- j)
                end-loc   loc)) ;1; (- loc* (font-char-width (IF (= j end) (1- j) j)))))
      (INCF loc (font-char-width j)))
    ;1; And step backward from end of same font to last non-space character*
    (DO* ((JJ end-index
              ;1;*(IF (= end-index (LENGTH line)) (1- end-index) end-index)
              (1- JJ))
          (loc end-loc))
               ;1;*(IF (= end-index JJ) end-loc (- end-loc (font-char-width JJ)))))
         ((OR (= JJ index)
              (NOT (OR (CHAR-EQUAL #\space (AREF line JJ))
		       (CHAR-EQUAL #\tab (AREF line JJ))
		       (CHAR-EQUAL #\) (AREF line JJ))
		       (CHAR-EQUAL #\] (AREF line JJ))
		       (CHAR-EQUAL #\. (AREF line JJ))
		       (CHAR-EQUAL #\, (AREF line JJ)))))
          (SETQ end-index JJ
                end-loc loc))
      (DECF loc (font-char-width JJ)))
    (VALUES line start-index (1+ end-index) start-loc end-loc Y (w:sheet-line-height window))))

(DEFUN doc-viewer-mouse-highlight-function (MOUSE-BLINKER window char char-x char-y line index width
                                            &aux startloc endloc)
  width index char-x
  (MULTIPLE-VALUE-SETQ (line nil nil startloc endloc)
    (highlighted-string-under-mouse window))
  (COND (line
         (UNLESS (EQ window (W:BLINKER-SHEET MOUSE-BLINKER))
           (w:BLINKER-SET-SHEET MOUSE-BLINKER window))
         (SHEET-SET-BLINKER-CURSORPOS window MOUSE-BLINKER startloc CHAR-Y)
         (W:BLINKER-SET-SIZE MOUSE-BLINKER
                             (- endloc startloc)
                             (W:FONT-BLINKER-HEIGHT (AREF (w:sheet-font-map window) (CHAR-FONT char))))
         (W:BLINKER-SET-VISIBILITY MOUSE-BLINKER T))
        (t (w:blinker-set-visibility mouse-blinker nil))))