;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XAM
;;;                       Module: Bitmaps
;;;                       Version: 1.0
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/xam/bitmap-meta.lisp
;;; File Creation Date: 02/04/92 10:41:30
;;; Last Modification Time: 12/09/92 08:17:55
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)

(defvar *bitmap-editor* "bitmap")
(defvar *edit-original-bitmap-p* nil)
(defvar *bitmap-temp-directory* (system-pathname :xit "../bitmaps/tmp/"))

(defvar *meta-bitmap-menu*)

(defun call-bitmap-editor (bitmap-filename &optional param-string)
  "invoke the bitmap editor, bitmap-filename is full pathname with extention"
  ;; got to cd to the tmp directory first as bitmap
  ;; doesn't cope with long pathnames
  (declare (special *bitmap-temp-directory*
		    *bitmap-editor*
		    *edit-original-bitmap-p*))
  (let* (result
	 old-date
	 (tmp-name (concatenate 'string  *bitmap-temp-directory* 
				(file-namestring bitmap-filename)))
	 (cp-chmod-cmd (concatenate 'string  "/bin/cp " bitmap-filename 
				   " " *bitmap-temp-directory* 
				   ";/bin/chmod 666  "tmp-name))
	 (args (concatenate 'string  "cd " *bitmap-temp-directory* ";"
			   *bitmap-editor* " -display " (display-variable) " " 
		           param-string  (file-namestring bitmap-filename))))
    (shell-command cp-chmod-cmd)
  
    (if (probe-file tmp-name)
      (setf old-date (file-write-date tmp-name))
      (setf old-date 0))
    (shell-command args)
    (setf result (> (file-write-date tmp-name) old-date))
    (when result ; bitmap was changed
      (pushnew *bitmap-temp-directory* *bitmap-directory* :test 'string-equal)
      (when *edit-original-bitmap-p* ;; overwrite original
	(setf args 
	    (concatenate 'string  "/bin/cp " tmp-name bitmap-filename))
	(shell-command args)))
    result
   ))

(defmethod edit-bitmap ((self bitmap-dispel))
  "Edits an image file by invoking an external bitmap editor"
  (if (call-bitmap-editor (get-bitmap-file self))
	    (reload-bitmap self)))

#||
(defmethod select-another-bitmap ((self bitmap-dispel) directory)
  "displays a list of radiobuttoned bitmapnames and sets new bitmap"
  ;; directory is a string
  (let ((entry-list nil) a-name sel-result
			 (dir-contents (directory 
					(make-pathname 
					 :directory directory
					 :name :wild :type :wild))))
    (dolist (entry dir-contents)
      (setf a-name (pathname-name entry))
      (push (list* a-name a-name) entry-list))
    (setf sel-result (single-select "Bitmap:" :entries entry-list))
    (if (not (eq sel-result :CANCEL))	; I'd rather a result of NIL
	(replace-bitmap self sel-result) sel-result)))
||#

(defmethod select-meta-bitmap-menu ((self bitmap-dispel))
  (declare (special *meta-bitmap-menu*))
  (unless (and (boundp '*meta-bitmap-menu*) *meta-bitmap-menu*)
    (setf *meta-bitmap-menu* (make-meta-bitmap-menu)))
  (setf (view-of *meta-bitmap-menu*) self)
  (popup *meta-bitmap-menu*))

(defun destroy-meta-bitmap-menu ()
  (declare (special *meta-bitmap-menu*))
  (destroy-and-make-unbound *meta-bitmap-menu*))

(defun make-meta-bitmap-menu ()
  (while-busy nil
    (make-window 'shadow-popup-margined-window
       :name :meta-bitmap-menu
       :adjust-size? t
       :destroy-after? nil
       :margins 
       `((standard-margins
	  :label-options
	  (:name :label
	   :inside-border 3
	   :text "Bitmaps")
	  :quad-space-options
	  (:name :space
	   :thickness 1)))
       :client-window 
       `(uniform-part-intel
	 :adjust-size? t
	 :part-class bitmap-menu
	 :layouter distance-layouter
	 :inside-border 5
	 :reactivity-entries
	 ((:part-event
	   (call :eval (setf (bitmap (view-of *self*))
			   *part-value*))))
	 :parts   ((:part-mouse-feedback :inverse
		    :layouter (distance-layouter :orientation :right)
		    :reactivity-entries ((:part-event (call :pass-part-event))) 
		    :parts
		    ((:view-of "radio-choice-box-clear"
		      :bitmap "radio-choice-box-clear"
		      :action-docu "Select Bitmap: radio-choice-box-clear")
		     (:view-of "radio-choice-box-set"
		      :bitmap "radio-choice-box-set"
		      :action-docu "Select Bitmap: radio-choice-box-set")))
		   (:part-mouse-feedback :inverse
		    :layouter (distance-layouter :orientation :right)
		    :reactivity-entries ((:part-event (call :pass-part-event))) 
		    :parts
		    ((:view-of "choice-box-clear"
		      :bitmap "choice-box-clear"
		      :action-docu "Select Bitmap: choice-box-clear")
		     (:view-of "choice-box-set"
		      :bitmap "choice-box-set"
		      :action-docu "Select Bitmap: choice-box-set")
		     (:view-of "choice-box-checked"
		      :bitmap "choice-box-checked"
		      :action-docu "Select Bitmap: choice-box-checked")))
		   (:part-mouse-feedback :inverse
		    :layouter (distance-layouter :orientation :right)
		    :reactivity-entries ((:part-event (call :pass-part-event))) 
		    :parts
		    ((:view-of "button"
		      :bitmap "button"
		      :action-docu "Select Bitmap: button")
		     (:view-of "bar"
		      :bitmap "bar"
		      :action-docu "Select Bitmap: bar")))
		   (:part-mouse-feedback :inverse
		    :layouter (distance-layouter :orientation :right)
		    :reactivity-entries ((:part-event (call :pass-part-event))) 
		    :parts
		    ((:view-of "button-m"
		      :bitmap "button-m"
		      :action-docu "Select Bitmap: button-m")
		     (:view-of "button-ml"
		      :bitmap "button-ml"
		      :action-docu "Select Bitmap: button-ml")
		     (:view-of "button-l"
		      :bitmap "button-l"
		      :action-docu "Select Bitmap: button-l")
		     (:view-of "button-xl"
		      :bitmap "button-xl"
		      :action-docu "Select Bitmap: button-xl")))
		  (:part-mouse-feedback :inverse
		   :layouter (distance-layouter :orientation :right)
		   :reactivity-entries ((:part-event (call :pass-part-event))) 
		   :parts
		   ((:view-of "accept-button-m"
		     :bitmap "accept-button-m"
		     :action-docu "Select Bitmap: accept-button-m")
		    (:view-of "accept-button-ml"
		     :bitmap "accept-button-ml"
		     :action-docu "Select Bitmap: accept-button-ml")
		    (:view-of "accept-button-l"
		     :bitmap "accept-button-l"
		     :action-docu "Select Bitmap: accept-button-l")
		    (:view-of "accept-button-xl"
		     :bitmap "accept-button-xl"
		     :action-docu "Select Bitmap: accept-button-xl")))
		  (:part-mouse-feedback :inverse
		   :layouter (distance-layouter :orientation :right)
		   :reactivity-entries ((:part-event (call :pass-part-event))) 
		   :parts
		   ((:view-of "button-l-rec"
		     :bitmap "button-l-rec"
		     :action-docu "Select Bitmap: button-l-rec")
		    (:view-of "button-3d"
		     :bitmap "button-3d"
		     :action-docu "Select Bitmap: button-3d")
		    (:view-of "button-xxl"
		     :bitmap "button-xxl"
		     :action-docu "Select Bitmap: button-xxl"))))))))




