;;; CLisp OLE Automation interface
;;;
;;; Copyright (C) 2005 Tomas Hlavaty <kvietaag@seznam.cz>
;;;
;;; This is Free Software, covered by the GNU GPL (v2)
;;; See http://www.gnu.org/copyleft/gpl.html

(defpackage "EXCEL"
  (:use "OLE" "LISP")
  (:export "EXCEL" "WORKBOOKS" "WORKBOOK" "WORKSHEETS" "WORKSHEET" "RANGE"))

(in-package "EXCEL")

(pushnew :excel *features*)

;;; classes

(defclass excel (idispatch)
  ()
  (:default-initargs :interface (ole:create "excel.application" t)))

(defclass workbooks (idispatch)
  ())

(defclass workbook (idispatch)
  ())

(defclass worksheets (idispatch)
  ())

(defclass worksheet (idispatch)
  ())

(defclass range (idispatch)
  ())

;;; methods

(defmethod quit-excel ((excel excel))
  (ole:invoke-method excel "quit"))

(defmethod excel-version ((excel excel))
  (ole:invoke-get excel "version"))

(defmethod visible ((excel excel))
  (ole:invoke-get excel "visible"))

(defmethod (setf visible) (visible (excel excel))
  (ole:invoke-put excel "visible" (if visible 1 0))
  visible)

;;(with-ole ((excel (make-instance 'excel)))
;;  (setf (visible excel) t)
;;  (format t "@@@ *ole-objects* ~s~%" ole::*ole-objects*))

;; (with-ole ()
;;   (with-iunknown (excel (make-instance 'excel :interface (create "excel.application" t)))
;; 	(format t "-- visible ~s~%" (visible excel))
;; 	(format t "-- visible ~s~%" (setf (visible excel) t))
;; 	(format t "-- visible ~s~%" (visible excel))
;; 	(format t "-- visible ~s~%" (setf (visible excel) nil))
;; 	(format t "-- visible ~s~%" (visible excel))))

(defmethod user-control ((excel excel))
  (ole:invoke-get excel "usercontrol"))

(defmethod active-book ((excel excel))
  (let ((dispatch (ole:invoke excel ole::DISPATCH_PROPERTYGET "activebook" nil t)))
	(when dispatch
	  (make-instance 'workbook :interface dispatch))))

(defmethod active-sheet ((excel excel))
  (let ((dispatch (ole:invoke excel ole::DISPATCH_PROPERTYGET "activesheet" nil t)))
	(when dispatch
	  (make-instance 'worksheet :interface dispatch))))

;(defmethod active-cell ((excel excel))
;  (ole:invoke-get excel "activecell"))

(defmethod open-excel-file ((self workbooks) filename)
  (ole:invoke-get self "open" filename))

(defmethod add-workbook ((books workbooks) &optional name)
  (let ((dispatch (if name
					  (ole:invoke books ole::DISPATCH_PROPERTYGET "add" (list name) t)
					  (ole:invoke books ole::DISPATCH_PROPERTYGET "add" nil t))))
	(when dispatch
	  (make-instance 'workbook :interface dispatch))))

(defmethod add-worksheet ((book workbook) &optional name)
  (let ((dispatch (if name
					  (ole:invoke book ole::DISPATCH_PROPERTYGET "add" (list name) t)
					  (ole:invoke book ole::DISPATCH_PROPERTYGET "add" nil t))))
	(when dispatch
	  (make-instance 'worksheet :interface dispatch))))

(defmethod count-workbooks ((self workbooks))
  (ole:invoke-get self "count"))

(defmethod count-worksheets ((self worksheets))
  (ole:invoke-get self "count"))

(defmethod name ((self workbook))
  (ole:invoke-get self "name"))

(defmethod name ((self worksheet))
  (ole:invoke-get self "name"))

(defmethod workbooks ((self excel))
  (let ((dispatch (ole:invoke self ole::DISPATCH_PROPERTYGET "workbooks" nil t)))
	(when dispatch
	  (make-instance 'workbooks :interface dispatch))))

(defmethod workbook ((self excel) i)
  (let ((dispatch (ole:invoke self ole::DISPATCH_PROPERTYGET "workbooks"
							  (list i) t)))
	(when dispatch
	  (make-instance 'workbook :interface dispatch))))

(defmethod worksheets ((self workbook))
  (let ((dispatch (ole:invoke self ole::DISPATCH_PROPERTYGET "worksheets" nil t)))
	(when dispatch
	  (make-instance 'worksheets :interface dispatch))))

(defmethod worksheet ((self workbook) i)
  (let ((dispatch (ole:invoke self ole::DISPATCH_PROPERTYGET "worksheets"
							  (list i) t)))
	(when dispatch
	  (make-instance 'worksheet :interface dispatch))))

(defmethod range ((sheet worksheet) &optional name)
  (let ((dispatch (if name
					  (ole:invoke sheet ole::DISPATCH_PROPERTYGET "range" (list name) t)
					  (ole:invoke sheet ole::DISPATCH_PROPERTYGET "range" nil t))))
	(when dispatch
	  (make-instance 'range :interface dispatch))))

(defmethod (setf value) (val (range range))
  (ole:invoke-put range "value" val)
  val)

(defmethod (setf saved) (val (book workbook))
  (ole:invoke-put book "saved" (if val 1 0))
  val)

;;; examples

(defun get-structure (filename)
  (ole:with-ole ((excel (make-instance 'excel))
				 (books (workbooks excel)))
	(open-excel-file books filename)
	(prog1 (loop for i from 1 to (count-workbooks books)
				 for book = (workbook excel i)
				 for sheets = (worksheets book)
				 collect (cons (name book)
							   (list
								(loop for i from 1 to (count-worksheets sheets)
									  for sheet = (worksheet book i)
									  collect (name sheet)))))
	  (quit-excel excel))))

;;(get-structure "c:/Program Files/Microsoft Office/OFFICE11/SAMPLES/SOLVSAMP.XLS")

(defun example1 ()
  (ole:with-ole ((excel (make-instance 'excel))
				 (books (workbooks excel)))
	(setf (visible excel) t)
	(let* ((book (add-workbook books))
		   (sheet (active-sheet excel))
		   (range (range sheet "A1:E7"))) ; intentionally isn't 3x3 array;-)
	  (prog1 (list (name book) (name sheet))
		(let* ((n 3) ; 3x3 array:-)
			   (data (make-array `(,n ,n))))
		  (dotimes (i n)
			(dotimes (j n)
			  (setf (aref data i j) (* (1+ i) (1+ j)))))
		  (setf (value range) data))
		(sleep 3) ; watch the sheet for a while
		(setf (saved book) t)
		(quit-excel excel)))))

;;(example1)