;;; -*- mode: lisp; package: editor -*-
;;; Last updated: <2005/07/08>

(provide "calc+")

(in-package "editor")

(eval-when (:compile-toplevel :load-toplevel :execute)
	(require "calc")
	(use-package *calc-package*))

(export '(calc+-beginning-of-line
		  calc+-complete-next
		  calc+-complete-previous
		  calc+-eval-line-add-history
		  calc+-modifier)
		"ed")

(defvar *calc-mode-syntax-table* nil)
(unless *calc-mode-syntax-table*
	(setf *calc-mode-syntax-table* (make-syntax-table))
	(set-syntax-match *calc-mode-syntax-table* #\( #\)))

(defvar *calc+-history* nil)
(defvar *calc+-completion-list* nil)
(defvar *calc+-completion-number* -1)

(setf (symbol-function 'calc::cls)
	  #'(lambda ()
			(delete-region (point-min) (point-max))
			(insert "$ ")
			(quit)))

(defun calc+-search-ans (num)
	(save-excursion
		(scan-buffer (concat "$ " (nth num *calc+-history*)) :reverse t)
		(next-line)
		(buffer-substring (point)
						  (progn
							  (goto-eol)
							  (point)))))

(defun calc+-modifier ()
	(interactive)
	(let ((ime (get-ime-mode))
		  cmd
		  str)
		(toggle-ime nil)
		(setf cmd (case (read-char)
					  ((#\1) #'(lambda ()
								   (interactive)
								   (when (setf str (calc+-search-ans 0))
									   (copy-to-clipboard str)
									   (message "Copy to clipboard \"~A\" ...done" str))))
					  ((#\C-1) #'(lambda ()
									 (interactive)
									 (when (setf str (calc+-search-ans 0))
										 (insert str))))
					  ((#\M-1) #'(lambda ()
									 (interactive)
									 (when (setf str (nth 0 *calc+-history*))
										 (insert str))))
					  ((#\2) #'(lambda ()
								   (interactive)
								   (when (setf str (calc+-search-ans 1))
									   (copy-to-clipboard str)
									   (message "Copy to clipboard \"~A\" ...done" str))))
					  ((#\C-2) #'(lambda ()
									 (interactive)
									 (when (setf str (calc+-search-ans 1))
										 (insert str))))
					  ((#\M-2) #'(lambda ()
									 (interactive)
									 (when (setf str (nth 1 *calc+-history*))
										 (insert str))))
					  ((#\3) #'(lambda ()
								   (interactive)
								   (when (setf str (calc+-search-ans 2))
									   (copy-to-clipboard str)
									   (message "Copy to clipboard \"~A\" ...done" str))))
					  ((#\C-3) #'(lambda ()
									 (interactive)
									 (when (setf str (calc+-search-ans 2))
										 (insert str))))
					  ((#\M-3) #'(lambda ()
									 (interactive)
									 (when (setf str (nth 2 *calc+-history*))
										 (insert str))))
					  ((#\4) #'(lambda ()
								   (interactive)
								   (when (setf str (calc+-search-ans 3))
									   (copy-to-clipboard str)
									   (message "Copy to clipboard \"~A\" ...done" str))))
					  ((#\C-4) #'(lambda ()
									 (interactive)
									 (when (setf str (calc+-search-ans 3))
										 (insert str))))
					  ((#\M-4) #'(lambda ()
									 (interactive)
									 (when (setf str (nth 3 *calc+-history*))
										 (insert str))))
					  ((#\5) #'(lambda ()
								   (interactive)
								   (when (setf str (calc+-search-ans 4))
									   (copy-to-clipboard str)
									   (message "Copy to clipboard \"~A\" ...done" str))))
					  ((#\C-5) #'(lambda ()
									 (interactive)
									 (when (setf str (calc+-search-ans 4))
										 (insert str))))
					  ((#\M-5) #'(lambda ()
									 (interactive)
									 (when (setf str (nth 4 *calc+-history*))
										 (insert str))))))
		(toggle-ime ime)
		(when cmd
			(call-interactively cmd))))

(defun calc+-make-completion (preedit)
	(setf *calc+-completion-list*
		  (if preedit
				  (let ((reg (compile-regexp (concat "^" (regexp-quote preedit)))))
					  (remove-if #'(lambda (x)
									   (not (string-match reg x))) *calc+-history*))
			  *calc+-history*)))

(defun calc+-get-line ()
	(let (line)
		(when (save-excursion
				  (goto-bol)
				  (looking-at "^ *\\$ *\\(.*\\)$"))
			(setf line (match-string 1))
			(when (not (string-match "^[ 	]*$" line))
				line))))

(defun calc+-eval-line-add-history ()
	(interactive)
	(let ((expr-line (calc+-get-line)))
		(when expr-line
			(setf *calc+-history* (cons expr-line *calc+-history*))))
	(calc-eval-line))

(defun calc+-complete-from-history (direction)
	(let (expr-begin expr-end)
		(when (save-excursion
				  (goto-bol)
				  (looking-at "^ *\\$ *\\(.*\\)$"))
			(setf expr-begin (match-beginning 1)
				  expr-end   (match-end 1))
			(unless (or (eq *last-command* 'calc+-complete-next)
						(eq *last-command* 'calc+-complete-previous))
				(setf *calc+-completion-list* (calc+-make-completion (calc+-get-line))
					  *calc+-completion-number* -1))
			(let (number str)
				(if (eq direction 'up)
						(if (< (1+ *calc+-completion-number*) (length *calc+-completion-list*))
								(setf number (1+ *calc+-completion-number*)))
					(if (> *calc+-completion-number* 0)
							(setf number (1- *calc+-completion-number*))))
				(when number
					(setf str (nth number *calc+-completion-list*))
					(delete-region expr-begin expr-end)
					(insert str)
					(setf *calc+-completion-number* number))))))

(defun calc+-complete-previous ()
	(interactive)
	(calc+-complete-from-history 'up))

(defun calc+-complete-next ()
	(interactive)
	(calc+-complete-from-history 'down))

(defun calc+-beginning-of-line ()
	(interactive)
	(if (save-excursion
			(goto-bol)
			(looking-at "^ *\\$ ?"))
			(goto-char (match-end 0))
		(goto-bol)))

(define-key *calc-mode-map* #\RET 'calc+-eval-line-add-history)
(define-key *calc-mode-map* #\C-a 'calc+-beginning-of-line)
(define-key *calc-mode-map* '(#\C-c #\C-c) 'calc+-modifier)
(define-key *calc-mode-map* #\C-M-n 'calc+-complete-next)
(define-key *calc-mode-map* #\C-M-p 'calc+-complete-previous)