(scheme-mode-syntax-table): Mark ; as being also the
[bpt/emacs.git] / lisp / progmodes / dcl-mode.el
CommitLineData
43e34a41
RS
1;;; dcl-mode.el --- major mode for editing DCL command files
2
034babe1
NR
3;; Copyright (c) 1997, 2001, 2002, 2003, 2004, 2005
4;; Free Software Foundation, Inc.
d898671f 5
43e34a41
RS
6;; Author: Odd Gripenstam <gripenstamol@decus.se>
7;; Maintainer: Odd Gripenstam <gripenstamol@decus.se>
8;; Keywords: DCL editing major-mode languages
9
d898671f
RS
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56
LK
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
d898671f 26
43e34a41
RS
27;;; Commentary:
28
29;; DCL mode is a package for editing DCL command files. It helps you
30;; indent lines, add leading `$' and trailing `-', move around in the
31;; code and insert lexical functions.
32;;
33;; Type `C-h m' when you are editing a .COM file to get more
34;; information about this mode.
a1506d29 35;;
43e34a41
RS
36;; To use templates you will need a version of tempo.el that is at
37;; least later than the buggy 1.1.1, which was included with my versions of
a1506d29 38;; Emacs. I used version 1.2.4.
43e34a41
RS
39;; The latest tempo.el distribution can be fetched from
40;; ftp.lysator.liu.se in the directory /pub/emacs.
41;; I recommend setting (setq tempo-interactive t). This will make
42;; tempo prompt you for values to put in the blank spots in the templates.
43;;
44;; There is limited support for imenu. The limitation is that you need
45;; a version of imenu.el that uses imenu-generic-expression. I found
46;; the version I use in Emacs 19.30. (It was *so* much easier to hook
47;; into that version than the one in 19.27...)
48;;
49;; Any feedback will be welcomed. If you write functions for
50;; dcl-calc-command-indent-function or dcl-calc-cont-indent-function,
a1506d29
JB
51;; please send them to the maintainer.
52;;
43e34a41
RS
53;;
54;; Ideas for improvement:
334f206c 55;; * Better font-lock support.
43e34a41
RS
56;; * Change meaning of `left margin' when dcl-tab-always-indent is nil.
57;; Consider the following line (`_' is the cursor):
58;; $ label: _ command
59;; Pressing tab with the cursor at the underline now inserts a tab.
60;; This should be part of the left margin and pressing tab should indent
61;; the line.
62;; * Make M-LFD work properly with comments in all cases. Now it only
63;; works on comment-only lines. But what is "properly"? New rules for
64;; indenting comments?
65;; * Even smarter indentation of continuation lines.
66;; * A delete-indentation function (M-^) that joins continued lines,
67;; including lines with end line comments?
68;; * Handle DECK/EOD.
69;; * `indent list' commands: C-M-q, C-u TAB. What is a list in DCL? One
70;; complete command line? A block? A subroutine?
71
72;;; Code:
73
74;;; *** Customization *****************************************************
75
334f206c
TTN
76
77;; First, font lock. This is a minimal approach, please improve!
78
79(defvar dcl-font-lock-keywords
80 '(("\\<\\(if\\|then\\|else\\|endif\\)\\>"
81 1 font-lock-keyword-face)
7651545c 82 ("\\<f[$][a-z_]+\\>"
334f206c
TTN
83 0 font-lock-builtin-face)
84 ("[.]\\(eq\\|not\\|or\\|and\\|lt\\|gt\\|le\\|ge\\|eqs\\|nes\\)[.]"
85 0 font-lock-builtin-face))
86 "Font lock keyword specification for DCL mode.
87Presently this includes some syntax, .OP.erators, and \"f$\" lexicals.")
88
89(defvar dcl-font-lock-defaults
90 '(dcl-font-lock-keywords nil)
91 "Font lock specification for DCL mode.")
92
93
94;; Now the rest.
95
174c05ac 96(defgroup dcl nil
28d16ed3
AS
97 "Major mode for editing DCL command files."
98 :group 'languages)
43e34a41 99
28d16ed3 100(defcustom dcl-basic-offset 4
43e34a41
RS
101 "*Number of columns to indent a block in DCL.
102A block is the commands between THEN-ELSE-ENDIF and between the commands
103dcl-block-begin-regexp and dcl-block-end-regexp.
104
105The meaning of this variable may be changed if
28d16ed3
AS
106dcl-calc-command-indent-function is set to a function."
107 :type 'integer
108 :group 'dcl)
43e34a41
RS
109
110
28d16ed3 111(defcustom dcl-continuation-offset 6
43e34a41
RS
112 "*Number of columns to indent a continuation line in DCL.
113A continuation line is a line that follows a line ending with `-'.
114
115The meaning of this variable may be changed if
28d16ed3
AS
116dcl-calc-cont-indent-function is set to a function."
117 :type 'integer
118 :group 'dcl)
43e34a41
RS
119
120
28d16ed3 121(defcustom dcl-margin-offset 8
43e34a41 122 "*Indentation for the first command line in DCL.
a1506d29 123The first command line in a file or after a SUBROUTINE statement is indented
43e34a41
RS
124this much. Other command lines are indented the same number of columns as
125the preceding command line.
28d16ed3
AS
126A command line is a line that starts with `$'."
127 :type 'integer
128 :group 'dcl)
43e34a41
RS
129
130
28d16ed3 131(defcustom dcl-margin-label-offset 2
43e34a41
RS
132 "*Number of columns to indent a margin label in DCL.
133A margin label is a label that doesn't begin or end a block, i.e. it
28d16ed3
AS
134doesn't match dcl-block-begin-regexp or dcl-block-end-regexp."
135 :type 'integer
136 :group 'dcl)
43e34a41
RS
137
138
28d16ed3 139(defcustom dcl-comment-line-regexp "^\\$!"
43e34a41 140 "*Regexp describing the start of a comment line in DCL.
28d16ed3
AS
141Comment lines are not indented."
142 :type 'regexp
143 :group 'dcl)
43e34a41
RS
144
145
28d16ed3 146(defcustom dcl-block-begin-regexp "loop[0-9]*:"
43e34a41 147 "*Regexp describing a command that begins an indented block in DCL.
28d16ed3
AS
148Set to nil to only indent at THEN-ELSE-ENDIF."
149 :type 'regexp
150 :group 'dcl)
43e34a41
RS
151
152
28d16ed3 153(defcustom dcl-block-end-regexp "endloop[0-9]*:"
43e34a41 154 "*Regexp describing a command that ends an indented block in DCL.
28d16ed3
AS
155Set to nil to only indent at THEN-ELSE-ENDIF."
156 :type 'regexp
157 :group 'dcl)
43e34a41
RS
158
159
28d16ed3 160(defcustom dcl-calc-command-indent-function nil
43e34a41 161 "*Function to calculate indentation for a command line in DCL.
a1506d29 162If this variable is non-nil it is called as a function:
43e34a41
RS
163
164\(func INDENT-TYPE CUR-INDENT EXTRA-INDENT LAST-POINT THIS-POINT)
165
a1506d29 166The function must return the number of columns to indent the current line or
43e34a41
RS
167nil to get the default indentation.
168
169INDENT-TYPE is a symbol indicating what kind of indentation should be done.
170It can have the following values:
171 indent the lines indentation should be increased, e.g. after THEN.
172 outdent the lines indentation should be decreased, e.g a line with ENDIF.
173 first-line indentation for the first line in a buffer or SUBROUTINE.
174CUR-INDENT is the indentation of the preceding command line.
a1506d29 175EXTRA-INDENT is the default change in indentation for this line
43e34a41
RS
176\(a negative number for 'outdent).
177LAST-POINT is the buffer position of the first significant word on the
178previous line or nil if the current line is the first line.
179THIS-POINT is the buffer position of the first significant word on the
180current line.
181
a1506d29 182If this variable is nil, the indentation is calculated as
43e34a41
RS
183CUR-INDENT + EXTRA-INDENT.
184
185This package includes two functions suitable for this:
186 dcl-calc-command-indent-multiple
28d16ed3 187 dcl-calc-command-indent-hang"
48c9c439 188 :type '(choice (const nil) function)
28d16ed3 189 :group 'dcl)
43e34a41
RS
190
191
28d16ed3 192(defcustom dcl-calc-cont-indent-function 'dcl-calc-cont-indent-relative
43e34a41 193 "*Function to calculate indentation for a continuation line.
a1506d29 194If this variable is non-nil it is called as a function:
43e34a41
RS
195
196\(func CUR-INDENT EXTRA-INDENT)
197
a1506d29 198The function must return the number of columns to indent the current line or
43e34a41
RS
199nil to get the default indentation.
200
a1506d29 201If this variable is nil, the indentation is calculated as
43e34a41
RS
202CUR-INDENT + EXTRA-INDENT.
203
204This package includes one function suitable for this:
28d16ed3
AS
205 dcl-calc-cont-indent-relative"
206 :type 'function
207 :group 'dcl)
43e34a41
RS
208
209
28d16ed3 210(defcustom dcl-tab-always-indent t
43e34a41
RS
211 "*Controls the operation of the TAB key in DCL mode.
212If t, pressing TAB always indents the current line.
213If nil, pressing TAB indents the current line if point is at the left margin.
a1506d29 214Data lines (i.e. lines not part of a command line or continuation line) are
28d16ed3
AS
215never indented."
216 :type 'boolean
217 :group 'dcl)
43e34a41
RS
218
219
28d16ed3
AS
220(defcustom dcl-electric-characters t
221 "*Non-nil means reindent immediately when a label, ELSE or ENDIF is inserted."
222 :type 'boolean
223 :group 'dcl)
43e34a41
RS
224
225
28d16ed3
AS
226(defcustom dcl-tempo-comma ", "
227 "*Text to insert when a comma is needed in a template, in DCL mode."
228 :type 'string
229 :group 'dcl)
43e34a41 230
28d16ed3
AS
231(defcustom dcl-tempo-left-paren "("
232 "*Text to insert when a left parenthesis is needed in a template in DCL."
233 :type 'string
234 :group 'dcl)
43e34a41
RS
235
236
28d16ed3
AS
237(defcustom dcl-tempo-right-paren ")"
238 "*Text to insert when a right parenthesis is needed in a template in DCL."
239 :type 'string
240 :group 'dcl)
43e34a41
RS
241
242; I couldn't decide what looked best, so I'll let you decide...
243; Remember, you can also customize this with imenu-submenu-name-format.
28d16ed3
AS
244(defcustom dcl-imenu-label-labels "Labels"
245 "*Imenu menu title for sub-listing with label names."
246 :type 'string
247 :group 'dcl)
248(defcustom dcl-imenu-label-goto "GOTO"
249 "*Imenu menu title for sub-listing with GOTO statements."
250 :type 'string
251 :group 'dcl)
252(defcustom dcl-imenu-label-gosub "GOSUB"
253 "*Imenu menu title for sub-listing with GOSUB statements."
254 :type 'string
255 :group 'dcl)
256(defcustom dcl-imenu-label-call "CALL"
257 "*Imenu menu title for sub-listing with CALL statements."
258 :type 'string
259 :group 'dcl)
260
261(defcustom dcl-imenu-generic-expression
8a946354
SS
262 `((nil "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):[ \t]+SUBROUTINE\\b" 1)
263 (,dcl-imenu-label-labels
43e34a41 264 "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):\\([ \t]\\|$\\)" 1)
8a946354
SS
265 (,dcl-imenu-label-goto "\\s-GOTO[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)
266 (,dcl-imenu-label-gosub "\\s-GOSUB[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)
267 (,dcl-imenu-label-call "\\s-CALL[ \t]+\\([A-Za-z0-9_\$]+\\)" 1))
28d16ed3 268 "*Default imenu generic expression for DCL.
43e34a41
RS
269
270The default includes SUBROUTINE labels in the main listing and
a1506d29 271sub-listings for other labels, CALL, GOTO and GOSUB statements.
28d16ed3
AS
272See `imenu-generic-expression' for details."
273 :type '(repeat (sexp :tag "Imenu Expression"))
274 :group 'dcl)
43e34a41
RS
275
276
28d16ed3
AS
277(defcustom dcl-mode-hook nil
278 "*Hook called by `dcl-mode'."
279 :type 'hook
280 :group 'dcl)
43e34a41
RS
281
282
283;;; *** Global variables ****************************************************
284
285
286(defvar dcl-mode-syntax-table nil
287 "Syntax table used in DCL-buffers.")
09d252f2 288(unless dcl-mode-syntax-table
43e34a41
RS
289 (setq dcl-mode-syntax-table (make-syntax-table))
290 (modify-syntax-entry ?! "<" dcl-mode-syntax-table) ; comment start
291 (modify-syntax-entry ?\n ">" dcl-mode-syntax-table) ; comment end
292 (modify-syntax-entry ?< "(>" dcl-mode-syntax-table) ; < and ...
293 (modify-syntax-entry ?> ")<" dcl-mode-syntax-table) ; > is a matching pair
09d252f2 294 (modify-syntax-entry ?\\ "_" dcl-mode-syntax-table) ; not an escape
a1506d29 295)
43e34a41
RS
296
297
298(defvar dcl-mode-map ()
299 "Keymap used in DCL-mode buffers.")
300(if dcl-mode-map
301 ()
302 (setq dcl-mode-map (make-sparse-keymap))
303 (define-key dcl-mode-map "\e\n" 'dcl-split-line)
304 (define-key dcl-mode-map "\e\t" 'tempo-complete-tag)
305 (define-key dcl-mode-map "\e^" 'dcl-delete-indentation)
306 (define-key dcl-mode-map "\em" 'dcl-back-to-indentation)
307 (define-key dcl-mode-map "\ee" 'dcl-forward-command)
308 (define-key dcl-mode-map "\ea" 'dcl-backward-command)
309 (define-key dcl-mode-map "\e\C-q" 'dcl-indent-command)
310 (define-key dcl-mode-map "\t" 'dcl-tab)
311 (define-key dcl-mode-map ":" 'dcl-electric-character)
312 (define-key dcl-mode-map "F" 'dcl-electric-character)
313 (define-key dcl-mode-map "f" 'dcl-electric-character)
314 (define-key dcl-mode-map "E" 'dcl-electric-character)
315 (define-key dcl-mode-map "e" 'dcl-electric-character)
316 (define-key dcl-mode-map "\C-c\C-o" 'dcl-set-option)
317 (define-key dcl-mode-map "\C-c\C-f" 'tempo-forward-mark)
318 (define-key dcl-mode-map "\C-c\C-b" 'tempo-backward-mark)
319
320 (define-key dcl-mode-map [menu-bar] (make-sparse-keymap))
321 (define-key dcl-mode-map [menu-bar dcl]
322 (cons "DCL" (make-sparse-keymap "DCL")))
323
324 ;; Define these in bottom-up order
325 (define-key dcl-mode-map [menu-bar dcl tempo-backward-mark]
326 '("Previous template mark" . tempo-backward-mark))
327 (define-key dcl-mode-map [menu-bar dcl tempo-forward-mark]
328 '("Next template mark" . tempo-forward-mark))
329 (define-key dcl-mode-map [menu-bar dcl tempo-complete-tag]
330 '("Complete template tag" . tempo-complete-tag))
331 (define-key dcl-mode-map [menu-bar dcl dcl-separator-tempo]
332 '("--"))
333 (define-key dcl-mode-map [menu-bar dcl dcl-save-all-options]
334 '("Save all options" . dcl-save-all-options))
335 (define-key dcl-mode-map [menu-bar dcl dcl-save-nondefault-options]
336 '("Save changed options" . dcl-save-nondefault-options))
337 (define-key dcl-mode-map [menu-bar dcl dcl-set-option]
338 '("Set option" . dcl-set-option))
339 (define-key dcl-mode-map [menu-bar dcl dcl-separator-option]
340 '("--"))
341 (define-key dcl-mode-map [menu-bar dcl dcl-delete-indentation]
342 '("Delete indentation" . dcl-delete-indentation))
343 (define-key dcl-mode-map [menu-bar dcl dcl-split-line]
344 '("Split line" . dcl-split-line))
345 (define-key dcl-mode-map [menu-bar dcl dcl-indent-command]
346 '("Indent command" . dcl-indent-command))
347 (define-key dcl-mode-map [menu-bar dcl dcl-tab]
348 '("Indent line/insert tab" . dcl-tab))
349 (define-key dcl-mode-map [menu-bar dcl dcl-back-to-indentation]
350 '("Back to indentation" . dcl-back-to-indentation))
351 (define-key dcl-mode-map [menu-bar dcl dcl-forward-command]
352 '("End of statement" . dcl-forward-command))
353 (define-key dcl-mode-map [menu-bar dcl dcl-backward-command]
354 '("Beginning of statement" . dcl-backward-command))
355 ;; imenu is only supported for versions with imenu-generic-expression
356 (if (boundp 'imenu-generic-expression)
357 (progn
358 (define-key dcl-mode-map [menu-bar dcl dcl-separator-movement]
359 '("--"))
360 (define-key dcl-mode-map [menu-bar dcl imenu]
361 '("Buffer index menu" . imenu))))
362 )
363
364
28d16ed3 365(defcustom dcl-ws-r
43e34a41
RS
366 "\\([ \t]*-[ \t]*\\(!.*\\)*\n\\)*[ \t]*"
367 "Regular expression describing white space in a DCL command line.
368White space is any number of continued lines with only space,tab,endcomment
28d16ed3
AS
369followed by space or tab."
370 :type 'regexp
371 :group 'dcl)
43e34a41
RS
372
373
28d16ed3 374(defcustom dcl-label-r
43e34a41
RS
375 "[a-zA-Z0-9_\$]*:\\([ \t!]\\|$\\)"
376 "Regular expression describing a label.
28d16ed3
AS
377A label is a name followed by a colon followed by white-space or end-of-line."
378 :type 'regexp
379 :group 'dcl)
43e34a41
RS
380
381
a1506d29 382(defcustom dcl-cmd-r
43e34a41
RS
383 "^\\$\\(.*-[ \t]*\\(!.*\\)*\n\\)*[^!\"\n]*\\(\".*\\(\"\".*\\)*\"\\)*[^!\"\n]*"
384 "Regular expression describing a DCL command line up to a trailing comment.
385A line starting with $, optionally followed by continuation lines,
386followed by the end of the command line.
387A continuation line is any characters followed by `-',
28d16ed3
AS
388optionally followed by a comment, followed by a newline."
389 :type 'regexp
390 :group 'dcl)
43e34a41
RS
391
392
a1506d29 393(defcustom dcl-command-regexp
43e34a41
RS
394 "^\\$\\(.*-[ \t]*\\(!.*\\)*\n\\)*.*\\(\".*\\(\"\".*\\)*\"\\)*"
395 "Regular expression describing a DCL command line.
396A line starting with $, optionally followed by continuation lines,
397followed by the end of the command line.
398A continuation line is any characters followed by `-',
28d16ed3
AS
399optionally followed by a comment, followed by a newline."
400 :type 'regexp
401 :group 'dcl)
43e34a41
RS
402
403
28d16ed3 404(defcustom dcl-electric-reindent-regexps
43e34a41
RS
405 (list "endif" "else" dcl-label-r)
406 "*Regexps that can trigger an electric reindent.
407A list of regexps that will trigger a reindent if the last letter
408is defined as dcl-electric-character.
409
410E.g.: if this list contains `endif', the key `f' is defined as
411dcl-electric-character and the you have just typed the `f' in
28d16ed3
AS
412`endif', the line will be reindented."
413 :type '(repeat regexp)
414 :group 'dcl)
43e34a41
RS
415
416
a1506d29 417(defvar dcl-option-alist
43e34a41
RS
418 '((dcl-basic-offset dcl-option-value-basic)
419 (dcl-continuation-offset curval)
420 (dcl-margin-offset dcl-option-value-margin-offset)
421 (dcl-margin-label-offset dcl-option-value-offset)
422 (dcl-comment-line-regexp dcl-option-value-comment-line)
423 (dcl-block-begin-regexp curval)
424 (dcl-block-end-regexp curval)
a1506d29
JB
425 (dcl-tab-always-indent toggle)
426 (dcl-electric-characters toggle)
43e34a41 427 (dcl-electric-reindent-regexps curval)
a1506d29
JB
428 (dcl-tempo-comma curval)
429 (dcl-tempo-left-paren curval)
430 (dcl-tempo-right-paren curval)
43e34a41
RS
431 (dcl-calc-command-indent-function curval)
432 (dcl-calc-cont-indent-function curval)
433 (comment-start curval)
434 (comment-start-skip curval)
435 )
436 "Options and default values for dcl-set-option.
437
438An alist with option variables and functions or keywords to get a
439default value for the option.
440
441The keywords are:
442curval the current value
443toggle the opposite of the current value (for t/nil)")
444
445
a1506d29 446(defvar dcl-option-history
43e34a41
RS
447 (mapcar (lambda (option-assoc)
448 (format "%s" (car option-assoc)))
449 dcl-option-alist)
450 "The history list for dcl-set-option.
451Preloaded with all known option names from dcl-option-alist")
452
453
454;; Must be defined after dcl-cmd-r
455;; This version is more correct but much slower than the one
456;; above. This version won't find GOTOs in comments or text strings.
457;(defvar dcl-imenu-generic-expression
458; (`
459; ((nil "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):[ \t]+SUBROUTINE\\b" 1)
460; ("Labels" "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):\\([ \t]\\|$\\)" 1)
461; ("GOTO" (, (concat dcl-cmd-r "GOTO[ \t]+\\([A-Za-z0-9_\$]+\\)")) 5)
462; ("GOSUB" (, (concat dcl-cmd-r
463; "GOSUB[ \t]+\\([A-Za-z0-9_\$]+\\)")) 5)
464; ("CALL" (, (concat dcl-cmd-r "CALL[ \t]+\\([A-Za-z0-9_\$]+\\)")) 5)))
465; "*Default imenu generic expression for DCL.
466
467;The default includes SUBROUTINE labels in the main listing and
a1506d29 468;sub-listings for other labels, CALL, GOTO and GOSUB statements.
43e34a41
RS
469;See `imenu-generic-expression' in a recent (e.g. Emacs 19.30) imenu.el
470;for details.")
471
472
473;;; *** Mode initialization *************************************************
474
475
476;;;###autoload
477(defun dcl-mode ()
478 "Major mode for editing DCL-files.
479
480This mode indents command lines in blocks. (A block is commands between
481THEN-ELSE-ENDIF and between lines matching dcl-block-begin-regexp and
482dcl-block-end-regexp.)
483
484Labels are indented to a fixed position unless they begin or end a block.
a1506d29 485Whole-line comments (matching dcl-comment-line-regexp) are not indented.
43e34a41
RS
486Data lines are not indented.
487
488Key bindings:
489
490\\{dcl-mode-map}
491Commands not usually bound to keys:
492
493\\[dcl-save-nondefault-options]\t\tSave changed options
494\\[dcl-save-all-options]\t\tSave all options
495\\[dcl-save-option]\t\t\tSave any option
496\\[dcl-save-mode]\t\t\tSave buffer mode
497
498Variables controlling indentation style and extra features:
499
500 dcl-basic-offset
501 Extra indentation within blocks.
502
503 dcl-continuation-offset
504 Extra indentation for continued lines.
505
506 dcl-margin-offset
507 Indentation for the first command line in a file or SUBROUTINE.
508
509 dcl-margin-label-offset
510 Indentation for a label.
511
512 dcl-comment-line-regexp
a1506d29 513 Lines matching this regexp will not be indented.
43e34a41
RS
514
515 dcl-block-begin-regexp
516 dcl-block-end-regexp
517 Regexps that match command lines that begin and end, respectively,
518 a block of commmand lines that will be given extra indentation.
519 Command lines between THEN-ELSE-ENDIF are always indented; these variables
520 make it possible to define other places to indent.
521 Set to nil to disable this feature.
522
523 dcl-calc-command-indent-function
524 Can be set to a function that customizes indentation for command lines.
525 Two such functions are included in the package:
526 dcl-calc-command-indent-multiple
527 dcl-calc-command-indent-hang
528
529 dcl-calc-cont-indent-function
530 Can be set to a function that customizes indentation for continued lines.
531 One such function is included in the package:
532 dcl-calc-cont-indent-relative (set by default)
533
534 dcl-tab-always-indent
535 If t, pressing TAB always indents the current line.
a1506d29 536 If nil, pressing TAB indents the current line if point is at the left
43e34a41
RS
537 margin.
538
a1506d29 539 dcl-electric-characters
43e34a41
RS
540 Non-nil causes lines to be indented at once when a label, ELSE or ENDIF is
541 typed.
542
543 dcl-electric-reindent-regexps
544 Use this variable and function dcl-electric-character to customize
545 which words trigger electric indentation.
546
547 dcl-tempo-comma
548 dcl-tempo-left-paren
549 dcl-tempo-right-paren
550 These variables control the look of expanded templates.
551
552 dcl-imenu-generic-expression
553 Default value for imenu-generic-expression. The default includes
554 SUBROUTINE labels in the main listing and sub-listings for
a1506d29 555 other labels, CALL, GOTO and GOSUB statements.
43e34a41
RS
556
557 dcl-imenu-label-labels
558 dcl-imenu-label-goto
559 dcl-imenu-label-gosub
560 dcl-imenu-label-call
561 Change the text that is used as sub-listing labels in imenu.
562
563Loading this package calls the value of the variable
a1506d29
JB
564`dcl-mode-load-hook' with no args, if that value is non-nil.
565Turning on DCL mode calls the value of the variable `dcl-mode-hook'
43e34a41
RS
566with no args, if that value is non-nil.
567
568
569The following example uses the default values for all variables:
570
a1506d29 571$! This is a comment line that is not indented (it matches
43e34a41
RS
572$! dcl-comment-line-regexp)
573$! Next follows the first command line. It is indented dcl-margin-offset.
574$ i = 1
575$ ! Other comments are indented like command lines.
576$ ! A margin label indented dcl-margin-label-offset:
a1506d29 577$ label:
43e34a41
RS
578$ if i.eq.1
579$ then
a1506d29 580$ ! Lines between THEN-ELSE and ELSE-ENDIF are
43e34a41
RS
581$ ! indented dcl-basic-offset
582$ loop1: ! This matches dcl-block-begin-regexp...
583$ ! ...so this line is indented dcl-basic-offset
a1506d29 584$ text = \"This \" + - ! is a continued line
43e34a41
RS
585 \"lined up with the command line\"
586$ type sys$input
a1506d29 587Data lines are not indented at all.
43e34a41
RS
588$ endloop1: ! This matches dcl-block-end-regexp
589$ endif
590$
334f206c
TTN
591
592
593There is some minimal font-lock support (see vars
594`dcl-font-lock-defaults' and `dcl-font-lock-keywords')."
43e34a41
RS
595 (interactive)
596 (kill-all-local-variables)
597 (set-syntax-table dcl-mode-syntax-table)
598
599 (make-local-variable 'indent-line-function)
600 (setq indent-line-function 'dcl-indent-line)
601
602 (make-local-variable 'comment-start)
603 (setq comment-start "!")
604
605 (make-local-variable 'comment-end)
606 (setq comment-end "")
607
608 (make-local-variable 'comment-multi-line)
609 (setq comment-multi-line nil)
a1506d29 610
43e34a41
RS
611 ;; This used to be "^\\$[ \t]*![ \t]*" which looks more correct.
612 ;; The drawback was that you couldn't make empty comment lines by pressing
613 ;; C-M-j repeatedly - only the first line became a comment line.
614 ;; This version has the drawback that the "$" can be anywhere in the line,
615 ;; and something inappropriate might be interpreted as a comment.
616 (make-local-variable 'comment-start-skip)
617 (setq comment-start-skip "\\$[ \t]*![ \t]*")
618
619 (if (boundp 'imenu-generic-expression)
c0b08eb0
DL
620 (progn (setq imenu-generic-expression dcl-imenu-generic-expression)
621 (setq imenu-case-fold-search t)))
43e34a41
RS
622 (setq imenu-create-index-function 'dcl-imenu-create-index-function)
623
624 (make-local-variable 'dcl-comment-line-regexp)
625 (make-local-variable 'dcl-block-begin-regexp)
626 (make-local-variable 'dcl-block-end-regexp)
627 (make-local-variable 'dcl-basic-offset)
628 (make-local-variable 'dcl-continuation-offset)
629 (make-local-variable 'dcl-margin-label-offset)
630 (make-local-variable 'dcl-margin-offset)
631 (make-local-variable 'dcl-tab-always-indent)
632 (make-local-variable 'dcl-electric-characters)
633 (make-local-variable 'dcl-calc-command-indent-function)
634 (make-local-variable 'dcl-calc-cont-indent-function)
635 (make-local-variable 'dcl-electric-reindent-regexps)
a1506d29 636
334f206c
TTN
637 ;; font lock
638 (make-local-variable 'font-lock-defaults)
639 (setq font-lock-defaults dcl-font-lock-defaults)
640
43e34a41
RS
641 (setq major-mode 'dcl-mode)
642 (setq mode-name "DCL")
643 (use-local-map dcl-mode-map)
644 (tempo-use-tag-list 'dcl-tempo-tags)
9a969196 645 (run-mode-hooks 'dcl-mode-hook))
43e34a41
RS
646
647
648;;; *** Movement commands ***************************************************
649
650
651;;;-------------------------------------------------------------------------
652(defun dcl-beginning-of-statement ()
653 "Go to the beginning of the preceding or current command line."
654 (interactive)
655 (re-search-backward dcl-command-regexp nil t))
656
657
658;;;-------------------------------------------------------------------------
659(defun dcl-end-of-statement ()
660 "Go to the end of the next or current command line."
661 (interactive)
662 (if (or (dcl-end-of-command-p)
663 (dcl-beginning-of-command-p)
664 (not (dcl-command-p)))
665 ()
666 (dcl-beginning-of-statement))
667 (re-search-forward dcl-command-regexp nil t))
668
669
670;;;-------------------------------------------------------------------------
671(defun dcl-beginning-of-command ()
672 "Move point to beginning of current command."
673 (interactive)
674 (let ((type (dcl-get-line-type)))
675 (if (and (eq type '$)
676 (bolp))
677 () ; already in the correct position
678 (dcl-beginning-of-statement))))
679
680
681;;;-------------------------------------------------------------------------
682(defun dcl-end-of-command ()
683 "Move point to end of current command or next command if not on a command."
684 (interactive)
685 (let ((type (dcl-get-line-type))
686 (start (point)))
687 (if (or (eq type '$)
688 (eq type '-))
689 (progn
690 (dcl-beginning-of-command)
691 (dcl-end-of-statement))
692 (dcl-end-of-statement))))
693
694
695;;;-------------------------------------------------------------------------
696(defun dcl-backward-command (&optional incl-comment-commands)
697 "Move backward to a command.
698Move point to the preceding command line that is not a comment line,
699a command line with only a comment, only contains a `$' or only
a1506d29 700contains a label.
43e34a41
RS
701
702Returns point of the found command line or nil if not able to move."
703 (interactive)
704 (let ((start (point))
705 done
706 retval)
707 ;; Find first non-empty command line
708 (while (not done)
709 ;; back up one statement and look at the command
710 (if (dcl-beginning-of-statement)
711 (cond
712 ((and dcl-block-begin-regexp ; might be nil
713 (looking-at (concat "^\\$" dcl-ws-r
714 dcl-block-begin-regexp)))
715 (setq done t retval (point)))
716 ((and dcl-block-end-regexp ; might be nil
717 (looking-at (concat "^\\$" dcl-ws-r
718 dcl-block-end-regexp)))
719 (setq done t retval (point)))
720 ((looking-at dcl-comment-line-regexp)
721 t) ; comment line, one more loop
722 ((and (not incl-comment-commands)
723 (looking-at "\\$[ \t]*!"))
724 t) ; comment only command, loop...
725 ((looking-at "^\\$[ \t]*$")
726 t) ; empty line, one more loop
727 ((not (looking-at
728 (concat "^\\$" dcl-ws-r dcl-label-r dcl-ws-r "$")))
729 (setq done t) ; not a label-only line, exit the loop
730 (setq retval (point))))
731 ;; We couldn't go further back, and we haven't found a command yet.
732 ;; Return to the start positionn
733 (goto-char start)
734 (setq done t)
735 (setq retval nil)))
736 retval))
737
738
739;;;-------------------------------------------------------------------------
740(defun dcl-forward-command (&optional incl-comment-commands)
741 "Move forward to a command.
742Move point to the end of the next command line that is not a comment line,
743a command line with only a comment, only contains a `$' or only
a1506d29 744contains a label.
43e34a41
RS
745
746Returns point of the found command line or nil if not able to move."
747 (interactive)
748 (let ((start (point))
749 done
750 retval)
751 ;; Find first non-empty command line
752 (while (not done)
753 ;; go forward one statement and look at the command
754 (if (dcl-end-of-statement)
755 (save-excursion
756 (dcl-beginning-of-statement)
757 (cond
758 ((and dcl-block-begin-regexp ; might be nil
759 (looking-at (concat "^\\$" dcl-ws-r
760 dcl-block-begin-regexp)))
761 (setq done t)
762 (setq retval (point)))
763 ((and dcl-block-end-regexp ; might be nil
764 (looking-at (concat "^\\$" dcl-ws-r
765 dcl-block-end-regexp)))
766 (setq done t)
767 (setq retval (point)))
768 ((looking-at dcl-comment-line-regexp)
769 t) ; comment line, one more loop
770 ((and (not incl-comment-commands)
771 (looking-at "\\$[ \t]*!"))
772 t) ; comment only command, loop...
773 ((looking-at "^\\$[ \t]*$")
774 t) ; empty line, one more loop
775 ((not (looking-at
776 (concat "^\\$" dcl-ws-r dcl-label-r dcl-ws-r "$")))
777 (setq done t) ; not a label-only line, exit the loop
778 (setq retval (point)))))
779 ;; We couldn't go further back, and we haven't found a command yet.
780 ;; Return to the start positionn
781 (goto-char start)
782 (setq done t)
783 (setq retval nil)))
784 retval))
785
786
787;;;-------------------------------------------------------------------------
788(defun dcl-back-to-indentation ()
789 "Move point to the first non-whitespace character on this line.
790Leading $ and labels counts as whitespace in this case.
791If this is a comment line then move to the first non-whitespace character
792in the comment.
793
a1506d29 794Typing \\[dcl-back-to-indentation] several times in a row will move point to other
43e34a41 795`interesting' points closer to the left margin, and then back to the
a1506d29 796rightmost point again.
43e34a41
RS
797
798E.g. on the following line, point would go to the positions indicated
799by the numbers in order 1-2-3-1-... :
800
801 $ label: command
802 3 2 1"
803 (interactive)
804 (if (eq last-command 'dcl-back-to-indentation)
805 (dcl-back-to-indentation-1 (point))
806 (dcl-back-to-indentation-1)))
807(defun dcl-back-to-indentation-1 (&optional limit)
808 "Helper function for dcl-back-to-indentation"
809
810 ;; "Indentation points" that we will travel to
811 ;; $ l: ! comment
812 ;; 4 3 2 1
813 ;;
814 ;; $ ! text
815 ;; 3 2 1
816 ;;
a1506d29 817 ;; $ l: command !
43e34a41
RS
818 ;; 3 2 1
819 ;;
820 ;; text
821 ;; 1
822
823 (let* ((default-limit (save-excursion (end-of-line) (1+ (point))))
824 (limit (or limit default-limit))
825 (last-good-point (point))
826 (opoint (point)))
827 ;; Move over blanks
828 (back-to-indentation)
829
830 ;; If we already were at the outermost indentation point then we
831 ;; start searching for the innermost point again.
832 (if (= (point) opoint)
833 (setq limit default-limit))
834
835 (if (< (point) limit)
836 (setq last-good-point (point)))
837
838 (cond
a1506d29 839 ;; Special treatment for comment lines. We are trying to allow
43e34a41
RS
840 ;; things like "$ !*" as comment lines.
841 ((looking-at dcl-comment-line-regexp)
842 (re-search-forward (concat dcl-comment-line-regexp "[ \t]*") limit t)
843 (if (< (point) limit)
844 (setq last-good-point (point))))
845
846 ;; Normal command line
847 ((looking-at "^\\$[ \t]*")
848 ;; Move over leading "$" and blanks
849 (re-search-forward "^\\$[ \t]*" limit t)
850 (if (< (point) limit)
851 (setq last-good-point (point)))
852
853 ;; Move over a label (if it isn't a block begin/end)
854 ;; We must treat block begin/end labels as commands because
855 ;; dcl-set-option relies on it.
856 (if (and (looking-at dcl-label-r)
857 (not (or (and dcl-block-begin-regexp
858 (looking-at dcl-block-begin-regexp))
859 (and dcl-block-end-regexp
860 (looking-at dcl-block-end-regexp)))))
861 (re-search-forward (concat dcl-label-r "[ \t]*") limit t))
862 (if (< (point) limit)
863 (setq last-good-point (point)))
864
865 ;; Move over the beginning of a comment
866 (if (looking-at "![ \t]*")
867 (re-search-forward "![ \t]*" limit t))
868 (if (< (point) limit)
869 (setq last-good-point (point)))))
870 (goto-char last-good-point)))
871
872
873;;; *** Support for indentation *********************************************
874
875
876(defun dcl-get-line-type ()
877 "Determine the type of the current line.
878Returns one of the following symbols:
879 $ for a complete command line or the beginning of a command line.
880 - for a continuation line
881 $! for a comment line
882 data for a data line
883 empty-data for an empty line following a data line
884 empty-$ for an empty line following a command line"
885 (or
886 ;; Check if it's a comment line.
887 ;; A comment line starts with $!
888 (save-excursion
889 (beginning-of-line)
890 (if (looking-at dcl-comment-line-regexp)
891 '$!))
892 ;; Check if it's a command line.
893 ;; A command line starts with $
894 (save-excursion
895 (beginning-of-line)
896 (if (looking-at "^\\$")
897 '$))
898 ;; Check if it's a continuation line
899 (save-excursion
900 (beginning-of-line)
901 ;; If we're at the beginning of the buffer it can't be a continuation
902 (if (bobp)
903 ()
904 (let ((opoint (point)))
905 (dcl-beginning-of-statement)
906 (re-search-forward dcl-command-regexp opoint t)
907 (if (>= (point) opoint)
908 '-))))
909 ;; Empty lines might be different things
910 (save-excursion
911 (if (and (bolp) (eolp))
912 (if (bobp)
913 'empty-$
914 (forward-line -1)
915 (let ((type (dcl-get-line-type)))
916 (cond
917 ((or (equal type '$) (equal type '$!) (equal type '-))
918 'empty-$)
919 ((equal type 'data)
920 'empty-data))))))
921 ;; Anything else must be a data line
922 (progn 'data)
923 ))
924
925
926;;;-------------------------------------------------------------------------
927(defun dcl-indentation-point ()
928 "Return point of first non-`whitespace' on this line."
929 (save-excursion
930 (dcl-back-to-indentation)
931 (point)))
932
a1506d29 933
43e34a41
RS
934;;;---------------------------------------------------------------------------
935(defun dcl-show-line-type ()
936 "Test dcl-get-line-type."
937 (interactive)
938 (let ((type (dcl-get-line-type)))
939 (cond
940 ((equal type '$)
941 (message "command line"))
942 ((equal type '\?)
943 (message "?"))
944 ((equal type '$!)
945 (message "comment line"))
946 ((equal type '-)
947 (message "continuation line"))
948 ((equal type 'data)
949 (message "data"))
950 ((equal type 'empty-data)
951 (message "empty-data"))
952 ((equal type 'empty-$)
953 (message "empty-$"))
954 (t
955 (message "hupp"))
956 )))
957
958
959;;; *** Perform indentation *************************************************
960
961
962;;;---------------------------------------------------------------------------
963(defun dcl-calc-command-indent-multiple
964 (indent-type cur-indent extra-indent last-point this-point)
965 "Indent lines to a multiple of dcl-basic-offset.
966
967Set dcl-calc-command-indent-function to this function to customize
968indentation of command lines.
969
970Command lines that need to be indented beyond the left margin are
971always indented to a column that is a multiple of dcl-basic-offset, as
972if tab stops were set at 4, 8, 12, etc.
973
974This supports a formatting style like this (dcl-margin offset = 2,
975dcl-basic-offset = 4):
976
977$ if cond
978$ then
979$ if cond
980$ then
981$ ! etc
982"
983 ;; calculate indentation if it's an interesting indent-type,
984 ;; otherwise return nil to get the default indentation
985 (let ((indent))
986 (cond
987 ((equal indent-type 'indent)
988 (setq indent (- cur-indent (% cur-indent dcl-basic-offset)))
989 (setq indent (+ indent extra-indent))))))
990
991
992;;;---------------------------------------------------------------------------
993;; Some people actually writes likes this. To each his own...
994(defun dcl-calc-command-indent-hang
995 (indent-type cur-indent extra-indent last-point this-point)
996 "Indent lines as default, but indent THEN, ELSE and ENDIF extra.
997
998Set dcl-calc-command-indent-function to this function to customize
999indentation of command lines.
1000
1001This function supports a formatting style like this:
1002
1003$ if cond
1004$ then
1005$ xxx
1006$ endif
1007$ xxx
1008
1009If you use this function you will probably want to add \"then\" to
1010dcl-electric-reindent-regexps and define the key \"n\" as
a1506d29 1011dcl-electric-character.
43e34a41
RS
1012"
1013 (let ((case-fold-search t))
1014 (save-excursion
1015 (cond
1016 ;; No indentation, this word is `then': +2
1017 ;; last word was endif: -2
1018 ((null indent-type)
1019 (or (progn
1020 (goto-char this-point)
1021 (if (looking-at "\\bthen\\b")
1022 (+ cur-indent extra-indent 2)))
1023 (progn
1024 (goto-char last-point)
1025 (if (looking-at "\\bendif\\b")
1026 (- (+ cur-indent extra-indent) 2)))))
1027 ;; Indentation, last word was `then' or `else': -2
1028 ((equal indent-type 'indent)
1029 (goto-char last-point)
1030 (cond
1031 ((looking-at "\\bthen\\b")
1032 (- (+ cur-indent extra-indent) 2))
1033 ((looking-at "\\belse\\b")
1034 (- (+ cur-indent extra-indent) 2))))
a1506d29 1035 ;; Outdent, this word is `endif' or `else': + 2
43e34a41
RS
1036 ((equal indent-type 'outdent)
1037 (goto-char this-point)
1038 (cond
1039 ((looking-at "\\bendif\\b")
1040 (+ cur-indent extra-indent 2))
1041 ((looking-at "\\belse\\b")
1042 (+ cur-indent extra-indent 2))))))))
1043
1044
1045;;;---------------------------------------------------------------------------
1046(defun dcl-calc-command-indent ()
1047 "Calculate how much the current line shall be indented.
1048The line is known to be a command line.
1049
1050Find the indentation of the preceding line and analyze its contents to
1051see if the current lines should be indented.
1052Analyze the current line to see if it should be `outdented'.
1053
1054Calculate the indentation of the current line, either with the default
1055method or by calling dcl-calc-command-indent-function if it is
1056non-nil.
1057
1058If the current line should be outdented, calculate its indentation,
1059either with the default method or by calling
a1506d29 1060dcl-calc-command-indent-function if it is non-nil.
43e34a41
RS
1061
1062
1063Rules for default indentation:
1064
1065If it is the first line in the buffer, indent dcl-margin-offset.
1066
a1506d29 1067Go to the previous command line with a command on it.
43e34a41
RS
1068Find out how much it is indented (cur-indent).
1069Look at the first word on the line to see if the indentation should be
1070adjusted. Skip margin-label, continuations and comments while looking for
1071the first word. Save this buffer position as `last-point'.
a1506d29 1072If the first word after a label is SUBROUTINE, set extra-indent to
43e34a41
RS
1073dcl-margin-offset.
1074
1075First word extra-indent
1076THEN +dcl-basic-offset
1077ELSE +dcl-basic-offset
1078block-begin +dcl-basic-offset
1079
1080Then return to the current line and look at the first word to see if the
1081indentation should be adjusted again. Save this buffer position as
a1506d29 1082`this-point'.
43e34a41
RS
1083
1084First word extra-indent
1085ELSE -dcl-basic-offset
1086ENDIF -dcl-basic-offset
1087block-end -dcl-basic-offset
1088
1089
1090If dcl-calc-command-indent-function is nil or returns nil set
1091cur-indent to cur-indent+extra-indent.
1092
1093If an extra adjustment is necessary and if
1094dcl-calc-command-indent-function is nil or returns nil set cur-indent
a1506d29 1095to cur-indent+extra-indent.
43e34a41
RS
1096
1097See also documentation for dcl-calc-command-indent-function.
1098The indent-type classification could probably be expanded upon.
1099"
1100 ()
1101 (save-excursion
1102 (beginning-of-line)
1103 (let ((is-block nil)
1104 (case-fold-search t)
1105 cur-indent
1106 (extra-indent 0)
1107 indent-type last-point this-point extra-indent2 cur-indent2
1108 indent-type2)
1109 (if (bobp) ; first line in buffer
1110 (setq cur-indent 0 extra-indent dcl-margin-offset
1111 indent-type 'first-line
1112 this-point (dcl-indentation-point))
1113 (save-excursion
1114 (let (done)
1115 ;; Find first non-empty command line
1116 (while (not done)
1117 ;; back up one statement and look at the command
1118 (if (dcl-beginning-of-statement)
1119 (cond
1120 ((and dcl-block-begin-regexp ; might be nil
1121 (looking-at (concat "^\\$" dcl-ws-r
1122 dcl-block-begin-regexp)))
1123 (setq done t) (setq is-block t))
1124 ((and dcl-block-end-regexp ; might be nil
1125 (looking-at (concat "^\\$" dcl-ws-r
1126 dcl-block-end-regexp)))
1127 (setq done t) (setq is-block t))
1128 ((looking-at dcl-comment-line-regexp)
1129 t) ; comment line, one more loop
1130 ((looking-at "^\\$[ \t]*$")
1131 t) ; empty line, one more loop
1132 ((not (looking-at
1133 (concat "^\\$" dcl-ws-r dcl-label-r dcl-ws-r "$")))
1134 (setq done t))) ; not a label-only line, exit the loop
1135 ;; We couldn't go further back, so this must have been the
1136 ;; first line.
1137 (setq cur-indent dcl-margin-offset
a1506d29 1138 last-point (dcl-indentation-point))
43e34a41
RS
1139 (setq done t)))
1140 ;; Examine the line to get current indentation and possibly a
1141 ;; reason to indent.
1142 (cond
1143 (cur-indent)
1144 ((looking-at (concat "^\\$[ \t]*" dcl-label-r dcl-ws-r
1145 "\\(subroutine\\b\\)"))
1146 (setq cur-indent dcl-margin-offset
1147 last-point (1+ (match-beginning 1))))
1148 (t
1149 ;; Find out how much this line is indented.
1150 ;; Look at comment, continuation character, command but not label
1151 ;; unless it's a block.
1152 (if is-block
1153 (re-search-forward "^\\$[ \t]*")
1154 (re-search-forward (concat "^\\$[ \t]*\\(" dcl-label-r
1155 "\\)*[ \t]*")))
1156 (setq cur-indent (current-column))
1157 ;; Look for a reason to indent: Find first word on this line
1158 (re-search-forward dcl-ws-r)
1159 (setq last-point (point))
1160 (cond
1161 ((looking-at "\\bthen\\b")
1162 (setq extra-indent dcl-basic-offset indent-type 'indent))
1163 ((looking-at "\\belse\\b")
1164 (setq extra-indent dcl-basic-offset indent-type 'indent))
1165 ((and dcl-block-begin-regexp ; might be nil
1166 (looking-at dcl-block-begin-regexp))
1167 (setq extra-indent dcl-basic-offset indent-type 'indent))
1168 ))))))
1169 (setq extra-indent2 0)
1170 ;; We're back at the beginning of the original line.
1171 ;; Look for a reason to outdent: Find first word on this line
1172 (re-search-forward (concat "^\\$" dcl-ws-r))
1173 (setq this-point (dcl-indentation-point))
1174 (cond
1175 ((looking-at "\\belse\\b")
1176 (setq extra-indent2 (- dcl-basic-offset) indent-type2 'outdent))
1177 ((looking-at "\\bendif\\b")
1178 (setq extra-indent2 (- dcl-basic-offset) indent-type2 'outdent))
1179 ((and dcl-block-end-regexp ; might be nil
1180 (looking-at dcl-block-end-regexp))
1181 (setq extra-indent2 (- dcl-basic-offset) indent-type2 'outdent))
1182 ((looking-at (concat dcl-label-r dcl-ws-r "\\(subroutine\\b\\)"))
1183 (setq cur-indent2 0 extra-indent2 dcl-margin-offset
1184 indent-type2 'first-line
1185 this-point (1+ (match-beginning 1)))))
1186 ;; Calculate indent
1187 (setq cur-indent
1188 (or (and dcl-calc-command-indent-function
1189 (funcall dcl-calc-command-indent-function
1190 indent-type cur-indent extra-indent
1191 last-point this-point))
1192 (+ cur-indent extra-indent)))
1193 ;; Calculate outdent
1194 (if indent-type2
1195 (progn
1196 (or cur-indent2 (setq cur-indent2 cur-indent))
1197 (setq cur-indent
1198 (or (and dcl-calc-command-indent-function
1199 (funcall dcl-calc-command-indent-function
1200 indent-type2 cur-indent2 extra-indent2
1201 last-point this-point))
1202 (+ cur-indent2 extra-indent2)))))
1203 cur-indent
1204 )))
1205
1206
1207;;;---------------------------------------------------------------------------
1208(defun dcl-calc-cont-indent-relative (cur-indent extra-indent)
1209 "Indent continuation lines to align with words on previous line.
1210
1211Indent continuation lines to a position relative to preceding
1212significant command line elements.
1213
1214Set `dcl-calc-cont-indent-function' to this function to customize
1215indentation of continuation lines.
1216
1217Indented lines will align with either:
1218
1219* the second word on the command line
1220 $ set default -
1221 [-]
674e010d 1222* the word after an assignment
43e34a41
RS
1223 $ a = b + -
1224 d
1225* the third word if it's a qualifier
1226 $ set terminal/width=80 -
1227 /page=24
1228* the innermost nonclosed parenthesis
1229 $ if ((a.eq.b .and. -
1230 d.eq.c .or. f$function(xxxx, -
1231 yyy)))
1232"
1233 (let ((case-fold-search t)
a1506d29 1234 indent)
43e34a41
RS
1235 (save-excursion
1236 (dcl-beginning-of-statement)
1237 (let ((end (save-excursion (forward-line 1) (point))))
1238 ;; Move over blanks and label
1239 (if (re-search-forward (concat "^\\$[ \t]*\\(" dcl-label-r
1240 "\\)*[ \t]*") end t)
1241 (progn
1242 ;; Move over the first word (might be `@filespec')
1243 (if (> (skip-chars-forward "@:[]<>$\\-a-zA-Z0-9_.;" end) 0)
1244 (let (was-assignment)
1245 (skip-chars-forward " \t" end)
1246 ;; skip over assignment if there is one
1247 (if (looking-at ":?==?")
1248 (progn
1249 (setq was-assignment t)
1250 (skip-chars-forward " \t:=" end)))
1251 ;; This could be the position to indent to
1252 (setq indent (current-column))
a1506d29 1253
43e34a41
RS
1254 ;; Move to the next word unless we have seen an
1255 ;; assignment. If it starts with `/' it's a
1256 ;; qualifier and we will indent to that position
1257 (if (and (not was-assignment)
1258 (> (skip-chars-forward "a-zA-Z0-9_" end) 0))
1259 (progn
1260 (skip-chars-forward " \t" end)
1261 (if (= (char-after (point)) ?/)
1262 (setq indent (current-column)))))
1263 ))))))
1264 ;; Now check if there are any parenthesis to adjust to.
1265 ;; If there is, we will indent to the position after the last non-closed
1266 ;; opening parenthesis.
1267 (save-excursion
1268 (beginning-of-line)
1269 (let* ((start (save-excursion (dcl-beginning-of-statement) (point)))
1270 (parse-sexp-ignore-comments t) ; for parse-partial
1271 (par-pos (nth 1 (parse-partial-sexp start (point)))))
1272 (if par-pos ; is nil if no parenthesis was found
1273 (setq indent (save-excursion
1274 (goto-char par-pos)
1275 (1+ (current-column)))))))
1276 indent))
1277
1278
1279;;;---------------------------------------------------------------------------
1280(defun dcl-calc-continuation-indent ()
1281 "Calculate how much the current line shall be indented.
1282The line is known to be a continuation line.
1283
1284Go to the previous command line.
1285Find out how much it is indented."
1286;; This was copied without much thought from dcl-calc-command-indent, so
1287;; it's a bit clumsy.
1288 ()
1289 (save-excursion
1290 (beginning-of-line)
1291 (if (bobp)
1292 ;; Huh? a continuation line first in the buffer??
1293 dcl-margin-offset
1294 (let ((is-block nil)
1295 (indent))
1296 (save-excursion
1297 ;; Find first non-empty command line
1298 (let ((done))
1299 (while (not done)
1300 (if (dcl-beginning-of-statement)
1301 (cond
1302 ((and dcl-block-begin-regexp
1303 (looking-at (concat "^\\$" dcl-ws-r
1304 dcl-block-begin-regexp)))
1305 (setq done t) (setq is-block t))
1306 ((and dcl-block-end-regexp
1307 (looking-at (concat "^\\$" dcl-ws-r
1308 dcl-block-end-regexp)))
1309 (setq done t) (setq is-block t))
1310 ((looking-at dcl-comment-line-regexp)
1311 t)
1312 ((looking-at "^\\$[ \t]*$")
1313 t)
1314 ((not (looking-at
1315 (concat "^\\$" dcl-ws-r dcl-label-r dcl-ws-r "$")))
1316 (setq done t)))
1317 ;; This must have been the first line.
1318 (setq indent dcl-margin-offset)
1319 (setq done t)))
1320 (if indent
1321 ()
1322 ;; Find out how much this line is indented.
1323 ;; Look at comment, continuation character, command but not label
1324 ;; unless it's a block.
1325 (if is-block
1326 (re-search-forward "^\\$[ \t]*")
1327 (re-search-forward (concat "^\\$[ \t]*\\(" dcl-label-r
1328 "\\)*[ \t]*")))
1329 (setq indent (current-column))
1330 )))
1331 ;; We're back at the beginning of the original line.
1332 (or (and dcl-calc-cont-indent-function
1333 (funcall dcl-calc-cont-indent-function indent
1334 dcl-continuation-offset))
1335 (+ indent dcl-continuation-offset))
1336 ))))
1337
1338
1339;;;---------------------------------------------------------------------------
1340(defun dcl-indent-command-line ()
1341 "Indent a line known to be a command line."
1342 (let ((indent (dcl-calc-command-indent))
1343 (pos (- (point-max) (point))))
1344 (save-excursion
1345 (beginning-of-line)
1346 (re-search-forward "^\\$[ \t]*")
1347 ;; Indent any margin-label if the offset is set
1348 ;; (Don't look at block labels)
1349 (if (and dcl-margin-label-offset
1350 (looking-at dcl-label-r)
1351 (not (and dcl-block-begin-regexp
1352 (looking-at dcl-block-begin-regexp)))
1353 (not (and dcl-block-end-regexp
1354 (looking-at dcl-block-end-regexp))))
1355 (progn
1356 (dcl-indent-to dcl-margin-label-offset)
1357 (re-search-forward dcl-label-r)))
1358 (dcl-indent-to indent 1)
1359 )
a1506d29 1360 ;;
43e34a41
RS
1361 (if (> (- (point-max) pos) (point))
1362 (goto-char (- (point-max) pos)))
1363 ))
1364
1365
1366;;;-------------------------------------------------------------------------
1367(defun dcl-indent-continuation-line ()
1368 "Indent a line known to be a continuation line.
1369
1370Notice that no special treatment is made for labels. They have to be
1371on the first part on a command line to be taken into consideration."
1372 (let ((indent (dcl-calc-continuation-indent)))
1373 (save-excursion
1374 (beginning-of-line)
1375 (re-search-forward "^[ \t]*")
1376 (dcl-indent-to indent))
1377 (skip-chars-forward " \t")))
1378
1379
1380;;;---------------------------------------------------------------------------
1381(defun dcl-delete-chars (chars)
1382 "Delete all characters in the set CHARS around point."
1383 (skip-chars-backward chars)
1384 (delete-region (point) (progn (skip-chars-forward chars) (point))))
1385
1386
1387;;;---------------------------------------------------------------------------
1388(defun dcl-indent-line ()
1389 "The DCL version of `indent-line-function'.
1390Adjusts indentation on the current line. Data lines are not indented."
1391 (let ((type (dcl-get-line-type)))
1392 (cond
1393 ((equal type '$)
1394 (dcl-indent-command-line))
1395 ((equal type '\?)
1396 (message "Unknown line type!"))
1397 ((equal type '$!))
1398 ((equal type 'data))
1399 ((equal type 'empty-data))
1400 ((equal type '-)
1401 (dcl-indent-continuation-line))
1402 ((equal type 'empty-$)
1403 (insert "$" )
1404 (dcl-indent-command-line))
1405 (t
1406 (message "dcl-indent-line: unknown type"))
1407 )))
a1506d29 1408
43e34a41
RS
1409
1410;;;-------------------------------------------------------------------------
1411(defun dcl-indent-command ()
1412 "Indents the complete command line that point is on.
1413This includes continuation lines."
1414 (interactive "*")
1415 (let ((type (dcl-get-line-type)))
1416 (if (or (equal type '$)
1417 (equal type '-)
1418 (equal type 'empty-$))
1419 (save-excursion
1420 (indent-region (progn (or (looking-at "^\\$")
1421 (dcl-beginning-of-statement))
1422 (point))
1423 (progn (dcl-end-of-statement) (point))
1424 nil)))))
1425
1426
1427;;;-------------------------------------------------------------------------
1428(defun dcl-tab ()
1429 "Insert tab in data lines or indent code.
1430If `dcl-tab-always-indent' is t, code lines are always indented.
1431If nil, indent the current line only if point is at the left margin or in
1432the lines indentation; otherwise insert a tab."
1433 (interactive "*")
1434 (let ((type (dcl-get-line-type))
1435 (start-point (point)))
1436 (cond
1437 ;; Data line : always insert tab
a1506d29 1438 ((or (equal type 'data) (equal type 'empty-data))
43e34a41 1439 (tab-to-tab-stop))
a1506d29 1440 ;; Indent only at start of line
43e34a41
RS
1441 ((not dcl-tab-always-indent) ; nil
1442 (let ((search-end-point
1443 (save-excursion
1444 (beginning-of-line)
1445 (re-search-forward "^\\$?[ \t]*" start-point t))))
1446 (if (or (bolp)
1447 (and search-end-point
1448 (>= search-end-point start-point)))
1449 (dcl-indent-line)
1450 (tab-to-tab-stop))))
1451 ;; Always indent
1452 ((eq dcl-tab-always-indent t) ; t
1453 (dcl-indent-line))
1454 )))
1455
1456
1457;;;-------------------------------------------------------------------------
1458(defun dcl-electric-character (arg)
1459 "Inserts a character and indents if necessary.
a1506d29 1460Insert a character if the user gave a numeric argument or the flag
43e34a41
RS
1461`dcl-electric-characters' is not set. If an argument was given,
1462insert that many characters.
1463
1464The line is only reindented if the word just typed matches any of the
1465regexps in `dcl-electric-reindent-regexps'."
1466 (interactive "*P")
1467 (if (or arg (not dcl-electric-characters))
1468 (if arg
1469 (self-insert-command (prefix-numeric-value arg))
1470 (self-insert-command 1))
1471 ;; Insert the character and indent
1472 (self-insert-command 1)
1473 (let ((case-fold-search t))
1474 ;; There must be a better way than (memq t ...).
a1506d29 1475 ;; (apply 'or ...) didn't work
43e34a41
RS
1476 (if (memq t (mapcar 'dcl-was-looking-at dcl-electric-reindent-regexps))
1477 (dcl-indent-line)))))
1478
1479
1480;;;-------------------------------------------------------------------------
1481(defun dcl-indent-to (col &optional minimum)
1482 "Like indent-to, but only indents if indentation would change"
1483 (interactive)
1484 (let (cur-indent collapsed indent)
1485 (save-excursion
1486 (skip-chars-forward " \t")
1487 (setq cur-indent (current-column))
1488 (skip-chars-backward " \t")
1489 (setq collapsed (current-column)))
1490 (setq indent (max col (+ collapsed (or minimum 0))))
1491 (if (/= indent cur-indent)
1492 (progn
1493 (dcl-delete-chars " \t")
1494 (indent-to col minimum)))))
a1506d29 1495
43e34a41
RS
1496
1497;;;-------------------------------------------------------------------------
1498(defun dcl-split-line ()
1499 "Break line at point and insert text to keep the syntax valid.
1500
1501Inserts continuation marks and splits character strings."
1502 ;; Still don't know what to do with comments at the end of a command line.
1503 (interactive "*")
1504 (let (done
1505 (type (dcl-get-line-type)))
1506 (cond
1507 ((or (equal type '$) (equal type '-))
1508 (let ((info (parse-partial-sexp
1509 (save-excursion (dcl-beginning-of-statement) (point))
1510 (point))))
1511 ;; handle some special cases
1512 (cond
1513 ((nth 3 info) ; in text constant
1514 (insert "\" + -\n\"")
1515 (indent-according-to-mode)
1516 (setq done t))
1517 ((not (nth 4 info)) ; not in comment
1518 (cond
1519 ((and (not (eolp))
1520 (= (char-after (point)) ?\")
1521 (= (char-after (1- (point))) ?\"))
1522 (progn ; a " "" " situation
1523 (forward-char -1)
1524 (insert "\" + -\n\"")
1525 (forward-char 1)
1526 (indent-according-to-mode)
1527 (setq done t)))
1528 ((and (dcl-was-looking-at "[ \t]*-[ \t]*") ; after cont mark
1529 (looking-at "[ \t]*\\(!.*\\)?$"))
1530 ;; Do default below. This might considered wrong if we're
1531 ;; after a subtraction: $ x = 3 - <M-LFD>
1532 )
1533 (t
1534 (delete-horizontal-space)
1535 (insert " -")
1536 (insert "\n") (indent-according-to-mode)
1537 (setq done t))))
1538 ))))
1539 ;; use the normal function for other cases
1540 (if (not done) ; normal M-LFD action
1541 (indent-new-comment-line))))
1542
a1506d29 1543
43e34a41
RS
1544;;;-------------------------------------------------------------------------
1545(defun dcl-delete-indentation (&optional arg)
1546 "Join this line to previous like delete-indentation.
1547Also remove the continuation mark if easily detected."
1548 (interactive "*P")
1549 (delete-indentation arg)
1550 (let ((type (dcl-get-line-type)))
1551 (if (and (or (equal type '$)
1552 (equal type '-)
1553 (equal type 'empty-$))
1554 (not (bobp))
1555 (= (char-after (1- (point))) ?-))
1556 (progn
1557 (delete-backward-char 1)
1558 (fixup-whitespace)))))
1559
1560
1561;;; *** Set options *********************************************************
1562
1563
1564;;;-------------------------------------------------------------------------
1565(defun dcl-option-value-basic (option-assoc)
1566 "Guess a value for basic-offset."
1567 (save-excursion
1568 (dcl-beginning-of-command)
1569 (let* (;; current lines indentation
1570 (this-indent (save-excursion
1571 (dcl-back-to-indentation)
1572 (current-column)))
1573 ;; previous lines indentation
1574 (prev-indent (save-excursion
1575 (if (dcl-backward-command)
1576 (progn
1577 (dcl-back-to-indentation)
1578 (current-column)))))
1579 (next-indent (save-excursion
1580 (dcl-end-of-command)
1581 (if (dcl-forward-command)
1582 (progn
1583 (dcl-beginning-of-command)
1584 (dcl-back-to-indentation)
1585 (current-column)))))
1586 (diff (if prev-indent
1587 (abs (- this-indent prev-indent)))))
1588 (cond
1589 ((and diff
1590 (/= diff 0))
1591 diff)
1592 ((and next-indent
1593 (/= (- this-indent next-indent) 0))
1594 (abs (- this-indent next-indent)))
1595 (t
1596 dcl-basic-offset)))))
1597
1598
1599;;;-------------------------------------------------------------------------
1600(defun dcl-option-value-offset (option-assoc)
1601 "Guess a value for an offset.
1602Find the column of the first non-blank character on the line.
e190af9a 1603Returns the column offset."
43e34a41
RS
1604 (save-excursion
1605 (beginning-of-line)
1606 (re-search-forward "^$[ \t]*" nil t)
1607 (current-column)))
1608
1609
1610;;;-------------------------------------------------------------------------
1611(defun dcl-option-value-margin-offset (option-assoc)
1612 "Guess a value for margin offset.
1613Find the column of the first non-blank character on the line, not
a1506d29 1614counting labels.
43e34a41
RS
1615Returns a number as a string."
1616 (save-excursion
1617 (beginning-of-line)
1618 (dcl-back-to-indentation)
1619 (current-column)))
1620
1621
1622;;;-------------------------------------------------------------------------
1623(defun dcl-option-value-comment-line (option-assoc)
1624 "Guess a value for `dcl-comment-line-regexp'.
1625Must return a string."
1626 ;; Should we set comment-start and comment-start-skip as well?
1627 ;; If someone wants `$!&' as a comment line, C-M-j won't work well if
1628 ;; they aren't set.
1629 ;; This must be done after the user has given the real value in
1630 ;; dcl-set-option.
1631 (format
1632 "%S"
1633 (save-excursion
1634 (beginning-of-line)
1635 ;; We could search for "^\\$.*!+[^ \t]*", but, as noted above, we
1636 ;; can't handle that case very good, so there is no point in
1637 ;; suggesting it.
1638 (if (looking-at "^\\$[^!\n]*!")
1639 (let ((regexp (buffer-substring (match-beginning 0) (match-end 0))))
1640 (concat "^" (regexp-quote regexp)))
1641 dcl-comment-line-regexp))))
a1506d29 1642
43e34a41
RS
1643
1644;;;-------------------------------------------------------------------------
1645(defun dcl-guess-option-value (option)
1646 "Guess what value the user would like to give the symbol option."
1647 (let* ((option-assoc (assoc option dcl-option-alist))
1648 (option (car option-assoc))
1649 (action (car (cdr option-assoc)))
1650 (value (cond
1651 ((fboundp action)
1652 (funcall action option-assoc))
1653 ((eq action 'toggle)
1654 (not (eval option)))
1655 ((eq action 'curval)
1656 (cond ((or (stringp (symbol-value option))
1657 (numberp (symbol-value option)))
1658 (format "%S" (symbol-value option)))
1659 (t
1660 (format "'%S" (symbol-value option))))))))
1661 ;; format the value as a string if not already done
1662 (if (stringp value)
1663 value
1664 (format "%S" value))))
1665
1666
1667;;;-------------------------------------------------------------------------
1668(defun dcl-guess-option ()
1669 "Guess what option the user wants to set by looking around in the code.
1670Returns the name of the option variable as a string."
1671 (let ((case-fold-search t))
1672 (cond
1673 ;; Continued line
1674 ((eq (dcl-get-line-type) '-)
1675 "dcl-calc-cont-indent-function")
1676 ;; Comment line
1677 ((save-excursion
1678 (beginning-of-line)
1679 (looking-at "^\\$[ \t]*!"))
1680 "dcl-comment-line-regexp")
1681 ;; Margin offset: subroutine statement or first line in buffer
1682 ;; Test this before label indentation to detect a subroutine
1683 ((save-excursion
1684 (beginning-of-line)
1685 (or (looking-at (concat "^\\$[ \t]*" dcl-label-r dcl-ws-r
1686 "subroutine"))
1687 (save-excursion
1688 (not (dcl-backward-command t)))))
1689 "dcl-margin-offset")
1690 ;; Margin offset: on command line after subroutine statement
1691 ((save-excursion
1692 (beginning-of-line)
1693 (and (eq (dcl-get-line-type) '$)
1694 (dcl-backward-command)
1695 (looking-at (concat "^\\$[ \t]*" dcl-label-r dcl-ws-r
1696 "subroutine"))))
1697 "dcl-margin-offset")
1698 ;; Label indentation
1699 ((save-excursion
1700 (beginning-of-line)
1701 (and (looking-at (concat "^\\$[ \t]*" dcl-label-r))
1702 (not (and dcl-block-begin-regexp
1703 (looking-at (concat "^\\$[ \t]*"
1704 dcl-block-begin-regexp))))
1705 (not (and dcl-block-end-regexp
1706 (looking-at (concat "^\\$[ \t]*"
1707 dcl-block-end-regexp))))))
1708 "dcl-margin-label-offset")
1709 ;; Basic offset
1710 ((and (eq (dcl-get-line-type) '$) ; beginning of command
1711 (save-excursion
1712 (beginning-of-line)
1713 (let* ((this-indent (save-excursion
1714 (dcl-back-to-indentation)
1715 (current-column)))
1716 (prev-indent (save-excursion
1717 (if (dcl-backward-command)
1718 (progn
1719 (dcl-back-to-indentation)
1720 (current-column)))))
1721 (next-indent (save-excursion
1722 (dcl-end-of-command)
1723 (if (dcl-forward-command)
1724 (progn
1725 (dcl-beginning-of-command)
1726 (dcl-back-to-indentation)
1727 (current-column))))))
1728 (or (and prev-indent ; last cmd is indented differently
1729 (/= (- this-indent prev-indent) 0))
1730 (and next-indent
1731 (/= (- this-indent next-indent) 0))))))
1732 "dcl-basic-offset")
a1506d29 1733 ;; No more guesses.
43e34a41
RS
1734 (t
1735 ""))))
1736
1737
1738;;;-------------------------------------------------------------------------
1739(defun dcl-set-option (option-sym option-value)
1740 "Set a value for one of the dcl customization variables.
1741The function tries to guess which variable should be set and to what value.
1742All variable names are available as completions and in the history list."
1743 (interactive
1744 (let* ((option-sym
1745 (intern (completing-read
1746 "Set DCL option: " ; prompt
1747 (mapcar (function ; alist of valid values
1748 (lambda (option-assoc)
1749 (cons (format "%s" (car option-assoc)) nil)))
1750 dcl-option-alist)
1751 nil ; no predicate
1752 t ; only value from the list OK
1753 (dcl-guess-option) ; initial (default) value
1754 'dcl-option-history))) ; history list
1755 (option-value
1756 (eval-minibuffer
1757 (format "Set DCL option %s to: " option-sym)
1758 (dcl-guess-option-value option-sym))))
1759 (list option-sym option-value)))
1760 ;; Should make a sanity check on the symbol/value pair.
1761 ;; `set' instead of `setq' because we want option-sym to be evaluated.
1762 (set option-sym option-value))
1763
1764
1765;;; *** Save options ********************************************************
1766
1767
1768;;;-------------------------------------------------------------------------
1769(defun dcl-save-local-variable (var &optional def-prefix def-suffix)
1770 "Save a variable in a `Local Variables' list.
a1506d29
JB
1771Set or update the value of VAR in the current buffers
1772`Local Variables:' list."
43e34a41
RS
1773 ;; Look for "Local variables:" line in last page.
1774 (save-excursion
1775 (goto-char (point-max))
1776 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
1777 (if (let ((case-fold-search t))
1778 (search-forward "Local Variables:" nil t))
1779 (let ((continue t)
1780 prefix prefixlen suffix beg
1781 prefix-string suffix-string)
1782 ;; The prefix is what comes before "local variables:" in its line.
1783 ;; The suffix is what comes after "local variables:" in its line.
1784 (skip-chars-forward " \t")
1785 (or (eolp)
1786 (setq suffix-string (buffer-substring (point)
1787 (progn (end-of-line) (point)))))
1788 (goto-char (match-beginning 0))
1789 (or (bolp)
1790 (setq prefix-string
1791 (buffer-substring (point)
1792 (progn (beginning-of-line) (point)))))
1793
1794 (if prefix-string (setq prefixlen (length prefix-string)
1795 prefix (regexp-quote prefix-string)))
1796 (if suffix-string (setq suffix (concat (regexp-quote suffix-string)
1797 "$")))
1798 (while continue
1799 ;; Look at next local variable spec.
1800 (if selective-display (re-search-forward "[\n\C-m]")
1801 (forward-line 1))
1802 ;; Skip the prefix, if any.
1803 (if prefix
1804 (if (looking-at prefix)
1805 (forward-char prefixlen)
1806 (error "Local variables entry is missing the prefix")))
1807 ;; Find the variable name; strip whitespace.
1808 (skip-chars-forward " \t")
1809 (setq beg (point))
1810 (skip-chars-forward "^:\n")
1811 (if (eolp) (error "Missing colon in local variables entry"))
1812 (skip-chars-backward " \t")
1813 (let* ((str (buffer-substring beg (point)))
1814 (found-var (read str))
1815 val)
1816 ;; Setting variable named "end" means end of list.
1817 (if (string-equal (downcase str) "end")
1818 (progn
1819 ;; Not found. Insert a new entry before this line
1820 (setq continue nil)
1821 (beginning-of-line)
a1506d29 1822 (insert (concat prefix-string (symbol-name var) ": "
43e34a41
RS
1823 (prin1-to-string (eval var)) " "
1824 suffix-string "\n")))
1825 ;; Is it the variable we are looking for?
1826 (if (eq var found-var)
1827 (progn
1828 ;; Found it: delete the variable value and insert the
1829 ;; new value.
1830 (setq continue nil)
1831 (skip-chars-forward "^:")
1832 (forward-char 1)
1833 (delete-region (point) (progn (read (current-buffer))
1834 (point)))
1835 (insert " ")
1836 (prin1 (eval var) (current-buffer))
1837 (skip-chars-backward "\n")
1838 (skip-chars-forward " \t")
1839 (or (if suffix (looking-at suffix) (eolp))
1840 (error
1841 "Local variables entry is terminated incorrectly")))
1842 (end-of-line))))))
1843 ;; Did not find "Local variables:"
1844 (goto-char (point-max))
1845 (if (not (bolp))
1846 (insert "\n"))
1847 ;; If def- parameter not set, use comment- if set. In that case, make
1848 ;; sure there is a space in a suitable position
1849 (let ((def-prefix
1850 (cond
1851 (def-prefix
1852 def-prefix)
1853 (comment-start
1854 (if (or (equal comment-start "")
1855 (string-match "[ \t]$" comment-start))
1856 comment-start
1857 (concat comment-start " ")))))
1858 (def-suffix
1859 (cond
1860 (def-suffix
1861 def-suffix)
1862 (comment-end
1863 (if (or (equal comment-end "")
1864 (string-match "^[ \t]" comment-end))
1865 comment-end
1866 (concat " " comment-end))))))
1867 (insert (concat def-prefix "Local variables:" def-suffix "\n"))
a1506d29 1868 (insert (concat def-prefix (symbol-name var) ": "
43e34a41
RS
1869 (prin1-to-string (eval var)) def-suffix "\n"))
1870 (insert (concat def-prefix "end:" def-suffix)))
1871 )))
1872
1873
1874;;;-------------------------------------------------------------------------
1875(defun dcl-save-all-options ()
1876 "Save all dcl-mode options for this buffer.
1877Saves or updates all dcl-mode related options in a `Local Variables:'
1878section at the end of the current buffer."
1879 (interactive "*")
1880 (mapcar (lambda (option-assoc)
1881 (let* ((option (car option-assoc)))
1882 (dcl-save-local-variable option "$! ")))
1883 dcl-option-alist))
1884
1885
1886;;;-------------------------------------------------------------------------
1887(defun dcl-save-nondefault-options ()
1888 "Save changed DCL mode options for this buffer.
1889Saves or updates all DCL mode related options that don't have their
1890default values in a `Local Variables:' section at the end of the
1891current buffer.
1892
1893No entries are removed from the `Local Variables:' section. This means
1894that if a variable is given a non-default value in the section and
1895later is manually reset to its default value, the variable's entry will
1896still be present in the `Local Variables:' section with its old value."
1897 (interactive "*")
1898 (mapcar (lambda (option-assoc)
1899 (let* ((option (car option-assoc))
1900 (option-name (symbol-name option)))
1901 (if (and (string-equal "dcl-"
1902 (substring option-name 0 4))
1903 (not (equal (default-value option) (eval option))))
1904 (dcl-save-local-variable option "$! "))))
1905 dcl-option-alist))
1906
1907
1908;;;-------------------------------------------------------------------------
1909(defun dcl-save-option (option)
1910 "Save a DCL mode option for this buffer.
1911Saves or updates an option in a `Local Variables:'
1912section at the end of the current buffer."
1913 (interactive
1914 (let ((option (intern (completing-read "Option: " obarray))))
1915 (list option)))
1916 (dcl-save-local-variable option))
1917
1918
1919;;;-------------------------------------------------------------------------
1920(defun dcl-save-mode ()
1921 "Save the current mode for this buffer.
1922Save the current mode in a `Local Variables:'
1923section at the end of the current buffer."
1924 (interactive)
1925 (let ((mode (prin1-to-string major-mode)))
1926 (if (string-match "-mode$" mode)
1927 (let ((mode (intern (substring mode 0 (match-beginning 0)))))
1928 (dcl-save-option 'mode))
1929 (message "Strange mode: %s" mode))))
1930
1931
1932;;; *** Templates ***********************************************************
1933;; tempo seems to be the only suitable package among those included in
1934;; standard Emacs. I would have liked something closer to the functionality
1935;; of LSE templates...
1936
1937
1938(require 'tempo)
1939(defvar dcl-tempo-tags nil
1940 "Tempo tags for DCL mode.")
a1506d29 1941
43e34a41 1942(tempo-define-template "dcl-f$context"
a1506d29 1943 '("f$context" dcl-tempo-left-paren
43e34a41
RS
1944 (p "context-type: ") dcl-tempo-comma
1945 (p "context-symbol: ") dcl-tempo-comma
1946 (p "selection-item: ") dcl-tempo-comma
1947 (p "selection-value: ") dcl-tempo-comma
1948 (p "value-qualifier: ") dcl-tempo-right-paren)
1949 "f$context" "" 'dcl-tempo-tags)
1950
1951(tempo-define-template "dcl-f$csid"
a1506d29 1952 '("f$csid" dcl-tempo-left-paren
43e34a41
RS
1953 (p "context-symbol: ") dcl-tempo-right-paren)
1954 "f$csid" "" 'dcl-tempo-tags)
1955
1956(tempo-define-template "dcl-f$cvsi"
a1506d29 1957 '("f$cvsi" dcl-tempo-left-paren
43e34a41
RS
1958 (p "start-bit: ") dcl-tempo-comma
1959 (p "number-of-bits: ") dcl-tempo-comma
1960 (p "string: ") dcl-tempo-right-paren)
1961 "f$cvsi" "" 'dcl-tempo-tags)
1962
1963(tempo-define-template "dcl-f$cvtime"
a1506d29 1964 '("f$cvtime" dcl-tempo-left-paren
43e34a41
RS
1965 (p "[input_time]: ") dcl-tempo-comma
1966 (p "[output_time_format]: ") dcl-tempo-comma
1967 (p "[output_field]: ") dcl-tempo-right-paren)
1968 "f$cvtime" "" 'dcl-tempo-tags)
1969
1970(tempo-define-template "dcl-f$cvui"
a1506d29 1971 '("f$cvui" dcl-tempo-left-paren
43e34a41
RS
1972 (p "start-bit: ") dcl-tempo-comma
1973 (p "number-of-bits: ") dcl-tempo-comma
1974 (p "string") dcl-tempo-right-paren)
1975 "f$cvui" "" 'dcl-tempo-tags)
1976
1977(tempo-define-template "dcl-f$device"
a1506d29 1978 '("f$device" dcl-tempo-left-paren
43e34a41
RS
1979 (p "[search_devnam]: ") dcl-tempo-comma
1980 (p "[devclass]: ") dcl-tempo-comma
1981 (p "[devtype]: ") dcl-tempo-comma
1982 (p "[stream-id]: ") dcl-tempo-right-paren)
1983 "f$device" "" 'dcl-tempo-tags)
1984
1985(tempo-define-template "dcl-f$directory"
1986 '("f$directory" dcl-tempo-left-paren
1987 dcl-tempo-right-paren)
1988 "f$directory" "" 'dcl-tempo-tags)
1989
1990(tempo-define-template "dcl-f$edit"
a1506d29 1991 '("f$edit" dcl-tempo-left-paren
43e34a41
RS
1992 (p "string: ") dcl-tempo-comma
1993 (p "edit-list: ") dcl-tempo-right-paren)
1994 "f$edit" "" 'dcl-tempo-tags)
1995
1996(tempo-define-template "dcl-f$element"
a1506d29 1997 '("f$element" dcl-tempo-left-paren
43e34a41
RS
1998 (p "element-number: ") dcl-tempo-comma
1999 (p "delimiter: ") dcl-tempo-comma
2000 (p "string: ") dcl-tempo-right-paren)
2001 "f$element" "" 'dcl-tempo-tags)
2002
2003(tempo-define-template "dcl-f$environment"
a1506d29 2004 '("f$environment" dcl-tempo-left-paren
43e34a41
RS
2005 (p "item: ") dcl-tempo-right-paren)
2006 "f$environment" "" 'dcl-tempo-tags)
2007
2008(tempo-define-template "dcl-f$extract"
a1506d29 2009 '("f$extract" dcl-tempo-left-paren
43e34a41
RS
2010 (p "start: ") dcl-tempo-comma
2011 (p "length: ") dcl-tempo-comma
2012 (p "string: ") dcl-tempo-right-paren)
2013 "f$extract" "" 'dcl-tempo-tags)
2014
2015(tempo-define-template "dcl-f$fao"
a1506d29 2016 '("f$fao" dcl-tempo-left-paren
43e34a41
RS
2017 (p "control-string: ") dcl-tempo-comma
2018 ("argument[,...]: ") dcl-tempo-right-paren)
2019 "f$fao" "" 'dcl-tempo-tags)
2020
2021(tempo-define-template "dcl-f$file_attributes"
a1506d29 2022 '("f$file_attributes" dcl-tempo-left-paren
43e34a41
RS
2023 (p "filespec: ") dcl-tempo-comma
2024 (p "item: ") dcl-tempo-right-paren)
2025 "f$file_attributes" "" 'dcl-tempo-tags)
2026
2027(tempo-define-template "dcl-f$getdvi"
a1506d29 2028 '("f$getdvi" dcl-tempo-left-paren
43e34a41
RS
2029 (p "device-name: ") dcl-tempo-comma
2030 (p "item: ") dcl-tempo-right-paren)
2031 "f$getdvi" "" 'dcl-tempo-tags)
2032
2033(tempo-define-template "dcl-f$getjpi"
a1506d29 2034 '("f$getjpi" dcl-tempo-left-paren
43e34a41
RS
2035 (p "pid: ") dcl-tempo-comma
2036 (p "item: ") dcl-tempo-right-paren )
2037 "f$getjpi" "" 'dcl-tempo-tags)
2038
2039(tempo-define-template "dcl-f$getqui"
a1506d29 2040 '("f$getqui" dcl-tempo-left-paren
43e34a41
RS
2041 (p "function: ") dcl-tempo-comma
2042 (p "[item]: ") dcl-tempo-comma
2043 (p "[object-id]: ") dcl-tempo-comma
2044 (p "[flags]: ") dcl-tempo-right-paren)
2045 "f$getqui" "" 'dcl-tempo-tags)
2046
2047(tempo-define-template "dcl-f$getsyi"
a1506d29 2048 '("f$getsyi" dcl-tempo-left-paren
43e34a41
RS
2049 (p "item: ") dcl-tempo-comma
2050 (p "[node-name]: ") dcl-tempo-comma
2051 (p "[cluster-id]: ") dcl-tempo-right-paren)
2052 "f$getsyi" "" 'dcl-tempo-tags)
2053
2054(tempo-define-template "dcl-f$identifier"
a1506d29 2055 '("f$identifier" dcl-tempo-left-paren
43e34a41
RS
2056 (p "identifier: ") dcl-tempo-comma
2057 (p "conversion-type: ") dcl-tempo-right-paren)
2058 "f$identifier" "" 'dcl-tempo-tags)
2059
2060(tempo-define-template "dcl-f$integer"
a1506d29 2061 '("f$integer" dcl-tempo-left-paren
43e34a41
RS
2062 (p "expression: ") dcl-tempo-right-paren)
2063 "f$integer" "" 'dcl-tempo-tags)
2064
2065(tempo-define-template "dcl-f$length"
2066 '("f$length" dcl-tempo-left-paren
2067 (p "string: ") dcl-tempo-right-paren )
2068 "f$length" "" 'dcl-tempo-tags)
2069
2070(tempo-define-template "dcl-f$locate"
a1506d29 2071 '("f$locate" dcl-tempo-left-paren
43e34a41
RS
2072 (p "substring: ") dcl-tempo-comma
2073 (p "string: ") dcl-tempo-right-paren)
2074 "f$locate" "" 'dcl-tempo-tags)
2075
2076(tempo-define-template "dcl-f$message"
a1506d29 2077 '("f$message" dcl-tempo-left-paren
43e34a41
RS
2078 (p "status-code: ") dcl-tempo-right-paren )
2079 "f$message" "" 'dcl-tempo-tags)
2080
2081(tempo-define-template "dcl-f$mode"
2082 '("f$mode" dcl-tempo-left-paren dcl-tempo-right-paren)
2083 "f$mode" "" 'dcl-tempo-tags)
2084
2085(tempo-define-template "dcl-f$parse"
a1506d29 2086 '("f$parse" dcl-tempo-left-paren
43e34a41
RS
2087 (p "filespec: ") dcl-tempo-comma
2088 (p "[default-spec]: ") dcl-tempo-comma
2089 (p "[related-spec]: ") dcl-tempo-comma
2090 (p "[field]: ") dcl-tempo-comma
2091 (p "[parse-type]: ") dcl-tempo-right-paren)
2092 "f$parse" "" 'dcl-tempo-tags)
2093
2094(tempo-define-template "dcl-f$pid"
a1506d29 2095 '("f$pid" dcl-tempo-left-paren
43e34a41
RS
2096 (p "context-symbol: ") dcl-tempo-right-paren)
2097 "f$pid" "" 'dcl-tempo-tags)
2098
2099(tempo-define-template "dcl-f$privilege"
a1506d29 2100 '("f$privilege" dcl-tempo-left-paren
43e34a41
RS
2101 (p "priv-states: ") dcl-tempo-right-paren)
2102 "f$privilege" "" 'dcl-tempo-tags)
2103
2104(tempo-define-template "dcl-f$process"
2105 '("f$process()")
2106 "f$process" "" 'dcl-tempo-tags)
2107
2108(tempo-define-template "dcl-f$search"
a1506d29 2109 '("f$search" dcl-tempo-left-paren
43e34a41
RS
2110 (p "filespec: ") dcl-tempo-comma
2111 (p "[stream-id]: ") dcl-tempo-right-paren)
2112 "f$search" "" 'dcl-tempo-tags)
2113
2114(tempo-define-template "dcl-f$setprv"
a1506d29 2115 '("f$setprv" dcl-tempo-left-paren
43e34a41
RS
2116 (p "priv-states: ") dcl-tempo-right-paren)
2117 "f$setprv" "" 'dcl-tempo-tags)
2118
2119(tempo-define-template "dcl-f$string"
a1506d29 2120 '("f$string" dcl-tempo-left-paren
43e34a41
RS
2121 (p "expression: ") dcl-tempo-right-paren)
2122 "f$string" "" 'dcl-tempo-tags)
2123
2124(tempo-define-template "dcl-f$time"
2125 '("f$time" dcl-tempo-left-paren dcl-tempo-right-paren)
2126 "f$time" "" 'dcl-tempo-tags)
2127
2128(tempo-define-template "dcl-f$trnlnm"
a1506d29 2129 '("f$trnlnm" dcl-tempo-left-paren
43e34a41
RS
2130 (p "logical-name: ") dcl-tempo-comma
2131 (p "[table]: ") dcl-tempo-comma
2132 (p "[index]: ") dcl-tempo-comma
2133 (p "[mode]: ") dcl-tempo-comma
2134 (p "[case]: ") dcl-tempo-comma
2135 (p "[item]: ") dcl-tempo-right-paren)
2136 "f$trnlnm" "" 'dcl-tempo-tags)
2137
2138(tempo-define-template "dcl-f$type"
a1506d29 2139 '("f$type" dcl-tempo-left-paren
43e34a41
RS
2140 (p "symbol-name: ") dcl-tempo-right-paren)
2141 "f$type" "" 'dcl-tempo-tags)
2142
2143(tempo-define-template "dcl-f$user"
2144 '("f$user" dcl-tempo-left-paren dcl-tempo-right-paren)
2145 "f$user" "" 'dcl-tempo-tags)
2146
2147(tempo-define-template "dcl-f$verify"
a1506d29 2148 '("f$verify" dcl-tempo-left-paren
43e34a41
RS
2149 (p "[procedure-value]: ") dcl-tempo-comma
2150 (p "[image-value]: ") dcl-tempo-right-paren)
2151 "f$verify" "" 'dcl-tempo-tags)
2152
2153
2154
2155
2156;;; *** Unsorted stuff *****************************************************
2157
2158
2159;;;-------------------------------------------------------------------------
2160(defun dcl-beginning-of-command-p ()
2161 "Return t if point is at the beginning of a command.
2162Otherwise return nil."
2163 (and (bolp)
2164 (eq (dcl-get-line-type) '$)))
2165
2166
2167;;;-------------------------------------------------------------------------
2168(defun dcl-end-of-command-p ()
2169 "Check if point is at the end of a command.
2170Return t if point is at the end of a command, either the end of an
2171only line or at the end of the last continuation line.
2172Otherwise return nil."
2173 ;; Must be at end-of-line on a command line or a continuation line
2174 (let ((type (dcl-get-line-type)))
2175 (if (and (eolp)
2176 (or (eq type '$)
2177 (eq type '-)))
2178 ;; Next line must not be a continuation line
2179 (save-excursion
2180 (forward-line)
2181 (not (eq (dcl-get-line-type) '-))))))
2182
2183
2184;;;-------------------------------------------------------------------------
2185(defun dcl-command-p ()
2186 "Check if point is on a command line.
2187Return t if point is on a command line or a continuation line,
2188otherwise return nil."
2189 (let ((type (dcl-get-line-type)))
2190 (or (eq type '$)
2191 (eq type '-))))
2192
2193
2194;;;-------------------------------------------------------------------------
2195(defun dcl-was-looking-at (regexp)
2196 (save-excursion
2197 (let ((start (point))
2198 (found (re-search-backward regexp 0 t)))
2199 (if (not found)
2200 ()
2201 (equal start (match-end 0))))))
2202
a1506d29 2203
43e34a41
RS
2204;;;-------------------------------------------------------------------------
2205(defun dcl-imenu-create-index-function ()
2206 "Jacket routine to make imenu searches non case sensitive."
2207 (let ((case-fold-search t))
2208 (imenu-default-create-index-function)))
2209
2210
2211
2212;;; *** Epilogue ************************************************************
2213
2214
2215(provide 'dcl-mode)
2216
2217(run-hooks 'dcl-mode-load-hook) ; for your customizations
2218
ab5796a9 2219;;; arch-tag: e00d421b-f26c-483e-a8bd-af412ea7764a
43e34a41 2220;;; dcl-mode.el ends here