diff options
Diffstat (limited to 'elisp/mfl-mode.el')
-rw-r--r-- | elisp/mfl-mode.el | 306 |
1 files changed, 285 insertions, 21 deletions
diff --git a/elisp/mfl-mode.el b/elisp/mfl-mode.el index 5c66edc6..aadcab08 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 |