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