Trailing whitepace deleted.
[bpt/emacs.git] / lisp / progmodes / dcl-mode.el
1 ;;; dcl-mode.el --- major mode for editing DCL command files
2
3 ;; Copyright (c) 1997 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 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
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.
34 ;;
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
37 ;; Emacs. I used version 1.2.4.
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,
50 ;; please send them to the maintainer.
51 ;;
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
74 (defgroup dcl nil
75 "Major mode for editing DCL command files."
76 :group 'languages)
77
78 (defcustom dcl-basic-offset 4
79 "*Number of columns to indent a block in DCL.
80 A block is the commands between THEN-ELSE-ENDIF and between the commands
81 dcl-block-begin-regexp and dcl-block-end-regexp.
82
83 The meaning of this variable may be changed if
84 dcl-calc-command-indent-function is set to a function."
85 :type 'integer
86 :group 'dcl)
87
88
89 (defcustom dcl-continuation-offset 6
90 "*Number of columns to indent a continuation line in DCL.
91 A continuation line is a line that follows a line ending with `-'.
92
93 The meaning of this variable may be changed if
94 dcl-calc-cont-indent-function is set to a function."
95 :type 'integer
96 :group 'dcl)
97
98
99 (defcustom dcl-margin-offset 8
100 "*Indentation for the first command line in DCL.
101 The first command line in a file or after a SUBROUTINE statement is indented
102 this much. Other command lines are indented the same number of columns as
103 the preceding command line.
104 A command line is a line that starts with `$'."
105 :type 'integer
106 :group 'dcl)
107
108
109 (defcustom dcl-margin-label-offset 2
110 "*Number of columns to indent a margin label in DCL.
111 A margin label is a label that doesn't begin or end a block, i.e. it
112 doesn't match dcl-block-begin-regexp or dcl-block-end-regexp."
113 :type 'integer
114 :group 'dcl)
115
116
117 (defcustom dcl-comment-line-regexp "^\\$!"
118 "*Regexp describing the start of a comment line in DCL.
119 Comment lines are not indented."
120 :type 'regexp
121 :group 'dcl)
122
123
124 (defcustom dcl-block-begin-regexp "loop[0-9]*:"
125 "*Regexp describing a command that begins an indented block in DCL.
126 Set to nil to only indent at THEN-ELSE-ENDIF."
127 :type 'regexp
128 :group 'dcl)
129
130
131 (defcustom dcl-block-end-regexp "endloop[0-9]*:"
132 "*Regexp describing a command that ends an indented block in DCL.
133 Set to nil to only indent at THEN-ELSE-ENDIF."
134 :type 'regexp
135 :group 'dcl)
136
137
138 (defcustom dcl-calc-command-indent-function nil
139 "*Function to calculate indentation for a command line in DCL.
140 If this variable is non-nil it is called as a function:
141
142 \(func INDENT-TYPE CUR-INDENT EXTRA-INDENT LAST-POINT THIS-POINT)
143
144 The function must return the number of columns to indent the current line or
145 nil to get the default indentation.
146
147 INDENT-TYPE is a symbol indicating what kind of indentation should be done.
148 It 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.
152 CUR-INDENT is the indentation of the preceding command line.
153 EXTRA-INDENT is the default change in indentation for this line
154 \(a negative number for 'outdent).
155 LAST-POINT is the buffer position of the first significant word on the
156 previous line or nil if the current line is the first line.
157 THIS-POINT is the buffer position of the first significant word on the
158 current line.
159
160 If this variable is nil, the indentation is calculated as
161 CUR-INDENT + EXTRA-INDENT.
162
163 This package includes two functions suitable for this:
164 dcl-calc-command-indent-multiple
165 dcl-calc-command-indent-hang"
166 :type '(choice (const nil) function)
167 :group 'dcl)
168
169
170 (defcustom dcl-calc-cont-indent-function 'dcl-calc-cont-indent-relative
171 "*Function to calculate indentation for a continuation line.
172 If this variable is non-nil it is called as a function:
173
174 \(func CUR-INDENT EXTRA-INDENT)
175
176 The function must return the number of columns to indent the current line or
177 nil to get the default indentation.
178
179 If this variable is nil, the indentation is calculated as
180 CUR-INDENT + EXTRA-INDENT.
181
182 This package includes one function suitable for this:
183 dcl-calc-cont-indent-relative"
184 :type 'function
185 :group 'dcl)
186
187
188 (defcustom dcl-tab-always-indent t
189 "*Controls the operation of the TAB key in DCL mode.
190 If t, pressing TAB always indents the current line.
191 If nil, pressing TAB indents the current line if point is at the left margin.
192 Data lines (i.e. lines not part of a command line or continuation line) are
193 never indented."
194 :type 'boolean
195 :group 'dcl)
196
197
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)
202
203
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)
208
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)
213
214
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)
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.
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
240 `((nil "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):[ \t]+SUBROUTINE\\b" 1)
241 (,dcl-imenu-label-labels
242 "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):\\([ \t]\\|$\\)" 1)
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))
246 "*Default imenu generic expression for DCL.
247
248 The default includes SUBROUTINE labels in the main listing and
249 sub-listings for other labels, CALL, GOTO and GOSUB statements.
250 See `imenu-generic-expression' for details."
251 :type '(repeat (sexp :tag "Imenu Expression"))
252 :group 'dcl)
253
254
255 (defcustom dcl-mode-hook nil
256 "*Hook called by `dcl-mode'."
257 :type 'hook
258 :group 'dcl)
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
273 )
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
343 (defcustom dcl-ws-r
344 "\\([ \t]*-[ \t]*\\(!.*\\)*\n\\)*[ \t]*"
345 "Regular expression describing white space in a DCL command line.
346 White space is any number of continued lines with only space,tab,endcomment
347 followed by space or tab."
348 :type 'regexp
349 :group 'dcl)
350
351
352 (defcustom dcl-label-r
353 "[a-zA-Z0-9_\$]*:\\([ \t!]\\|$\\)"
354 "Regular expression describing a label.
355 A label is a name followed by a colon followed by white-space or end-of-line."
356 :type 'regexp
357 :group 'dcl)
358
359
360 (defcustom dcl-cmd-r
361 "^\\$\\(.*-[ \t]*\\(!.*\\)*\n\\)*[^!\"\n]*\\(\".*\\(\"\".*\\)*\"\\)*[^!\"\n]*"
362 "Regular expression describing a DCL command line up to a trailing comment.
363 A line starting with $, optionally followed by continuation lines,
364 followed by the end of the command line.
365 A continuation line is any characters followed by `-',
366 optionally followed by a comment, followed by a newline."
367 :type 'regexp
368 :group 'dcl)
369
370
371 (defcustom dcl-command-regexp
372 "^\\$\\(.*-[ \t]*\\(!.*\\)*\n\\)*.*\\(\".*\\(\"\".*\\)*\"\\)*"
373 "Regular expression describing a DCL command line.
374 A line starting with $, optionally followed by continuation lines,
375 followed by the end of the command line.
376 A continuation line is any characters followed by `-',
377 optionally followed by a comment, followed by a newline."
378 :type 'regexp
379 :group 'dcl)
380
381
382 (defcustom dcl-electric-reindent-regexps
383 (list "endif" "else" dcl-label-r)
384 "*Regexps that can trigger an electric reindent.
385 A list of regexps that will trigger a reindent if the last letter
386 is defined as dcl-electric-character.
387
388 E.g.: if this list contains `endif', the key `f' is defined as
389 dcl-electric-character and the you have just typed the `f' in
390 `endif', the line will be reindented."
391 :type '(repeat regexp)
392 :group 'dcl)
393
394
395 (defvar dcl-option-alist
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)
403 (dcl-tab-always-indent toggle)
404 (dcl-electric-characters toggle)
405 (dcl-electric-reindent-regexps curval)
406 (dcl-tempo-comma curval)
407 (dcl-tempo-left-paren curval)
408 (dcl-tempo-right-paren curval)
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
416 An alist with option variables and functions or keywords to get a
417 default value for the option.
418
419 The keywords are:
420 curval the current value
421 toggle the opposite of the current value (for t/nil)")
422
423
424 (defvar dcl-option-history
425 (mapcar (lambda (option-assoc)
426 (format "%s" (car option-assoc)))
427 dcl-option-alist)
428 "The history list for dcl-set-option.
429 Preloaded 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
446 ;sub-listings for other labels, CALL, GOTO and GOSUB statements.
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
458 This mode indents command lines in blocks. (A block is commands between
459 THEN-ELSE-ENDIF and between lines matching dcl-block-begin-regexp and
460 dcl-block-end-regexp.)
461
462 Labels are indented to a fixed position unless they begin or end a block.
463 Whole-line comments (matching dcl-comment-line-regexp) are not indented.
464 Data lines are not indented.
465
466 Key bindings:
467
468 \\{dcl-mode-map}
469 Commands 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
476 Variables 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
491 Lines matching this regexp will not be indented.
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.
514 If nil, pressing TAB indents the current line if point is at the left
515 margin.
516
517 dcl-electric-characters
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
533 other labels, CALL, GOTO and GOSUB statements.
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
541 Loading this package calls the value of the variable
542 `dcl-mode-load-hook' with no args, if that value is non-nil.
543 Turning on DCL mode calls the value of the variable `dcl-mode-hook'
544 with no args, if that value is non-nil.
545
546
547 The following example uses the default values for all variables:
548
549 $! This is a comment line that is not indented (it matches
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:
555 $ label:
556 $ if i.eq.1
557 $ then
558 $ ! Lines between THEN-ELSE and ELSE-ENDIF are
559 $ ! indented dcl-basic-offset
560 $ loop1: ! This matches dcl-block-begin-regexp...
561 $ ! ...so this line is indented dcl-basic-offset
562 $ text = \"This \" + - ! is a continued line
563 \"lined up with the command line\"
564 $ type sys$input
565 Data lines are not indented at all.
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)
585
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)
595 (progn (setq imenu-generic-expression dcl-imenu-generic-expression)
596 (setq imenu-case-fold-search t)))
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)
611
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.
669 Move point to the preceding command line that is not a comment line,
670 a command line with only a comment, only contains a `$' or only
671 contains a label.
672
673 Returns 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.
713 Move point to the end of the next command line that is not a comment line,
714 a command line with only a comment, only contains a `$' or only
715 contains a label.
716
717 Returns 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.
761 Leading $ and labels counts as whitespace in this case.
762 If this is a comment line then move to the first non-whitespace character
763 in the comment.
764
765 Typing \\[dcl-back-to-indentation] several times in a row will move point to other
766 `interesting' points closer to the left margin, and then back to the
767 rightmost point again.
768
769 E.g. on the following line, point would go to the positions indicated
770 by 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 ;;
788 ;; $ l: command !
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
810 ;; Special treatment for comment lines. We are trying to allow
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.
849 Returns 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
904
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
938 Set dcl-calc-command-indent-function to this function to customize
939 indentation of command lines.
940
941 Command lines that need to be indented beyond the left margin are
942 always indented to a column that is a multiple of dcl-basic-offset, as
943 if tab stops were set at 4, 8, 12, etc.
944
945 This supports a formatting style like this (dcl-margin offset = 2,
946 dcl-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
969 Set dcl-calc-command-indent-function to this function to customize
970 indentation of command lines.
971
972 This function supports a formatting style like this:
973
974 $ if cond
975 $ then
976 $ xxx
977 $ endif
978 $ xxx
979
980 If you use this function you will probably want to add \"then\" to
981 dcl-electric-reindent-regexps and define the key \"n\" as
982 dcl-electric-character.
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))))
1006 ;; Outdent, this word is `endif' or `else': + 2
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.
1019 The line is known to be a command line.
1020
1021 Find the indentation of the preceding line and analyze its contents to
1022 see if the current lines should be indented.
1023 Analyze the current line to see if it should be `outdented'.
1024
1025 Calculate the indentation of the current line, either with the default
1026 method or by calling dcl-calc-command-indent-function if it is
1027 non-nil.
1028
1029 If the current line should be outdented, calculate its indentation,
1030 either with the default method or by calling
1031 dcl-calc-command-indent-function if it is non-nil.
1032
1033
1034 Rules for default indentation:
1035
1036 If it is the first line in the buffer, indent dcl-margin-offset.
1037
1038 Go to the previous command line with a command on it.
1039 Find out how much it is indented (cur-indent).
1040 Look at the first word on the line to see if the indentation should be
1041 adjusted. Skip margin-label, continuations and comments while looking for
1042 the first word. Save this buffer position as `last-point'.
1043 If the first word after a label is SUBROUTINE, set extra-indent to
1044 dcl-margin-offset.
1045
1046 First word extra-indent
1047 THEN +dcl-basic-offset
1048 ELSE +dcl-basic-offset
1049 block-begin +dcl-basic-offset
1050
1051 Then return to the current line and look at the first word to see if the
1052 indentation should be adjusted again. Save this buffer position as
1053 `this-point'.
1054
1055 First word extra-indent
1056 ELSE -dcl-basic-offset
1057 ENDIF -dcl-basic-offset
1058 block-end -dcl-basic-offset
1059
1060
1061 If dcl-calc-command-indent-function is nil or returns nil set
1062 cur-indent to cur-indent+extra-indent.
1063
1064 If an extra adjustment is necessary and if
1065 dcl-calc-command-indent-function is nil or returns nil set cur-indent
1066 to cur-indent+extra-indent.
1067
1068 See also documentation for dcl-calc-command-indent-function.
1069 The 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
1109 last-point (dcl-indentation-point))
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
1182 Indent continuation lines to a position relative to preceding
1183 significant command line elements.
1184
1185 Set `dcl-calc-cont-indent-function' to this function to customize
1186 indentation of continuation lines.
1187
1188 Indented lines will align with either:
1189
1190 * the second word on the command line
1191 $ set default -
1192 [-]
1193 * the word after an assignment
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)
1205 indent)
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))
1224
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.
1253 The line is known to be a continuation line.
1254
1255 Go to the previous command line.
1256 Find 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 )
1331 ;;
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
1341 Notice that no special treatment is made for labels. They have to be
1342 on 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'.
1361 Adjusts 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 )))
1379
1380
1381 ;;;-------------------------------------------------------------------------
1382 (defun dcl-indent-command ()
1383 "Indents the complete command line that point is on.
1384 This 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.
1401 If `dcl-tab-always-indent' is t, code lines are always indented.
1402 If nil, indent the current line only if point is at the left margin or in
1403 the 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
1409 ((or (equal type 'data) (equal type 'empty-data))
1410 (tab-to-tab-stop))
1411 ;; Indent only at start of line
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.
1431 Insert a character if the user gave a numeric argument or the flag
1432 `dcl-electric-characters' is not set. If an argument was given,
1433 insert that many characters.
1434
1435 The line is only reindented if the word just typed matches any of the
1436 regexps 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 ...).
1446 ;; (apply 'or ...) didn't work
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)))))
1466
1467
1468 ;;;-------------------------------------------------------------------------
1469 (defun dcl-split-line ()
1470 "Break line at point and insert text to keep the syntax valid.
1471
1472 Inserts 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
1514
1515 ;;;-------------------------------------------------------------------------
1516 (defun dcl-delete-indentation (&optional arg)
1517 "Join this line to previous like delete-indentation.
1518 Also 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.
1573 Find the column of the first non-blank character on the line.
1574 Returns the column offset."
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.
1584 Find the column of the first non-blank character on the line, not
1585 counting labels.
1586 Returns 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'.
1596 Must 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))))
1613
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.
1641 Returns 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")
1704 ;; No more guesses.
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.
1712 The function tries to guess which variable should be set and to what value.
1713 All 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.
1742 Set or update the value of VAR in the current buffers
1743 `Local Variables:' list."
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)
1793 (insert (concat prefix-string (symbol-name var) ": "
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"))
1839 (insert (concat def-prefix (symbol-name var) ": "
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.
1848 Saves or updates all dcl-mode related options in a `Local Variables:'
1849 section 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.
1860 Saves or updates all DCL mode related options that don't have their
1861 default values in a `Local Variables:' section at the end of the
1862 current buffer.
1863
1864 No entries are removed from the `Local Variables:' section. This means
1865 that if a variable is given a non-default value in the section and
1866 later is manually reset to its default value, the variable's entry will
1867 still 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.
1882 Saves or updates an option in a `Local Variables:'
1883 section 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.
1893 Save the current mode in a `Local Variables:'
1894 section 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.")
1912
1913 (tempo-define-template "dcl-f$context"
1914 '("f$context" dcl-tempo-left-paren
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"
1923 '("f$csid" dcl-tempo-left-paren
1924 (p "context-symbol: ") dcl-tempo-right-paren)
1925 "f$csid" "" 'dcl-tempo-tags)
1926
1927 (tempo-define-template "dcl-f$cvsi"
1928 '("f$cvsi" dcl-tempo-left-paren
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"
1935 '("f$cvtime" dcl-tempo-left-paren
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"
1942 '("f$cvui" dcl-tempo-left-paren
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"
1949 '("f$device" dcl-tempo-left-paren
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"
1962 '("f$edit" dcl-tempo-left-paren
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"
1968 '("f$element" dcl-tempo-left-paren
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"
1975 '("f$environment" dcl-tempo-left-paren
1976 (p "item: ") dcl-tempo-right-paren)
1977 "f$environment" "" 'dcl-tempo-tags)
1978
1979 (tempo-define-template "dcl-f$extract"
1980 '("f$extract" dcl-tempo-left-paren
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"
1987 '("f$fao" dcl-tempo-left-paren
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"
1993 '("f$file_attributes" dcl-tempo-left-paren
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"
1999 '("f$getdvi" dcl-tempo-left-paren
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"
2005 '("f$getjpi" dcl-tempo-left-paren
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"
2011 '("f$getqui" dcl-tempo-left-paren
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"
2019 '("f$getsyi" dcl-tempo-left-paren
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"
2026 '("f$identifier" dcl-tempo-left-paren
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"
2032 '("f$integer" dcl-tempo-left-paren
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"
2042 '("f$locate" dcl-tempo-left-paren
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"
2048 '("f$message" dcl-tempo-left-paren
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"
2057 '("f$parse" dcl-tempo-left-paren
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"
2066 '("f$pid" dcl-tempo-left-paren
2067 (p "context-symbol: ") dcl-tempo-right-paren)
2068 "f$pid" "" 'dcl-tempo-tags)
2069
2070 (tempo-define-template "dcl-f$privilege"
2071 '("f$privilege" dcl-tempo-left-paren
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"
2080 '("f$search" dcl-tempo-left-paren
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"
2086 '("f$setprv" dcl-tempo-left-paren
2087 (p "priv-states: ") dcl-tempo-right-paren)
2088 "f$setprv" "" 'dcl-tempo-tags)
2089
2090 (tempo-define-template "dcl-f$string"
2091 '("f$string" dcl-tempo-left-paren
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"
2100 '("f$trnlnm" dcl-tempo-left-paren
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"
2110 '("f$type" dcl-tempo-left-paren
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"
2119 '("f$verify" dcl-tempo-left-paren
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.
2133 Otherwise 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.
2141 Return t if point is at the end of a command, either the end of an
2142 only line or at the end of the last continuation line.
2143 Otherwise 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.
2158 Return t if point is on a command line or a continuation line,
2159 otherwise 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
2174
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