;;; -*- Mode:Common-Lisp; Package:TV; Base:10; Fonts:(CPTFONT HL10B HL12BI HL12B CPTFONTB)Ï1; Ï*Patch-File:T -*-

;Ï1;;                     RESTRICTED RIGHTS LEGEND          Ï*
;Ï1;; Use, duplication, or disclosure by the Government is subject toÏ*
;Ï1;; restrictions as set forth in subdivision (b)(3)(ii) of the Rights inÏ*
;Ï1;; Technical Data and Computer Software clause at 52.227-7013.Ï*
;Ï1;;                   TEXAS INSTRUMENTS INCORPORATED.Ï*
;Ï1;;                            P.O. BOX 149149Ï*
;Ï1;;                         AUSTIN, TEXAS 78714-9149Ï*
;Ï1;;                             MS 2151Ï*
;Ï1;; Copyright (C) 1986,1987, 1988, 1989 Texas Instruments Incorporated. All rights reserved.Ï*

;;;----------------------------------------------------------------------
;;; This software developed by:
;;;	James Rice
;;; at the Stanford University Knowledge Systems Lab in 1986, 1987.
;;;
;;; This work was supported in part by:
;;;	DARPA Grant F30602-85-C-0012
;;;----------------------------------------------------------------------
;;;  Much of this file is derived from code licensed from Texas Instruments
;;;  Inc.  Since we'd like them to adopt these changes, we're claiming
;;;  no rights to them, however, the following restrictions apply to the
;;;  TI code:
;;; Your rights to use and copy Explorer System Software must be obtained
;;; directly by license from Texas Instruments Incorporated.  Unauthorized
;;; use is prohibited.
;;;----------------------------------------------------------------------

;Ï1-------------------------------------------------------------------------------Ï*
;Ï1;; Mouse sensitive printing in Inspector panes...Ï*
;Ï1-------------------------------------------------------------------------------Ï*

;Ï1;; This file contains a modification to the Inspector to allow the user toÏ*
;Ï1;; define the way in which things are inspected just like print methods.Ï*
;Ï1;; This can be done by using a special, which is bound when printing concisely. Ï*
;Ï1;; This is : *printing-mouse-sensitively*  Ï*
;Ï1;;           - true whilst printing concisely  (i.e. will accept item1s)Ï*
;Ï1;; This can be used within print methods or format directives to switch onÏ*
;Ï1;; the sending of item1 messages rather then just printing the object.Ï*
;Ï1-------------------------------------------------------------------------------Ï*

(DEFUN Ï4print-concisely-asÏ* (something stream print-as depth)
  "Ï2Prints something concisely on stream, whose printed representation is Print-As.Ï*"
  (IGNORE something)
  (Print-Item-Concisely print-as stream depth))

(DEFUN Ï4princ-concisely-asÏ* (something stream princ-as depth)
  "Ï2Princs something concisely on stream, whose printed representation is Princ-As.Ï*"
  (IGNORE something depth)
  (PRINC princ-as stream))

;Ï1-------------------------------------------------------------------------------Ï*

(DEFUN Ï4fontify-stringÏ* (STRING font)
  "Ï2 Given a normal string and a font it returns a fat string, whose chars are in
 the font Font.Ï*"
  (LET ((LENGTH (LENGTH (THE string string))))
    (LET ((fat-string (MAKE-ARRAY length :type 'art-fat-string)))
      ;Ï1; Don't change this to :element-type unless you are sure thatÏ*
      ;Ï1; it will really give you an art-fat-string.Ï*
      (LOOP for i from 0 to (- length 1) do
	    (SETF (AREF fat-string i) (CODE-CHAR (AREF string i) 0 font)))
      fat-string)))

;Ï1------------------------------------------------------------------------------------Ï*

format:
(DEFUN Ï4string-of-padsÏ* (COUNT char)
  (WITH-OUTPUT-TO-STRING (*standard-output*)
    (format-ctl-repeat-char count char)
    *standard-output*))

format:
(DEFUN Ï4string-of-justifyÏ* (width size &optional (CHAR #\SPACE))
  (WITH-OUTPUT-TO-STRING (*standard-output*)
    (format-ctl-justify width size char)
    *standard-output*))

(DEFUN Ï4process-argsÏ* (STREAM args font)
  "Ï2Given a set of args for the stream, which are an item, and a font, send the
 item to the stream, if provided, in the defined font, if provided.  Returns
 the agrs/font as appropriate.Ï*"
  (IF font
      (IF stream
	  (LET ((old-font (SEND stream :send-if-handles :current-font)))
	    (UNWIND-PROTECT
		(PROGN (SEND stream :send-if-handles :set-current-font font)
		       (IF (SEND stream :operation-handled-p :item1)
			   (LEXPR-SEND stream args)
			   nil))
	      (SEND stream :send-if-handles :set-current-font old-font)
	      (LIST :font font args)))
	  (LIST :font font args))
      (PROGN (IF (SEND stream :operation-handled-p :item1)
		 (LEXPR-SEND stream args)
		 nil)
	     args)))

(DEFMETHOD Ï4(mouse-sensitive-text-scroll-window-without-click :compoundÏ*)
	   (some-items)
  (LOOP for item in some-items do
	(IF (CONSP item)
	    (LEXPR-SEND self item)
	    (FORMAT self "Ï3~AÏ*" item))))


(DEFUN Ï4process-paramsÏ* (unencapsulated arg params &optional prin1p)
  (LET ((edge (CAR params))
	(period (CADR params))
	(MIN (CADDR params))
	(padchar (CADDDR params))
	(result nil))
    (COND
      ((NULL padchar) (SETQ padchar #\SPACE))
      ((NOT (NUMBERP padchar)) (SETQ padchar (CHARACTER padchar))))
    (IF format::atsign-flag
	nil
	(PUSH arg result))
    (COND
      ((NOT (NULL edge))
       (LET ((width
	       (FUNCALL
		 (COND
		   (prin1p (FUNCTION flatsize))
		   ((STRINGP unencapsulated) (FUNCTION length))
		   (t (FUNCTION flatc)))
		 unencapsulated)))
	 (COND
	   ((NOT (NULL min))
	    (PUSH (format::string-of-pads min padchar) result)
	    (SETQ width (+ width min))))
	 (COND
	   (period
	    (PUSH (format::string-of-pads
		    (* (CEILING (- edge width) period) period)
		    padchar) result))
	   (t (PUSH (format::string-of-justify edge width padchar) result))))))
    (IF (NOT format::atsign-flag)
	nil
	(PUSH arg result))
    (LIST :compound (REVERSE result))))

(DEFUN Ï4pp-objify-atom-different-nameÏ* (object location name)
  "Ï2Makes a PP-Obj for an atom with a different printed representation than the
 original object.Ï*"
  (DECLARE (SPECIAL sys::pprint-string))
  (IGNORE object)
  (LET ((start (LENGTH sys::pprint-string)))
    (print-object name 0 *standard-output* '(:string-out))
    (LET ((result
	    (sys::make-pp-obj :length   (- (LENGTH sys::pprint-string) start)
			     :object   start
			     :location location)))
      result)))

(DEFUN Ï4actually-itemize-for-listÏ*
       (something stream print-as princ-as font)
  (LET ((*print-escape* print-as)
	(*standard-output* stream)
	(*fontify-this-region* (IF font font *fontify-this-region*)))
    (DECLARE (SPECIAL *print-escape*))
    (IF (OR (EQ something print-as)
	    (EQ something princ-as))
	(LET ((result
		(sys::pp-objify something (CONS something something))))
	  ;Ï1; TAC 08-09-89 - not using *saved-pp-objects* Ï*
	  ;Ï1; (push result *saved-pp-objects*) Ï*
	  result)
	(LET ((result
		(pp-objify-atom-different-name
		  something (CONS something something)
		  (OR print-as princ-as))))
	  ;Ï1; TAC 08-09-89 - not using *saved-pp-objects* Ï*
	  ;Ï1; (push result *saved-pp-objects*)Ï*
	  result))))


(DEFUN Ï4itemize-for-listÏ* (something stream print-as princ-as font params &optional prin1p)
  "Ï2Itemises something to stream in font either princed or printed, whilst
 grinding out a list as the top level object.Ï*"
  (LET ((edge (CAR params))
	(period (CADR params))
	(MIN (CADDR params))
	(padchar (CADDDR params)))
    (COND
      ((NULL padchar) (SETQ padchar #\SPACE))
      ((NOT (NUMBERP padchar)) (SETQ padchar (CHARACTER padchar))))
    (IF format::atsign-flag
	nil
	(actually-itemize-for-list something stream print-as princ-as font))
    (COND
      ((NOT (NULL edge))
       (LET ((width
	       (FUNCALL
		 (COND
		   (prin1p (FUNCTION flatsize))
		   ((STRINGP something) (FUNCTION length))
		   (t (FUNCTION flatc)))
		 something)))
	 (COND
	   ((NOT (NULL min))
	    (format::format-ctl-repeat-char min padchar)
	    (SETQ width (+ width min))))
	 (COND
	   (period
	    (format::format-ctl-repeat-char
	      (* (CEILING (- edge width) period) period)
	      padchar))
	   (t (format::format-ctl-justify edge width padchar))))))
    (IF (NOT format::atsign-flag)
	nil
	(actually-itemize-for-list something stream print-as princ-as font))))

(DEFUN Ï4itemize-elementÏ* (something stream depth &Key print-as princ-as font params)
  "Ï2Given something to print it displays it as a mouse sensitive item, which looks
 like Print-as or Princ-as in stream. Depth is the depth of mouse sensitive
 items displayed.  If neither Princ-as nor Print-as are supplied then it looks
 like Something.  If stream is nil it returns the item args that would be sent
 to a stream.Ï*"
  (DECLARE (SPECIAL sys::pprint-string))
  (IF (AND (BOUNDP 'grind-into-list-string)
	   grind-into-list-string
	   (BOUNDP 'sys::pprint-string)
	   sys::pprint-string)
      (itemize-for-list something stream print-as princ-as font params)
      (LET ((args (process-params
		    something
		    (IF print-as
			(LIST :Item1 something
			      :Value #'print-concisely-as
			      print-as (+ 1 depth))
			(LIST :Item1 something
			      :Value #'princ-concisely-as
			      princ-as (+ 1 depth)))
		    params (NOT princ-as))))
	(process-args stream args font))))

;Ï1-------------------------------------------------------------------------------Ï*
;Ï1 TAC 08-15-89 -  var put into INSPECT.LISPÏ*

;Ï1(DEFVAR *printing-mouse-sensitively* nilÏ*
;Ï1  "True when the things that are being printed should be turned into mouseÏ*
;Ï1 sensitive items if you know how to.")Ï*

;Ï1 TAC 08-15-89 -  advice put into function in GENERAL-INSPECTOR.LISPÏ*
;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1  (ADVISE Print-Item-Concisely :Around :Mouse-Sensitivity-Addition nilÏ*
;Ï1    ;;; Bind *printing-mouse-sensitively* because this is a good place toÏ*
;Ï1    ;;; have mouse sensitive objects.Ï*
;Ï1    (LET ((*printing-mouse-sensitively* t))Ï*
;Ï1      (DECLARE (SPECIAL *printing-mouse-sensitively*))Ï*
;Ï1      :Do-It)))Ï*

;Ï1-------------------------------------------------------------------------------Ï*
;Ï1 TAC 08-15-89 -  advice put into INSPECT.LISP where grind-top-level is called fromÏ*
;Ï1                       grind-into-list.Ï*

;Ï1(LET ((compiler:compile-encapsulations-flag t))Ï*
;Ï1  (ADVISE Grind-Top-Level :Around :Mouse-Sensitivity-Addition nilÏ*
;Ï1    ;;; Bind *printing-mouse-sensitively* because this is a good place toÏ*
;Ï1    ;;; have mouse sensitive objects as long as you are grinding into anÏ*
;Ï1    ;;; inspect pane.Ï*
;Ï1    (IF (AND (SEVENTH arglist)Ï*
;	Ï1     (OR (EQUAL (SEVENTH arglist)  'grind-into-list-make-item)Ï*
;		Ï1 (EQUAL (SEVENTH arglist) #'grind-into-list-make-item))Ï*
;	Ï1     (NOT grind-into-list-string))Ï*
;	Ï1(LET ((*printing-mouse-sensitively* t))Ï*
;	Ï1  (DECLARE (SPECIAL *printing-mouse-sensitively*))Ï*
;	Ï1  :Do-It)Ï*
;	Ï1:Do-It)))Ï*

;Ï1-------------------------------------------------------------------------------Ï*

(DEFVAR Ï4*inspect-details*Ï* (BOUNDP '*printing-mouse-sensitively*)
"Ï2A global which is true if the user wants the contents of structures
 to be mouse sensitive in the inspector.Ï*")

;Ï1; Define some format directives for the Mouse system.Ï*

;Ï1; Formats something using two args; the first is the thing to formatÏ*
;Ï1; the second it slashify.Ï*

(format::defformat format::ð (:Multi-Arg) (args params)
  "Ï3Formats something, taking two arguments.  The first is the thing to format and the second 
 is the slashification. Thus (format stream 'A structure :- ~ð' a-struct slashify) will 
 print out a-struct slashifiedly if slashify is non-nil, otherwise unslashifiedly.
 If the thing being printed is being printed in an inspector pane then the thing to be printed 
 is printed out mouse sensitively as long as the *inspect-details* flag is true.Ï*"
  (LET ((thing-to-print (FIRST args))
	(slashify (SECOND args)))
    (IF (AND *inspect-details*
	     (BOUNDP '*printing-mouse-sensitively*)
	     *printing-mouse-sensitively*)
	(itemize-element thing-to-print *standard-output* 0
			 (IF slashify :Print-as :Princ-as)
			 thing-to-print :params params)
	(format::format-ctl-ascii (FIRST args) params (SECOND args)))
    (REST (REST args))))

(DEFPROP Ï4format::ðÏ* 2 format::number-of-arguments)

;Ï1; Format something using one arg, which is a list.  The first is the thingÏ*
;Ï1; to print and the second is slashify.  If there is a third then this is usedÏ*
;Ï1; as the thing to print, with the first being the internal representationÏ*
;Ï1; for the inspector.Ï*

(format::defformat format::ý (:One-Arg) (arg params)
  "Ï3Formats something, taking one argument, which is a two/three/four list.
 This list is as follows :-
   The first is the thing to format
   The second is the slashification
   The third, if provided is the printed representation of the first 
       (i.e the thing to print).
   The font in which to print it.
 Thus (format stream 'A structure :- ~ý' (list a-struct nil '#<struct>') will
 print out a-struct as the string '#<struct>', which will be princed.
 If the thing being printed is being printed in an inspector pane then the
 thing to be printed is printed out mouse sensitively as long as the
 *inspect-details* flag is true.Ï*"
  (LET ((thing-to-print (IF (CONSP arg) (FIRST arg) arg))
	(slashify (IF (CONSP arg) (SECOND arg) t))
	(display-as (IF (CONSP arg)
			(IF (< (LENGTH arg) 3)
			    (FIRST arg)
			    (THIRD arg))))
	(font (IF (CONSP arg) (FOURTH arg) nil)))
    (IF (AND *inspect-details*
	     (BOUNDP '*printing-mouse-sensitively*)
	     *printing-mouse-sensitively*
	     (> (LENGTH (FORMAT nil "Ï3~AÏ*" display-as)) 0))
	(itemize-element thing-to-print *standard-output* 0
			 (IF slashify :Print-as :Princ-as)
			 display-as :font font :params params)
	(format::format-ctl-ascii display-as params slashify))))

(format::defformat format::¸ (:One-Arg) (arg params)
  "Ï3Formats something, taking one argument, which is a two/three list.  This list
 is as follows :-
   The first is the thing to format
   The second is the slashification
   The third, if provided is the printed representation of the first 
       (i.e the thing to print).
 Thus (format stream 'A structure :- ~¸' (list a-struct nil '#<struct>') will
 print out a-struct as the string '#<struct>', which will be princed.
 This format directive does not provide mouse sensitivity.  The reason for it
 is that it is compatible with ~ý, which does.  This means that you can make
 alternate elements in lists, for instance, mouse sensitive, whilst still
 formatting the list as for ~ý.Ï*"
  (LET ((slashify (IF (CONSP arg) (SECOND arg) t))
	(display-as (IF (CONSP arg)
			(IF (< (LENGTH arg) 3)
			    (FIRST arg)
			    (THIRD arg)))))
    (format::format-ctl-ascii display-as params slashify)))