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