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