;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: GILT; 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 module contains some methods put into specific gadgets to do
;;; string editing.
;;;
;;; Designed and implemented by Brad Myers

#|
============================================================
Change log:
    3/25/92 Brad Myers - :control-n instead of #\control-n
    2/5/92 Brad Myers - use change-item, remove-item, etc.
    2/5/92  Ed Pervin - Made control characters :control-* for CMUCL
    3/26/91 Andrew Mickish - In Aggrelist-Edit-String-Func replaced call to
              "fill" with a call to "append" (to make non-destructive)
    3/21/91 Andrew Mickish - Added calls to kr:recompute-formula as a hack to
              get button widths to change size properly
    3/21/91 Andrew Mickish - Defined Motif-Button-String-Func and
              Motif-Menu-String-Func
    6/18/90 Brad Myers - Started
============================================================
|#

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

;;; Utility functions

;;;Set a single slot and return T
(defun set-one-value (gadget-obj slot-name final-string)
  (s-value gadget-obj slot-name
	   (if (string= final-string "") NIL final-string))
  T) ; must return T

(defun DeleteNth (lst n)
  (append (subseq lst 0 n)
	  (subseq lst (1+ n))))


;;;Set a member of an aggrelist
(defun Aggrelist-Edit-String-Func (gadget-obj aggrel str-obj
				   final-event final-string slot-for-rank)
  (let (rank)
    (dolist (o (g-value aggrel :components))
      (when (eq (g-value o :text) str-obj)
	(setq rank (g-value o slot-for-rank)) ; use :rank or :real-rank
					      ; depending on type of object
	(return))) ; leave dolist
    (unless rank (return-from Aggrelist-Edit-String-Func NIL))
    (if (string= final-string "")
	; delete the rank item
	(opal:remove-nth-item gadget-obj rank)
	; else replace string
	(progn
	  (let ((olditems (g-value gadget-obj :items)))
	  (when (or (not (integerp rank))
		    (< rank 0)
		    (>= rank (length olditems)))
	    (error "rank is not a good number ~s~%" rank))
	  (opal:change-item gadget-obj final-string rank)
	  (when (and (eq (1+ rank) (length olditems))
		     (eq (inter:event-char final-event) :control-\n))
	      ; then add a new item at the end
	      (let ((val (1+ (or (g-value gadget-obj :last-label-used)
				 3))))
		(s-value gadget-obj :last-label-used val)
		(opal:add-item gadget-obj (format NIL "Label~a" val))
		)))))
    T)) ;return T is successful

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Specific functions for different gadgets
;; These were created by looking at the gadget structure, so they might need to
;; changed if the gadgets are re-implemented.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun Text-Button-String-Func (gadget-obj str-obj final-event final-string)
  (let ((aggrel (g-value gadget-obj :TEXT-BUTTON-LIST)))
    (Aggrelist-Edit-String-Func gadget-obj aggrel str-obj
				final-event final-string :rank)))

(defun X-Button-String-Func (gadget-obj str-obj final-event final-string)
  (let ((aggrel (g-value gadget-obj :X-BUTTON-LIST)))
    (Aggrelist-Edit-String-Func gadget-obj aggrel str-obj
				final-event final-string :rank)))

(defun Radio-Button-String-Func (gadget-obj str-obj final-event final-string)
  (let ((aggrel (g-value gadget-obj :RADIO-BUTTON-LIST)))
    (Aggrelist-Edit-String-Func gadget-obj aggrel str-obj
				final-event final-string :rank)))

(defun Scroll-Menu-String-Func (gadget-obj str-obj final-event final-string)
  (if (eq str-obj (g-value gadget-obj :menu-title :text))
      ; then is title
      (set-one-value gadget-obj :title final-string)
      ; else is a menu item
      (let ((aggrel (g-value gadget-obj :MENU-ITEM-LIST)))
	(Aggrelist-Edit-String-Func gadget-obj aggrel str-obj final-event
				    final-string :real-rank))))

(defun Menu-String-Func (gadget-obj str-obj final-event final-string)
  (if (eq str-obj (g-value gadget-obj :menu-title :text))
      ; then is title
      (set-one-value gadget-obj :title final-string)
      ; else is a menu item
      (let ((aggrel (g-value gadget-obj :MENU-ITEM-LIST)))
	(Aggrelist-Edit-String-Func gadget-obj aggrel str-obj
				    final-event final-string :rank))))

(defun Gauge-String-Func (gadget-obj str-obj final-event final-string)
  (declare (ignore final-event))
  (if (eq str-obj (g-value gadget-obj :gauge-title))
      ; then is title
      (set-one-value gadget-obj :title final-string)
      ; else return NIL
      NIL))

(defun Labeled-Box-String-Func (gadget-obj str-obj final-event final-string)
  (declare (ignore final-event))
  (if (eq str-obj (g-value gadget-obj :label-text))
      ; then is label (title)
      (set-one-value gadget-obj :label-string final-string)
      ; else return NIL
      NIL))

(defun String-String-Func (gadget-obj str-obj final-event final-string)
  (declare (ignore final-event))
  (if (eq str-obj gadget-obj)
      ; then is me (otherwise, is probably an error)
      (s-value str-obj :string final-string)
      ; else return NIL
      NIL))

(defun Motif-Button-String-Func (gadget-obj str-obj final-event final-string)
  (let ((aggrel (g-value gadget-obj :BUTTON-LIST)))
    (Aggrelist-Edit-String-Func gadget-obj aggrel str-obj
				final-event final-string :rank)))

(defun Motif-Menu-String-Func (gadget-obj str-obj final-event final-string)
  (let ((aggrel (g-value gadget-obj :MENU-ITEM-LIST)))
    (Aggrelist-Edit-String-Func gadget-obj aggrel str-obj
				final-event final-string :rank)))

