;;; -*- Mode: Emacs-Lisp -*-
;;; This mode is to tag articles for Named Entity, and Scenario Template.
;;; These emacs-lisp functions are created by Mr.Shinnou,
;;;  and modified by Mr.Sekine, and Mr.Nobata.
;;; To use this mode, please add the following description
;;;  to your .emacs file.
;;;
;;; (autoload 'pntag-mode "pntag-mode" nil t)
;;; (setq auto-mode-alist (append (list '("\\.key$" . pntag-mode))
;;;                               auto-mode-alist))

(defvar pntag-mode-map () "keymap used in pntag mode.")

(if pntag-mode-map
    ()
  (setq pntag-mode-map (make-sparse-keymap))
  (define-key pntag-mode-map "\C-x\C-g"    'pntag-organization)
  (define-key pntag-mode-map "\C-x\C-n"    'pntag-person)
  (define-key pntag-mode-map "\C-x\C-l"    'pntag-location)
  (define-key pntag-mode-map "\C-x\C-a"    'pntag-artifact)

  (define-key pntag-mode-map "\C-x\C-d"    'pntag-date)
  (define-key pntag-mode-map "\C-x\C-t"    'pntag-time)
  (define-key pntag-mode-map "\C-x\C-m"    'pntag-money)
  (define-key pntag-mode-map "\C-x\C-r"    'pntag-percent)

  (define-key pntag-mode-map "\C-x\C-q"    'pntag-uncertain)
  (define-key pntag-mode-map "\C-x\C-p"    'pntag-optional)
  (define-key pntag-mode-map "\C-x\C-o"    'pntag-optional-detail)
  (define-key pntag-mode-map "\C-x\C-k"    'pntag-delete-tag)
)

(defun pntag-mode ()
  "Major mode for tagging text."
  (interactive)
  (kill-all-local-variables)
  (use-local-map pntag-mode-map)
  (setq major-mode 'pntag-mode)
  (setq mode-name "pntag")
  (run-hooks 'pntag-mode-hook))

(defun pntag-organization  () (interactive) (pntag "ORGANIZATION"))
(defun pntag-person        () (interactive) (pntag "PERSON"))
(defun pntag-location      () (interactive) (pntag "LOCATION"))
(defun pntag-artifact      () (interactive) (pntag "ARTIFACT"))
(defun pntag-date          () (interactive) (pntag "DATE"))
(defun pntag-time          () (interactive) (pntag "TIME"))
(defun pntag-money         () (interactive) (pntag "MONEY"))
(defun pntag-percent       () (interactive) (pntag "PERCENT"))
(defun pntag-uncertain     () (interactive) (pntag "?"))
(defun pntag-optional      () (interactive) (pntag "OPTIONAL"))

(defun pntag-optional-detail () (interactive)
  (let* ((pos  "")
        (type  ?0)
        (keys (read-string "Input possibilities: " "xv"))
        (len  (length keys))
        (i    0))
    
    (while (< i len)
      (progn
        (setq key (elt keys i))
        (cond
         ((= key ?x) (setq pos (concat pos "ORGANIZATION,")))
         ((= key ?b) (setq pos (concat pos "PERSON,")))
         ((= key ?v) (setq pos (concat pos "LOCATION,")))
         ((= key ?a) (setq pos (concat pos "ARTIFACT,")))
         ((= key ?d) (setq pos (concat pos "DATE,")))
         ((= key ?t) (setq pos (concat pos "TIME,")))
         ((= key ?e) (setq pos (concat pos "MONEY,")))
         ((= key ?r) (setq pos (concat pos "PERCENT,")))
         ((= key ?n) (setq pos (concat pos "NONE,")))
         ((and (<= ?0 key) (<= key ?9)) (setq type key)))
      (setq i (+ 1 i))))

    (pntag2 (concat "OPTIONAL POSSIBILITY=" 
                    (if (= (length pos) 0) pos
                      (substring pos 0 (- (length pos) 1)) )
                    " TYPE=" 
                    (- type ?0))
            "OPTIONAL")))

(defun pntag (str)
  (interactive)
  (let ((name))
      (if (null (mark))
          (error "No mark set in this buffer")
          (setq name (buffer-substring (mark) (point))))
      (delete-region (mark) (point))
      (goto-char (mark))
      (insert (concat "<" str ">" name "</" str ">"))
  )
)

(defun pntag2 (str1 str2)
  (interactive)
  (let ((name))
      (if (null (mark))
          (error "No mark set in this buffer")
          (setq name (buffer-substring (mark) (point))))
      (delete-region (mark) (point))
      (goto-char (mark))
      (insert (concat "<" str1 ">" name "</" str2 ">"))
  )
)

(defun pntag-delete-tag ()
  (interactive)
  (let (
        (current-point)
        (open-tag-start-point)
        (open-tag-end-point)
        (close-tag-start-point)
        (close-tag-end-point)
        (open-tag-candidate)
        (close-tag-candidate1)
        (close-tag-candidate2)
        )
    (setq current-point (point))

    (setq open-tag-candidate (buffer-substring current-point (+ current-point 1)))
    (if (string-equal "<" open-tag-candidate)
        (setq open-tag-start-point current-point)
      (setq open-tag-start-point (search-backward "<" nil t)))
    (goto-char current-point)

    (setq open-tag-end-point (search-backward ">" nil t))
    (goto-char current-point)

    (setq close-tag-candidate1 (buffer-substring current-point (+ current-point 2)))
    (setq close-tag-candidate2 (buffer-substring (- current-point 1) (+ current-point 1)))
    (if (string-equal "</" close-tag-candidate1)
        (progn
          (setq open-tag-start-point current-point)
          (setq close-tag-start-point current-point))
      (if (string-equal "</" close-tag-candidate2)
          (setq close-tag-start-point (- current-point 1))
        (setq close-tag-start-point (search-backward "</" nil t))))
    (goto-char current-point)

    (if (and open-tag-start-point
             open-tag-end-point
             (> open-tag-start-point open-tag-end-point))
        (if (and close-tag-start-point
                 (= open-tag-start-point close-tag-start-point))
            (progn
              (goto-char close-tag-start-point)
              (setq close-tag-end-point (search-forward ">"))
              (goto-char close-tag-start-point)
              (setq open-tag-start-point (search-backward "<"))
              (setq open-tag-end-point (search-forward ">"))
              (delete-region close-tag-start-point close-tag-end-point)
              (delete-region open-tag-start-point open-tag-end-point))
          (progn
            (goto-char open-tag-start-point)
            (setq open-tag-end-point (search-forward ">"))
            (setq close-tag-end-point (search-forward ">"))
            (setq close-tag-start-point (search-backward "</"))
            (delete-region close-tag-start-point close-tag-end-point)
            (delete-region open-tag-start-point open-tag-end-point))))
  )
)