(require 'tempo)
(defvar dcl-font-lock-keywords
'(("\\<\\(if\\|then\\|else\\|endif\\)\\>"
1 font-lock-keyword-face)
("\\<f[$][a-z_]+\\>"
0 font-lock-builtin-face)
("[.]\\(eq\\|not\\|or\\|and\\|lt\\|gt\\|le\\|ge\\|eqs\\|nes\\)[.]"
0 font-lock-builtin-face))
"Font lock keyword specification for DCL mode.
Presently this includes some syntax, .OP.erators, and \"f$\" lexicals.")
(defvar dcl-font-lock-defaults
'(dcl-font-lock-keywords nil)
"Font lock specification for DCL mode.")
(defgroup dcl nil
"Major mode for editing DCL command files."
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
:group 'languages)
(defcustom dcl-basic-offset 4
"*Number of columns to indent a block in DCL.
A block is the commands between THEN-ELSE-ENDIF and between the commands
dcl-block-begin-regexp and dcl-block-end-regexp.
The meaning of this variable may be changed if
dcl-calc-command-indent-function is set to a function."
:type 'integer
:group 'dcl)
(defcustom dcl-continuation-offset 6
"*Number of columns to indent a continuation line in DCL.
A continuation line is a line that follows a line ending with `-'.
The meaning of this variable may be changed if
dcl-calc-cont-indent-function is set to a function."
:type 'integer
:group 'dcl)
(defcustom dcl-margin-offset 8
"*Indentation for the first command line in DCL.
The first command line in a file or after a SUBROUTINE statement is indented
this much. Other command lines are indented the same number of columns as
the preceding command line.
A command line is a line that starts with `$'."
:type 'integer
:group 'dcl)
(defcustom dcl-margin-label-offset 2
"*Number of columns to indent a margin label in DCL.
A margin label is a label that doesn't begin or end a block, i.e. it
doesn't match dcl-block-begin-regexp or dcl-block-end-regexp."
:type 'integer
:group 'dcl)
(defcustom dcl-comment-line-regexp "^\\$!"
"*Regexp describing the start of a comment line in DCL.
Comment lines are not indented."
:type 'regexp
:group 'dcl)
(defcustom dcl-block-begin-regexp "loop[0-9]*:"
"*Regexp describing a command that begins an indented block in DCL.
Set to nil to only indent at THEN-ELSE-ENDIF."
:type 'regexp
:group 'dcl)
(defcustom dcl-block-end-regexp "endloop[0-9]*:"
"*Regexp describing a command that ends an indented block in DCL.
Set to nil to only indent at THEN-ELSE-ENDIF."
:type 'regexp
:group 'dcl)
(defcustom dcl-calc-command-indent-function nil
"*Function to calculate indentation for a command line in DCL.
If this variable is non-nil it is called as a function:
\(func INDENT-TYPE CUR-INDENT EXTRA-INDENT LAST-POINT THIS-POINT)
The function must return the number of columns to indent the current line or
nil to get the default indentation.
INDENT-TYPE is a symbol indicating what kind of indentation should be done.
It can have the following values:
indent the lines indentation should be increased, e.g. after THEN.
outdent the lines indentation should be decreased, e.g a line with ENDIF.
first-line indentation for the first line in a buffer or SUBROUTINE.
CUR-INDENT is the indentation of the preceding command line.
EXTRA-INDENT is the default change in indentation for this line
\(a negative number for 'outdent).
LAST-POINT is the buffer position of the first significant word on the
previous line or nil if the current line is the first line.
THIS-POINT is the buffer position of the first significant word on the
current line.
If this variable is nil, the indentation is calculated as
CUR-INDENT + EXTRA-INDENT.
This package includes two functions suitable for this:
dcl-calc-command-indent-multiple
dcl-calc-command-indent-hang"
:type '(choice (const nil) function)
:group 'dcl)
(defcustom dcl-calc-cont-indent-function 'dcl-calc-cont-indent-relative
"*Function to calculate indentation for a continuation line.
If this variable is non-nil it is called as a function:
\(func CUR-INDENT EXTRA-INDENT)
The function must return the number of columns to indent the current line or
nil to get the default indentation.
If this variable is nil, the indentation is calculated as
CUR-INDENT + EXTRA-INDENT.
This package includes one function suitable for this:
dcl-calc-cont-indent-relative"
:type 'function
:group 'dcl)
(defcustom dcl-tab-always-indent t
"*Controls the operation of the TAB key in DCL mode.
If t, pressing TAB always indents the current line.
If nil, pressing TAB indents the current line if point is at the left margin.
Data lines (i.e. lines not part of a command line or continuation line) are
never indented."
:type 'boolean
:group 'dcl)
(defcustom dcl-electric-characters t
"*Non-nil means reindent immediately when a label, ELSE or ENDIF is inserted."
:type 'boolean
:group 'dcl)
(defcustom dcl-tempo-comma ", "
"*Text to insert when a comma is needed in a template, in DCL mode."
:type 'string
:group 'dcl)
(defcustom dcl-tempo-left-paren "("
"*Text to insert when a left parenthesis is needed in a template in DCL."
:type 'string
:group 'dcl)
(defcustom dcl-tempo-right-paren ")"
"*Text to insert when a right parenthesis is needed in a template in DCL."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-label-labels "Labels"
"*Imenu menu title for sub-listing with label names."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-label-goto "GOTO"
"*Imenu menu title for sub-listing with GOTO statements."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-label-gosub "GOSUB"
"*Imenu menu title for sub-listing with GOSUB statements."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-label-call "CALL"
"*Imenu menu title for sub-listing with CALL statements."
:type 'string
:group 'dcl)
(defcustom dcl-imenu-generic-expression
`((nil "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):[ \t]+SUBROUTINE\\b" 1)
(,dcl-imenu-label-labels
"^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):\\([ \t]\\|$\\)" 1)
(,dcl-imenu-label-goto "\\s-GOTO[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)
(,dcl-imenu-label-gosub "\\s-GOSUB[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)
(,dcl-imenu-label-call "\\s-CALL[ \t]+\\([A-Za-z0-9_\$]+\\)" 1))
"*Default imenu generic expression for DCL.
The default includes SUBROUTINE labels in the main listing and
sub-listings for other labels, CALL, GOTO and GOSUB statements.
See `imenu-generic-expression' for details."
:type '(repeat (sexp :tag "Imenu Expression"))
:group 'dcl)
(defcustom dcl-mode-hook nil
"*Hook called by `dcl-mode'."
:type 'hook
:group 'dcl)
(defvar dcl-mode-syntax-table nil
"Syntax table used in DCL-buffers.")
(unless dcl-mode-syntax-table
(setq dcl-mode-syntax-table (make-syntax-table))
(modify-syntax-entry ?! "<" dcl-mode-syntax-table) (modify-syntax-entry ?\n ">" dcl-mode-syntax-table) (modify-syntax-entry ?< "(>" dcl-mode-syntax-table) (modify-syntax-entry ?> ")<" dcl-mode-syntax-table) (modify-syntax-entry ?\\ "_" dcl-mode-syntax-table) )
(defvar dcl-mode-map ()
"Keymap used in DCL-mode buffers.")
(if dcl-mode-map
()
(setq dcl-mode-map (make-sparse-keymap))
(define-key dcl-mode-map "\e\n" 'dcl-split-line)
(define-key dcl-mode-map "\e\t" 'tempo-complete-tag)
(define-key dcl-mode-map "\e^" 'dcl-delete-indentation)
(define-key dcl-mode-map "\em" 'dcl-back-to-indentation)
(define-key dcl-mode-map "\ee" 'dcl-forward-command)
(define-key dcl-mode-map "\ea" 'dcl-backward-command)
(define-key dcl-mode-map "\e\C-q" 'dcl-indent-command)
(define-key dcl-mode-map "\t" 'dcl-tab)
(define-key dcl-mode-map ":" 'dcl-electric-character)
(define-key dcl-mode-map "F" 'dcl-electric-character)
(define-key dcl-mode-map "f" 'dcl-electric-character)
(define-key dcl-mode-map "E" 'dcl-electric-character)
(define-key dcl-mode-map "e" 'dcl-electric-character)
(define-key dcl-mode-map "\C-c\C-o" 'dcl-set-option)
(define-key dcl-mode-map "\C-c\C-f" 'tempo-forward-mark)
(define-key dcl-mode-map "\C-c\C-b" 'tempo-backward-mark)
(define-key dcl-mode-map [menu-bar] (make-sparse-keymap))
(define-key dcl-mode-map [menu-bar dcl]
(cons "DCL" (make-sparse-keymap "DCL")))
(define-key dcl-mode-map [menu-bar dcl tempo-backward-mark]
'("Previous template mark" . tempo-backward-mark))
(define-key dcl-mode-map [menu-bar dcl tempo-forward-mark]
'("Next template mark" . tempo-forward-mark))
(define-key dcl-mode-map [menu-bar dcl tempo-complete-tag]
'("Complete template tag" . tempo-complete-tag))
(define-key dcl-mode-map [menu-bar dcl dcl-separator-tempo]
'("--"))
(define-key dcl-mode-map [menu-bar dcl dcl-save-all-options]
'("Save all options" . dcl-save-all-options))
(define-key dcl-mode-map [menu-bar dcl dcl-save-nondefault-options]
'("Save changed options" . dcl-save-nondefault-options))
(define-key dcl-mode-map [menu-bar dcl dcl-set-option]
'("Set option" . dcl-set-option))
(define-key dcl-mode-map [menu-bar dcl dcl-separator-option]
'("--"))
(define-key dcl-mode-map [menu-bar dcl dcl-delete-indentation]
'("Delete indentation" . dcl-delete-indentation))
(define-key dcl-mode-map [menu-bar dcl dcl-split-line]
'("Split line" . dcl-split-line))
(define-key dcl-mode-map [menu-bar dcl dcl-indent-command]
'("Indent command" . dcl-indent-command))
(define-key dcl-mode-map [menu-bar dcl dcl-tab]
'("Indent line/insert tab" . dcl-tab))
(define-key dcl-mode-map [menu-bar dcl dcl-back-to-indentation]
'("Back to indentation" . dcl-back-to-indentation))
(define-key dcl-mode-map [menu-bar dcl dcl-forward-command]
'("End of statement" . dcl-forward-command))
(define-key dcl-mode-map [menu-bar dcl dcl-backward-command]
'("Beginning of statement" . dcl-backward-command))
(if (boundp 'imenu-generic-expression)
(progn
(define-key dcl-mode-map [menu-bar dcl dcl-separator-movement]
'("--"))
(define-key dcl-mode-map [menu-bar dcl imenu]
'("Buffer index menu" . imenu))))
)
(defcustom dcl-ws-r
"\\([ \t]*-[ \t]*\\(!.*\\)*\n\\)*[ \t]*"
"Regular expression describing white space in a DCL command line.
White space is any number of continued lines with only space,tab,endcomment
followed by space or tab."
:type 'regexp
:group 'dcl)
(defcustom dcl-label-r
"[a-zA-Z0-9_\$]*:\\([ \t!]\\|$\\)"
"Regular expression describing a label.
A label is a name followed by a colon followed by white-space or end-of-line."
:type 'regexp
:group 'dcl)
(defcustom dcl-cmd-r
"^\\$\\(.*-[ \t]*\\(!.*\\)*\n\\)*[^!\"\n]*\\(\".*\\(\"\".*\\)*\"\\)*[^!\"\n]*"
"Regular expression describing a DCL command line up to a trailing comment.
A line starting with $, optionally followed by continuation lines,
followed by the end of the command line.
A continuation line is any characters followed by `-',
optionally followed by a comment, followed by a newline."
:type 'regexp
:group 'dcl)
(defcustom dcl-command-regexp
"^\\$\\(.*-[ \t]*\\(!.*\\)*\n\\)*.*\\(\".*\\(\"\".*\\)*\"\\)*"
"Regular expression describing a DCL command line.
A line starting with $, optionally followed by continuation lines,
followed by the end of the command line.
A continuation line is any characters followed by `-',
optionally followed by a comment, followed by a newline."
:type 'regexp
:group 'dcl)
(defcustom dcl-electric-reindent-regexps
(list "endif" "else" dcl-label-r)
"*Regexps that can trigger an electric reindent.
A list of regexps that will trigger a reindent if the last letter
is defined as dcl-electric-character.
E.g.: if this list contains `endif', the key `f' is defined as
dcl-electric-character and the you have just typed the `f' in
`endif', the line will be reindented."
:type '(repeat regexp)
:group 'dcl)
(defvar dcl-option-alist
'((dcl-basic-offset dcl-option-value-basic)
(dcl-continuation-offset curval)
(dcl-margin-offset dcl-option-value-margin-offset)
(dcl-margin-label-offset dcl-option-value-offset)
(dcl-comment-line-regexp dcl-option-value-comment-line)
(dcl-block-begin-regexp curval)
(dcl-block-end-regexp curval)
(dcl-tab-always-indent toggle)
(dcl-electric-characters toggle)
(dcl-electric-reindent-regexps curval)
(dcl-tempo-comma curval)
(dcl-tempo-left-paren curval)
(dcl-tempo-right-paren curval)
(dcl-calc-command-indent-function curval)
(dcl-calc-cont-indent-function curval)
(comment-start curval)
(comment-start-skip curval)
)
"Options and default values for dcl-set-option.
An alist with option variables and functions or keywords to get a
default value for the option.
The keywords are:
curval the current value
toggle the opposite of the current value (for t/nil)")
(defvar dcl-option-history
(mapcar (lambda (option-assoc)
(format "%s" (car option-assoc)))
dcl-option-alist)
"The history list for dcl-set-option.
Preloaded with all known option names from dcl-option-alist")
(defun dcl-mode ()
"Major mode for editing DCL-files.
This mode indents command lines in blocks. (A block is commands between
THEN-ELSE-ENDIF and between lines matching dcl-block-begin-regexp and
dcl-block-end-regexp.)
Labels are indented to a fixed position unless they begin or end a block.
Whole-line comments (matching dcl-comment-line-regexp) are not indented.
Data lines are not indented.
Key bindings:
\\{dcl-mode-map}
Commands not usually bound to keys:
\\[dcl-save-nondefault-options]\t\tSave changed options
\\[dcl-save-all-options]\t\tSave all options
\\[dcl-save-option]\t\t\tSave any option
\\[dcl-save-mode]\t\t\tSave buffer mode
Variables controlling indentation style and extra features:
dcl-basic-offset
Extra indentation within blocks.
dcl-continuation-offset
Extra indentation for continued lines.
dcl-margin-offset
Indentation for the first command line in a file or SUBROUTINE.
dcl-margin-label-offset
Indentation for a label.
dcl-comment-line-regexp
Lines matching this regexp will not be indented.
dcl-block-begin-regexp
dcl-block-end-regexp
Regexps that match command lines that begin and end, respectively,
a block of commmand lines that will be given extra indentation.
Command lines between THEN-ELSE-ENDIF are always indented; these variables
make it possible to define other places to indent.
Set to nil to disable this feature.
dcl-calc-command-indent-function
Can be set to a function that customizes indentation for command lines.
Two such functions are included in the package:
dcl-calc-command-indent-multiple
dcl-calc-command-indent-hang
dcl-calc-cont-indent-function
Can be set to a function that customizes indentation for continued lines.
One such function is included in the package:
dcl-calc-cont-indent-relative (set by default)
dcl-tab-always-indent
If t, pressing TAB always indents the current line.
If nil, pressing TAB indents the current line if point is at the left
margin.
dcl-electric-characters
Non-nil causes lines to be indented at once when a label, ELSE or ENDIF is
typed.
dcl-electric-reindent-regexps
Use this variable and function dcl-electric-character to customize
which words trigger electric indentation.
dcl-tempo-comma
dcl-tempo-left-paren
dcl-tempo-right-paren
These variables control the look of expanded templates.
dcl-imenu-generic-expression
Default value for imenu-generic-expression. The default includes
SUBROUTINE labels in the main listing and sub-listings for
other labels, CALL, GOTO and GOSUB statements.
dcl-imenu-label-labels
dcl-imenu-label-goto
dcl-imenu-label-gosub
dcl-imenu-label-call
Change the text that is used as sub-listing labels in imenu.
Loading this package calls the value of the variable
`dcl-mode-load-hook' with no args, if that value is non-nil.
Turning on DCL mode calls the value of the variable `dcl-mode-hook'
with no args, if that value is non-nil.
The following example uses the default values for all variables:
$! This is a comment line that is not indented (it matches
$! dcl-comment-line-regexp)
$! Next follows the first command line. It is indented dcl-margin-offset.
$ i = 1
$ ! Other comments are indented like command lines.
$ ! A margin label indented dcl-margin-label-offset:
$ label:
$ if i.eq.1
$ then
$ ! Lines between THEN-ELSE and ELSE-ENDIF are
$ ! indented dcl-basic-offset
$ loop1: ! This matches dcl-block-begin-regexp...
$ ! ...so this line is indented dcl-basic-offset
$ text = \"This \" + - ! is a continued line
\"lined up with the command line\"
$ type sys$input
Data lines are not indented at all.
$ endloop1: ! This matches dcl-block-end-regexp
$ endif
$
There is some minimal font-lock support (see vars
`dcl-font-lock-defaults' and `dcl-font-lock-keywords')."
(interactive)
(kill-all-local-variables)
(set-syntax-table dcl-mode-syntax-table)
(make-local-variable 'indent-line-function)
(setq indent-line-function 'dcl-indent-line)
(make-local-variable 'comment-start)
(setq comment-start "!")
(make-local-variable 'comment-end)
(setq comment-end "")
(make-local-variable 'comment-multi-line)
(setq comment-multi-line nil)
(make-local-variable 'comment-start-skip)
(setq comment-start-skip "\\$[ \t]*![ \t]*")
(if (boundp 'imenu-generic-expression)
(progn (setq imenu-generic-expression dcl-imenu-generic-expression)
(setq imenu-case-fold-search t)))
(setq imenu-create-index-function 'dcl-imenu-create-index-function)
(make-local-variable 'dcl-comment-line-regexp)
(make-local-variable 'dcl-block-begin-regexp)
(make-local-variable 'dcl-block-end-regexp)
(make-local-variable 'dcl-basic-offset)
(make-local-variable 'dcl-continuation-offset)
(make-local-variable 'dcl-margin-label-offset)
(make-local-variable 'dcl-margin-offset)
(make-local-variable 'dcl-tab-always-indent)
(make-local-variable 'dcl-electric-characters)
(make-local-variable 'dcl-calc-command-indent-function)
(make-local-variable 'dcl-calc-cont-indent-function)
(make-local-variable 'dcl-electric-reindent-regexps)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults dcl-font-lock-defaults)
(setq major-mode 'dcl-mode)
(setq mode-name "DCL")
(use-local-map dcl-mode-map)
(tempo-use-tag-list 'dcl-tempo-tags)
(run-mode-hooks 'dcl-mode-hook))
(defun dcl-beginning-of-statement ()
"Go to the beginning of the preceding or current command line."
(interactive)
(re-search-backward dcl-command-regexp nil t))
(defun dcl-end-of-statement ()
"Go to the end of the next or current command line."
(interactive)
(if (or (dcl-end-of-command-p)
(dcl-beginning-of-command-p)
(not (dcl-command-p)))
()
(dcl-beginning-of-statement))
(re-search-forward dcl-command-regexp nil t))
(defun dcl-beginning-of-command ()
"Move point to beginning of current command."
(interactive)
(let ((type (dcl-get-line-type)))
(if (and (eq type '$)
(bolp))
() (dcl-beginning-of-statement))))
(defun dcl-end-of-command ()
"Move point to end of current command or next command if not on a command."
(interactive)
(let ((type (dcl-get-line-type))
(start (point)))
(if (or (eq type '$)
(eq type '-))
(progn
(dcl-beginning-of-command)
(dcl-end-of-statement))
(dcl-end-of-statement))))
(defun dcl-backward-command (&optional incl-comment-commands)
"Move backward to a command.
Move point to the preceding command line that is not a comment line,
a command line with only a comment, only contains a `$' or only
contains a label.
Returns point of the found command line or nil if not able to move."
(interactive)
(let ((start (point))
done
retval)
(while (not done)
(if (dcl-beginning-of-statement)
(cond
((and dcl-block-begin-regexp (looking-at (concat "^\\$" dcl-ws-r
dcl-block-begin-regexp)))
(setq done t retval (point)))
((and dcl-block-end-regexp (looking-at (concat "^\\$" dcl-ws-r
dcl-block-end-regexp)))
(setq done t retval (point)))
((looking-at dcl-comment-line-regexp)
t) ((and (not incl-comment-commands)
(looking-at "\\$[ \t]*!"))
t) ((looking-at "^\\$[ \t]*$")
t) ((not (looking-at
(concat "^\\$" dcl-ws-r dcl-label-r dcl-ws-r "$")))
(setq done t) (setq retval (point))))
(goto-char start)
(setq done t)
(setq retval nil)))
retval))
(defun dcl-forward-command (&optional incl-comment-commands)
"Move forward to a command.
Move point to the end of the next command line that is not a comment line,
a command line with only a comment, only contains a `$' or only
contains a label.
Returns point of the found command line or nil if not able to move."
(interactive)
(let ((start (point))
done
retval)
(while (not done)
(if (dcl-end-of-statement)
(save-excursion
(dcl-beginning-of-statement)
(cond
((and dcl-block-begin-regexp (looking-at (concat "^\\$" dcl-ws-r
dcl-block-begin-regexp)))
(setq done t)
(setq retval (point)))
((and dcl-block-end-regexp (looking-at (concat "^\\$" dcl-ws-r
dcl-block-end-regexp)))
(setq done t)
(setq retval (point)))
((looking-at dcl-comment-line-regexp)
t) ((and (not incl-comment-commands)
(looking-at "\\$[ \t]*!"))
t) ((looking-at "^\\$[ \t]*$")
t) ((not (looking-at
(concat "^\\$" dcl-ws-r dcl-label-r dcl-ws-r "$")))
(setq done t) (setq retval (point)))))
(goto-char start)
(setq done t)
(setq retval nil)))
retval))
(defun dcl-back-to-indentation ()
"Move point to the first non-whitespace character on this line.
Leading $ and labels counts as whitespace in this case.
If this is a comment line then move to the first non-whitespace character
in the comment.
Typing \\[dcl-back-to-indentation] several times in a row will move point to other
`interesting' points closer to the left margin, and then back to the
rightmost point again.
E.g. on the following line, point would go to the positions indicated
by the numbers in order 1-2-3-1-... :
$ label: command
3 2 1"
(interactive)
(if (eq last-command 'dcl-back-to-indentation)
(dcl-back-to-indentation-1 (point))
(dcl-back-to-indentation-1)))
(defun dcl-back-to-indentation-1 (&optional limit)
"Helper function for dcl-back-to-indentation"
(let* ((default-limit (save-excursion (end-of-line) (1+ (point))))
(limit (or limit default-limit))
(last-good-point (point))
(opoint (point)))
(back-to-indentation)
(if (= (point) opoint)
(setq limit default-limit))
(if (< (point) limit)
(setq last-good-point (point)))
(cond
((looking-at dcl-comment-line-regexp)
(re-search-forward (concat dcl-comment-line-regexp "[ \t]*") limit t)
(if (< (point) limit)
(setq last-good-point (point))))
((looking-at "^\\$[ \t]*")
(re-search-forward "^\\$[ \t]*" limit t)
(if (< (point) limit)
(setq last-good-point (point)))
(if (and (looking-at dcl-label-r)
(not (or (and dcl-block-begin-regexp
(looking-at dcl-block-begin-regexp))
(and dcl-block-end-regexp
(looking-at dcl-block-end-regexp)))))
(re-search-forward (concat dcl-label-r "[ \t]*") limit t))
(if (< (point) limit)
(setq last-good-point (point)))
(if (looking-at "![ \t]*")
(re-search-forward "![ \t]*" limit t))
(if (< (point) limit)
(setq last-good-point (point)))))
(goto-char last-good-point)))
(defun dcl-get-line-type ()
"Determine the type of the current line.
Returns one of the following symbols:
$ for a complete command line or the beginning of a command line.
- for a continuation line
$! for a comment line
data for a data line
empty-data for an empty line following a data line
empty-$ for an empty line following a command line"
(or
(save-excursion
(beginning-of-line)
(if (looking-at dcl-comment-line-regexp)
'$!))
(save-excursion
(beginning-of-line)
(if (looking-at "^\\$")
'$))
(save-excursion
(beginning-of-line)
(if (bobp)
()
(let ((opoint (point)))
(dcl-beginning-of-statement)
(re-search-forward dcl-command-regexp opoint t)
(if (>= (point) opoint)
'-))))
(save-excursion
(if (and (bolp) (eolp))
(if (bobp)
'empty-$
(forward-line -1)
(let ((type (dcl-get-line-type)))
(cond
((or (equal type '$) (equal type '$!) (equal type '-))
'empty-$)
((equal type 'data)
'empty-data))))))
(progn 'data)
))
(defun dcl-indentation-point ()
"Return point of first non-`whitespace' on this line."
(save-excursion
(dcl-back-to-indentation)
(point)))
(defun dcl-show-line-type ()
"Test dcl-get-line-type."
(interactive)
(let ((type (dcl-get-line-type)))
(cond
((equal type '$)
(message "command line"))
((equal type '\?)
(message "?"))
((equal type '$!)
(message "comment line"))
((equal type '-)
(message "continuation line"))
((equal type 'data)
(message "data"))
((equal type 'empty-data)
(message "empty-data"))
((equal type 'empty-$)
(message "empty-$"))
(t
(message "hupp"))
)))
(defun dcl-calc-command-indent-multiple
(indent-type cur-indent extra-indent last-point this-point)
"Indent lines to a multiple of dcl-basic-offset.
Set dcl-calc-command-indent-function to this function to customize
indentation of command lines.
Command lines that need to be indented beyond the left margin are
always indented to a column that is a multiple of dcl-basic-offset, as
if tab stops were set at 4, 8, 12, etc.
This supports a formatting style like this (dcl-margin offset = 2,
dcl-basic-offset = 4):
$ if cond
$ then
$ if cond
$ then
$ ! etc
"
(let ((indent))
(cond
((equal indent-type 'indent)
(setq indent (- cur-indent (% cur-indent dcl-basic-offset)))
(setq indent (+ indent extra-indent))))))
(defun dcl-calc-command-indent-hang
(indent-type cur-indent extra-indent last-point this-point)
"Indent lines as default, but indent THEN, ELSE and ENDIF extra.
Set dcl-calc-command-indent-function to this function to customize
indentation of command lines.
This function supports a formatting style like this:
$ if cond
$ then
$ xxx
$ endif
$ xxx
If you use this function you will probably want to add \"then\" to
dcl-electric-reindent-regexps and define the key \"n\" as
dcl-electric-character.
"
(let ((case-fold-search t))
(save-excursion
(cond
((null indent-type)
(or (progn
(goto-char this-point)
(if (looking-at "\\bthen\\b")
(+ cur-indent extra-indent 2)))
(progn
(goto-char last-point)
(if (looking-at "\\bendif\\b")
(- (+ cur-indent extra-indent) 2)))))
((equal indent-type 'indent)
(goto-char last-point)
(cond
((looking-at "\\bthen\\b")
(- (+ cur-indent extra-indent) 2))
((looking-at "\\belse\\b")
(- (+ cur-indent extra-indent) 2))))
((equal indent-type 'outdent)
(goto-char this-point)
(cond
((looking-at "\\bendif\\b")
(+ cur-indent extra-indent 2))
((looking-at "\\belse\\b")
(+ cur-indent extra-indent 2))))))))
(defun dcl-calc-command-indent ()
"Calculate how much the current line shall be indented.
The line is known to be a command line.
Find the indentation of the preceding line and analyze its contents to
see if the current lines should be indented.
Analyze the current line to see if it should be `outdented'.
Calculate the indentation of the current line, either with the default
method or by calling dcl-calc-command-indent-function if it is
non-nil.
If the current line should be outdented, calculate its indentation,
either with the default method or by calling
dcl-calc-command-indent-function if it is non-nil.
Rules for default indentation:
If it is the first line in the buffer, indent dcl-margin-offset.
Go to the previous command line with a command on it.
Find out how much it is indented (cur-indent).
Look at the first word on the line to see if the indentation should be
adjusted. Skip margin-label, continuations and comments while looking for
the first word. Save this buffer position as `last-point'.
If the first word after a label is SUBROUTINE, set extra-indent to
dcl-margin-offset.
First word extra-indent
THEN +dcl-basic-offset
ELSE +dcl-basic-offset
block-begin +dcl-basic-offset
Then return to the current line and look at the first word to see if the
indentation should be adjusted again. Save this buffer position as
`this-point'.
First word extra-indent
ELSE -dcl-basic-offset
ENDIF -dcl-basic-offset
block-end -dcl-basic-offset
If dcl-calc-command-indent-function is nil or returns nil set
cur-indent to cur-indent+extra-indent.
If an extra adjustment is necessary and if
dcl-calc-command-indent-function is nil or returns nil set cur-indent
to cur-indent+extra-indent.
See also documentation for dcl-calc-command-indent-function.
The indent-type classification could probably be expanded upon.
"
()
(save-excursion
(beginning-of-line)
(let ((is-block nil)
(case-fold-search t)
cur-indent
(extra-indent 0)
indent-type last-point this-point extra-indent2 cur-indent2
indent-type2)
(if (bobp) (setq cur-indent 0 extra-indent dcl-margin-offset
indent-type 'first-line
this-point (dcl-indentation-point))
(save-excursion
(let (done)
(while (not done)
(if (dcl-beginning-of-statement)
(cond
((and dcl-block-begin-regexp (looking-at (concat "^\\$" dcl-ws-r
dcl-block-begin-regexp)))
(setq done t) (setq is-block t))
((and dcl-block-end-regexp (looking-at (concat "^\\$" dcl-ws-r
dcl-block-end-regexp)))
(setq done t) (setq is-block t))
((looking-at dcl-comment-line-regexp)
t) ((looking-at "^\\$[ \t]*$")
t) ((not (looking-at
(concat "^\\$" dcl-ws-r dcl-label-r dcl-ws-r "$")))
(setq done t))) (setq cur-indent dcl-margin-offset
last-point (dcl-indentation-point))
(setq done t)))
(cond
(cur-indent)
((looking-at (concat "^\\$[ \t]*" dcl-label-r dcl-ws-r
"\\(subroutine\\b\\)"))
(setq cur-indent dcl-margin-offset
last-point (1+ (match-beginning 1))))
(t
(if is-block
(re-search-forward "^\\$[ \t]*")
(re-search-forward (concat "^\\$[ \t]*\\(" dcl-label-r
"\\)*[ \t]*")))
(setq cur-indent (current-column))
(re-search-forward dcl-ws-r)
(setq last-point (point))
(cond
((looking-at "\\bthen\\b")
(setq extra-indent dcl-basic-offset indent-type 'indent))
((looking-at "\\belse\\b")
(setq extra-indent dcl-basic-offset indent-type 'indent))
((and dcl-block-begin-regexp (looking-at dcl-block-begin-regexp))
(setq extra-indent dcl-basic-offset indent-type 'indent))
))))))
(setq extra-indent2 0)
(re-search-forward (concat "^\\$" dcl-ws-r))
(setq this-point (dcl-indentation-point))
(cond
((looking-at "\\belse\\b")
(setq extra-indent2 (- dcl-basic-offset) indent-type2 'outdent))
((looking-at "\\bendif\\b")
(setq extra-indent2 (- dcl-basic-offset) indent-type2 'outdent))
((and dcl-block-end-regexp (looking-at dcl-block-end-regexp))
(setq extra-indent2 (- dcl-basic-offset) indent-type2 'outdent))
((looking-at (concat dcl-label-r dcl-ws-r "\\(subroutine\\b\\)"))
(setq cur-indent2 0 extra-indent2 dcl-margin-offset
indent-type2 'first-line
this-point (1+ (match-beginning 1)))))
(setq cur-indent
(or (and dcl-calc-command-indent-function
(funcall dcl-calc-command-indent-function
indent-type cur-indent extra-indent
last-point this-point))
(+ cur-indent extra-indent)))
(if indent-type2
(progn
(or cur-indent2 (setq cur-indent2 cur-indent))
(setq cur-indent
(or (and dcl-calc-command-indent-function
(funcall dcl-calc-command-indent-function
indent-type2 cur-indent2 extra-indent2
last-point this-point))
(+ cur-indent2 extra-indent2)))))
cur-indent
)))
(defun dcl-calc-cont-indent-relative (cur-indent extra-indent)
"Indent continuation lines to align with words on previous line.
Indent continuation lines to a position relative to preceding
significant command line elements.
Set `dcl-calc-cont-indent-function' to this function to customize
indentation of continuation lines.
Indented lines will align with either:
* the second word on the command line
$ set default -
[-]
* the word after an assignment
$ a = b + -
d
* the third word if it's a qualifier
$ set terminal/width=80 -
/page=24
* the innermost nonclosed parenthesis
$ if ((a.eq.b .and. -
d.eq.c .or. f$function(xxxx, -
yyy)))
"
(let ((case-fold-search t)
indent)
(save-excursion
(dcl-beginning-of-statement)
(let ((end (save-excursion (forward-line 1) (point))))
(if (re-search-forward (concat "^\\$[ \t]*\\(" dcl-label-r
"\\)*[ \t]*") end t)
(progn
(if (> (skip-chars-forward "@:[]<>$\\-a-zA-Z0-9_.;" end) 0)
(let (was-assignment)
(skip-chars-forward " \t" end)
(if (looking-at ":?==?")
(progn
(setq was-assignment t)
(skip-chars-forward " \t:=" end)))
(setq indent (current-column))
(if (and (not was-assignment)
(> (skip-chars-forward "a-zA-Z0-9_" end) 0))
(progn
(skip-chars-forward " \t" end)
(if (= (char-after (point)) ?/)
(setq indent (current-column)))))
))))))
(save-excursion
(beginning-of-line)
(let* ((start (save-excursion (dcl-beginning-of-statement) (point)))
(parse-sexp-ignore-comments t) (par-pos (nth 1 (parse-partial-sexp start (point)))))
(if par-pos (setq indent (save-excursion
(goto-char par-pos)
(1+ (current-column)))))))
indent))
(defun dcl-calc-continuation-indent ()
"Calculate how much the current line shall be indented.
The line is known to be a continuation line.
Go to the previous command line.
Find out how much it is indented."
()
(save-excursion
(beginning-of-line)
(if (bobp)
dcl-margin-offset
(let ((is-block nil)
(indent))
(save-excursion
(let ((done))
(while (not done)
(if (dcl-beginning-of-statement)
(cond
((and dcl-block-begin-regexp
(looking-at (concat "^\\$" dcl-ws-r
dcl-block-begin-regexp)))
(setq done t) (setq is-block t))
((and dcl-block-end-regexp
(looking-at (concat "^\\$" dcl-ws-r
dcl-block-end-regexp)))
(setq done t) (setq is-block t))
((looking-at dcl-comment-line-regexp)
t)
((looking-at "^\\$[ \t]*$")
t)
((not (looking-at
(concat "^\\$" dcl-ws-r dcl-label-r dcl-ws-r "$")))
(setq done t)))
(setq indent dcl-margin-offset)
(setq done t)))
(if indent
()
(if is-block
(re-search-forward "^\\$[ \t]*")
(re-search-forward (concat "^\\$[ \t]*\\(" dcl-label-r
"\\)*[ \t]*")))
(setq indent (current-column))
)))
(or (and dcl-calc-cont-indent-function
(funcall dcl-calc-cont-indent-function indent
dcl-continuation-offset))
(+ indent dcl-continuation-offset))
))))
(defun dcl-indent-command-line ()
"Indent a line known to be a command line."
(let ((indent (dcl-calc-command-indent))
(pos (- (point-max) (point))))
(save-excursion
(beginning-of-line)
(re-search-forward "^\\$[ \t]*")
(if (and dcl-margin-label-offset
(looking-at dcl-label-r)
(not (and dcl-block-begin-regexp
(looking-at dcl-block-begin-regexp)))
(not (and dcl-block-end-regexp
(looking-at dcl-block-end-regexp))))
(progn
(dcl-indent-to dcl-margin-label-offset)
(re-search-forward dcl-label-r)))
(dcl-indent-to indent 1)
)
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))
))
(defun dcl-indent-continuation-line ()
"Indent a line known to be a continuation line.
Notice that no special treatment is made for labels. They have to be
on the first part on a command line to be taken into consideration."
(let ((indent (dcl-calc-continuation-indent)))
(save-excursion
(beginning-of-line)
(re-search-forward "^[ \t]*")
(dcl-indent-to indent))
(skip-chars-forward " \t")))
(defun dcl-delete-chars (chars)
"Delete all characters in the set CHARS around point."
(skip-chars-backward chars)
(delete-region (point) (progn (skip-chars-forward chars) (point))))
(defun dcl-indent-line ()
"The DCL version of `indent-line-function'.
Adjusts indentation on the current line. Data lines are not indented."
(let ((type (dcl-get-line-type)))
(cond
((equal type '$)
(dcl-indent-command-line))
((equal type '\?)
(message "Unknown line type!"))
((equal type '$!))
((equal type 'data))
((equal type 'empty-data))
((equal type '-)
(dcl-indent-continuation-line))
((equal type 'empty-$)
(insert "$" )
(dcl-indent-command-line))
(t
(message "dcl-indent-line: unknown type"))
)))
(defun dcl-indent-command ()
"Indents the complete command line that point is on.
This includes continuation lines."
(interactive "*")
(let ((type (dcl-get-line-type)))
(if (or (equal type '$)
(equal type '-)
(equal type 'empty-$))
(save-excursion
(indent-region (progn (or (looking-at "^\\$")
(dcl-beginning-of-statement))
(point))
(progn (dcl-end-of-statement) (point))
nil)))))
(defun dcl-tab ()
"Insert tab in data lines or indent code.
If `dcl-tab-always-indent' is t, code lines are always indented.
If nil, indent the current line only if point is at the left margin or in
the lines indentation; otherwise insert a tab."
(interactive "*")
(let ((type (dcl-get-line-type))
(start-point (point)))
(cond
((or (equal type 'data) (equal type 'empty-data))
(tab-to-tab-stop))
((not dcl-tab-always-indent) (let ((search-end-point
(save-excursion
(beginning-of-line)
(re-search-forward "^\\$?[ \t]*" start-point t))))
(if (or (bolp)
(and search-end-point
(>= search-end-point start-point)))
(dcl-indent-line)
(tab-to-tab-stop))))
((eq dcl-tab-always-indent t) (dcl-indent-line))
)))
(defun dcl-electric-character (arg)
"Inserts a character and indents if necessary.
Insert a character if the user gave a numeric argument or the flag
`dcl-electric-characters' is not set. If an argument was given,
insert that many characters.
The line is only reindented if the word just typed matches any of the
regexps in `dcl-electric-reindent-regexps'."
(interactive "*P")
(if (or arg (not dcl-electric-characters))
(if arg
(self-insert-command (prefix-numeric-value arg))
(self-insert-command 1))
(self-insert-command 1)
(let ((case-fold-search t))
(if (memq t (mapcar 'dcl-was-looking-at dcl-electric-reindent-regexps))
(dcl-indent-line)))))
(defun dcl-indent-to (col &optional minimum)
"Like indent-to, but only indents if indentation would change"
(interactive)
(let (cur-indent collapsed indent)
(save-excursion
(skip-chars-forward " \t")
(setq cur-indent (current-column))
(skip-chars-backward " \t")
(setq collapsed (current-column)))
(setq indent (max col (+ collapsed (or minimum 0))))
(if (/= indent cur-indent)
(progn
(dcl-delete-chars " \t")
(indent-to col minimum)))))
(defun dcl-split-line ()
"Break line at point and insert text to keep the syntax valid.
Inserts continuation marks and splits character strings."
(interactive "*")
(let (done
(type (dcl-get-line-type)))
(cond
((or (equal type '$) (equal type '-))
(let ((info (parse-partial-sexp
(save-excursion (dcl-beginning-of-statement) (point))
(point))))
(cond
((nth 3 info) (insert "\" + -\n\"")
(indent-according-to-mode)
(setq done t))
((not (nth 4 info)) (cond
((and (not (eolp))
(= (char-after (point)) ?\")
(= (char-after (1- (point))) ?\"))
(progn ; a " "" " situation
(forward-char -1)
(insert "\" + -\n\"")
(forward-char 1)
(indent-according-to-mode)
(setq done t)))
((and (dcl-was-looking-at "[ \t]*-[ \t]*") (looking-at "[ \t]*\\(!.*\\)?$"))
)
(t
(delete-horizontal-space)
(insert " -")
(insert "\n") (indent-according-to-mode)
(setq done t))))
))))
(if (not done) (indent-new-comment-line))))
(defun dcl-delete-indentation (&optional arg)
"Join this line to previous like delete-indentation.
Also remove the continuation mark if easily detected."
(interactive "*P")
(delete-indentation arg)
(let ((type (dcl-get-line-type)))
(if (and (or (equal type '$)
(equal type '-)
(equal type 'empty-$))
(not (bobp))
(= (char-after (1- (point))) ?-))
(progn
(delete-backward-char 1)
(fixup-whitespace)))))
(defun dcl-option-value-basic (option-assoc)
"Guess a value for basic-offset."
(save-excursion
(dcl-beginning-of-command)
(let* ( (this-indent (save-excursion
(dcl-back-to-indentation)
(current-column)))
(prev-indent (save-excursion
(if (dcl-backward-command)
(progn
(dcl-back-to-indentation)
(current-column)))))
(next-indent (save-excursion
(dcl-end-of-command)
(if (dcl-forward-command)
(progn
(dcl-beginning-of-command)
(dcl-back-to-indentation)
(current-column)))))
(diff (if prev-indent
(abs (- this-indent prev-indent)))))
(cond
((and diff
(/= diff 0))
diff)
((and next-indent
(/= (- this-indent next-indent) 0))
(abs (- this-indent next-indent)))
(t
dcl-basic-offset)))))
(defun dcl-option-value-offset (option-assoc)
"Guess a value for an offset.
Find the column of the first non-blank character on the line.
Returns the column offset."
(save-excursion
(beginning-of-line)
(re-search-forward "^$[ \t]*" nil t)
(current-column)))
(defun dcl-option-value-margin-offset (option-assoc)
"Guess a value for margin offset.
Find the column of the first non-blank character on the line, not
counting labels.
Returns a number as a string."
(save-excursion
(beginning-of-line)
(dcl-back-to-indentation)
(current-column)))
(defun dcl-option-value-comment-line (option-assoc)
"Guess a value for `dcl-comment-line-regexp'.
Must return a string."
(format
"%S"
(save-excursion
(beginning-of-line)
(if (looking-at "^\\$[^!\n]*!")
(let ((regexp (buffer-substring (match-beginning 0) (match-end 0))))
(concat "^" (regexp-quote regexp)))
dcl-comment-line-regexp))))
(defun dcl-guess-option-value (option)
"Guess what value the user would like to give the symbol option."
(let* ((option-assoc (assoc option dcl-option-alist))
(option (car option-assoc))
(action (car (cdr option-assoc)))
(value (cond
((fboundp action)
(funcall action option-assoc))
((eq action 'toggle)
(not (eval option)))
((eq action 'curval)
(cond ((or (stringp (symbol-value option))
(numberp (symbol-value option)))
(format "%S" (symbol-value option)))
(t
(format "'%S" (symbol-value option))))))))
(if (stringp value)
value
(format "%S" value))))
(defun dcl-guess-option ()
"Guess what option the user wants to set by looking around in the code.
Returns the name of the option variable as a string."
(let ((case-fold-search t))
(cond
((eq (dcl-get-line-type) '-)
"dcl-calc-cont-indent-function")
((save-excursion
(beginning-of-line)
(looking-at "^\\$[ \t]*!"))
"dcl-comment-line-regexp")
((save-excursion
(beginning-of-line)
(or (looking-at (concat "^\\$[ \t]*" dcl-label-r dcl-ws-r
"subroutine"))
(save-excursion
(not (dcl-backward-command t)))))
"dcl-margin-offset")
((save-excursion
(beginning-of-line)
(and (eq (dcl-get-line-type) '$)
(dcl-backward-command)
(looking-at (concat "^\\$[ \t]*" dcl-label-r dcl-ws-r
"subroutine"))))
"dcl-margin-offset")
((save-excursion
(beginning-of-line)
(and (looking-at (concat "^\\$[ \t]*" dcl-label-r))
(not (and dcl-block-begin-regexp
(looking-at (concat "^\\$[ \t]*"
dcl-block-begin-regexp))))
(not (and dcl-block-end-regexp
(looking-at (concat "^\\$[ \t]*"
dcl-block-end-regexp))))))
"dcl-margin-label-offset")
((and (eq (dcl-get-line-type) '$) (save-excursion
(beginning-of-line)
(let* ((this-indent (save-excursion
(dcl-back-to-indentation)
(current-column)))
(prev-indent (save-excursion
(if (dcl-backward-command)
(progn
(dcl-back-to-indentation)
(current-column)))))
(next-indent (save-excursion
(dcl-end-of-command)
(if (dcl-forward-command)
(progn
(dcl-beginning-of-command)
(dcl-back-to-indentation)
(current-column))))))
(or (and prev-indent (/= (- this-indent prev-indent) 0))
(and next-indent
(/= (- this-indent next-indent) 0))))))
"dcl-basic-offset")
(t
""))))
(defun dcl-set-option (option-sym option-value)
"Set a value for one of the dcl customization variables.
The function tries to guess which variable should be set and to what value.
All variable names are available as completions and in the history list."
(interactive
(let* ((option-sym
(intern (completing-read
"Set DCL option: " (mapcar (function (lambda (option-assoc)
(cons (format "%s" (car option-assoc)) nil)))
dcl-option-alist)
nil t (dcl-guess-option) 'dcl-option-history))) (option-value
(eval-minibuffer
(format "Set DCL option %s to: " option-sym)
(dcl-guess-option-value option-sym))))
(list option-sym option-value)))
(set option-sym option-value))
(defun dcl-save-local-variable (var &optional def-prefix def-suffix)
"Save a variable in a `Local Variables' list.
Set or update the value of VAR in the current buffers
`Local Variables:' list."
(save-excursion
(goto-char (point-max))
(search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
(if (let ((case-fold-search t))
(search-forward "Local Variables:" nil t))
(let ((continue t)
prefix prefixlen suffix beg
prefix-string suffix-string)
(skip-chars-forward " \t")
(or (eolp)
(setq suffix-string (buffer-substring (point)
(progn (end-of-line) (point)))))
(goto-char (match-beginning 0))
(or (bolp)
(setq prefix-string
(buffer-substring (point)
(progn (beginning-of-line) (point)))))
(if prefix-string (setq prefixlen (length prefix-string)
prefix (regexp-quote prefix-string)))
(if suffix-string (setq suffix (concat (regexp-quote suffix-string)
"$")))
(while continue
(if selective-display (re-search-forward "[\n\C-m]")
(forward-line 1))
(if prefix
(if (looking-at prefix)
(forward-char prefixlen)
(error "Local variables entry is missing the prefix")))
(skip-chars-forward " \t")
(setq beg (point))
(skip-chars-forward "^:\n")
(if (eolp) (error "Missing colon in local variables entry"))
(skip-chars-backward " \t")
(let* ((str (buffer-substring beg (point)))
(found-var (read str))
val)
(if (string-equal (downcase str) "end")
(progn
(setq continue nil)
(beginning-of-line)
(insert (concat prefix-string (symbol-name var) ": "
(prin1-to-string (eval var)) " "
suffix-string "\n")))
(if (eq var found-var)
(progn
(setq continue nil)
(skip-chars-forward "^:")
(forward-char 1)
(delete-region (point) (progn (read (current-buffer))
(point)))
(insert " ")
(prin1 (eval var) (current-buffer))
(skip-chars-backward "\n")
(skip-chars-forward " \t")
(or (if suffix (looking-at suffix) (eolp))
(error
"Local variables entry is terminated incorrectly")))
(end-of-line))))))
(goto-char (point-max))
(if (not (bolp))
(insert "\n"))
(let ((def-prefix
(cond
(def-prefix
def-prefix)
(comment-start
(if (or (equal comment-start "")
(string-match "[ \t]$" comment-start))
comment-start
(concat comment-start " ")))))
(def-suffix
(cond
(def-suffix
def-suffix)
(comment-end
(if (or (equal comment-end "")
(string-match "^[ \t]" comment-end))
comment-end
(concat " " comment-end))))))
(insert (concat def-prefix "Local variables:" def-suffix "\n"))
(insert (concat def-prefix (symbol-name var) ": "
(prin1-to-string (eval var)) def-suffix "\n"))
(insert (concat def-prefix "end:" def-suffix)))
)))
(defun dcl-save-all-options ()
"Save all dcl-mode options for this buffer.
Saves or updates all dcl-mode related options in a `Local Variables:'
section at the end of the current buffer."
(interactive "*")
(mapcar (lambda (option-assoc)
(let* ((option (car option-assoc)))
(dcl-save-local-variable option "$! ")))
dcl-option-alist))
(defun dcl-save-nondefault-options ()
"Save changed DCL mode options for this buffer.
Saves or updates all DCL mode related options that don't have their
default values in a `Local Variables:' section at the end of the
current buffer.
No entries are removed from the `Local Variables:' section. This means
that if a variable is given a non-default value in the section and
later is manually reset to its default value, the variable's entry will
still be present in the `Local Variables:' section with its old value."
(interactive "*")
(mapcar (lambda (option-assoc)
(let* ((option (car option-assoc))
(option-name (symbol-name option)))
(if (and (string-equal "dcl-"
(substring option-name 0 4))
(not (equal (default-value option) (eval option))))
(dcl-save-local-variable option "$! "))))
dcl-option-alist))
(defun dcl-save-option (option)
"Save a DCL mode option for this buffer.
Saves or updates an option in a `Local Variables:'
section at the end of the current buffer."
(interactive
(let ((option (intern (completing-read "Option: " obarray))))
(list option)))
(dcl-save-local-variable option))
(defun dcl-save-mode ()
"Save the current mode for this buffer.
Save the current mode in a `Local Variables:'
section at the end of the current buffer."
(interactive)
(let ((mode (prin1-to-string major-mode)))
(if (string-match "-mode$" mode)
(let ((mode (intern (substring mode 0 (match-beginning 0)))))
(dcl-save-option 'mode))
(message "Strange mode: %s" mode))))
(defvar dcl-tempo-tags nil
"Tempo tags for DCL mode.")
(tempo-define-template "dcl-f$context"
'("f$context" dcl-tempo-left-paren
(p "context-type: ") dcl-tempo-comma
(p "context-symbol: ") dcl-tempo-comma
(p "selection-item: ") dcl-tempo-comma
(p "selection-value: ") dcl-tempo-comma
(p "value-qualifier: ") dcl-tempo-right-paren)
"f$context" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$csid"
'("f$csid" dcl-tempo-left-paren
(p "context-symbol: ") dcl-tempo-right-paren)
"f$csid" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$cvsi"
'("f$cvsi" dcl-tempo-left-paren
(p "start-bit: ") dcl-tempo-comma
(p "number-of-bits: ") dcl-tempo-comma
(p "string: ") dcl-tempo-right-paren)
"f$cvsi" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$cvtime"
'("f$cvtime" dcl-tempo-left-paren
(p "[input_time]: ") dcl-tempo-comma
(p "[output_time_format]: ") dcl-tempo-comma
(p "[output_field]: ") dcl-tempo-right-paren)
"f$cvtime" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$cvui"
'("f$cvui" dcl-tempo-left-paren
(p "start-bit: ") dcl-tempo-comma
(p "number-of-bits: ") dcl-tempo-comma
(p "string") dcl-tempo-right-paren)
"f$cvui" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$device"
'("f$device" dcl-tempo-left-paren
(p "[search_devnam]: ") dcl-tempo-comma
(p "[devclass]: ") dcl-tempo-comma
(p "[devtype]: ") dcl-tempo-comma
(p "[stream-id]: ") dcl-tempo-right-paren)
"f$device" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$directory"
'("f$directory" dcl-tempo-left-paren
dcl-tempo-right-paren)
"f$directory" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$edit"
'("f$edit" dcl-tempo-left-paren
(p "string: ") dcl-tempo-comma
(p "edit-list: ") dcl-tempo-right-paren)
"f$edit" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$element"
'("f$element" dcl-tempo-left-paren
(p "element-number: ") dcl-tempo-comma
(p "delimiter: ") dcl-tempo-comma
(p "string: ") dcl-tempo-right-paren)
"f$element" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$environment"
'("f$environment" dcl-tempo-left-paren
(p "item: ") dcl-tempo-right-paren)
"f$environment" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$extract"
'("f$extract" dcl-tempo-left-paren
(p "start: ") dcl-tempo-comma
(p "length: ") dcl-tempo-comma
(p "string: ") dcl-tempo-right-paren)
"f$extract" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$fao"
'("f$fao" dcl-tempo-left-paren
(p "control-string: ") dcl-tempo-comma
("argument[,...]: ") dcl-tempo-right-paren)
"f$fao" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$file_attributes"
'("f$file_attributes" dcl-tempo-left-paren
(p "filespec: ") dcl-tempo-comma
(p "item: ") dcl-tempo-right-paren)
"f$file_attributes" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$getdvi"
'("f$getdvi" dcl-tempo-left-paren
(p "device-name: ") dcl-tempo-comma
(p "item: ") dcl-tempo-right-paren)
"f$getdvi" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$getjpi"
'("f$getjpi" dcl-tempo-left-paren
(p "pid: ") dcl-tempo-comma
(p "item: ") dcl-tempo-right-paren )
"f$getjpi" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$getqui"
'("f$getqui" dcl-tempo-left-paren
(p "function: ") dcl-tempo-comma
(p "[item]: ") dcl-tempo-comma
(p "[object-id]: ") dcl-tempo-comma
(p "[flags]: ") dcl-tempo-right-paren)
"f$getqui" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$getsyi"
'("f$getsyi" dcl-tempo-left-paren
(p "item: ") dcl-tempo-comma
(p "[node-name]: ") dcl-tempo-comma
(p "[cluster-id]: ") dcl-tempo-right-paren)
"f$getsyi" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$identifier"
'("f$identifier" dcl-tempo-left-paren
(p "identifier: ") dcl-tempo-comma
(p "conversion-type: ") dcl-tempo-right-paren)
"f$identifier" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$integer"
'("f$integer" dcl-tempo-left-paren
(p "expression: ") dcl-tempo-right-paren)
"f$integer" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$length"
'("f$length" dcl-tempo-left-paren
(p "string: ") dcl-tempo-right-paren )
"f$length" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$locate"
'("f$locate" dcl-tempo-left-paren
(p "substring: ") dcl-tempo-comma
(p "string: ") dcl-tempo-right-paren)
"f$locate" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$message"
'("f$message" dcl-tempo-left-paren
(p "status-code: ") dcl-tempo-right-paren )
"f$message" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$mode"
'("f$mode" dcl-tempo-left-paren dcl-tempo-right-paren)
"f$mode" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$parse"
'("f$parse" dcl-tempo-left-paren
(p "filespec: ") dcl-tempo-comma
(p "[default-spec]: ") dcl-tempo-comma
(p "[related-spec]: ") dcl-tempo-comma
(p "[field]: ") dcl-tempo-comma
(p "[parse-type]: ") dcl-tempo-right-paren)
"f$parse" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$pid"
'("f$pid" dcl-tempo-left-paren
(p "context-symbol: ") dcl-tempo-right-paren)
"f$pid" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$privilege"
'("f$privilege" dcl-tempo-left-paren
(p "priv-states: ") dcl-tempo-right-paren)
"f$privilege" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$process"
'("f$process()")
"f$process" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$search"
'("f$search" dcl-tempo-left-paren
(p "filespec: ") dcl-tempo-comma
(p "[stream-id]: ") dcl-tempo-right-paren)
"f$search" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$setprv"
'("f$setprv" dcl-tempo-left-paren
(p "priv-states: ") dcl-tempo-right-paren)
"f$setprv" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$string"
'("f$string" dcl-tempo-left-paren
(p "expression: ") dcl-tempo-right-paren)
"f$string" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$time"
'("f$time" dcl-tempo-left-paren dcl-tempo-right-paren)
"f$time" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$trnlnm"
'("f$trnlnm" dcl-tempo-left-paren
(p "logical-name: ") dcl-tempo-comma
(p "[table]: ") dcl-tempo-comma
(p "[index]: ") dcl-tempo-comma
(p "[mode]: ") dcl-tempo-comma
(p "[case]: ") dcl-tempo-comma
(p "[item]: ") dcl-tempo-right-paren)
"f$trnlnm" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$type"
'("f$type" dcl-tempo-left-paren
(p "symbol-name: ") dcl-tempo-right-paren)
"f$type" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$user"
'("f$user" dcl-tempo-left-paren dcl-tempo-right-paren)
"f$user" "" 'dcl-tempo-tags)
(tempo-define-template "dcl-f$verify"
'("f$verify" dcl-tempo-left-paren
(p "[procedure-value]: ") dcl-tempo-comma
(p "[image-value]: ") dcl-tempo-right-paren)
"f$verify" "" 'dcl-tempo-tags)
(defun dcl-beginning-of-command-p ()
"Return t if point is at the beginning of a command.
Otherwise return nil."
(and (bolp)
(eq (dcl-get-line-type) '$)))
(defun dcl-end-of-command-p ()
"Check if point is at the end of a command.
Return t if point is at the end of a command, either the end of an
only line or at the end of the last continuation line.
Otherwise return nil."
(let ((type (dcl-get-line-type)))
(if (and (eolp)
(or (eq type '$)
(eq type '-)))
(save-excursion
(forward-line)
(not (eq (dcl-get-line-type) '-))))))
(defun dcl-command-p ()
"Check if point is on a command line.
Return t if point is on a command line or a continuation line,
otherwise return nil."
(let ((type (dcl-get-line-type)))
(or (eq type '$)
(eq type '-))))
(defun dcl-was-looking-at (regexp)
(save-excursion
(let ((start (point))
(found (re-search-backward regexp 0 t)))
(if (not found)
()
(equal start (match-end 0))))))
(defun dcl-imenu-create-index-function ()
"Jacket routine to make imenu searches non case sensitive."
(let ((case-fold-search t))
(imenu-default-create-index-function)))
(provide 'dcl-mode)
(run-hooks 'dcl-mode-load-hook)