;;; dymore.el --- mode for editing DYMORE input files

;; Copyright (C) 2006 Jinwei Shen

;; Author:      Jinwei Shen
;; X-URL:       http://research.nianet.org/~shenjw/webpage/dymore.el
;; Keywords:    DYMORE

;; This file is not part of GNU Emacs.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This code borrowed heavily from the xrdb-mode.el in emacs.

;; This code fontifies (highlights) the keywords and comments of DYMORE
;; input file, but the keywords listed here is by no means
;; complete. You can also use M-C-a, M-C-e to move around data blocks.

;;; Installation:

;; Install dymore.el somewhere in your lisp load path. Maybe add
;; lines in your ~/.emacs along the lines of:
;
;; (setq my-path (concat (getenv "HOME") "/local/share/emacs/site-lisp"
;; (setq load-path (cons my-path load-path))
;; (autoload 'dymore-mode "dymore" "Enter dymore mode." t)
;
;; when editing DYMORE input file, use M-x dymore-mode to invoke this
;; mode.



;;; Code:

(defvar dymore-basic-offset 2
  "*Number of spaces per indentation level.")

(defconst dymore-version "2.31"
  "`dymore-mode' version number.")

(require 'custom)



(defgroup dymore nil
  "Support for editing X resource database files"
  :group 'languages)

(defcustom dymore-mode-hook nil
  "*Hook to be run when `dymore-mode' is entered."
  :type 'hook
  :group 'dymore)

(defcustom dymore-subdivide-by 'paragraph
  "*Default alignment subdivision when re-indenting a region or buffer.
This variable controls how much of the buffer is searched to find a
goal column on which to align.  Every non-comment line in the region
defined by this variable is scanned for the first `:' character on the
line, and this character's column is the line's goal column.  The
rightmost line goal column in the region is taken as the region's goal
column.

This variable can take one of the following symbol values:

 `buffer'    - All lines in the buffer are scanned.  This is the
               slowest option.

 `paragraph' - All lines in the paragraph are scanned.  Paragraphs
               are delimited by blank lines, comment lines, and page
               delimiters.

 `page'      - All lines in the page are scanned.  Pages are delimited
               with `page-delimiter', usually ^L (control-L).

 `line'      - Only the previous non-comment line is scanned.  This is
               the fastest method.

This variable is used by the various indentation commands, and can be
overridden in those commands by using \\[universal-argument]."
  :type '(radio (const :tag "Do not subdivide buffer" buffer)
                (const :tag "Subdivide by paragraphs" paragraph)
                (const :tag "Subdivide by pages" page)
                (const :tag "Each line is independent" line))
  :group 'dymore)

(defcustom dymore-compress-whitespace nil
  "*Collapse all whitespace to a single space after insertion of `:'."
  :type 'boolean
  :group 'dymore)

(defcustom dymore-program "dymore"
  "*Program to run to load or merge resources in the X resource database."
  :type 'string
  :group 'dymore)

(defcustom dymore-program-args '("-merge")
  "*List of string arguments to pass to `dymore-program'."
  :type '(repeat string)
  :group 'dymore)

(defvar dymore-master-file nil
  "If non-nil, merge in the named file instead of the buffer's file.
The intent is to allow you to set this variable in the file's local
variable section, e.g.:

    ! Local Variables:
    ! dymore-master-file: \"Xdefaults\"
    ! End:

so that typing \\[dymore-database-merge-buffer-or-region] in that buffer
merges the named master file instead of the buffer's file.  Note that
if the file name has a relative path, the `default-directory' for the
buffer is prepended to come up with a file name.

You may also want to set `dymore-program-args' in the local variables
section as well.")
(make-variable-buffer-local 'dymore-master-file)


;; Non-user customizable
(defconst dymore-comment-re "^[ \t]*[!]"
  "Regular expression describing the beginning of a comment line.")



;; utilities
(defun dymore-point (position)
  ;; Returns the value of point at certain commonly referenced POSITIONs.
  ;; POSITION can be one of the following symbols:
  ;;
  ;; bol  -- beginning of line
  ;; eol  -- end of line
  ;; bod  -- beginning of defun
  ;; boi  -- back to indentation
  ;; ionl -- indentation of next line
  ;; iopl -- indentation of previous line
  ;; bonl -- beginning of next line
  ;; bopl -- beginning of previous line
  ;; bop  -- beginning of paragraph
  ;; eop  -- end of paragraph
  ;; bopg -- beginning of page
  ;; eopg -- end of page
  ;;
  ;; This function does not modify point or mark.
  (let ((here (point)))
    (cond
     ((eq position 'bod)  (beginning-of-defun))
     ((eq position 'bol)  (beginning-of-line))
     ((eq position 'eol)  (end-of-line))
     ((eq position 'boi)  (back-to-indentation))
     ((eq position 'bonl) (forward-line 1))
     ((eq position 'bopl) (forward-line -1))
     ((eq position 'bop)  (forward-paragraph -1))
     ((eq position 'eop)  (forward-paragraph 1))
     ((eq position 'bopg)  (forward-page -1))
     ((eq position 'eopg)  (forward-page 1))
     (t
      (error "unknown buffer position requested: %s" position)))
    (prog1
        (point)
      (goto-char here))
    ))

(defmacro dymore-safe (&rest body)
  ;; safely execute BODY, return nil if an error occurred
  (` (condition-case nil
         (progn (,@ body))
       (error nil))))

(defsubst dymore-skip-to-separator ()
  ;; skip forward from the beginning of the line to the separator
  ;; character as given by dymore-separator-char. Returns t if the
  ;; char was found, otherwise, nil.
  (beginning-of-line)
  (skip-chars-forward "^:" (dymore-point 'eol))
  (and (eq (char-after) ?:)
       (current-column)))

(defsubst dymore-in-comment-p (&optional lim)
  (let* ((lim (or lim (dymore-point 'bod)))
         (state (parse-partial-sexp lim (point))))
    (nth 4 state)))

(defsubst dymore-boi-col ()
  (let ((here (point)))
    (goto-char (dymore-point 'boi))
    (prog1
        (current-column)
      (goto-char here))))

(defvar dymore-prompt-history nil)

(defun dymore-prompt-for-subdivision ()
  (let ((options '(("buffer" . buffer)
                   ("paragraphs" . paragraph)
                   ("pages" . page)
                   ("lines" . line)))
        (completion-ignore-case t))
    (cdr (assoc
          (completing-read "Subdivide alignment by? " options nil t
                           (cons (format "%s" dymore-subdivide-by) 0)
                           'dymore-prompt-history)
          options))))


;; commands
(defun dymore-electric-separator (arg)
  "Insert a colon, and possibly indent line.
Numeric argument inserts that many separators.  If the numeric
argument is not given, or is 1, and the separator is not inserted in a
comment, then the line is indented according to `dymore-subdivide-by'."
  (interactive "P")
  (self-insert-command (prefix-numeric-value arg))
  ;; only do electric behavior if arg is not given
  (or arg
      (dymore-in-comment-p)
      (dymore-indent-line))
  ;; compress whitespace
  (and dymore-compress-whitespace
       (just-one-space)))

(defun dymore-electric-bang (arg)
  "Insert an exclamation point to start a comment.
Numeric argument inserts that many exclamation characters.  If the
numeric argument is not given, or is 1, and the bang character is the
first character on a line, the line is indented to column zero."
  (interactive "P")
  (let ((how-many (prefix-numeric-value arg)))
    (self-insert-command how-many)
    (save-excursion
      (if (and (= how-many 1)
               (dymore-in-comment-p)
               (memq (char-before (dymore-point 'boi)) '(?\n nil)))
          (indent-line-to 0)))
    ))


(defun dymore-indent-region (start end &optional arg)
  "Indent all lines in the region according to `dymore-subdivide-by'.
With optional \\[universal-argument], prompt for subdivision."
  (interactive "r\nP")
  (dymore-align-to-column
   (dymore-guess-goal-column (if arg
                               (dymore-prompt-for-subdivision)
                             dymore-subdivide-by))
   start end))

(defun dymore-indent-page (&optional arg)
  "Indent all lines in the page according to `dymore-subdivide-by'.
With optional \\[universal-argument], prompt for subdivision."
  (interactive "P")
  (dymore-align-to-column
   (dymore-guess-goal-column (if arg
                               (dymore-prompt-for-subdivision)
                             dymore-subdivide-by))
   (dymore-point 'bopg)
   (dymore-point 'eopg)))

(defun dymore-indent-paragraph (&optional arg)
  "Indent all lines in the paragraph according to `dymore-subdivide-by'.
With optional \\[universal-argument], prompt for subdivision."
  (interactive "P")
  (dymore-align-to-column
   (dymore-guess-goal-column (if arg
                               (dymore-prompt-for-subdivision)
                             dymore-subdivide-by))
   (dymore-point 'bop)
   (dymore-point 'eop)))

(defun dymore-indent-buffer (&optional arg)
  "Indent all lines in the buffer according to `dymore-subdivide-by'.
With optional \\[universal-argument], prompt for subdivision."
  (interactive "P")
  (let ((subdivide-by (if arg
                          (dymore-prompt-for-subdivision)
                        dymore-subdivide-by)))
    (save-excursion
      (beginning-of-buffer)
      (if (eq subdivide-by 'buffer)
          (dymore-align-to-column (dymore-guess-goal-column 'buffer)
                                (point-min) (point-max))
        (let (mvfwdfunc indentfunc)
          (cond
           ((eq subdivide-by 'paragraph)
            (setq mvfwdfunc 'forward-paragraph
                  indentfunc 'dymore-indent-paragraph))
           ((eq subdivide-by 'page)
            (setq mvfwdfunc 'forward-page
                  indentfunc 'dymore-indent-page))
           ((eq subdivide-by 'line)
            (setq mvfwdfunc 'forward-line
                  indentfunc 'dymore-indent-page))
           (t (error "Illegal alignment subdivision: %s" subdivide-by))
           )
          (while (< (point) (point-max))
            (funcall indentfunc)
            (funcall mvfwdfunc 1))
          )))))


;; internal alignment functions
(defun dymore-align-to-column (goalcol &optional start end)
  (let ((start (or start (dymore-point 'bol)))
        (end (or end (dymore-point 'bonl))))
    (save-excursion
      (save-restriction
        (narrow-to-region start end)
        (beginning-of-buffer)
        (while (< (point) (point-max))
          (if (and (not (looking-at dymore-comment-re))
                   (dymore-skip-to-separator))
              (indent-line-to (max 0 (+ goalcol
                                        (- (current-column))
                                        (dymore-boi-col))
                                   )))
          (forward-line 1))
        ))))

(defun dymore-guess-goal-column (subdivide-by)
  ;; Returns the goal column of the current line based on SUBDIVIDE-BY,
  ;; which can be any value allowed by `dymore-subdivide-by'.
  (let ((here (point))
        (goalcol 0))
    (save-restriction
      (cond
       ((eq subdivide-by 'line)
        (while (and (zerop (forward-line -1))
                    (or (looking-at dymore-comment-re)
                        (not (dymore-skip-to-separator)))))
        ;; maybe we didn't find one
        (if (not (dymore-skip-to-separator))
            (goto-char here))
        (narrow-to-region (dymore-point 'bol) (dymore-point 'bonl)))
       ((eq subdivide-by 'page)
        (narrow-to-page))
       ((eq subdivide-by 'paragraph)
        (narrow-to-region (dymore-point 'bop) (dymore-point 'eop)))
       ((eq subdivide-by 'buffer))
       (t (error "Illegal alignment subdivision: %s" subdivide-by)))
      (goto-char (point-min))
      (while (< (point) (point-max))
        (if (and (not (looking-at dymore-comment-re))
                 (dymore-skip-to-separator))
            (setq goalcol (max goalcol (- (current-column) (dymore-boi-col)))))
        (forward-line 1)))
    (goto-char here)
    goalcol))



;; major-mode stuff
(defvar dymore-mode-abbrev-table nil
  "Abbreviation table used in `dymore-mode' buffers.")
(define-abbrev-table 'dymore-mode-abbrev-table ())


(defvar dymore-mode-syntax-table nil
  "Syntax table used in `dymore-mode' buffers.")
(if dymore-mode-syntax-table
    nil
  (setq dymore-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry ?!  "<"    dymore-mode-syntax-table)
  (modify-syntax-entry ?\\ "\\"   dymore-mode-syntax-table)
  (modify-syntax-entry ?\n ">"    dymore-mode-syntax-table)
  (modify-syntax-entry ?/  ". 14" dymore-mode-syntax-table)
  (modify-syntax-entry ?*  "_ 23" dymore-mode-syntax-table)
  (modify-syntax-entry ?.  "_"    dymore-mode-syntax-table)
  (modify-syntax-entry ?#  "_"    dymore-mode-syntax-table)
  (modify-syntax-entry ??  "_"    dymore-mode-syntax-table)
  (modify-syntax-entry ?<  "("    dymore-mode-syntax-table)
  (modify-syntax-entry ?>  ")"    dymore-mode-syntax-table)
  )


(defvar dymore-mode-map ()
  "Keymap used in `dymore-mode' buffers.")
(if dymore-mode-map
    ()
  (setq dymore-mode-map (make-sparse-keymap))
  ;; make the separator key electric
  (define-key dymore-mode-map ":"        'dymore-electric-separator)
  (define-key dymore-mode-map "!"        'dymore-electric-bang)
  (define-key dymore-mode-map "\C-c\C-a" 'dymore-indent-buffer)
  (define-key dymore-mode-map "\C-c\C-b" 'dymore-submit-bug-report)
;;  (define-key dymore-mode-map "\C-c\C-c" 'dymore-database-merge-buffer-or-region)
  (define-key dymore-mode-map "\C-c\C-p" 'dymore-indent-paragraph)
  (define-key dymore-mode-map "\C-c\["   'dymore-indent-page)
  (define-key dymore-mode-map "\C-c\C-r" 'dymore-indent-region)
  (define-key dymore-mode-map "\C-c;"    'comment-region)
  (define-key dymore-mode-map "\C-c\C-c" 'uncomment-region)
  )

(defun dymore-indent-line-function ()
  "Indent line based on depth in parentheses.
See the variable `dymore-basic-offset.'"
  ;; find the beginning of this construct
  (let ((depth 0)
        (here (point)))
    (condition-case nil
        (while t
          (backward-up-list 1)
          (setq depth (1+ depth)))
      (error nil))
    (goto-char here)
    (if (string-match "^[ \t]*}[ \t]*$"
		      (buffer-substring (point-at-bol) (point-at-eol)))
	(setq depth (1- depth)))
    (beginning-of-line)
    (delete-horizontal-space)
    (insert-char ?\040 (* depth dymore-basic-offset))))

;;;###autoload
(defun dymore-mode ()
  "Major mode for editing dymore config files"
  (interactive)
  (kill-all-local-variables)
  (set-syntax-table dymore-mode-syntax-table)
  (setq major-mode 'dymore-mode
        mode-name "dymore"
        local-abbrev-table dymore-mode-abbrev-table)
  (use-local-map dymore-mode-map)
  (setq font-lock-defaults '(dymore-font-lock-keywords))
  ;; local variables
  (make-local-variable 'parse-sexp-ignore-comments)
  (make-local-variable 'comment-start-skip)
  (make-local-variable 'comment-start)
  (make-local-variable 'comment-end)
  (make-local-variable 'paragraph-start)
  (make-local-variable 'paragraph-separate)
  (make-local-variable 'paragraph-ignore-fill-prefix)
  (make-local-variable 'indent-line-function)
  ;; now set their values
  (setq parse-sexp-ignore-comments t
        comment-start-skip "![ \t]*"
        comment-start "!"
        comment-end "")
  (setq indent-line-function 'dymore-indent-line-function)
  (run-hooks 'dymore-mode-hook))



;; faces and font-locking
(defvar dymore-option-name-face 'dymore-option-name-face
  "Face for option name on a line in an X resource db file")

(defvar dymore-option-value-face 'dymore-option-value-face
  "Face for option value on a line in an X resource db file")

(make-face 'dymore-option-name-face)
(make-face 'dymore-option-value-face)

(defun dymore-font-lock-mode-hook ()
  (or (face-differs-from-default-p 'dymore-option-name-face)
      (copy-face 'font-lock-keyword-face 'dymore-option-name-face))
  (or (face-differs-from-default-p 'dymore-option-value-face)
      (copy-face 'font-lock-string-face 'dymore-option-value-face))
  (remove-hook 'font-lock-mode-hook 'dymore-font-lock-mode-hook))
(add-hook 'font-lock-mode-hook 'dymore-font-lock-mode-hook)

(defconst dymore-font-lock-keywords
  (eval-when-compile
    (list
     ;;
     ;; Variables names.
     (cons (concat "\\("
		   ".*_NAME[ 	]*{.*}[ 	]*{"
		   "\\)")
	   'font-lock-variable-name-face)

     (cons (concat "\\("
		   "@COMMENTS[ 	]*{.*"
		   "\\)")
	   'font-lock-comment-face)

;;      (cons (concat "^#[ 	]*\\(_NAME\\|include\\)[ 	]*\\(<[^>\"\n]*>?\\)" "")
;;  	   '(2 font-lock-variable-name-face))

     (cons (concat "\\<\\("
		   "POST_PROCESSING_ANALYSIS\\|"
		   "FEM_CONTROL_PARAMETERS\\|"
		   "STEP_CONTROL_PARAMETERS\\|"
		   "FINITE_ELEMENT_ANALYSIS\\|"
 		   "CREATE_FINITE_ELEMENT_MODEL\\|"
 		   ".*_DEFINITION"
 		   "\\)\\>")
 	   'font-lock-function-name-face)

     ;;
     ;; Keywords.
     (concat "\\<\\("
	     "CONNECTED_TO_BODY\\|ORIGIN\\|IS_DEFINED_IN_FRAME\\|"
	     "ORIENTATION_E3\\|ORIENTATION_E2\\|ETA_VALUE\\|"
	     "COORDINATES\\|"
	     "AT_POINT"
	     "\\)\\>")
     ;;
     ;; Operators.  Is this too much?
     (cons (mapconcat 'identity
		      '("=" ",")
		      "\\|")
	   'font-lock-constant-face)
     ))
  "Default expressions to highlight in dymore mode.")
(put 'dymore-mode 'font-lock-defaults '(dymore-font-lock-keywords))



;; merging and manipulating the X resource database
(defun dymore-database-merge-buffer-or-region (start end)
  "Merge the current buffer's resources into the X resource database.

`dymore-program' is the program to actually call, with the arguments
specified in `dymore-program-args'.  This latter can be set to do either
a merge or a load, etc.  Also, if the file local variable
`dymore-master-file' is non-nil, then it is merged instead of the
buffer's file.

If the current region is active, it is merged instead of the buffer,
and this overrides any use of `dymore-master-file'."
  (interactive
   ;; the idea here is that if the region is inactive, start and end
   ;; will be nil, if not passed in programmatically
   (list (dymore-safe (and (mark) (region-beginning)))
         (dymore-safe (and (mark) (region-end)))))
  (message "Merging with args: %s..." dymore-program-args)
  (let ((outbuf (get-buffer-create "*Shell Command Output*")))
    ;; I prefer the XEmacs way of doing this, but this is the easiest
    ;; way to work in both XEmacs and Emacs.
    (with-current-buffer outbuf (erase-buffer))
    (cond
     ((and start end)
      (apply 'call-process-region start end dymore-program nil outbuf t
             dymore-program-args))
     (dymore-master-file
      (apply 'call-process dymore-program dymore-master-file outbuf t
             dymore-program-args))
     (t
      (apply 'call-process-region (point-min) (point-max) dymore-program
             nil outbuf t dymore-program-args)))
    (if (not (zerop (with-current-buffer outbuf (buffer-size))))
        (pop-to-buffer outbuf)))
  (message "Merging... done"))



;; submitting bug reports

(defconst dymore-mode-help-address "tools-help@python.org"
  "Address for dymore-mode bug reports.")

(defun dymore-submit-bug-report ()
  "Submit via mail a bug report on dymore-mode."
  (interactive)
  ;; load in reporter
  (require 'reporter)
  (let ((reporter-prompt-for-summary-p t)
        (varlist '(dymore-subdivide-by
                   dymore-mode-hook
                   dymore-compress-whitespace
                   )))
    (and (if (y-or-n-p "Do you want to submit a report on dymore-mode? ")
             t
           (message "")
           nil)
         (require 'reporter)
         (reporter-submit-bug-report
          dymore-mode-help-address
          (format "dymore-mode %s" dymore-version)
          varlist nil nil "Dear Barry,")
         )))


(provide 'dymore-mode)
;;; dymore-mode.el ends here