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