;;; tempo2.el --- Alternative template mode.
;;
;; ~/share/emacs/pkg/tempo2/tempo2.el ---
;;
;; $Id: tempo2.el,v 1.12 2005/10/12 19:20:54 harley Exp $
;;

;;; Commentary:

;; I didnt like the way "tempo.el" defined the templates.
;; The quoting of the symbols was hard to write correctly.
;; "'n" and "n" ought to be the same.  Tempo2 fixes
;; that.  Templates are stored in a hash table which is kept
;; as a property on the major mode.

;; templates are modeled after "tempo.el" templates:
;;  "strings" self insert
;;  symbols are treated as controls:
;;     >    indent
;;     n    newline
;;     >n   indent newline
;;     p    point to return to
;;  (p "prompt" var)  prompt for a string, insert it and store it in var
;;  (p nil var)       insert var previously prompted for
;;  (functions) are evaluated and the return values used as a template.
;; 

;; (tempo2-electric-add
;;  'emacs-lisp-mode
;;  '("defun" "(defun " p " (" p ")" >n
;;         "\"" p "\"" >n "(interactive" p ")" >n > p ")")
;;  '("if" "(if " p >n > p ")")
;;  '("when" "(when " >n > p ")")
;;  '("let" "(let ((" p "))" >n > p ")"))
;; and so on...

;; M-x tempo2-mode
;; type the keyword "for", then ctrl-right.
;; press ctrl-right to advance to the next points

;;; History:


;;; User Vars:

(defvar tempo2-interactive t
  "If we should prompt for expansions interactively.")
(make-local-variable 'tempo2-interactive)


(defvar tempo2-mode-map
  (let ((map (make-sparse-keymap)))
    ;; (define-key map " "      'tempo2-expand-at-point-or-insert)
    ;; this is busted
    ;; (define-key map "\C-c-"  'tempo2-mode-off)
    (define-key map [f6]     'tempo2-expand-at-point)
    (define-key map ""  'tempo2-expand-at-point-or-forward)
    (define-key map ""  'tempo2-backward-mark)
    map))

;; Internal Vars:
(defvar tempo2-mode nil
  "Variable for.")
(make-variable-buffer-local 'tempo2-mode)

(defvar tempo2-symbol-cmds (make-hash-table))

(defvar tempo2-prompt-vars nil
  "The value of vars already prompted for.")

(defvar tempo2-markers-first nil
  "First marker to jump to after inserting a template.")

(defvar tempo2-buffer-hashtable nil
  "Hashtable to use for the current buffer.")
(make-local-variable 'tempo2-buffer-hashtable)

(defvar tempo2-markers nil
  "List of tempo markers.")
(make-local-variable 'tempo2-markers)

;;; Code:

(add-to-list 'minor-mode-alist '(tempo2-mode " t2"))
(add-to-list 'minor-mode-map-alist (cons 'tempo2-mode tempo2-mode-map))

(defun tempo2-mode (&optional arg)
  "Toggle variable tempo2-mode.  On with ARG."
  (interactive "P")
  (setq tempo2-mode
	(if (null arg) (not tempo2-mode)
            (> (prefix-numeric-value arg) 0)))
  (force-mode-line-update))

;; Are these needed?
(defun tempo2-mode-on ()
  "Turn on tempo2-mode."
  (interactive)
  (tempo2-mode +1))
(defun tempo2-mode-off ()
  "Turn off tempo2-mode."
  (interactive)
  (tempo2-mode -1))

(defun tempo2-markers-clear ()
  "Clear the markers in the buffer."
  (setq tempo2-markers nil))

(defun tempo2-markers-add (marker)
  "Add the MARKER to the list of tempo markers."
  ;; cast to a marker
  (when (not (markerp marker))
    (setq marker (let ((m (make-marker))) (set-marker m marker))))
  ;; set the first if unset
  (if (not tempo2-markers-first)
    (setq tempo2-markers-first marker))
  ;; add it to the list.
  (setq tempo2-markers (cons marker tempo2-markers))
  (tempo2-markers-sorted))

(defun tempo2-markers-sorted ()
  "."
  (setq tempo2-markers (sort tempo2-markers #'<))
  tempo2-markers)
;; (tempo2-markers-sorted)

(defun tempo2-markers-find-around (pos)
  "Scan the list to find the next marker.
Argument POS a."
  (let ((marks (tempo2-markers-sorted))
        (m-prev -1)
        (m-next nil))
    (while (and marks (< (car marks) pos))
      (let ((tmp (car marks)))
        (when (< m-prev tmp)
          (setq m-prev tmp)))
      (setq marks (cdr marks)))
    ;; fixup ends
    (setq m-prev (if (/= m-prev -1) m-prev))
    (setq m-next (car marks))
    (when (and m-next (= m-next pos))
      (setq m-next (cadr marks)))
    ;;
    (list m-prev m-next)))

(defun tempo2-forward-mark (&optional pnt)
  "Move forward to the next tempo2 marker after PNT."
  (interactive "d")
  (setq pnt (if pnt pnt (point)))
  (let ((found (tempo2-markers-find-around pnt)))
    (let ((p (cadr found)))
      (when p
        (goto-char p)))))

(defun tempo2-backward-mark (&optional pnt)
  "Move backward to the prior tempo2 marker before PNT."
  (interactive "d")
  (setq pnt (if pnt pnt (point)))
  (let ((found (tempo2-markers-find-around pnt)))
    (let ((p (car found)))
      (when p
        (goto-char p)))))

;;;;;;;;;;

;; (assert nil t "args: %s %s %s" 1 2 3 4)

(defmacro deftempo2-symbol-cmd (cmd &rest body)
  "Tempo2:.
Argument CMD aa.
Optional argument BODY aa."
  (assert (symbolp cmd) "must be a symbol")
  (let ((cmd-symbol (intern (format "tempo2-symbol-cmd-%s" cmd))))
    `(progn
       (defun ,cmd-symbol ,@body)
       (puthash ',cmd ',cmd-symbol tempo2-symbol-cmds)
       ',cmd-symbol)))

(deftempo2-symbol-cmd > (arg)
  "tempo2: "
  (indent-according-to-mode))

(deftempo2-symbol-cmd n (arg)
  "tempo2: "
  (insert "\n"))

(deftempo2-symbol-cmd >n (arg)
  "tempo2: "
  (save-excursion (indent-according-to-mode))
  (insert "\n"))

(deftempo2-symbol-cmd quote (arg)
  "tempo2: "
  (funcall 'tempo2-eval (cdr arg)))

;;;;;;;;;;

(defun tempo2-var-find (var)
  "Find the binding for VAR."
  (assoc var tempo2-prompt-vars))

(defun tempo2-var-bind (var val)
  "Bind the tempo VAR to VAL."
  (let ((varval (list var val)))
    (setq tempo2-prompt-vars (cons varval tempo2-prompt-vars))
    varval))

;; fixme: check for symbol (p "prompt" var) (p var)
;; or be compatable with tempo2?
(deftempo2-symbol-cmd p (arg)
  "tempo2: Remember a point to return to later."
  (let ((prompt (cadr arg))
        (var (caddr arg)))
    ;; remember where we are
    (tempo2-markers-add (point))
    ;; have a value?
    (if var
      (let ((varval (tempo2-var-find var)))
        (if varval
          (insert (cadr varval))
          (let ((val (read-string prompt)))
            (insert val)
            (tempo2-var-bind var val))))
      (if prompt
        (insert (read-string prompt)))
      nil)))

;;;;;;;;;;

(defun tempo2-eval (exp)
  "Evaluate the template expression EXP."
  (cond
   ;; skip nulls
   ((null exp)
    nil)
   ;; insert strings
   ((stringp exp)
    (insert exp))
   ;; a command symbol?
   ((and (symbolp exp) (gethash exp tempo2-symbol-cmds))
    ;;(message "symbol: '%s'" exp)
    (funcall (gethash exp tempo2-symbol-cmds) (list exp)))
   ;; a command symbol with args?
   ((and (listp exp) (gethash (car exp) tempo2-symbol-cmds))
    (funcall (gethash (car exp) tempo2-symbol-cmds) exp))
   ;; looks like a function? eval it
   ((and (listp exp) (functionp (car exp)))
    (tempo2-eval (eval exp)))
   ;; some unknown list
   ((listp exp)
    (mapcar 'tempo2-eval exp))
   (t
    (error "Not handled: '%s'" exp)))
  nil)

(defun tempo2-eval-template (template)
  "Evaluate the tempo2 TEMPLATE."
  (let ((tempo2-markers-first nil)
        (tempo2-prompt-vars   nil))
    (tempo2-eval template)
    ;; jump to the first spot
    (when tempo2-markers-first
      (goto-char tempo2-markers-first))))

;;;;;;;;;;

(defun tempo2-hashtable-mode-clear (&optional mode)
  "Clear the tempo2 hashtable for the MODE."
  (let ((m (or mode major-mode)))
    (if m
      (put m 'tempo2-hashtable nil))))
;; (tempo2-hashtable-mode-clear 'perl-mode)

(defun tempo2-electric-mode-table (mode)
  "Get the electric hashtable for MODE."
  (if (not (hash-table-p (get mode 'tempo2-hashtable)))
    (put mode 'tempo2-hashtable (make-hash-table :test 'equal)))
  (get mode 'tempo2-hashtable))
 
(defun tempo2-electric-alias (mode &rest modes)
  (let ((tbl (tempo2-electric-mode-table mode)))
    (dolist (m modes)
      (put m 'tempo2-hashtable tbl))
    nil))
 
(defun tempo2-electric-add (mode &rest templates)
  "Set up MODE to have TEMPLATES defined."
  (let ((tbl (tempo2-electric-mode-table mode))
        (tlst templates))
    (while tlst
      (when (car tlst)
        ;;(message "tlst: %s" tlst)
        (puthash (caar tlst) (cdar tlst) tbl)
        ;; (message "%s=>%s" (caar tlst) (cdar tlst));;(car tlst))
        (setq tlst (cdr tlst))))
    mode))

(defun tempo2-buffer-hashtable ()
  "Return the tempo2 hashtable for this buffer."
  (or tempo2-buffer-hashtable
      (let ((table (get major-mode 'tempo2-hashtable)))
        (when table
          (setq tempo2-buffer-hashtable table)
          table))))

;;;;;;;;;;

(defun tempo2-expand-at-point (arg)
  "Exapnd the template before point.  Dont expand with ARG."
  (interactive "*p")
  (let (w-start w-end word table template
                (did-expand nil))
    ;; FIXME: make find-word a function
    ;; set a var to the word for user use
    ;; find the word
    (save-excursion
      (setq w-end (point))
      ;;(backward-word)
      (skip-syntax-backward "w_")
      (setq w-start (point))
      (when (< w-start w-end)
        (setq word (buffer-substring-no-properties w-start w-end))))
    ;;
    ;; (message "word: '%s'" word)
    ;; 
    (when word
      (setq table (tempo2-buffer-hashtable))
      (when table
        (setq template (gethash word table))
        (when template
          (kill-region w-start w-end)
          (tempo2-eval-template template)
          (setq did-expand t))))
    ;; return wether we expanded or not.
    did-expand))

(defun tempo2-expand-at-point-or-insert (&optional arg)
  "If not ARG and before a template, expand it, else insert the char."
  (interactive "*p")
  ;; (message "arg: '%s'" arg)
  (if (and (= arg 1) (not (tempo2-expand-at-point arg)))
    (self-insert-command arg)))

(defun tempo2-expand-at-point-or-forward (&optional arg)
  "If not ARG, expand the template else move forward."
  (interactive "*p")
  ;; (message "arg: '%s'" arg)
  (if (and (= arg 1) (not (tempo2-expand-at-point arg)))
    (tempo2-forward-mark)))

;;
(provide 'tempo2)

;;; tempo2.el ends here