dcl-mode.el 75 KB

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