;;; 
;;; eltk.el: Emacs Lisp 用のツールキットを作成する試案
;;; 
;;;     [1999/06/01] OSHIRO Naoki.
;;;   
;;;     $Log:$
;;;

;;; eltk-item-info: ((id type x y value command))
;;;   -->後々は ((id type x y (オプションの連想リスト))) としたい．
;;;      例えば ((id "text" x y 
;;;                  (("text" "foo") ("command" "shell") ("width" 10) ...)))
(defvar eltk-item-info nil)
(defvar eltk-item-curid 0)
(defvar eltk-width 50)
(defvar eltk-height 30)
(defvar eltk-grip nil)
(defvar eltk-x 0)
(defvar eltk-y 0)
(defvar eltk-widthfit nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun eltk-sample ()
  (interactive)
  (eltk-init)
  (eltk-create "text" 8 0 "Eltk Sample")
  (eltk-create "text" 0 1 "------------------------------")
  (eltk-create "text" 5 4 "1. foo" '(shell-command "echo hello"))
  (eltk-create "text" 5 5 "1. foo" '(shell-command "date"))
  (eltk-create "text" 5 6 "2. bazbaz"
       (list 'shell-command
	     (list 'format "echo %s" 
		   (list 'eltk-getvalue-item eltk-item-curid))))
  (eltk-create "text" 5 7 "3. barber\n   shop"
	       (list 'message (list 'format "id:%d" eltk-item-curid)))
  (eltk-create "text" 5 9 "4.")
  (eltk-create "text" 8 9 "whoami"
       (list 'shell-command
	     (list 'format "%s" 
		   (list 'eltk-getvalue-item eltk-item-curid))))
  (eltk-create "text" 5 10 "5. gnus" '(gnus))
  (eltk-create "text" 10 12 "+------+\n| Text |\n+------+")
  (eltk-create "text" 18 3  " | \n-+-\n | \n | \n | \n | \n | \n | ")
  (eltk-create "text" 1 16 
       "Key Bindings:\n  h:left j:down k:up l:right\n  (g ,):grip item\n  (x .):exec bind command\n  (e RET):edit a:add d:delete\n  (f i):raise (b u):lower\n  w:widthfit(10)")
)

;(defun eltk-sample ()
;  (interactive)
;  (eltk-init)
;  (eltk-create "text" 1 1 "foo")
;  (eltk-create "text" 1 2 "bar")
;  (eltk-create "text" 1 3 "baz")
;)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun eltk-string-split (split-char str)
  (let (list (m 0) (n 0))
    (catch 'done
      (while 1
	(if (not (setq m (string-match split-char str))) (throw 'done 1)
	  (setq list (cons (substring str 0 m) list))
          (setq str (substring str (+ m 1)))
	  )))
    (setq list (cons (substring str n) list))
    (reverse list)
    ))
(defun eltk-nthassoc (key list)
  (if (not (assoc key list)) nil
    (let ((n 0))
      (catch 'done
	(while list
	  (setq id (car (car list)))
	  (if (numberp key) (setq key (int-to-string key)))
	  (if (numberp id)  (setq id  (int-to-string id )))
	  (if (string= id key) (throw 'done 1))
	  (setq n (+ n 1))
	  (setq list (cdr list))))
      n)))
(defun eltk-nthdelete (n list)
  (eltk-nthreplace n list nil))
(defun eltk-nthinsert (n list ins)
  (if (>= n (length list))
      (eltk-nthreplace n list ins)
    (eltk-nthreplace n list (reverse (cons (nth n list) ins)))))
(defun eltk-nthreplace (n list rep)
  (if (>= n (length list))
      (progn
	(append
	 (reverse (nthcdr (- (length list) n) (reverse list)))
	 rep))
    (append
     (reverse (nthcdr (- (length list) n) (reverse list)))
     rep
     (nthcdr (+ n 1) list))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun eltk-make-canvas ()
  (set-buffer (get-buffer-create "*tmp*"))
  (erase-buffer)
  (overwrite-mode t)
  (let ((x 0) (y 0) (width eltk-width) (height eltk-height))
    (while (< y height)
      (setq x 0)
      (while (< x width)
	(insert " ")
	(setq x (+ x 1)))
      (insert "|\n")
      (setq y (+ y 1)))
    (setq x 0)
    (while (< x width)
      (insert "-")
      (setq x (+ x 1))))
  (goto-char (point-min)))
(defun eltk-setpoint (x y)
  (goto-line (+ y 1))
  (move-to-column x)
  (setq eltk-x x)
  (setq eltk-y y))
(defun eltk-delete-rectangle (text)
  (let ((x eltk-x) (y eltk-y) l)
    (setq text (reverse text))
    (while text
      (eltk-setpoint x (+ y (- (length text) 1)))
      (delete-char (length (car text)))
      (setq text (cdr text)))
    (eltk-setpoint x y)))
(defun eltk-widthfit-textlist (width src)
  (let (dest n)
    (while src
      (setq text (car src))
      (setq n (- (length text) width))
      (if (>= n 0)
	  (setq text (substring text 0 width))
	(while (< n 0)
	  (setq text (format "%s " text))
	  (setq n (+ n 1))
	  ))
      (setq dest (cons (format "%s|" text) dest))
      (setq src (cdr src))
      )
    (reverse dest)))
(defun eltk-display (type x y val)
  (save-excursion
    (switch-to-buffer (get-buffer-create "*tmp*"))
    (eltk-setpoint x y)
    (if eltk-widthfit
	(setq val (eltk-widthfit-textlist 10 (eltk-string-split "\n" val)))
      (setq val (eltk-string-split "\n" val)))
    (eltk-delete-rectangle val)
    (insert-rectangle val)))
(defun eltk-getvalue-item (id)
  (let ((n (eltk-nthassoc id eltk-item-info)))
    (if (not n) ()
      (nth 4 (nth n eltk-item-info)))))
(defun eltk-getcommand-item (id)
  (let ((n (eltk-nthassoc id eltk-item-info)))
    (if (not n) ()
      (nth 5 (nth n eltk-item-info)))))
(defun eltk-create (type x y val &optional command)
  (eltk-display type x y val)
  (setq n eltk-item-curid)
  (setq eltk-item-info (cons (list n type x y val command) eltk-item-info))
  (setq eltk-item-curid (+ n 1)))
(defun eltk-point-to-xy (p)
  (let ((x 0) (y 0))
    (setq p (- p 1))
    (setq y (/ p (+ eltk-width 2)))
    (setq x (- p (* y (+ eltk-width 2))))
    (list x y)))
(defun eltk-redisplay ()
  (interactive)
  (let ((info-list (reverse eltk-item-info)) (x eltk-x) (y eltk-y))
    (eltk-make-canvas)
    (while info-list
      (setq info (car info-list))
      (if (not info) ()
	(eltk-display (nth 1 info) (nth 2 info) (nth 3 info) (nth 4 info)))
      (setq info-list (cdr info-list)))
    (eltk-setpoint x y)))
(defun eltk-delete-item ()
  (interactive)
  (let ((id (car (car (eltk-find)))))
    (setq n (eltk-nthassoc id eltk-item-info))
    (if (not n) ()
      (if (and eltk-grip (= eltk-grip id)) (setq eltk-grip nil))
      (setq eltk-item-info (eltk-nthdelete n eltk-item-info))
      (eltk-redisplay))))
(defun eltk-move (id x y)
  (let ((n (eltk-nthassoc id eltk-info-list)))
    (if (not n) ()
      (setq info (nth n eltk-item-info))
      (setq eltk-x x)
      (setq eltk-y y)
      (setq info (eltk-nthreplace 2 info (list x)))
      (setq info (eltk-nthreplace 3 info (list y)))
      (setq eltk-item-info
	    (eltk-nthreplace n eltk-item-info (list info)))
      (eltk-redisplay)
      )))
(defun eltk-move-relative (sx sy)
  (interactive)
  (if (not eltk-grip) 
      (progn
	(setq eltk-x (+ eltk-x sx))
	(setq eltk-y (+ eltk-y sy))
	(eltk-setpoint eltk-x eltk-y)
	)
    (setq info (assoc eltk-grip eltk-item-info))
    (setq x (+ (nth 2 info) sx))
    (setq y (+ (nth 3 info) sy))
    (setq tmpx (+ eltk-x sx))
    (setq tmpy (+ eltk-y sy))
    (setq info (eltk-nthreplace 2 info (list x)))
    (setq info (eltk-nthreplace 3 info (list y)))
    (setq eltk-item-info
	  (eltk-nthreplace (eltk-nthassoc (car info) eltk-item-info) eltk-item-info (list info)))
    (eltk-redisplay)
    (eltk-setpoint tmpx tmpy)
    ))
(defun eltk-raise (id)
  (interactive)
  (let ((n (eltk-nthassoc id eltk-item-info)) info)
    (if (not n) ()
      (setq info (nth n eltk-item-info))
      (setq eltk-item-info (eltk-nthdelete n eltk-item-info))
      (setq eltk-item-info (eltk-nthinsert 0 eltk-item-info (list info)))
      (eltk-redisplay))
    (message "%S" eltk-item-info)
  ))
(defun eltk-lower (id)
  (interactive)
  (let ((n (eltk-nthassoc id eltk-item-info)) info)
    (if (not n) ()
      (setq info (nth n eltk-item-info))
      (setq eltk-item-info (eltk-nthdelete n eltk-item-info))
      (setq eltk-item-info (eltk-nthinsert (length eltk-item-info) eltk-item-info (list info)))
      (eltk-redisplay))
    (message "%S" eltk-item-info)
  ))
(defun eltk-execcommand-item ()
  (interactive)
  (let ((id (car (car (eltk-find)))))
    (if (not id) ()
      (eval (eltk-getcommand-item id)))))
(defun eltk-edit-item ()
  (interactive)
  (let ((id (car (car (eltk-find)))))
    (if (not id) ()
      (setq n (eltk-nthassoc id eltk-item-info))
      (setq info (nth n eltk-item-info))
      (setq val (read-string "Value: " (nth 4 info)))
      (setq eltk-item-info (eltk-nthreplace n eltk-item-info
	    (list (eltk-nthreplace 4 info (list val)))))
      (eltk-redisplay))))
(defun eltk-add-item ()
  (interactive)
  (setq val (read-string "Value: "))
  (if (string= val "") ()
    (eltk-create "text" eltk-x eltk-y val nil)
    (eltk-redisplay))
  )
(defun eltk-keysetup ()
  (interactive)
  (local-set-key "l" (quote eltk-move-relative-x))
  (local-set-key "h" (quote eltk-move-relative-xx))
  (local-set-key "j" (quote eltk-move-relative-y))
  (local-set-key "k" (quote eltk-move-relative-yy))
  (local-set-key "g" (quote eltk-toggle-grip-item))
  (local-set-key "," (quote eltk-toggle-grip-item))
  (local-set-key "b" (quote eltk-lower-grip))
  (local-set-key "u" (quote eltk-lower-grip))
  (local-set-key "f" (quote eltk-raise-grip))
  (local-set-key "i" (quote eltk-raise-grip))
  (local-set-key "d" (quote eltk-delete-item))
  (local-set-key "a" (quote eltk-add-item))
  (local-set-key "e" (quote eltk-edit-item))
  (local-set-key "x" (quote eltk-execcommand-item))
  (local-set-key "." (quote eltk-execcommand-item))
  (local-set-key "\r" (quote eltk-edit-item))
  (local-set-key "w" (quote eltk-toggle-widthfit))
)
(defun eltk-toggle-widthfit ()
  (interactive)
  (setq eltk-widthfit (not eltk-widthfit))
  (eltk-redisplay)
  )
(defun eltk-raise-grip ()
  (interactive)
  (eltk-raise eltk-grip))
(defun eltk-lower-grip ()
  (interactive)
  (eltk-lower eltk-grip))
(defun eltk-move-relative-y ()
  (interactive)
  (eltk-move-relative 0 1))
(defun eltk-move-relative-x ()
  (interactive)
  (eltk-move-relative 1 0))
(defun eltk-move-relative-yy ()
  (interactive)
  (eltk-move-relative 0 -1))
(defun eltk-move-relative-xx ()
  (interactive)
  (eltk-move-relative -1 0))
(defun eltk-find ()
  (interactive)
  (let (p x y xx yy id-list)
    (setq p (eltk-point-to-xy (point)))
    (setq x (nth 0 p))
    (setq y (nth 1 p))
    (let ((info-list eltk-item-info) xx yy)
      (catch 'found
	(while info-list
	  (setq info (car info-list))
	  (setq id (nth 0 info)
		xx (nth 2 info)
		yy (nth 3 info)
		val (nth 4 info))
	  (setq text (eltk-string-split "\n" val))
	  (catch 'found-line
	    (while text
	      (setq w (length (car text)))
	      (if eltk-widthfit (setq w 10))
	      (setq text (cdr text))
	      (if (and (>= x xx) (< x (+ xx w)) (= y yy))
		  (progn
		    (setq id-list (cons (list id val) id-list))
		    (throw 'found-line 1)))
	      (setq yy (+ yy 1))))
	  (setq info-list (cdr info-list))
	  )))
    (setq id-list (reverse id-list))
    (message "(%s,%s):%s" x y id-list)
    id-list
))
(defun eltk-toggle-grip-item ()
  (interactive)
  (if eltk-grip (setq eltk-grip nil)
    (let ((id (car (car (eltk-find)))))
      (if id (setq eltk-grip id))))
  (message "Grip: %s" eltk-grip)
  )
(defun eltk-init ()
  (interactive)
  (setq eltk-item-curid 0)
  (setq eltk-item-info nil)
  (setq eltk-grip nil)
  (setq eltk-x 0)
  (setq eltk-y 0)
  (eltk-make-canvas)
  (eltk-keysetup)
  )

;;; end of eltk.el