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