;;; HappyInput

;;; ͈͑I̓ZNVłȂ
;;;  F6 L[ɂ`I͔rłĂȂ

;;; L[蓖
(global-set-key #\C-7 'HappyInput) ; Ctrl+7

(defun HappyInput ()
  (interactive)
  ;; HappyInput.exe ̃tpX
  (setq ScriptPath "C:\\Utility\\Happy\\HappyInput.exe")
  ;; Portable ŎgƂ͈ȉLɂ
  ;; (setq ScriptPath (concat (substring (si:system-root) 0 2) ScriptPath))
  ;; sR[h
  (case (buffer-eol-code)
    (0 (setq newlinechar "LF"))
    (1 (setq newlinechar "CRLF"))
    (2 (setq newlinechar "CR")))
  (setq sl (pre-selection-p))
  (setq sel nil)
  (selection-start-end (e s)
    (when (/= s e)
      (setq sel t start s end e)
      (if (> start end) (rotatef start end))))
  (if sel ; pre-selection-p ɂ锻ł F6 ł̃ZNVɑΉłȂ
    ;; ͈͑I
    (progn
      (setq option " string")
      (goto-char start)
      (if (bolp)
        (progn
          (setq startlinenumber (current-line-number))
          (goto-char end)
          (if (or (bolp) (eobp))
            (if (and (not (bolp)) (= startlinenumber (current-line-number)))
              (setq option " line-string")
              (setq option " line"))))
        (goto-char end))
      (setq data (buffer-substring start end))
      (copy-to-clipboard data)
      (goto-char start) (start-selection 2 t) (goto-char end))
    ;; ͈͔I
    (progn
      (if sl (return-from HappyInput)) ; }EXɂ`Ił͉Ȃ
                                       ;  F6 ɂ`Iɂ͔Ή
      (if (bolp)
        (setq option " menu")
        (save-excursion
          (setq option " normal")
          (setq current (point))
          (goto-bol)
          (setq data (buffer-substring (point) current))
          (copy-to-clipboard data)))
      (if (and (eolp) (not (eobp))) (setq option2 " 1") (setq option2 " 0"))
      (setq option (concat option option2 " \"" (get-buffer-file-name) "\""))))
  ;; HappyInput.exe Ăяo
  (launch-application
    (concat ScriptPath " " newlinechar option)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; HappyTeX

;;; IĂƂ̕擾B
;;; IĂȂƃJ[\ʒu̕擾iftHgjB
;;; IĂȂƂ擾Ȃ悤ɂ΁A 1   2 ɕ
;;; XB

;;; L[蓖
(global-set-key #\C-8 'HappyTeX1) ; Ctrl+8
(global-set-key #\C-9 'HappyTeX2) ; Ctrl+9

(defun HappyTeX1 ()
  (interactive)
  (HappyTeX ""))

(defun HappyTeX2 ()
  (interactive)
  (HappyTeX " /s"))

(defun HappyTeX (type)
  ;; HappyTeX.exe ̃tpX
  (setq ScriptPath "C:\\Utility\\Happy\\HappyTeX.exe")
  ;; Portable ŎgƂ͈ȉLɂ
  ;; (setq ScriptPath (concat (substring (si:system-root) 0 2) ScriptPath))
  (setq PathName (get-buffer-file-name))
  ;; VKt@CȂ疼Otĕۑ̃EBhEoďI
  (unless PathName (progn (save-as-dialog) (return-from HappyTeX)))
  ;; XVĂ㏑ۑ
  (if (buffer-modified-p)
    (save-buffer)
    (if (string/= type "") (setq type " /j")))
  ;; _sԍ̎擾
  (setq LineNumber (format nil "~D" (current-line-number)))
  ;; ̎擾
  (if (pre-selection-p)
    (selection-start-end (start end)
      (setq str (buffer-substring start end)))
    (getword)     ; J[\ʒu̕擾    1
;;;    (setq str "") ; J[\ʒu̕擾Ȃ  2
  )
  ;; HappyTeX.exe Ăяo
  (launch-application
    (concat ScriptPath " \"" PathName "\" " LineNumber " " str type)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; 擾̊֐͈ʓIȃt@Cz肵ĂāATeXt@Cɓ
;;; ȂB
;;; TeXt@C̏ꍇA
;;;   pJ^Ji͎gȂ낤A
;;;   Rg[V[PX擾Ăi󎚂Ȃ̂ŁjӖȂB

(setq digit_latin   "[0-9A-Z_a-z]")    ; 1 pp
(setq half_katakana "[-]")           ; 2 pJ^Ji
(setq full_digit    "[O-X]")         ; 3 Sp
(setq full_latin    "[`-y-]")    ; 4 SpAt@xbg
(setq hiragana      "[TU[-]")   ; 5 Ђ炪
(setq katakana      "[RS[@-]")   ; 6 J^Ji
(setq greek         "[--]")    ; 7 MV
(setq cyrillic      "[@-`p-]")    ; 8 L
(setq kanji         "[VWXZ-K]") ; 9 

(defun getword ()
  (getcharclass)
  (save-excursion
    (case class
      (-1 (setq start (point)))
      ( 0 (setq start (point)) (forward-char))
      ( 1 (skip-chars-backward digit_latin)   (setq start (point))
          (skip-chars-forward  digit_latin))
      ( 2 (skip-chars-backward half_katakana) (setq start (point))
          (skip-chars-forward  half_katakana))
      ( 3 (skip-chars-backward full_digit)    (setq start (point))
          (skip-chars-forward  full_digit))
      ( 4 (skip-chars-backward full_latin)    (setq start (point))
          (skip-chars-forward  full_latin))
      ( 5 (skip-chars-backward hiragana)      (setq start (point))
          (skip-chars-forward  hiragana))
      ( 6 (skip-chars-backward katakana)      (setq start (point))
          (skip-chars-forward  katakana))
      ( 7 (skip-chars-backward greek)         (setq start (point))
          (skip-chars-forward  greek))
      ( 8 (skip-chars-backward cyrillic)      (setq start (point))
          (skip-chars-forward  cyrillic))
      ( 9 (skip-chars-backward kanji)         (setq start (point))
          (skip-chars-forward  kanji))
      (10 (skip-chars-backward "[")
          (if (bobp) (setq start (point))
            (progn
              (backward-char) (getcharclass)
              (case class
                (5 (skip-chars-backward hiragana) (setq start (point))
                   (skip-chars-forward  hiragana))
                (6 (skip-chars-backward katakana) (setq start (point))
                   (skip-chars-forward  katakana))
                (t (forward-char) (setq start (point)) (setq class 10)))))
          (when (= class 10)
            (skip-chars-forward "[")
            (getcharclass)
            (case class
              (5 (skip-chars-forward hiragana))
              (6 (skip-chars-forward katakana))))))
    (setq str (buffer-substring start (point)))))

(defun getcharclass ()
  (cond
    ((char= (following-char) #\ )             (setq class -1)) ; p
    ((char= (following-char) #\@)            (setq class -1)) ; Sp
    ((char= (following-char) (code-char #xa)) (setq class -1)) ; s
    ((char= (following-char) (code-char 0))   (setq class -1)) ; EOF
    ((char= (following-char) #\[)            (setq class 10)) ; 
    ((string-match digit_latin   (string (following-char))) (setq class 1))
    ((string-match half_katakana (string (following-char))) (setq class 2))
    ((string-match full_digit    (string (following-char))) (setq class 3))
    ((string-match full_latin    (string (following-char))) (setq class 4))
    ((string-match hiragana      (string (following-char))) (setq class 5))
    ((string-match katakana      (string (following-char))) (setq class 6))
    ((string-match greek         (string (following-char))) (setq class 7))
    ((string-match cyrillic      (string (following-char))) (setq class 8))
    ((string-match kanji         (string (following-char))) (setq class 9))
    (t (setq class 0))))
