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