;;; This file is copyright (c) 2004,2005,2006 by Panu Kalliokoski
;;; and released under the license in ../LICENSE

(defun stx-bracket-word-with (str)
 (forward-word 1)
 (insert str)
 (backward-word 1)
 (insert str))

(defun stx-make-bold ()
 "Put in syntax for boldfacing the current word."
 (interactive)
 (stx-bracket-word-with "*"))

(defun stx-make-italic ()
 "Put in syntax for italicising the current word."
 (interactive)
 (stx-bracket-word-with "/"))

(defun stx-make-literal ()
 "Put in syntax for making the current word literal."
 (interactive)
 (stx-bracket-word-with "''"))

(defun stx-make-underline ()
 "Put in syntax for underlining the current word."
 (interactive)
 (stx-bracket-word-with "_"))

(defun stx-make-heading ()
 "Put in syntax for making a section heading."
 (interactive)
 (beginning-of-line)
 (insert "! "))

(defvar stx-stx2any-args "" "Additional arguments to give to stx2any.")

(defun stx-transform-buffer (fmt)
 "Process the buffer via stx2any.  Possible formats are those
supported by stx2any, namely:
html, man, latex, docbook-xml, xhtml, text, (ps)."
 (interactive "sOutput format: ")
 (shell-command-on-region (point-min) (point-max)
			  (concat "stx2any " stx-stx2any-args " -T " fmt)
			  "*stx2any-output*")
 (switch-to-buffer-other-window "*stx2any-output*"))

(defvar stx-preview-command "groffer"
  "Command to use for previewing postscript.")

(defun stx-preview-buffer-as-webpage ()
 "Preview the buffer as converted to a web page, via browse-url."
 (interactive)
 (let ((myfile (make-temp-name "/tmp/stx2any")))
   (shell-command-on-region (point-min) (point-max)
			    (concat "stx2any " stx-stx2any-args
				    " -T html >" myfile))
   (browse-url (concat "file://" myfile))))

;;;###autoload
(defun stx-preview-buffer ()
 "Preview the buffer as it would be printed by stx-print-buffer.
The actual command used for previewing can be set by the variable
stx-preview-command."
 (interactive)
 (stx-send-buffer "man" stx-preview-command))

;;;###autoload
(defun stx-print-buffer ()
 "Print the buffer via stx2any, groff and lpr.
The actual command used for printing can be set by the variable
lpr-command."
 (interactive)
 (stx-send-buffer "ps" lpr-command))

(defun stx-send-buffer (fmt command)
 "Helper function for stx-preview-buffer and stx-print-buffer."
 (shell-command-on-region (point-min) (point-max)
			  (concat "stx2any " stx-stx2any-args
				  " -T " fmt " | " command)))

(defvar stx-mode-map
 (let ((mymap (make-sparse-keymap)))
   (define-key mymap "\C-c\C-c" 'stx-transform-buffer)
   (define-key mymap "\C-c\C-p" 'stx-preview-buffer)
   (define-key mymap "\C-cp" 'stx-print-buffer)
   (define-key mymap "\C-cb" 'stx-make-bold)
   (define-key mymap "\C-ci" 'stx-make-italic)
   (define-key mymap "\C-cl" 'stx-make-literal)
   (define-key mymap "\C-cu" 'stx-make-underline)
   (define-key mymap "\C-ch" 'stx-make-heading)
   (define-key mymap [menu-bar stx] (cons "Stx" (make-sparse-keymap "Stx")))
   (define-key mymap [menu-bar stx stx-make-bold]
    '(menu-item "Make a word bold" stx-make-bold))
   (define-key mymap [menu-bar stx stx-make-italic]
    '(menu-item "Make a word italic" stx-make-italic))
   (define-key mymap [menu-bar stx stx-make-literal]
    '(menu-item "Make a word literal" stx-make-literal))
   (define-key mymap [menu-bar stx stx-make-underline]
    '(menu-item "Underline a word" stx-make-underline))
   (define-key mymap [menu-bar stx stx-make-heading]
    '(menu-item "Make current line a heading" stx-make-heading))
   (define-key mymap [menu-bar stx stx-preview-buffer-as-webpage]
    '(menu-item "Preview as web page" stx-preview-buffer-as-webpage))
   (define-key mymap [menu-bar stx stx-print-buffer]
    '(menu-item "Print buffer" stx-print-buffer))
   (define-key mymap [menu-bar stx stx-preview-buffer]
    '(menu-item "Print preview" stx-preview-buffer))
   (define-key mymap [menu-bar stx stx-transform-buffer]
    '(menu-item "Convert buffer" stx-transform-buffer))
   mymap)
 "Keymap for Stx major mode.")

(defvar stx-list-marker-regexp "^ *[-*#] ")
(defvar stx-hard-divisor-regexp "^\\(---*\\|{{{\\|}}}\\)$")
(defvar stx-paragraph-separate
  (concat "[ \t]*$\\|" (substring stx-hard-divisor-regexp 1) "\\|!\\|.*::$")
  "Regexp to match paragraph separators in Stx.")
(defvar stx-paragraph-start
  (concat stx-paragraph-separate "\\|" (substring stx-list-marker-regexp 1))
  "Regexp to match paragraph starts or separators in Stx.")

(defvar stx-font-lock-keywords
 (append (list (cons stx-list-marker-regexp 'font-lock-builtin-face)
	       (cons stx-hard-divisor-regexp 'font-lock-builtin-face))
 '(("w_[a-z_]*\\|\\(un\\)?define\\|dnl" . font-lock-keyword-face)
   ("\\[\\[[- ]\\|[- ]\\]\\]\\| -- " . font-lock-builtin-face)
   ("[A-Za-z0-9)]\\(--\\)[(A-Za-z0-9]" 1 font-lock-builtin-face)
   ("\\(//\\|::\\)$" . font-lock-builtin-face)
   ("\\(^\\|[ (\"'-]\\)/\\([^ /][^/]*\\)/\\($\\|[ ,.;:?!)\"'-]\\)"
    2 font-lock-type-face)
   ("\\(^\\|[ (\"'-]\\)\\*\\([^ *][^*]*\\)\\*\\($\\|[ ,.;:?!)\"'-]\\)"
    2 font-lock-comment-face)
   ("\\(^\\|[ (\"'-]\\)_\\([^ _][^_]*\\)_\\($\\|[ ,.;:?!)\"'-]\\)"
    2 font-lock-type-face)
   ("\\(^\\|[ (\"-]\\)''\\([^ '][^']*\\)''\\($\\|[ ,.;:?!)\"-]\\)"
    2 font-lock-string-face)
   ("`\\([^']\\)'" . font-lock-constant-face)
   ("^\\(!!*\\)\\(.*\\)$"
    (1 font-lock-builtin-face) (2 font-lock-comment-face))))
 "Faces for Stx fontification.")

(defvar stx-mode-hook '() "Hooks to run upon entering Stx major mode.")

;;;###autoload
(defun stx-mode ()
 "A major mode for editing Stx (structured text) documents."
 (interactive)

 (kill-all-local-variables)
 (use-local-map stx-mode-map)
 (make-local-variable 'font-lock-defaults)
 (make-local-variable 'paragraph-start)
 (make-local-variable 'paragraph-separate)
 (setq major-mode 'stx-mode mode-name "Stx"
       font-lock-defaults '(stx-font-lock-keywords t)
       paragraph-start stx-paragraph-start
       paragraph-separate stx-paragraph-separate)
 (turn-on-font-lock)
 (auto-fill-mode 1)
 (run-hooks 'stx-mode-hook))