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