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