;;; -*- Mode:Common-Lisp; Package:MACTOOLBOX; Base:10; Patch-file:T -*-

;;; Reason: Changes to the clipboard code to avoid hangs early in boot, to keep the edit menu state correct, and to do a better job
;;; of passing commands from the edit menu to Zmacs. 

;;;                           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, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 07/11/89 10:36:58 by jones,
;;; while running on HOBBS from band LOD1
;;; With SYSTEM 6.9, GC 6.3, VIRTUAL-MEMORY 6.1, MICRONET 6.0, MICRONET-COMM 6.1,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-PATHNAME 6.0, MAC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0,
;;;  BASIC-NAMESPACE 6.1, BASIC-FILE 6.2, RPC 6.1, NFS 6.0, EH 6.3, MAKE-SYSTEM 6.0,
;;;  MEMORY-AUX 6.0, COMPILER 6.6, TV 6.11, NVRAM 6.1, UCL 6.0, INPUT-EDITOR 6.0,
;;;  MACTOOLBOX 2.3, METER 6.0, ZWEI 6.3, DEBUG-TOOLS 6.3, WINDOW-MX 6.3, PRINTER 6.1,
;;;  MAC-PRINTER-TYPES 6.1, CLIPBOARD 6.0, NETWORK-PATHNAME 6.0, NETWORK-NAMESPACE 6.0,
;;;  DATALINK 6.0, CHAOSNET 6.0, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  MX-DATALINK 6.1, NAMESPACE-EDITOR 6.0, IP 3.47, NFS-SERVER 6.0, MX-SERIAL 6.0,
;;;  PRINTER-TYPES 6.0, IMAGEN 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0,
;;;  VT100 6.0, STREAMER-TAPE 6.3, DECNET 1.69, VISIDOC 6.2, PROFILE 6.1, TI-CLOS 6.9,
;;;  CLEH 6.4, Experimental CLX 6.1, CLUE 6.5, Experimental BUG 11.10, Experimental ACTION 2.0,
;;;   microcode 138, Band Name: p616*1

#!C
; From file MAC-CLIP.LISP#> JONES; HEYERDAHL:
#10R MACTOOLBOX#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MACTOOLBOX"))
                          (SI:*LISP-MODE* :Common-lisp)
                          (*READTABLE* Sys:Common-lisp-readtable)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* Sys::*common-lisp-symbol-substitutions*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: clipboard; MAC-CLIP.#"


(defvar *max-clipboard-size* (first (last add:*ACB-Q-SIZES*)) "The largest string that can be transfered to or from the clipboard.")

(defun GET-STRING-FROM-CLIPBOARD (&optional (errorp *DEBUG-CUT-PASTE-HANDLER*)) 
  "This function will return a character string from the Macintosh Clipboard.
   It will return null character string
    if a text character string is not in the Clipboard."
  (LET ((*application-channel* 8)
	scrap-result
	string-on-lisp-side)
    
    (without-interrupts
      
      ;; If we are trying to disk save then don't try to reallocate handle.
      (unless *scrap-operation-enabled*
	(return-from get-string-from-clipboard ""))
      
      (SETQ scrap-result
	    (getscrap *clipboard-temp-handle* "TEXT"))
      
      ;; If there was some error just return an empty string.
      (when (> 0 scrap-result)
	(if errorp (signal-oserr scrap-result 'getscrap))
	(return-from get-string-from-clipboard ""))

      (unless (< scrap-result *max-clipboard-size*)
	(tv:notify nil "The contents of the Mac clipboard was too large (> ~d bytes) to be put into the Explorer kill history and was truncated."
		   *max-clipboard-size*)
	(setf scrap-result *max-clipboard-size*))
      
      (setf string-on-lisp-side
	    (make-array scrap-result
			:element-type 'string-char
			:fill-pointer scrap-result))
      
      ;; Copy the scrap to the lisp side.
      (tb:block-move *clipboard-temp-handle* string-on-lisp-side scrap-result)

      (tb:!SetHandleSize *clipboard-temp-handle* 0))
    
    ;; Do the ASCII translation.
    (si:%buffer-char-map string-on-lisp-side 0 scrap-result
			 string-on-lisp-side 0 scrap-result
			 *ascii-to-explorer-char-map* #xff 0)
    string-on-lisp-side))

(defun PUT-STRING-IN-CLIPBOARD (str)
  "This function will put a character string into the Clipboard.
   The Clipboard in the MAC is also called the scrap."
  (declare (values t-or-nil))
  (without-interrupts
    (let ((*application-channel* 8)
	   (str-length (array-active-length str))
	   str-pointer)

      ;; This limit is imposed by block-move. We need to fix it. *BJ*
      (unless (< str-length *max-clipboard-size*)
	(tv:notify nil "The first element in the Explorer kill history was too large (> ~d bytes) to put into the Macintosh clipboard and was truncated."
		   *max-clipboard-size*)
	(setf str-length *max-clipboard-size*))

      (unless *scrap-operation-enabled*
	(return-from put-string-in-clipboard nil))
      
      (when (> str-length (array-total-size *clipboard-temp-string*))
	(setf *clipboard-temp-string* (adjust-array *clipboard-temp-string* str-length :element-type 'string-char)))
      
      (setf (fill-pointer *clipboard-temp-string*) str-length)

      (cond ((zerop (suppress-oserr (!SetHandleSize *clipboard-temp-handle* str-length)))
	     
	     (si:%buffer-char-map str 0 str-length
				  *clipboard-temp-string* 0 str-length
				  *explorer-to-ascii-char-map* #xff 0)
	     
	     (tb:block-move *clipboard-temp-string* *clipboard-temp-handle* str-length)
	     
	     (tb:!Hlock *clipboard-temp-handle*)
	     (setf str-pointer (deref *clipboard-temp-handle*))
	     (tb:!SystemEdit 3)
	     (!zeroscrap)
	     (!putscrap str-length "TEXT" str-pointer)
	     (!HUnlock *clipboard-temp-handle*)
	     (!SetHandleSize *clipboard-temp-handle* 0)
	     t)
	    (t
	     (tv:notify nil "There was not enough memory in the Mac heap to copy the first element of Explorer kill history to the Macintosh clipboard.")
	     nil
	     )))))

(defun set-suspend-timeout-limit-ticks (ticks)
  (let ((cmd (add:get-acb-fast 4)))
    (setf (add:opcode cmd) 27)
    (setf (add:requestor-complete cmd) t)
    (setf (add:parm-32b cmd 0) ticks)
    (add:transmit-packet cmd (add:find-channel 'display-io))))

(defmethod (ADD:MISC-HANDLER :CASE :HANDLE-OPCODE 16) (cmd &aux misc-str)
  "Handle the opcodes for scrap integration. This method also sends a message to the selected window
   if it handles it when multiFinder suspends or resumes us."

  (let ((*application-channel* 8))
    (condition-call (cond)
	
	(ecase (add:subopcode cmd)
	  
	  (#.*suspend-command*
	   ;; If the requestor is complete it means that we took the timeout on the Mac side and that we
	   ;; shouldn't touch the clipboard.
	   (unless (add:requestor-complete cmd)
	     
	     ;;  Change the Mac's mouse cursor to the watch while we copy the clipboard.
	     (LET ((true-mouse-cursor tv:mouse-blinker))
	       (unwind-protect
		   (progn		   
		     (set-suspend-timeout-limit-ticks (* 5 60))	       ; Allow up to 5 more seconds to respond. */
		     (SEND mac:*mac* :set-mouse-blinker (- 4 mac:mac-mouse-cursor-offset))
		     (when w:selected-window
		       (send w:selected-window :send-if-handles :mac-suspend-command))
		     (without-interrupts 
		       (when (and (setf misc-str (zwei:kill-ring-string 0))
				  (not (equal misc-str *last-string-put-in-clipboard*)))
			 
			 (put-string-in-clipboard misc-str)
			 (setf *last-string-put-in-clipboard* misc-str))))
		 
		 ;;  Restore the Mac's mouse cursor to what the Explorer thinks it is...
		 (WHEN (TYPEP (tv:blinker-sheet true-mouse-cursor) '(OR mac:mac-window mac:mac-screen))
		   (SEND true-mouse-cursor :create-Mac-image-of-Explorer-mouse-cursor nil nil))))))
	  
	  (#.*resume-command*
	   (when w:selected-window
	     (send w:selected-window :send-if-handles :mac-resume-command))
	   (setf misc-str (get-string-from-clipboard))
	   (unless (zerop (array-active-length misc-str))
	     (zwei:kill-string misc-str)))
	  
	  (#.*edit-command*
	   ;; The first parm in the buffer contains the item number of the selected menu item.
	   (when w:selected-window
	     (send w:selected-window :send-if-handles :mac-edit-command (add:parm-32b cmd 0)))))
      
      ((not *debug-cut-paste-handler*)
       (tv:notify nil "Error from cut-paste handler: ~s" (send cond :report-string))))))

;; This method takes care of moving between buffers.
(defmethod (ZWEI:ZMACS-BUFFER :AFTER :SELECT) (&rest ignore)
  (cond ((not (typep w:selected-window 'zwei:zmacs-window-pane)))
	((zwei:buffer-read-only-p self)
	 (enable-edit-menu *copy-command-mask*))
	(t
	 (enable-edit-menu (logior *undo-command-mask*
				   *cut-command-mask*
				   *copy-command-mask*
				   *paste-command-mask*
				   *clear-command-mask*)))))

(defmethod (zwei:zmacs-window-pane :MAC-EDIT-COMMAND) (cmd)

  (ecase cmd
    
    (#.*undo-command*
     (send tv:superior :force-kbd-input '(:execute zwei:com-quick-undo)))
    
    (#.*cut-command*
     (send tv:superior :force-kbd-input '(:execute zwei:com-kill-region))
     )
    
    (#.*copy-command*
     (send tv:superior :force-kbd-input '(:execute zwei:com-save-region)))
    
    (#.*paste-command*
     (send tv:superior :force-kbd-input '(:execute zwei:com-yank)))
    
    (#.*clear-command*
     (send tv:superior :force-kbd-input '(:execute zwei:com-kill-region))))

  (send tv:superior :force-kbd-input `(:execute set-in-instance ,self zwei:mark-p nil))
  (send tv:superior :force-kbd-input `(:execute zwei:must-redisplay ,self ,zwei:dis-text))
  (send tv:superior :force-kbd-input `(:execute zwei:redisplay ,self)))

))