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