;; Copyright (C) 1995 Gerald Schueller.
;; Copyright (C) 1995 Bjoern Beutel.
(provide 'malaga)
(defconst malaga-version "7.12" "Version of Malaga.")
;; malaga mode (for editing malaga files). ====================================
(setq auto-mode-alist ; Files for which malaga mode will be invoked.
(append '(("\\.all$" . malaga-mode)
("\\.esym$" . malaga-mode)
("\\.lex$" . malaga-mode)
("\\.mal$" . malaga-mode)
("\\.mor$" . malaga-mode)
("\\.sym$" . malaga-mode)
("\\.syn$" . malaga-mode)
("\\.pro$" . malaga-project-mode)
) auto-mode-alist))
;;-----------------------------------------------------------------------------
(defun malaga-mode ()
"Major mode for editing Malaga code.
\\<malaga-mode-map>
Key bindings:
\\[malaga-electric-tab], \\[malaga-electric-semicolon] \
and \\[malaga-electric-terminate-line] indent code.
\\[malaga-goto-previous-rule] jumps to previous malaga rule.
\\[malaga-goto-next-rule] jumps to next malaga rule.
\\[malaga-goto-rule] jumps to malaga rule with specific name.
\\[malmake] creates malmake process.
\\[malaga] creates malaga process.
\\[mallex] creates mallex process.
\\[malaga-delete-arrow] deletes the debugger arrow.
Commands:
malaga-upcase-keywords
malaga-downcase-keywords
Variables controlling malaga-mode for all buffers:
malaga-indent-level
malaga-change-to-project-directory"
(interactive)
(kill-all-local-variables)
(use-local-map malaga-mode-map)
(setq major-mode 'malaga-mode)
(setq mode-name "Malaga")
(setq parse-sexp-ignore-comments t)
(set-syntax-table malaga-mode-syntax-table)
(make-local-variable 'indent-line-function)
(setq indent-line-function 'malaga-indent-line)
(make-local-variable 'comment-start)
(setq comment-start "\# ")
(make-local-variable 'comment-end)
(setq comment-end "")
(make-local-variable 'comment-start-skip)
(setq comment-start-skip "# *")
(make-local-variable 'completion-ignore-case)
(setq completion-ignore-case t)
(malaga-font)
(malaga-init-menu)
(run-hooks 'malaga-mode-hook))
;;-----------------------------------------------------------------------------
(defun malaga-init-menu ()
"Initialize menu for malaga mode."
(let ((malaga-items
'("Malaga"
["Previous rule" malaga-goto-previous-rule t]
["Next rule" malaga-goto-next-rule t]
["Jump to rule..." malaga-goto-rule t]
"-----"
["Comment region" comment-region (mark)]
["Uncomment region"
(comment-region (region-beginning) (region-end) -1)
(mark)]
"-----"
["UPCASE keywords" malaga-upcase-keywords t]
["downcase keywords" malaga-downcase-keywords t]
"-----"
["Call malmake..." malmake t]
["Call mallex..." mallex t]
["Call malaga..." malaga t]
["Change to project directory"
(setq malaga-change-to-project-directory
(not malaga-change-to-project-directory))
:style toggle :selected malaga-change-to-project-directory]
)))
(cond ((string-match "XEmacs\\|Lucid" emacs-version)
(set-buffer-menubar (copy-sequence current-menubar))
(add-submenu nil malaga-items))
(t
(require 'easymenu)
(easy-menu-define malaga-menu malaga-mode-map
"Malaga menu" malaga-items)))))
;; Data Structures for malaga mode. ===========================================
(defconst malaga-keywords-list
'("accept" "allo_rule" "and" "assert" "break" "choose" "combi_rule"
"continue" "default" "define" "else" "elseif" "end" "end_rule" "error"
"foreach" "greater" "greater_equal" "if" "in" "include" "initial"
"input_filter" "less" "less_equal" "matches" "not" "or" "output_filter"
"parallel" "pruning_rule" "repeat" "require" "result" "return"
"robust_rule" "rules" "select" "stop" "subrule" "then" "while")
"The keywords used in malaga rule files (as a list).")
(defvar malaga-keywords nil
"The keywords used in malaga rule files (as an obarray for completion).")
(setq malaga-keywords (make-vector 127 0))
(mapcar (function (lambda (x) (intern x malaga-keywords)))
malaga-keywords-list)
(defconst malaga-ident-re "\\([A-Za-z\240-\377][A-Za-z_&|0-9\240-\377]*\\)")
(defconst malaga-rule-re
(concat "\\<\\(allo_rule\\|combi_rule\\|end_rule\\|input_filter"
"\\|output_filter\\|pruning_rule\\|robust_rule\\|subrule\\)\\>"))
(defconst malaga-begin-block-re
(concat "\\(" malaga-rule-re "[\t ]*\\({\\|" malaga-ident-re "[\t ]*(\\)\\)"
"\\|\\<\\(foreach\\|if\\|parallel\\|repeat\\|select\\)\\>"
"[\t ]*[^\t ;]"))
(defconst malaga-end-block-re "\\<end\\>")
(defconst malaga-sub-block-re "\\<\\(and\\|else\\|elseif\\|or\\|while\\)\\>")
(defconst malaga-noindent-re
"\\<\\(and\\|else\\|elseif\\|end\\|or\\|while\\|then\\)\\>")
(defconst malaga-autoindent-lines-re
(concat "\\<\\(and\\|[A-Za-z_]+rule\\|end\\|else\\|elseif\\|foreach\\|if"
"\\|of\\|parallel\\|select\\|while\\)\\>"))
(defvar malaga-mode-syntax-table nil
"Syntax table in use in Malaga-mode buffers.")
(setq malaga-mode-syntax-table (make-syntax-table))
(modify-syntax-entry ?# "<" malaga-mode-syntax-table)
(modify-syntax-entry ?\n ">" malaga-mode-syntax-table)
(modify-syntax-entry ?\\ "\\" malaga-mode-syntax-table)
(modify-syntax-entry ?& "w" malaga-mode-syntax-table)
(modify-syntax-entry ?| "w" malaga-mode-syntax-table)
(modify-syntax-entry ?$ "w" malaga-mode-syntax-table)
(modify-syntax-entry ?@ "w" malaga-mode-syntax-table)
(modify-syntax-entry ?_ "w" malaga-mode-syntax-table)
(modify-syntax-entry ?< "(>" malaga-mode-syntax-table)
(modify-syntax-entry ?> ")<" malaga-mode-syntax-table)
(modify-syntax-entry ?{ "(}" malaga-mode-syntax-table)
(modify-syntax-entry ?} "){" malaga-mode-syntax-table)
(modify-syntax-entry ?( "()" malaga-mode-syntax-table)
(modify-syntax-entry ?) ")(" malaga-mode-syntax-table)
(modify-syntax-entry ?[ "(]" malaga-mode-syntax-table)
(modify-syntax-entry ?] ")[" malaga-mode-syntax-table)
(modify-syntax-entry ?= "." malaga-mode-syntax-table)
(modify-syntax-entry ?~ "." malaga-mode-syntax-table)
(modify-syntax-entry ?, "." malaga-mode-syntax-table)
(modify-syntax-entry ?\; "." malaga-mode-syntax-table)
(modify-syntax-entry ?: "." malaga-mode-syntax-table)
(modify-syntax-entry ?. "." malaga-mode-syntax-table)
(modify-syntax-entry ?+ "." malaga-mode-syntax-table)
(modify-syntax-entry ?- "." malaga-mode-syntax-table)
(modify-syntax-entry ?/ "." malaga-mode-syntax-table)
(modify-syntax-entry ?? "." malaga-mode-syntax-table)
(modify-syntax-entry ?* "." malaga-mode-syntax-table)
(defvar malaga-mode-map ()
"Keymap used in Malaga mode.")
(setq malaga-mode-map (make-sparse-keymap))
(define-key malaga-mode-map "\t" 'malaga-electric-tab)
(define-key malaga-mode-map ";" 'malaga-electric-semicolon)
(define-key malaga-mode-map "\r" 'malaga-electric-terminate-line)
(if (string-match "XEmacs\\|Lucid" emacs-version)
(define-key malaga-mode-map "\C-h" 'backward-delete-char-untabify)
(define-key malaga-mode-map "\177" 'backward-delete-char-untabify))
(define-key malaga-mode-map "\C-c\C-d" 'malaga-delete-arrow)
(define-key malaga-mode-map "\C-c\C-p" 'malmake)
(define-key malaga-mode-map "\C-c\C-r" 'malaga)
(define-key malaga-mode-map "\C-c\C-l" 'mallex)
(define-key malaga-mode-map "\M-n" 'malaga-goto-next-rule)
(define-key malaga-mode-map "\M-p" 'malaga-goto-previous-rule)
(define-key malaga-mode-map "\M-g" 'malaga-goto-rule)
;; User configuration for malaga mode. ========================================
(defconst malaga-indent-level 2
"*Indentation of Malaga statements with respect to containing block.")
;; Font-lock functions. =======================================================
(defconst malaga-font-lock-keywords
(list (list (concat "\\([@\$]" malaga-ident-re "\\>\\)")
1 'font-lock-variable-name-face)
(list (concat "\\<\\(" (mapconcat 'identity malaga-keywords-list "\\|")
"\\)\\>")
1 'font-lock-keyword-face))
"Expressions to highlight in Malaga mode.")
(defun malaga-font ()
"Set font-lock variables for malaga mode."
(make-local-variable 'font-lock-keywords-case-fold-search) ; For GNU Emacs.
(setq font-lock-keywords-case-fold-search t)
(put major-mode 'font-lock-keywords-case-fold-search t) ; For XEmacs.
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(malaga-font-lock-keywords nil t)))
;; Electric keys. =============================================================
(defun malaga-electric-terminate-line ()
"Terminate line and indent next line."
(interactive)
;; Check if current line should be indented.
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(if (looking-at malaga-autoindent-lines-re)
(malaga-indent-line)))
;; Remove trailing whitespaces.
(delete-horizontal-space)
(newline)
(malaga-indent-line))
;;-----------------------------------------------------------------------------
(defun malaga-electric-semicolon ()
"Insert a semicolon and indent line."
(interactive)
(if (looking-at "[ \t]*$") (malaga-electric-tab))
(insert ";"))
;;-----------------------------------------------------------------------------
(defun malaga-electric-tab ()
"Function called when TAB is pressed in Malaga mode."
(interactive)
(let ((old-point (point-marker)))
(save-excursion
(beginning-of-line)
(malaga-indent-line))
(beginning-of-line)
(skip-chars-forward " \t")
(if (> old-point (point))
(goto-char old-point))))
;; Other malaga mode functions. ===============================================
(defun malaga-change-keywords (change-word)
"Apply function CHANGE-WORD to all keywords in current buffer."
(save-excursion
(let ((keywords (concat "\\<\\(" (mapconcat 'identity malaga-keywords-list
"\\|") "\\)\\>"))
(ref-point (point-min))
state)
(goto-char (point-min))
(while (re-search-forward keywords nil t)
(setq state (parse-partial-sexp ref-point (point)))
(if (or (nth 3 state) (nth 4 state))
()
(setq ref-point (point))
(funcall change-word -1))))))
(defun malaga-upcase-keywords ()
"Upcase all malaga keywords in the buffer."
(interactive)
(malaga-change-keywords 'upcase-word))
(defun malaga-downcase-keywords ()
"Downcase all malaga keywords in the buffer."
(interactive)
(malaga-change-keywords 'downcase-word))
(defun malaga-goto-previous-rule ()
"Go to beginning of previous rule in current buffer."
(interactive)
(if (not (search-backward-regexp (concat "^" malaga-rule-re) nil t))
(message "No previous rule.")))
(defun malaga-goto-next-rule ()
"Go to beginning of next rule in current buffer."
(interactive)
(let ((old-point (point)))
(forward-char)
(if (search-forward-regexp (concat "^" malaga-rule-re) nil t)
(beginning-of-line)
(goto-char old-point)
(message "No next rule."))))
(defun malaga-goto-rule (rule-name)
"Go to beginning of RULE-NAME in current buffer."
(interactive "sRule Name: ")
(let ((old-point (point)))
(goto-char (point-min))
(if (search-forward-regexp
(concat "^" malaga-rule-re "[\t {]+" rule-name) nil t)
(beginning-of-line)
(goto-char old-point)
(message "No rule \"%s\"." rule-name))))
(defun malaga-delete-arrow ()
"Delete the source file arrow for the current buffer."
(interactive)
(setq overlay-arrow-string nil))
;; Indentation. ===============================================================
(defconst malaga-indent-alist
'((block . (+ ind malaga-indent-level))
(contexp . ind)
(string . 0)
(comment . 0)
(unknown . 0)))
;;-----------------------------------------------------------------------------
(defun malaga-indent-line ()
"Indent current line as a Malaga code."
(let* ((indent-str (malaga-calculate-indent))
(type (car indent-str))
(ind (car (cdr indent-str ))))
(if (and (looking-at "\#") (= 0 (current-column)))
()
(delete-horizontal-space)
(cond ((looking-at malaga-rule-re)
;; Some things should not be indented.
())
((looking-at malaga-noindent-re)
;; Other things should have no extra indent.
(indent-to ind))
(t ;; But most lines are treated this way:
(indent-to (eval (cdr (assoc type malaga-indent-alist)))))))))
;;-----------------------------------------------------------------------------
(defun malaga-calculate-indent ()
"Calculate the indent of the current Malaga line.
Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(save-excursion
(let* ((state (save-excursion (parse-partial-sexp (point-min) (point))))
(nest 0)
(par 0)
(indent t)
(complete nil)
(type (catch 'nesting
;; Check if inside a string or parenthesis.
(cond ((nth 3 state) (throw 'nesting 'string))
((nth 4 state) (throw 'nesting 'comment))
((> (car state) 0)
(skip-chars-forward " \t")
(if (looking-at "[\]\>\)\}]") (setq indent nil))
(goto-char (nth 1 state))
(cond (indent
(forward-char)
(skip-chars-forward " \t")))
(setq par (current-column))
(throw 'nesting 'contexp)))
;; Loop until correct indent is found.
(while t
(backward-sexp 1)
(cond (; Nest block outwards.
(looking-at malaga-begin-block-re)
(if (= nest 0)
(throw 'nesting 'block)
(setq nest (1- nest))))
(; Nest block inwards.
(looking-at malaga-end-block-re)
(setq complete t
nest (1+ nest)))
(; If, else or foreach statement.
(and (not complete)
(looking-at malaga-sub-block-re))
(throw 'nesting 'block))
(; No known statements.
(bobp)
(throw 'nesting 'unknown))
(; Found complete statement.
(save-excursion (forward-sexp 1)
(= (following-char) ?\;))
(setq complete t))
(; No known statements.
(= (point) (point-min))
(throw 'nesting 'unknown)))))))
;; Return type of block and indent level.
(if (> par 0) ; Unclosed Parenthesis.
(list 'contexp par)
(list type (malaga-indent-level))))))
;;-----------------------------------------------------------------------------
(defun malaga-indent-level ()
"Return the indent-level of the current statement."
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(current-column)))
;; Malaga project mode. =======================================================
(defvar malaga-project-mode-map ()
"Keymap used in Malaga project mode.")
(setq malaga-project-mode-map (make-sparse-keymap))
(define-key malaga-project-mode-map "\C-c\C-p" 'malmake)
(define-key malaga-project-mode-map "\C-c\C-r" 'malaga)
(define-key malaga-project-mode-map "\C-c\C-l" 'mallex)
(defun malaga-project-mode ()
"Major mode for editing Malaga project files.
\\<malaga-project-mode-map>
Key bindings:
\\[malmake] creates malmake process.
\\[malaga] creates malaga process.
\\[mallex] creates mallex process."
(interactive)
(kill-all-local-variables)
(setq major-mode 'malaga-project-mode)
(setq mode-name "Malaga-project")
(use-local-map malaga-project-mode-map)
(run-hooks 'malaga-project-mode-hook))
;; Malaga process mode. =======================================================
(require 'comint)
(defvar malaga-last-frame nil
"Where malaga-display-line should put the debugging arrow.")
(defvar malaga-process-mode-map ()
"Keymap used in Malaga process mode.")
(setq malaga-process-mode-map (copy-keymap comint-mode-map))
(define-key malaga-process-mode-map "\t" 'comint-dynamic-complete-filename)
(define-key malaga-process-mode-map "\C-c\C-d" 'malaga-delete-arrow)
(define-key malaga-process-mode-map "\C-c\C-p" 'malmake)
(define-key malaga-process-mode-map "\C-c\C-r" 'malaga)
(define-key malaga-process-mode-map "\C-c\C-l" 'mallex)
;;-----------------------------------------------------------------------------
(defun malaga-process-mode ()
"Major mode for running a malaga, mallex or malmake process.
\\<malaga-process-mode-map>
Key bindings:
\\[comint-dynamic-complete-filename] completes a filename.
\\[malmake] creates malmake process.
\\[malaga] creates malaga process.
\\[mallex] creates mallex process.
\\[malaga-delete-arrow] deletes the debugger arrow.
Variables controlling malaga-process-mode for all buffers:
malaga-change-to-project-directory"
(interactive)
(comint-mode)
(run-hooks 'shell-mode-hook)
(setq major-mode 'malaga-process-mode)
(setq mode-name "Malaga-process")
(setq mode-line-process '(": %s"))
(use-local-map malaga-process-mode-map)
(make-local-variable 'comint-prompt-regexp)
(setq comint-prompt-regexp "^\(malaga|mallex|debug\)> *")
(setq paragraph-start comint-prompt-regexp)
(run-hooks 'malaga-process-mode-hook))
;;-----------------------------------------------------------------------------
(defun malaga-sentinel (proc msg)
"malaga-sentinel is called if the process malaga exits.
The sentinel receives two arguments: the process malaga
and a string describing the type of event, normally finished."
(cond ((null (buffer-name (process-buffer proc)))
;; Buffer killed.
;; Stop displaying an arrow in a source file.
(setq overlay-arrow-string nil)
(set-process-buffer proc nil))
((memq (process-status proc) '(signal exit))
(setq overlay-arrow-string nil)
(let* ((obuf (current-buffer)))
;; Save-excursion isn't the right thing
;; if process-buffer is current-buffer.
(unwind-protect
(progn
(set-buffer (process-buffer proc))
(accept-process-output)
;; Fix the mode line.
(setq mode-line-process
(concat ": " (symbol-name (process-status proc))))
;; Force mode line redisplay soon.
(set-buffer-modified-p (buffer-modified-p))
(if (eobp)
(insert ?\n mode-name " " msg)
(save-excursion
(goto-char (point-max))
(insert ?\n mode-name " " msg)))
;; If buffer and mode line will show that the process
;; is dead, we can delete it now. Otherwise it
;; will stay around until M-x list-processes.
(delete-process proc))
;; Restore old buffer, but don't restore old point
;; if obuf is the gud buffer.
(set-buffer obuf))))))
;;-----------------------------------------------------------------------------
(defun malaga-display-line (process file line column)
"Put the overlay-arrow on LINE and COLUMN in FILE for PROCESS."
(let* ((last-nonmenu-event t) ; Prevent use of dialog box for questions.
(source-buffer (find-file-noselect file))
position
line-start)
;; Make overlay-arrow-position a marker.
(or (markerp overlay-arrow-position)
(setq overlay-arrow-position (make-marker)))
(set-buffer source-buffer)
(save-restriction
(widen)
(goto-line line)
(setq line-start (point))
(move-to-column column)
(setq position (point)))
(if (or (< position (point-min)) (> position (point-max)))
(widen))
(cond ((equal "malmake" (process-name process))
(switch-to-buffer source-buffer)
(goto-char position)
(setq overlay-arrow-string nil)
(display-buffer (process-buffer process)))
(t
(set-window-point (display-buffer source-buffer) position)
(goto-char position)
(set-marker overlay-arrow-position line-start source-buffer)
(setq overlay-arrow-string "=>")
(switch-to-buffer (process-buffer process))))))
;;-----------------------------------------------------------------------------
(defun malaga-marker-filter (string)
"Detect file/line markers in STRING."
(cond ((string-match
"\\(SHOW \"\\([^\"]+\\)\":\\([0-9]+\\):\\([0-9]+\\)\n\\)"
string)
(setq malaga-last-frame
(list (substring string (match-beginning 2) (match-end 2))
(string-to-int (substring string
(match-beginning 3)
(match-end 3)))
(string-to-int (substring string
(match-beginning 4)
(match-end 4)))))
(setq string (concat (substring string 0 (match-beginning 1))
(substring string (match-end 1))))))
string)
;;-----------------------------------------------------------------------------
(defun malaga-filter (proc string)
"Insert STRING from malaga process PROC into the buffer."
(let ((inhibit-quit t)
(old-buffer (current-buffer)))
(set-buffer (process-buffer proc))
;; Print the process output, checking for source file markers.
(comint-output-filter proc (malaga-marker-filter string))
(set-buffer old-buffer)
;; Check for a filename-and-line number.
(cond (malaga-last-frame
(malaga-display-line proc
(nth 0 malaga-last-frame)
(nth 1 malaga-last-frame)
(nth 2 malaga-last-frame))
(setq malaga-last-frame nil)))))
;;-----------------------------------------------------------------------------
(defun malaga-init (process-name project-file &optional option)
"Call malaga, mallex or malmake and create the appropriate buffer."
(let ((buffer-name (concat "*" process-name "*"))
(process-environment process-environment)
(program-name process-name)
process-buffer)
(cond ((or (not (get-process process-name))
(y-or-n-p "There is another process running. Kill it? "))
(if (get-process process-name)
(delete-process process-name))
(setq process-buffer (get-buffer-create buffer-name))
(set-buffer process-buffer)
(kill-region (point-min) (point-max))
(if (equal process-name "malmake")
(display-buffer process-buffer)
(switch-to-buffer process-buffer))
(if malaga-change-to-project-directory
(setq default-directory (file-name-directory project-file)))
(insert "\nCurrent directory: " default-directory "\n\n")
(setenv "MALAGA_MODE" "t")
(if option
(make-comint process-name program-name nil project-file option)
(make-comint process-name program-name nil project-file))
(malaga-process-mode)
(setq mode-line-buffer-identification
(concat process-name ": "
(file-name-sans-extension
(file-name-nondirectory project-file))))
(set-process-filter (get-buffer-process process-buffer)
'malaga-filter)
(set-process-sentinel (get-buffer-process process-buffer)
'malaga-sentinel)))))
;; Creating malaga-processes. =================================================
(defvar malaga-project-file "" "The default malaga project file.")
(defconst malaga-change-to-project-directory t
"*If non-nil, the buffer directory is set to the project directory
when malaga, mallex or malmake is started.")
(defun malaga-read-project-file-name ()
"Read the name of the malaga project file."
(setq malaga-project-file
(expand-file-name
(read-file-name "Project file: "
(file-name-directory malaga-project-file)
malaga-project-file t
(file-name-nondirectory malaga-project-file)))))
(defun malaga (project-file)
"Run malaga with PROJECT-FILE in buffer *malaga*."
(interactive (list (malaga-read-project-file-name)))
(malaga-init "malaga" project-file))
(defun mallex (project-file)
"Run mallex with PROJECT-FILE in buffer *mallex*."
(interactive (list (malaga-read-project-file-name)))
(malaga-init "mallex" project-file))
(defun malmake (project-file)
"Run malmake with PROJECT-FILE in buffer *malmake*."
(interactive (list (malaga-read-project-file-name)))
(save-some-buffers)
(malaga-init "malmake" project-file))
;; End of file. ===============================================================