;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: INTERACTORS; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; This file contains the keyboard interactors to input a multifont
;;; text line using a noncontinuous mode.
;;; It should be loaded after Interactor
;;;

#|
============================================================
Change log:
         8/20/92 Andrew Mickish - Added kr-send of :final-function
	 5/13/92 Rich McDaniel - Made SET-FOCUS using NIL as the multifont
                        parameter turn off the focus.
	 4/6/92  Ed Pervin - Renamed opal:copy-selection to
			opal:copy-selected-text	so as not conflict
			with inter:copy-selection.
 	 2/11/92 Rich McDaniel - started

============================================================
|#

(in-package "INTERACTORS" :use '("KR" "LISP"))

(export
  '(FOCUS-MULTIFONT-TEXTINTER
    SET-FOCUS
    CUT-SELECTION
    COPY-SELECTION
    PASTE-SELECTION
   )
)


;; Helper procedures for the default procedure to go into the slots

(proclaim '(special Focus-Multifont-Textinter))

(defun Focus-Interactor-Initialize (new-Text-schema)
   (if-debug new-Text-schema (format T "Text initialize ~s~%" new-Text-schema))
   (Check-Interactor-Type new-Text-schema inter:focus-multifont-textinter)
   (Check-Required-Slots new-Text-schema)
   (Set-Up-Defaults new-Text-schema)
   (when (g-value new-Text-schema :obj-to-change)
      (set-focus new-Text-schema (g-value new-Text-schema :obj-to-change))
   )
)


;; Default procedure
 
;; Go procedure utilities

(defun Focus-Do-Start (an-interactor obj-over event)
   (if-debug an-interactor (format T "Text starting over ~s~%" obj-over))
   ;; if obj-to-change supplied, then use that, otherwise use whatever was
   ;; under the mouse when started
   (let ((obj (g-value an-interactor :obj-to-change)))
      (when obj
         (kr-send an-interactor :stop-action an-interactor obj event)
      )
   )
)


(defun Focus-Error (an-interactor &rest args)
   (declare (ignore args))
   (error "Focus-Multifont-Textinter has had an illegal procedure called.
Only the Do-Start procedure state is allowed to be used in this
interactor.  Somehow the interactor was pulled out of the start state.
The offending interactor was ~S." an-interactor)
) 


;; Editing function.  Gets the characters to the screen.

;; Does the same stuff as inter:Edit-String (in textkeyhandling.lisp)
;; but string-object is of type opal:multifont-text.
(defun Focus-Int-Edit-String (an-interactor string-object event)
   (when (and event (schema-p string-object) (not (event-mousep event)))
      (let ((new-trans-char
                 (inter::Translate-key (event-char event) an-interactor)))
         (when new-trans-char
            (unless (eq new-trans-char :kill-line)
               (s-value an-interactor :kill-mode nil)
            )
            (case new-trans-char
               (:prev-char
                     (opal:toggle-selection string-object nil)
                     (opal:go-to-prev-char string-object))
               (:prev-word
                     (opal:toggle-selection string-object nil)
                     (opal:go-to-prev-word string-object))
               (:next-char
                     (opal:toggle-selection string-object nil)
                     (opal:go-to-next-char string-object))
               (:next-word
                     (opal:toggle-selection string-object nil)
                     (opal:go-to-next-word string-object))
               (:up-line
                     (opal:toggle-selection string-object nil)
                     (opal:go-to-prev-line string-object))
               (:down-line
                     (opal:toggle-selection string-object nil)
                     (opal:go-to-next-line string-object))
               (:beginning-of-line
                     (opal:toggle-selection string-object nil)
                     (opal:go-to-beginning-of-line string-object))
               (:end-of-line
                     (opal:toggle-selection string-object nil)
                     (opal:go-to-end-of-line string-object))
               (:beginning-of-string
                     (opal:toggle-selection string-object nil)
                     (opal:go-to-beginning-of-text string-object))
               (:end-of-string
                     (opal:toggle-selection string-object nil)
                     (opal:go-to-end-of-text string-object))
               (:prev-char-select
                     (opal:toggle-selection string-object t)
                     (opal:go-to-prev-char string-object))
               (:prev-word-select
                     (opal:toggle-selection string-object t)
                     (opal:go-to-prev-word string-object))
               (:next-char-select
                     (opal:toggle-selection string-object t)
                     (opal:go-to-next-char string-object))
               (:next-word-select
                     (opal:toggle-selection string-object t)
                     (opal:go-to-next-word string-object))
               (:up-line-select
                     (opal:toggle-selection string-object t)
                     (opal:go-to-prev-line string-object))
               (:down-line-select
                     (opal:toggle-selection string-object t)
                     (opal:go-to-next-line string-object))
               (:beginning-of-line-select
                     (opal:toggle-selection string-object t)
                     (opal:go-to-beginning-of-line string-object))
               (:end-of-line-select
                     (opal:toggle-selection string-object t)
                     (opal:go-to-end-of-line string-object))
               (:beginning-of-string-select
                     (opal:toggle-selection string-object t)
                     (opal:go-to-beginning-of-text string-object))
               (:end-of-string-select
                     (opal:toggle-selection string-object t)
                     (opal:go-to-end-of-text string-object))
               (:compose-character nil)
               (:kill-line
                     (let ((deleted-stuff
                                 (opal:kill-rest-of-line string-object))
                           (cut-buffer (g-value an-interactor :cut-buffer))
                           (a-window (event-window event)))
                        (when deleted-stuff
                           (if (g-value an-interactor :kill-mode)
                              (setq deleted-stuff (opal:concatenate-text
                                    cut-buffer deleted-stuff))
                              (s-value an-interactor :kill-mode t)
                           )
                           (s-value an-interactor :cut-buffer deleted-stuff)
                           (opal:set-x-cut-buffer a-window
                                 (opal:text-to-string deleted-stuff))
                        )
                     ))
               (:delete-selection
                     (let* ((deleted-stuff
                                  (opal:delete-selection string-object))
                            (deleted-string
                                  (opal:text-to-string deleted-stuff))
                            (a-window (event-window event)))
                        (unless (string= deleted-string "")
                           (s-value an-interactor :cut-buffer deleted-stuff)
                           (opal:set-x-cut-buffer a-window deleted-string)
                        )
                     ))
               (:copy-selection
                     (let* ((copied-stuff
                                 (opal:copy-selected-text string-object))
                            (copied-string
                                  (opal:text-to-string copied-stuff))
                            (a-window (event-window event)))
                        (unless (string= copied-string "")
                           (s-value an-interactor :cut-buffer copied-stuff)
                           (opal:set-x-cut-buffer a-window copied-string)
                        )
                     ))
               (:copy-buffer
                     (let ((yanked-stuff (g-value an-interactor :cut-buffer)))
                        (opal:insert-text string-object yanked-stuff)
                     ))
               (:copy-from-X-cut-buffer
                     (let ((yanked-stuff (opal:get-x-cut-buffer
                                               (event-window event))))
                        (opal:insert-string string-object yanked-stuff)
                     ))
               (:delete-next-char
                     (if (g-value string-object :selection-p)
                        (when (zerop (length (opal:text-to-string
                              (opal:delete-selection string-object))))
                           (opal:delete-char string-object)
                        )
                        (opal:delete-char string-object)
                     ))
               (:delete-next-word
                     (if (g-value string-object :selection-p)
                        (when (zerop (length (opal:text-to-string
                              (opal:delete-selection string-object))))
                           (opal:delete-word string-object)
                        )
                        (opal:delete-word string-object)
                     ))
               (:delete-prev-char
                     (if (g-value string-object :selection-p)
                        (when (zerop (length (opal:text-to-string
                              (opal:delete-selection string-object))))
                           (opal:delete-prev-char string-object)
                        )
                        (opal:delete-prev-char string-object)
                     ))
               (:delete-prev-word
                     (if (g-value string-object :selection-p)
                        (when (zerop (length (opal:text-to-string
                              (opal:delete-selection string-object))))
                           (opal:delete-prev-word string-object)
                        )
                        (opal:delete-prev-word string-object)
                     ))
               (:delete-string    (opal:set-strings string-object nil))
               ;; here might be a keyword, character, string, or function
               (T
		; amickish 8/20/92 - added 'if' and 'kr-send'
		(if (eq (inter:event-char event)
			(g-value an-interactor :stop-event))
		    (kr-send an-interactor :final-function
			     an-interactor string-object event
			     (opal:get-string string-object)
			     (inter:event-x event) (inter:event-y event))
                  (cond
                     ((event-mousep event) NIL) ; ignore these
                     ((and (characterp new-trans-char)
                           (or (graphic-char-p new-trans-char)
                           (eql new-trans-char #\NewLine)))
                        ; then is a regular character, so add to str
                        (when (g-value string-object :selection-p)
                           (let ((deleted-stuff (opal:text-to-string
                                    (opal:delete-selection string-object)))
                                 (a-window (event-window event)))
                              (unless (string= deleted-stuff "")
                                 (opal:set-x-cut-buffer a-window deleted-stuff)
                              )
                           )
                        )
                        (opal:add-char string-object new-trans-char))
                     ;; check if a string
                     ((stringp new-trans-char) ; then insert into string
                        (when (g-value string-object :selection-p)
                           (let ((deleted-stuff (opal:text-to-string
                                    (opal:delete-selection string-object)))
                                 (a-window (event-window event)))
                              (unless (string= deleted-stuff "")
                                 (opal:set-x-cut-buffer a-window deleted-stuff)
                              )
                           )
                        )
                        (opal:Insert-String string-object new-trans-char))
                     ; now check for functions
                     ((if (symbolp new-trans-char) ; check if a function,
                                      ; need all 3 tests to do it right!
                            (fboundp new-trans-char)
                            (functionp new-trans-char))
                        ; then call the function
                        (funcall new-trans-char an-interactor
                              string-object event))
                     (T ; otherwise, must be a bad character
                        (Beep)))
                  )
               )
            )
         )
      )
   )
)


;; Change focus of interactor from one multifont-text to another.
(defun SET-FOCUS (interactor multifont)
   (if (or (null multifont) (is-a-p multifont opal:multifont-text))
      (let ((obj (g-value interactor :obj-to-change)))
         (when obj
            (opal:set-cursor-visible obj nil)
            (opal:toggle-selection obj nil)
         )
         (if multifont
            (progn
               (opal:set-cursor-visible multifont t)
               (s-value interactor :obj-to-change multifont)
            )
            (s-value interactor :obj-to-change nil)
         )
         (s-value interactor :kill-mode nil)
      )
      (error "Tried to set focus of ~S to ~S." interactor multifont)
   )
)


(defun CUT-SELECTION (interactor)
   (let ((string-object (g-value interactor :obj-to-change)))
      (when string-object
         (let ((deleted-stuff (opal:delete-selection string-object)))
            (s-value interactor :cut-buffer deleted-stuff)
         )
      )
   )
)


(defun COPY-SELECTION (interactor)
   (let ((string-object (g-value interactor :obj-to-change)))
      (when string-object
         (let ((copied-stuff (opal:copy-selected-text string-object)))
            (s-value interactor :cut-buffer copied-stuff)
         )
      )
   )
)


(defun PASTE-SELECTION (interactor)
   (let ((string-object (g-value interactor :obj-to-change)))
      (when string-object
         (let ((copied-stuff (g-value interactor :cut-buffer)))
            (opal:insert-text string-object copied-stuff)
         )
      )
   )
)


;;; Focus-Multifont-Textinter schema

(Create-Schema 'inter:focus-multifont-textinter
   (:is-a inter:interactor)
   (:name :First-Focus-Text-interactor)
   (:stop-event NIL)
   (:stop-action 'Text-Int-Running-Action)
   (:start-where T)
   (:start-event '(:any-keyboard))
   (:obj-to-change NIL)  ; Must supply.  Determines which multifont-text has
                         ; the keyboard focus.
   (:cursor-where-press T)
   (:remembered-last-object NIL)
   (:key-translation-table NIL) ;table of translations; set below
   (:kill-mode NIL)
   (:edit-func 'Focus-Int-Edit-String)
   (:Go 'General-Go)  ; Proc executed when events happen.
   (:Do-Start 'Focus-Do-Start) ; Proc executed when event handled.
   (:Do-Running 'Focus-Error)
   (:Do-Explicit-Stop 'Focus-Error)
   (:Do-Stop 'Focus-Error)
   (:Do-Abort 'Focus-Error)
   (:Do-Outside 'Focus-Error)
   (:Do-Back-Inside 'Focus-Error)
   (:Do-Outside-Stop 'Focus-Error)
   (:initialize 'Focus-Interactor-Initialize) ; proc to call when created
)


;; Following are definitions of non-standard keys.

;; Initializes the hash table of an-interactor with the standard
;; translations.  If there is no table in an-interactor, creates one.
;; Otherwise, removes any translations that are there before adding the
;; new ones.
(defun Set-Enhanced-Key-Translations (an-interactor)
   (let ((ht (get-local-value an-interactor :key-translation-table)))
      (if (not (hash-table-p ht))
         (s-value an-interactor :key-translation-table
               (setq ht (make-hash-table)))
         ; else re-initialize ht
         (clrhash ht)
      )
      (bind-key-internal :leftarrow  :prev-char ht)
      (bind-key-internal :control-\b :prev-char ht)

      (bind-key-internal :shift-leftarrow :prev-char-select ht)
      (bind-key-internal :control-b       :prev-char-select ht)
    
      (bind-key-internal :meta-leftarrow :prev-word ht)
      (bind-key-internal :meta-\b        :prev-word ht)
    
      (bind-key-internal :shift-meta-leftarrow :prev-word-select ht)
      (bind-key-internal :meta-b               :prev-word-select ht)
    
      (bind-key-internal :rightarrow :next-char ht)
      (bind-key-internal :control-\f :next-char ht)

      (bind-key-internal :shift-rightarrow :next-char-select ht)
      (bind-key-internal :control-f        :next-char-select ht)
    
      (bind-key-internal :meta-rightarrow :next-word ht)
      (bind-key-internal :meta-\f         :next-word ht)

      (bind-key-internal :shift-meta-rightarrow :next-word-select ht)
      (bind-key-internal :meta-f                :next-word-select ht)
    
      (bind-key-internal :uparrow    :up-line ht)
      (bind-key-internal :control-\p :up-line ht)

      (bind-key-internal :shift-uparrow :up-line-select ht)
      (bind-key-internal :control-p     :up-line-select ht)
    
      (bind-key-internal :downarrow  :down-line ht)
      (bind-key-internal :control-\n :down-line ht)

      (bind-key-internal :shift-downarrow :down-line-select ht)
      (bind-key-internal :control-n       :down-line-select ht)
    
#+kcl (bind-key-internal #\rubout    :delete-prev-char ht)
#-kcl (bind-key-internal #\delete    :delete-prev-char ht)
      (bind-key-internal #\backspace :delete-prev-char ht)
      (bind-key-internal :control-h  :delete-prev-char ht)
      (bind-key-internal :control-\h :delete-prev-char ht)
    

      (bind-key-internal :meta-rubout    :delete-prev-word ht)
      (bind-key-internal :meta-delete    :delete-prev-word ht)
      (bind-key-internal :meta-backspace :delete-prev-char ht)
      (bind-key-internal :meta-h         :delete-prev-word ht)
      (bind-key-internal :meta-\h        :delete-prev-word ht)
    
      (bind-key-internal :control-d   :delete-next-char ht)
      (bind-key-internal :control-\d  :delete-next-char ht)
    
      (bind-key-internal :meta-d  :delete-next-word ht)
      (bind-key-internal :meta-\d :delete-next-word ht)
    
      (bind-key-internal :control-w  :delete-selection ht)
      (bind-key-internal :control-\w :delete-selection ht)
    
      (bind-key-internal :meta-w  :copy-selection ht)
      (bind-key-internal :meta-\w :copy-selection ht)
    
      (bind-key-internal :control-u  :delete-string ht)
      (bind-key-internal :control-\u :delete-string ht)
    
      (bind-key-internal :home       :beginning-of-string ht)
      (bind-key-internal :control-\, :beginning-of-string ht)
      (bind-key-internal :meta-<     :beginning-of-string ht)

      (bind-key-internal :control-< :beginning-of-string-select ht)
    
       (bind-key-internal :end       :end-of-string ht) 
       (bind-key-internal :control-. :end-of-string ht)
       (bind-key-internal :meta->    :end-of-string ht)

       (bind-key-internal :control-> :end-of-string-select ht)
    
       (bind-key-internal :control-\a :beginning-of-line ht)
    
       (bind-key-internal :control-a :beginning-of-line-select ht)

       (bind-key-internal :control-\e :end-of-line ht)
    
       (bind-key-internal :control-e :end-of-line-select ht)

       (bind-key-internal :control-c  :copy-to-X-cut-buffer ht)
       (bind-key-internal :control-\c :copy-to-X-cut-buffer ht)
    
       (bind-key-internal :control-k  :kill-line ht)
       (bind-key-internal :control-\k :kill-line ht)
    
       (bind-key-internal :meta-y  :copy-from-X-cut-buffer ht)
       (bind-key-internal :meta-\y :copy-from-X-cut-buffer ht)
    
      (bind-key-internal :insert      :copy-buffer ht)
      (bind-key-internal :insert-line :copy-buffer ht)
#+(or vax dec3100 dec5000)
      (bind-key-internal :insert-here :copy-buffer ht)
      (bind-key-internal :control-y   :copy-buffer ht)
      (bind-key-internal :control-\y  :copy-buffer ht)
    
      (bind-key-internal #\return     #\Newline ht)
      (bind-key-internal :control-j   #\Newline ht)
      (bind-key-internal :control-\j  #\Newline ht)
    
    ;; translate the number pad into regular characters (if CMU)
#+cmu (bind-key-internal :num-pad-1 #\1 ht)
#+cmu (bind-key-internal :num-pad-2 #\2 ht)
#+cmu (bind-key-internal :num-pad-3 #\3 ht)
#+cmu (bind-key-internal :num-pad-4 #\4 ht)
#+cmu (bind-key-internal :num-pad-5 #\5 ht)
#+cmu (bind-key-internal :num-pad-6 #\6 ht)
#+cmu (bind-key-internal :num-pad-7 #\7 ht)
#+cmu (bind-key-internal :num-pad-8 #\8 ht)
#+cmu (bind-key-internal :num-pad-9 #\9 ht)
#+cmu (bind-key-internal :num-pad-0 #\0 ht)
#+cmu (bind-key-internal :num-pad-/ #\/ ht)
#+cmu (bind-key-internal :num-pad-* #\* ht)
#+cmu (bind-key-internal :num-pad-- #\- ht)
#+cmu (bind-key-internal :num-pad-+ #\+ ht)
#+cmu (bind-key-internal :num-pad-. #\. ht)
#+cmu (bind-key-internal :num-pad-enter #\NewLine ht)  ; the enter key
   )
)

(Set-Enhanced-Key-Translations inter:focus-multifont-textinter)

;; Toggle italic fonts.
(Bind-Key :F2
   #'(lambda (an-interactor obj event)
        (declare (ignore an-interactor event))
        (opal:change-font-of-selection obj nil :italic :toggle-first)
     )
   Focus-Multifont-Textinter
)


;; Toggle bold fonts.
(Bind-Key :F3
   #'(lambda (an-interactor obj event)
        (declare (ignore an-interactor event))
        (opal:change-font-of-selection obj nil :bold :toggle-first)
     )
   Focus-Multifont-Textinter
)


;; Next text typed will be in next smaller size
(Bind-Key :F4
   #'(lambda (an-interactor obj event)
        (declare (ignore an-interactor event))
        (opal:change-font-of-selection obj nil :size :smaller)
     )
   Focus-Multifont-Textinter
)


;; Next text typed will be in next bigger size
(Bind-Key :F5
   #'(lambda (an-interactor obj event)
        (declare (ignore an-interactor event))
        (opal:change-font-of-selection obj nil :size :bigger)
     )
   Focus-Multifont-Textinter
)


;; Next text typed will be in fixed family
(Bind-Key :F6
   #'(lambda (an-interactor obj event)
        (declare (ignore an-interactor event))
        (opal:change-font-of-selection obj nil :family :fixed)
     )
   Focus-Multifont-Textinter
)


;; Next text typed will be in serif family
(Bind-Key :F7
   #'(lambda (an-interactor obj event)
        (declare (ignore an-interactor event))
        (opal:change-font-of-selection obj nil :family :serif)
     )
   Focus-Multifont-Textinter
)


;; Next text typed will be in sans-serif family
(Bind-Key :F8
   #'(lambda (an-interactor obj event)
        (declare (ignore an-interactor event))
        (opal:change-font-of-selection obj nil :family :sans-serif)
     )
   Focus-Multifont-Textinter
)
