;;; uko-macros.el -- macros used in UKO-II

;; Copyright (C) 2003 Michael Kuehn, Universität Koblenz-Landau

;; Author: Michael Kuehn <kuehn@uni-koblenz.de>
;; Maintainer: Michael Kuehn <kuehn@uni-koblenz.de>
;; Created: March 2003
;; 
;; $Id: uko-macros.el,v 1.4 2003/09/23 09:52:22 rriipp Exp $



(defvar uko-macros-names-buffer nil
  "Buffer containing the available UKO-II macro names.")

(defvar uko-macros-expansion-list
  (list
   (cons  "KOMMA" 'uko-macro-komma)
   (cons  "PUNKT" 'uko-macro-punkt)
   (cons  "ZEILE" 'uko-macro-zeile)
   (cons  "GROß" 'uko-macro-gross)
   (cons  "NEUES" 'uko-macro-neues)
   (cons  "SICHER" 'uko-macros-sicher)
   (cons  "LEER" 'uko-macro-leerz)
   (cons  "ZUSAMMEN" 'uko-macro-zusamm)
   (cons  "LÖSCHEN" 'uko-macro-loesch)
   (cons  "SPRECHEN" 'uko-macro-sprich)
   (cons  "ENDE" 'uko-macro-ende)
   (cons  "LAUT" 'uko-macro-laut)
   (cons  "LOGOX" 'uko-macro-logox)
   ) 
  "The association list mapping the macro names to the macro functions.")

(defvar uko-macros-macro nil)

(defvar uko-macros-text-window nil
  "Temporary store for UKO-II text window.")

(defvar uko-find-buffer-word-point 0)

(defvar uko-find-buffer-word-code "")

(defun uko-macro-initialize ()
  "Initialization routine for UKO-II macro facility."
  (setq uko-macros-names-buffer (get-buffer-create "*UKO Macro Names*"))
  (save-current-buffer
    (set-buffer uko-macros-names-buffer)
    (setq modeline-format (list " UKO Macros"))
    (delete-region (point-min) (point-max))
    (let ((macs uko-macros-expansion-list))
      (while macs
	(insert (caar macs))
	(newline)
	(setq macs (cdr macs))
	) ) )
  )

;; calls "uko-set-macros-state"
(defun uko-macros ()
  "sdfhakjsdhf
asdklfjklsdjf"
  (interactive)
  (uko-set-macros-state)
  )

;; calls "uko-macros-commmand-state"
(defun uko-macros-command ()
  (interactive)
  (uko-set-macros-command-state)
  )



;; calls "uko-set-macros-state" to return to beginning of input, undos previous input
(defun uko-macros-command-undo ()
  (interactive)
  (uko-set-macros-state)
  (message uko-macros-macro)
  )



;; chooses selected word from macros-expansion-list and leaves
(defun uko-macros-execute ()
  "Take the selected macro of the name buffer and execute it."
  (interactive)
  (beginning-of-line)
  (let ((here (point)))
    (end-of-line)
    (let ((name (buffer-substring here (point)))) 
      (let ((macr (assoc name uko-macros-expansion-list)))
	(unless macr (error 'unknown-macro))
	(uko-macros-leave)
	(command-execute (cdr macr))
	) ) ) )
	

;; 
(defun uko-macros-leave ()
  "Leave UKO-II macro mode."
  (goto-char 1)
  (set-window-buffer uko-proposal-window uko-proposal-empty-buffer)
  (uko-proposal-delete-window)
  (select-window uko-macros-text-window)
  (uko-set-default-state)
  (goto-char (extent-start-position uko-expand-extent))
  (delete-region (point) (extent-end-position uko-expand-extent))
  (set-extent-endpoints uko-expand-extent (point) (point))
  )

(defun uko-macros-cancel ()
  (interactive)
  "Cancel UKO-II macro mode."
  (uko-macros-leave)
  (uko-enter)
  )

;;;----------------------------------------------------------------


;;; macro-retrieval works like the i-search in emacs. 

;; deletes the last letter of the selection-string and calls uko-macros-retrieve
(defun uko-macros-delete-letter ()
  (interactive)
  (when (> (point) (extent-start-position uko-expand-extent))
    (delete-backward-char 1)
    (uko-macros-retrieve)
  ) )


;; selects the first macro matching the selection-string
(defun uko-macros-retrieve ()
  (setq uko-search-last-direction nil)
  (save-current-buffer
    (set-buffer uko-macros-names-buffer)
    (goto-char (point-min))
    )
  (uko-macros-retrieve-next)
  )

(defun uko-macros-retrieve-next ()
  (interactive)
  (if (uko-search-forward-buffer 
        (substring (extent-string uko-expand-extent) 0 -1)
	uko-macros-names-buffer t nil)
      (save-current-buffer
	(set-buffer uko-macros-names-buffer)
	(beginning-of-line)
	(let ((here (point)))
	  (end-of-line)
	  (setq uko-macros-macro (buffer-substring here (point)))
	  (message uko-macros-macro)
	  (sleep-for 1)
	  ) )
    (progn 
      (setq uko-macros-macro nil) 
      (beep)
    ) ) )

;; ============================================================

(defun uko-insert-punctuation (p &optional caps)
  (when (equal (char-before) ?\ ) (delete-backward-char 1))
  (insert p) (insert ?\ )
  (when caps (setq uko-capsword-flag t) )
  )

(defun uko-macro-komma ()				 
  (interactive)
  (uko-insert-punctuation ?\, )
  (uko-enter)
  )

(defun uko-macro-punkt ()
  (interactive)
  (uko-insert-punctuation ?\. t)
  (uko-enter)
  )

(defun uko-macro-zeile ()
  (interactive)
  (insert ?\n )
  (setq uko-capsword-flag t)
  (uko-enter)
  )

(defun uko-macro-gross ()
  (interactive)
  (let ((here (point)))
    (backward-word 1)
    (let ((char (string-to-char (buffer-substring (point) (+ 1 (point))))))
      (if (char= char (downcase char))
	  (upcase-region (point) (+ 1 (point)))
	(downcase-region (point) (+ 1 (point)))
	) )
    (goto-char here)
    )
  (uko-enter)
  )

(defun uko-macro-leerz ()
  (interactive)
  (insert " ")
  (uko-enter)
  )

(defun uko-macro-zusamm ()
  (interactive)
  (backward-word 1)
  (delete-backward-char 1)
  (forward-word 1)
  (forward-char 1)
  (uko-enter)
  )

(defun uko-macro-neues ()
  (interactive)
  (let ((here (point)) word)
    (backward-word 1)
    (let ((there (point)))
      (forward-word 1)
      (setq word (buffer-substring there (point)))
      )
    (goto-char here)
    (save-current-buffer
      (set-buffer uko-noclient-dictionary-buffer)
      (goto-char (point-max))
      (insert word)
      (insert "\n")
      ) )
  (uko-enter)
  )

(defun uko-macros-sicher ()
  (interactive)
  (save-current-buffer
    (set-buffer uko-noclient-dictionary-buffer)
    (write-region (point-min) (point-max) 
	(concat uko-emacs-directory "ukodict.txt"))
    )
  (uko-enter)
  )

(defun uko-macro-viper ()
  (interactive)
  (viper-exit-insert-state)
  )

(defun uko-macro-loesch ()
  (interactive)
  (delete-region (point-min) (point-max))
  (uko-enter)
  )

(defun uko-macro-sprich ()
  (interactive)
  (if (not (uko-speak-is-connected))
      (progn
	(uko-speak-connect)
;;	(uko-speak-set-default-output-format)
;;	(uko-speak-set-voice-german-female)  ;; ELAN SpeechCube
;;	(uko-speak-set-voice "Christiane") ;; Logox4
;;	(uko-speak-set-rate "0")
;;	(sleep-for 2)
;;	(uko-speak-send-string "<LICENSE=UNI-KOBLENZ.SASA-HASAN@CF32F-BV6GZ-2FENJ-F2DHN>")
;;	(uko-speak-start)
;;	(sleep-for 2)
	) ) 
  (uko-speak-stop)
  (uko-speak-send-current-buffer)
  (uko-speak-start)
  (uko-enter) 
)

(defun uko-macro-ende ()
  (interactive)
  (uko-leave)
  )

(defun uko-macro-laut ()
  (interactive)
  (setq uko-speak-each-word (not uko-speak-each-word))
  )

(defun uko-macro-logox ()
  (interactive)
  (uko-speak-connect)
  (sleep-for 2)
  (uko-speak-init-logox)
  (sleep-for 2)
  (uko-speak-connect)
  )

;; ================================================================
;; 

;(defvar uko-buffer-word-keymap (make-sparse-keymap))
;(define-key uko-buffer-word-keymap uko-physical-switch-0 'uko-buffer-word-undo)
;(define-key uko-buffer-word-keymap uko-physical-switch-1 'uko-find-prev-buffer-word)
;(define-key uko-buffer-word-keymap uko-physical-switch-2 'uko-buffer-word-select)
;(define-key uko-buffer-word-keymap uko-physical-switch-3
;  (lambda () (interactive) (beep)) )

(defun uko-find-buffer-word ()
  (setq uko-find-buffer-word-point (extent-start-position uko-expand-extent))
  (setq uko-find-buffer-word-code (substring (extent-string uko-expand-extent) 0 -1))
  (set-extent-property uko-expand-extent 'keymap uko-buffer-word-keymap)
  (uko-find-last-buffer-word)
  )

(defun uko-find-prev-buffer-word ()
  (if (> uko-find-buffer-word-point (point-min))
    (let ((word
	    (save-excursion
	      (goto-char uko-find-buffer-word-point)
	      (backward-word)
	      (setq uko-find-buffer-word-point (point))
	      (forward-word)
	      (buffer-substring uko-find-buffer-word-point (point)))))
      (if (string= (uko-keyscode word) uko-find-buffer-word-code)
	  word
	(uko-find-last-buffer-word)
	) )
    nil) )

