summaryrefslogtreecommitdiffabout
path: root/elisp
authorSergey Poznyakoff <gray@gnu.org.ua>2007-05-27 20:00:10 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2007-05-27 20:00:10 (GMT)
commit6bb637f647598002be3c8acfaf3b396966d3e581 (patch) (side-by-side diff)
treeead65d2b207e8874684c558d4127e93a346ddc7d /elisp
parente3b13bbba66a92a75ac73d3ab50bca45d69c7c0d (diff)
downloadmailfromd-6bb637f647598002be3c8acfaf3b396966d3e581.tar.gz
mailfromd-6bb637f647598002be3c8acfaf3b396966d3e581.tar.bz2
Improve mfl-mode
git-svn-id: file:///svnroot/mailfromd/trunk@1479 7a8a7f39-df28-0410-adc6-e0d955640f24
Diffstat (limited to 'elisp') (more/less context) (ignore whitespace changes)
-rw-r--r--elisp/mfl-mode.el306
1 files changed, 285 insertions, 21 deletions
diff --git a/elisp/mfl-mode.el b/elisp/mfl-mode.el
index 5c66edc..aadcab0 100644
--- a/elisp/mfl-mode.el
+++ b/elisp/mfl-mode.el
@@ -29,6 +29,12 @@
;; Install the file mfl-mode.elc (and, optionally, mfl-mode.el) to
;; any directory in your Emacs load-path.
+;; Customization:
+;; To your .emacs or site-start.el add:
+;; (autoload 'mfl-mode "mfl-mode")
+;; (setq auto-mode-alist (append auto-mode-alist
+;; '(("\\.mf$" . mfl-mode))))
+
(eval-when-compile
;; We use functions from these modules
(mapcar 'require '(font-lock)))
@@ -51,12 +57,232 @@
(modify-syntax-entry ?\/ ". 14" mfl-mode-syntax-table)
(modify-syntax-entry ?\* ". 23" mfl-mode-syntax-table))
-(defvar mfl-mode-map (make-sparse-keymap)
+(defvar mfl-mode-map nil
"Keymap used in MFL mode.")
-;(define-key mfl-mode-map [menu-bar] (make-sparse-keymap))
-;(define-key cflow-mode-map [menu-bar MFL]
-; (cons "MFL" (make-sparse-keymap "MFL")))
+(unless mfl-mode-map
+ (setq mfl-mode-map (make-sparse-keymap))
+ (define-key mfl-mode-map "\t" 'mfl-indent-line)
+ (define-key mfl-mode-map "\r" 'mfl-newline-and-indent)
+ (define-key mfl-mode-map "\C-c\C-c" 'mfl-check-syntax)
+ (define-key mfl-mode-map "\C-\M-a" 'beginning-of-defun)
+ (define-key mfl-mode-map "\C-\M-e" 'end-of-defun)
+
+ (define-key mfl-mode-map [menu-bar] (make-sparse-keymap))
+ (define-key mfl-mode-map [menu-bar MFL]
+ (cons "MFL" mfl-mode-map))
+ (define-key mfl-mode-map [mfl-check-syntax]
+ '("Check syntax" . mfl-check-syntax))
+ (define-key mfl-mode-map [beginning-of-defun]
+ '("Beginning of definition" . beginning-of-defun))
+ (define-key mfl-mode-map [end-of-defun]
+ '("End of definition" . beginning-of-defun)))
+
+
+
+(defgroup mfl nil
+ "MFL programming utilities"
+ :group 'unix
+ :group 'languages)
+
+(defgroup mfl nil
+ "MFL script mode"
+ :group 'mfl
+ :prefix "mfl-")
+
+(defgroup mfl-lint nil
+ "Variables controlling invocation of mailfromd in `lint' mode.
+"
+ :group 'mfl)
+
+(defcustom mfl-mailfromd-command "mailfromd"
+ "*The default mailfromd command line (without --lint option)"
+ :type 'string
+ :group 'mfl-lint)
+
+(defcustom mfl-include-path nil
+ "*Additional include directories"
+ :type '(repeat string)
+ :group 'mfl-lint)
+
+(defgroup mfl-indentation nil
+ "Variables controlling indentation in MFL scripts.
+"
+ :group 'mfl)
+
+(defcustom mfl-basic-offset 2
+ "*The default indentation increment."
+ :type 'integer
+ :group 'mfl-indentation)
+
+(defcustom mfl-case-line-offset 0
+ "*The default indentation increment for `when' and `case' lines."
+ :type 'integer
+ :group 'mfl-indentation)
+
+(defun mfl-find-comment-start ()
+ "Find the beginning of a multiline comment the point is in."
+ (while (not (or (bobp) (looking-at ".*/\\*")))
+ (forward-line -1)))
+
+(defun mfl-next-line-indentation ()
+ "Guess and return the indentation of the next line."
+ (save-excursion
+ (beginning-of-line)
+ (cond
+ ((not (eolp))
+ (skip-chars-forward " \t")
+ (cond
+ ((looking-at (regexp-opt '("do" "if" "else" "elif") 'words))
+ (+ (current-indentation) mfl-basic-offset))
+ ((looking-at ".*/\\*")
+ (+ (current-indentation)
+ (- (match-end 0) (match-beginning 0)) 1)) ; FIXME: customization
+ ((looking-at ".*\\*/\\s *$")
+ (mfl-find-comment-start)
+ (forward-line -1)
+ (current-indentation))
+ ((looking-at ".*:[ \t]*$")
+ (+ (current-indentation) mfl-basic-offset))
+ (t
+ (current-indentation))))
+ (t
+ (forward-line -1)
+ (mfl-next-line-indentation)))))
+
+(defun mfl-find-line-indentation (regexp)
+ "Move backwards to the line containing "REGEXP", skipping over
+block constructs. Return the indentation of the line, or 0
+if no matching line was found."
+ (catch 'found
+ (while (not (bobp))
+ (forward-line -1)
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (cond
+ ((looking-at regexp)
+ (throw 'found (current-indentation)))
+ ((looking-at "\\<done\\>")
+ (mfl-find-line-indent "\\<do\\>"))
+ ((looking-at "\\<fi\\>")
+ (mfl-find-line-indent "\\<if\\>"))))
+ 0))
+
+(defun mfl-find-line-forward (regexp)
+ "Move forward to the line containing "REGEXP", skipping over
+block constructs. Return t if the line was found, nil otherwise."
+ (catch 'found
+ (while (not (eobp))
+ (forward-line 1)
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (cond
+ ((looking-at regexp)
+ (throw 'found t))
+ ((looking-at "\\<do\\>")
+ (mfl-find-line-forward "\\<done\\>"))
+ ((looking-at "\\<if\\>")
+ (mfl-find-line-forward "\\<fi\\>"))))
+ nil))
+
+(defun mfl-compute-line-indentation ()
+ "Compute the indentation of the current line."
+ (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (cond
+ ((looking-at (regexp-opt '("else" "elif" "fi") 'words))
+ (mfl-find-line-indentation (regexp-opt '("if" "elif") 'words)))
+ ((looking-at "\\<done\\>")
+ ; FIXME: Continuation lines are not properly handled
+ (mfl-find-line-indentation ".*\\<do\\>"))
+ ((looking-at "\\<when\\>")
+ (+ (mfl-find-line-indentation "\\<on\\>")
+ mfl-case-line-offset))
+ ((looking-at (regexp-opt '("case" "default") 'words))
+ (+ (mfl-find-line-indentation "\\<switch\\>")
+ mfl-case-line-offset))
+ (t
+ (forward-line -1)
+ (mfl-next-line-indentation)))))
+
+(defun mfl-indent-line ()
+ "Indent the current line."
+ (interactive "*")
+ (let ((start-of-line (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (point)))
+ (shift-amt (mfl-compute-line-indentation)))
+ (if (not (= shift-amt (current-indentation)))
+ (let ((off (- (point) start-of-line)))
+ (beginning-of-line)
+ (delete-region (point) start-of-line)
+ (indent-to shift-amt)
+ (if (>= off 0)
+ (goto-char (+ (point) off))
+ (beginning-of-line))))))
+
+(defun mfl-newline-and-indent ()
+ "Indent the current line, insert a newline, and then indent again."
+ (interactive "*")
+ (mfl-indent-line)
+ (newline-and-indent))
+
+
+(defun mfl-check-syntax ()
+ "Checks the syntax of the current MFL buffer."
+ (interactive "*")
+ (compile (concat
+ mfl-mailfromd-command
+ " --lint"
+ (if mfl-include-path
+ (apply 'concat (mapcar (lambda (x) (concat " -I" x))
+ mfl-include-path))
+ "")
+ " "
+ (buffer-file-name))))
+
+
+
+(defun mfl-at-beginning-of-defun-p ()
+ "Return true if the point is at the beginning of a defun"
+ (or (looking-at "[ \t]*prog [a-z]+")
+ (looking-at (concat "[ \t]*"
+ (regexp-opt '("begin" "end") 'words)))
+ (looking-at "[ \t]*func\\s +[a-zA-Z_][a-zA-Z0-9_]*\\s *(")))
+
+(defun mfl-search-next-defun ()
+ "If the point is at the beginning of a defun, return t. Otherwise,
+move forward to the beginning of a next defun. Return t on success, nil
+otherwise."
+ (catch 'loop
+ (while (not (eobp))
+ (if (mfl-at-beginning-of-defun-p)
+ (throw 'loop t))
+ (forward-line 1))
+ nil))
+
+(defun mfl-beginning-of-defun ()
+ "Interface to `beginning-of-defun'"
+ (catch 'loop
+ (while (not (bobp))
+ (forward-line -1)
+ (if (mfl-at-beginning-of-defun-p)
+ (throw 'loop t)))
+ nil))
+
+(defun mfl-end-of-defun-function ()
+ "Interface to `end-of-defun'"
+ (let ((pos (save-excursion
+ (and (mfl-search-next-defun)
+ (mfl-find-line-forward "\\<do\\>")
+ (mfl-find-line-forward "\\<done\\>")
+ (forward-line 1)
+ (point)))))
+ (if pos
+ (goto-char pos)
+ pos)))
(defconst mfl-keywords
@@ -70,24 +296,27 @@
"not" "on" "or" "pass"
"prog" "reject" "replace" "return"
"returns" "set" "switch" "tempfail"
- "throw" "when" "while"
- ;; FIXME: These are context-dependent
- "as" "from" "host" "poll"))))
+ "throw" "when" "while") 'words)))
+
+(defconst mfl-on-keywords
+ ;; context-dependent keywords
+ (eval-when-compile
+ (regexp-opt '("as" "from" "host" "poll") 'words)))
(defconst mfl-constants
(eval-when-compile
(regexp-opt '("__file__" "__function__" "__line__" "__major__"
"__minor__" "__package__" "__patch__" "__preproc__"
- "__version__"))))
+ "__version__") 'words)))
(defconst mfl-type-names
(eval-when-compile
- (regexp-opt '("number" "string"))))
+ (regexp-opt '("number" "string") 'words)))
(defconst mfl-preprocessor-directives
(eval-when-compile
(regexp-opt '("include" "include_once" "error" "line"
- "pragma" "require" "warning"))))
+ "pragma" "require" "warning") 'words)))
(defconst mfl-m4-keywords
(eval-when-compile
@@ -101,13 +330,21 @@
"m4_pushdef" "m4_regexp" "m4_shift" "m4_sinclude"
"m4_substr" "m4_symbols" "m4_syscmd" "m4_sysval"
"m4_traceoff" "m4_traceon" "m4_translit" "m4_undivert"
- "m4_dnl" "m4___line__" "m4___file__"))))
+ "m4_dnl" "m4___line__" "m4___file__") 'words)))
(defconst mfl-macros
(eval-when-compile
- (regexp-opt '("defined" "printf" "_" "N_"))))
+ (regexp-opt '("defined" "printf" "_" "N_") 'words)))
+
+(defconst mfl-status-codes
+ (eval-when-compile
+ (regexp-opt '("success" "not_found" "failure" "temp_failure"
+ "ston_conv" "divzero" "regcomp" "invip"
+ "invcidr" "invtime" "dbfailure" "range"
+ "url" "noresolve" "ioerr") 'words)))
+
;; Font-lock stuff
(defconst mfl-font-lock-keywords
(eval-when-compile
@@ -124,22 +361,27 @@
2 font-lock-string-face)
;; Fontify otherwise as symbol names, and the preprocessor directive
;; names.
- (list
- (concat "^#[ \t]*\\(" mfl-preprocessor-directives
+ (list
+ (concat "^#[ \t]*\\(" mfl-preprocessor-directives
"\\)\\>[ \t!]*\\(\\sw+\\)?")
'(1 font-lock-builtin-face))
;; Otherwise, fontify #...\n as comments:
- (list
- "^#\\(.*\\)\n" 1 font-lock-comment-face)
-
+ (list
+ "^#\\(.*\\)\n" 1 font-lock-comment-face)
+
;; Fontify all type names.
`(eval .
(cons (concat "\\<\\(" ,mfl-type-names "\\)\\>") 'font-lock-type-face))
+ ;; Fontify exception and status codes
+ `(eval .
+ (cons (concat "\\<\\(" ,mfl-status-codes "\\)\\>")
+ 'font-lock-constant-face))
+
;;
;; Fontify all builtin keywords
(concat "\\<\\(" mfl-keywords "\\)\\>")
-
+
;; Fontify m4 keywords and macros
(list
(concat "\\<\\(" mfl-m4-keywords "\\)\\>")
@@ -156,15 +398,30 @@
"defined[ \t]*([ \t]*\\([a-zA-Z0-9_]+\\)[ \t]*)"
1 font-lock-variable-name-face)
(list
- (concat "\\<\\(" mfl-type-names "\\)\\>[ \t]+\\([a-zA-Z0-9_]+\\)")
+ (concat mfl-type-names "[ \t]+\\([a-zA-Z0-9_]+\\)")
2 font-lock-variable-name-face)
;; Fontify macro names
(list
"${?\\([a-zA-Z0-9_]+\\)}?"
1 font-lock-constant-face)
+
+ ;; Fontify `on poll' statement
+ (list
+ (concat "\\<on\\>.*\\(" mfl-on-keywords "\\)")
+ 1 font-lock-keyword-face)
+
+ (list
+ (concat "\\<on\\>.*" mfl-on-keywords ".*\\(" mfl-on-keywords "\\)")
+ 1 font-lock-keyword-face)
+
+ (list
+ (concat "\\<on\\>.*" mfl-on-keywords ".*" mfl-on-keywords ".*\\(" mfl-on-keywords "\\)")
+ 1 font-lock-keyword-face)
+
+ ;; FIXME: Fontify preprocessor quotes
)))
-
+
;;;###autoload
(defun mfl-mode ()
"Major mode for viewing cflow output files
@@ -175,11 +432,18 @@ Key bindings are:
(interactive)
(kill-all-local-variables)
(use-local-map mfl-mode-map)
+ (make-local-variable 'beginning-of-defun-function)
+ (make-local-variable 'end-of-defun-function)
+
(setq major-mode 'mfl-mode
- mode-name "MFL")
+ mode-name "MFL"
+ beginning-of-defun-function 'mfl-beginning-of-defun
+ end-of-defun-function 'mfl-end-of-defun-function
+ indent-line-function 'mfl-indent-line)
(set-syntax-table mfl-mode-syntax-table)
+
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults
'((mfl-font-lock-keywords) nil nil

Return to:

Send suggestions and report system problems to the System administrator.