home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / rexxmd11.zip / rexx-mode.el < prev    next >
Lisp/Scheme  |  1994-07-24  |  54KB  |  1,612 lines
  1. ;;; rexx-mode.el --- REXX code editing commands for Emacs
  2. ;; Copyright (C) 1994 Scott Maxwell
  3.  
  4. ;; Maintainer: Scott Maxwell - scottmax@netcom.com
  5. ;; Keywords: rexx
  6.  
  7. ;;------------------------------------------------------------------------
  8. ;;; IMPORTANT NOTE: Since there is no difference between line labels and
  9. ;;            procedure name labels in REXX, there is no way for
  10. ;;            rexx-mode to know the difference.  Therefore, I have
  11. ;;            adopted the convention that a '_' preceding a label
  12. ;;            indicates a line label.  Otherwise, it's a procedure
  13. ;;            name.  If you don't precede your line labels with '_',
  14. ;;            I can't predict what will happen to your formatting.
  15. ;;------------------------------------------------------------------------
  16.  
  17. ;; This is a full featured rexx-mode.  That means that it should format
  18. ;; your REXX code correctly in all cases (except the one mentioned above.)
  19. ;; Please let me know if it doesn't.
  20.  
  21. ;; Everyone should probably look at the docs for this as it has detailed
  22. ;; information on all rexx-mode features.  These include:
  23. ;;    * indentation styles
  24. ;;    * command/function name completion
  25. ;;    * automatic capitalization options
  26. ;;    * REXX command/function online help
  27. ;;    * single key DO ('{') and END ('}')
  28. ;;    * keymaps for going to the start/end of procedures/blocks
  29. ;;    * keymaps for reindenting procedures/blocks/regions of code
  30. ;; Get into REXX mode and do M-x describe-mode for details.
  31.  
  32. ;; This file is part of GNU Emacs.
  33.  
  34. ;; GNU Emacs is free software; you can redistribute it and/or modify
  35. ;; it under the terms of the GNU General Public License as published by
  36. ;; the Free Software Foundation; either version 2, or (at your option)
  37. ;; any later version.
  38.  
  39. ;; GNU Emacs is distributed in the hope that it will be useful,
  40. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  41. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  42. ;; GNU General Public License for more details.
  43.  
  44. ;; You should have received a copy of the GNU General Public License
  45. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  46. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  47.  
  48. ;;; Commentary:
  49.  
  50. ;; This REXX mode code began as the EMACS 19.22 build c-mode.el.
  51.  
  52. ;; A smart editing mode for REXX code.  It knows a lot about REXX syntax
  53. ;; and tries to position the cursor according to REXX layout conventions.
  54. ;; You can change the details of the layout style with option variables.
  55. ;; It also supports completion, auto-capitalization and REXX function help.
  56. ;; Load it and do M-x describe-mode for details.
  57.  
  58. ;; If you want to enable all features of rexx-mode, as well as VX-Rexx
  59. ;; support, you can just add these lines to your .emacs:
  60. ;;
  61. ;;   (setq auto-mode-alist (cons '("\\.cmd$" . rexx-mode) auto-mode-alist))
  62. ;;   (setq auto-mode-alist (cons '("\\.vrx$" . rexx-mode) auto-mode-alist))
  63. ;;   (setq auto-mode-alist (cons '("\\.vrm$" . rexx-mode) auto-mode-alist))
  64. ;;   (autoload 'rexx-mode "rexx-mode")
  65. ;;
  66. ;;   (setq rexx-command-auto-upper 2)
  67. ;;   (setq rexx-external-function-auto-capitilize t)
  68. ;;   (setq rexx-auto-build-procedure-table t)
  69. ;;   (setq rexx-super-completion-mode t)
  70. ;;   (setq rexx-additional-doc-files '("rexx-os2" "vxrexx-doc"))
  71. ;;   (load "vxrexx-mode")
  72. ;;   (setq vxrexx-build-master-table t)
  73.  
  74.  
  75. ;; To autoload, add this to your .emacs file:
  76. ;;
  77. ;;   (setq auto-mode-alist (cons '("\\.cmd$" . rexx-mode) auto-mode-alist))
  78. ;;   (autoload 'rexx-mode "rexx-mode")
  79. ;;
  80. ;; If you are not using OS/2, this "\\.cmd$" will probably be
  81. ;; something different.  If you are using VX-REXX, you might also
  82. ;; find it valuable to add "\\.vrx$" and maybe even "\\.vrm$".
  83.  
  84. ;; If you want to take advantage of automatic capitalization, you might
  85. ;; also want to add:
  86. ;;
  87. ;;   (setq rexx-command-auto-upper t)
  88. ;;   (setq rexx-external-function-auto-capitilize t)
  89. ;;
  90. ;; This will automatically convert all internal commands/functions to
  91. ;; uppercase and capitalize all external function names that it knows
  92. ;; about.  To capitalize instead of uppercasing internal commands/
  93. ;; functions, change rexx-command-auto-upper to 1 instead of t.
  94. ;; I personally set this to 2 which will uppercase commands and
  95. ;; capitalize functions.  Function names will only be capitalized
  96. ;; when rexx-mode thinks it is appropriate.  This means after a
  97. ;; CALL or when followed by a '('.  It also will not do completion
  98. ;; on function names in double quotes(") but will do so in single
  99. ;; quotes(').  The reason for this is that quoted non-function names
  100. ;; may be added to external function expansion tables such as VX-Rexx
  101. ;; method and property names.  These will only expand after quotes
  102. ;; (single or double.)  See the rexx-doc.el file for more information.
  103. ;;
  104. ;; If you want rexx-mode to automatically add new procedures you write
  105. ;; to its local expansion table, add:
  106. ;;    (setq rexx-auto-build-procedure-table t)
  107. ;;
  108. ;; Then, when you load a rexx file, rexx-mode will automatically scan
  109. ;; the file, adding any procedure names it finds to its local table.
  110. ;; Also, everytime you hit colon after a procedure name, it will add
  111. ;; the new procedure to the table as well.  If you want to rebuild this
  112. ;; table from scratch, use M-x rexx-build-procedure-table.  This is also
  113. ;; bound to M-C-Tab by default.
  114.  
  115. ;; If you want to enable very high level completion, add:
  116. ;;   (setq rexx-super-completion-mode)
  117. ;;
  118. ;; This will enable command specific completion.  For instance, after
  119. ;; typing RxFuncAdd, the command specific completion function for
  120. ;; RxFuncAdd will kick in and prompt you for the name of the function
  121. ;; you want to add and the package it came from, defaulting to the
  122. ;; package name it finds in its expansion table if present.
  123. ;;
  124. ;; Also, you should be aware that both [ESC Tab] and [Ctrl Tab] are
  125. ;; mapped to REXX completion.  Just type part of the command name and
  126. ;; hit one of these combinations and rexx-mode will spit out the rest
  127. ;; of the word or a list of choices.  You can hit [Ctrl-x 1] to get
  128. ;; rid of the completion window.
  129. ;;
  130. ;; If you want help about any REXX command, try [Ctrl h] [Ctrl f].
  131. ;; If you don't plan to use this feature, you can save some memory
  132. ;; by using the nodoc completion file.  Just add this to your .emacs:
  133. ;;   (setq rexx-doc-file "rexx-sml")
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141. ;;; Code:
  142.  
  143. (defvar rexx-developing-mode-docs nil
  144.   "This should only be true if you are working on doc/completion tables
  145. and you need them to be rebuilt every time you re-evaluate rexx-mode.")
  146.  
  147. (provide 'rexx-mode)
  148.  
  149. (defvar rexx-additional-doc-files nil
  150.   "*This specifies any additional doc/completion files you would
  151. like loaded.  For instance, I have included a completion
  152. file for Watcom VX-Rexx with this package.  If you wish to
  153. define your own list, you should define a structure that
  154. looks like this in your .emacs file:
  155.     (setq rexx-additional-doc-files '(\"rexx-os2\"
  156.                       \"vxrexx-doc\"
  157.                       \"unzipapi-doc\"
  158.                       \"rxextras-doc\"))")
  159.  
  160. (defvar rexx-doc-file "rexx-doc"
  161.   "*Specifies file to use for REXX documentation and completion.\n
  162. This currently defaults to "rexx-os2".  The file "rexx-os2.el"
  163. should have been included with this packet and contains
  164. fairly complete documentation for OS/2 internal and external
  165. commands as well as nicer capitalization for many function
  166. names.  If you wish to use stripped down tables to conserve
  167. memory, add
  168.     (setq rexx-doc-file \"rexx-sml\")
  169. to you .emacs file.  Alternatively, if you wish to replace
  170. this file with your own, add
  171.     (setq rexx-doc-file \"my-file\")
  172. or something along those lines to your .emacs.
  173. You can disable this feature altogether with
  174.     (setq rexx-doc-file nil)")
  175.  
  176. (defvar rexx-command-auto-upper nil
  177.   "*If this is t, rexx-mode will automatically convert all
  178. REXX command and internal function names to upper case.
  179. If it is 1, it will capitalize.  If 2 or higher, it will
  180. capitalize functions and uppercase commands.")
  181.  
  182. (defvar rexx-external-function-auto-capitilize nil
  183.   "*If non-nil, rexx-mode will automagically fix capitalization
  184. for any external functions it knows about.")
  185.  
  186. (defvar rexx-auto-build-procedure-table nil
  187.   "*If non-nil, rexx-mode will automatically build a local table
  188. of procedures defined in the current buffer.  These are then
  189. added to the completion table for this buffer.")
  190.  
  191. (defvar rexx-super-completion-mode nil
  192.   "*If non-nill, enables command specific completion functions.")
  193.  
  194. (defvar rexx-command-table nil
  195.   "Table of REXX commands for rexx-command-auto-upper.")
  196.  
  197. (defvar rexx-external-function-table nil
  198.   "Table of REXX external functions for rexx-external-function-auto-capitilize.")
  199.  
  200. (defconst rexx-user-procedure-table nil
  201.   "Table of REXX user procedures defined in the current file.  This is
  202. created automatically for each buffer if rexx-auto-build-procedure-table
  203. is non-nil.")
  204.  
  205. (make-variable-buffer-local 'rexx-user-procedure-table)
  206.  
  207. (if (or (not rexx-command-table)
  208.     rexx-developing-mode-docs)
  209.     (progn
  210.       (if rexx-developing-mode-docs
  211.       (progn
  212.         (setq rexx-command-table nil)
  213.         (setq rexx-external-function-table nil)
  214.         (setq rexx-command-and-function-table nil)))
  215.       (if rexx-doc-file
  216.       (load rexx-doc-file))
  217.       (let ((scan rexx-additional-doc-files))
  218.     (while (car scan)
  219.       (load (car scan))
  220.       (setq scan (cdr scan))))))
  221.  
  222. (defconst rexx-command-and-function-table nil
  223.   "Combined table of REXX commands and external functions for help.")
  224. (setq rexx-command-and-function-table
  225.       (append rexx-command-table rexx-external-function-table))
  226.  
  227. (defvar rexx-build-eval nil
  228.   "*If this is defined, it is evaluated (executed) just after the
  229. rexx-user-procedure-table is cleared and recreated by scanning
  230. the buffer but before it is appended to the command and external
  231. function lists.  I am using this instead of a hook so that this
  232. can be buffer local.
  233.  
  234. You can use this to add names of your own from some other source
  235. or to change the way the scan works altogether.  My VX-Rexx
  236. extensions take advantage of this.")
  237.  
  238. (defvar rexx-warn-illegal-line-label t
  239.   "*Warn the user if he might be using a line label that is not
  240. preceded by a '_'.")
  241.  
  242. (defvar rexx-mode-abbrev-table nil
  243.   "Abbrev table in use in REXX mode.")
  244. (define-abbrev-table 'rexx-mode-abbrev-table ())
  245.  
  246. (defvar rexx-mode-map ()
  247.   "Keymap used in REXX mode.")
  248. (if rexx-mode-map
  249.     ()
  250.   (setq rexx-mode-map (make-sparse-keymap))
  251.   (define-key rexx-mode-map ":" 'electric-rexx-colon)
  252.   (define-key rexx-mode-map "{" 'electric-rexx-do)
  253.   (define-key rexx-mode-map "}" 'electric-rexx-end)
  254.   (define-key rexx-mode-map " " 'electric-rexx-space)
  255.   (define-key rexx-mode-map ";" 'electric-rexx-space)
  256.   (define-key rexx-mode-map "(" 'electric-rexx-paren)
  257.   (define-key rexx-mode-map ")" 'electric-rexx-space)
  258.   (define-key rexx-mode-map "'" 'electric-rexx-space)
  259.   (define-key rexx-mode-map "\"" 'electric-rexx-space)
  260.   (define-key rexx-mode-map "" 'electric-rexx-newline)
  261.   (define-key rexx-mode-map "\177" 'backward-delete-char-untabify)
  262.   (define-key rexx-mode-map "\t" 'rexx-indent-command)
  263.   (define-key rexx-mode-map [C-tab] 'rexx-complete-symbol)
  264.   (define-key rexx-mode-map "\e\t" 'rexx-complete-symbol)
  265.   (define-key rexx-mode-map [M-C-tab] 'rexx-build-procedure-table)
  266.   (define-key rexx-mode-map "\M-\C-\\" 'rexx-indent-region)
  267.   (define-key rexx-mode-map [M-C-space] 'rexx-capitalize-sexp)
  268.   (define-key rexx-mode-map "\M-\C-q" 'rexx-indent-sexp)
  269.   (define-key rexx-mode-map "\M-\C-a" 'rexx-beginning-of-procedure)
  270.   (define-key rexx-mode-map "\M-\C-e" 'rexx-end-of-procedure)
  271.   (define-key rexx-mode-map "\M-\C-f" 'rexx-forward-sexp)
  272.   (define-key rexx-mode-map "\M-\C-b" 'rexx-backward-sexp))
  273.  
  274. (defvar rexx-mode-syntax-table nil
  275.   "Syntax table in use in REXX-mode buffers.")
  276.  
  277. (if rexx-mode-syntax-table
  278.     ()
  279.   (setq rexx-mode-syntax-table (make-syntax-table))
  280.   (modify-syntax-entry ?\\ "." rexx-mode-syntax-table)
  281.   (modify-syntax-entry ?/ ". 14" rexx-mode-syntax-table)
  282.   (modify-syntax-entry ?* ". 23" rexx-mode-syntax-table)
  283.   (modify-syntax-entry ?+ "." rexx-mode-syntax-table)
  284.   (modify-syntax-entry ?- "." rexx-mode-syntax-table)
  285.   (modify-syntax-entry ?= "." rexx-mode-syntax-table)
  286.   (modify-syntax-entry ?% "." rexx-mode-syntax-table)
  287.   (modify-syntax-entry ?< "." rexx-mode-syntax-table)
  288.   (modify-syntax-entry ?> "." rexx-mode-syntax-table)
  289.   (modify-syntax-entry ?& "." rexx-mode-syntax-table)
  290.   (modify-syntax-entry ?| "." rexx-mode-syntax-table)
  291.   (modify-syntax-entry ?. "_" rexx-mode-syntax-table)
  292.   (modify-syntax-entry ?! "_" rexx-mode-syntax-table)
  293.   (modify-syntax-entry ?\' "\"" rexx-mode-syntax-table))
  294.  
  295. (defvar rexx-indent-level 3
  296.   "*Indentation of REXX statements with respect to containing block.")
  297. (defvar rexx-procedure-indent-level 3
  298.   "*Indentation of REXX statements after a procedure label.")
  299. (defvar rexx-procedure-arg-indent-level 0
  300.   "*Indentation of ARG or PARSE ARG immediately after a procedure label.")
  301. (defvar rexx-return-indent 0
  302.   "*Indentation for RETURN.")
  303. (defvar rexx-do-offset -3
  304.   "*Extra indentation for DO after a THEN or ELSE.")
  305. (defvar rexx-end-offset 0
  306.   "*Indentation for END, compared with text being enclosed.")
  307. (defvar rexx-when-offset 1
  308.   "*Indentation for WHEN relative to SELECT.")
  309. (defvar rexx-continued-statement-offset 1
  310.   "*Extra indent for lines not starting new statements.")
  311. (defvar rexx-expose-string "(Globals)"
  312.   "*String to automatically display after PROCEDURE.")
  313.  
  314. (defconst rexx-style-alist
  315.   '(("Maxwell"
  316.      (rexx-indent-level               .  3)
  317.      (rexx-procedure-indent-level     .  3)
  318.      (rexx-procedure-arg-indent-level .  0)
  319.      (rexx-return-indent          .  0)
  320.      (rexx-do-offset                  . -3)
  321.      (rexx-end-offset              .  0)
  322.      (rexx-when-offset              .  1)
  323.      (rexx-continued-statement-offset .  1))
  324.     ("Cowlishaw"
  325.      (rexx-indent-level               .  3)
  326.      (rexx-procedure-indent-level     .  0)
  327.      (rexx-procedure-arg-indent-level .  0)
  328.      (rexx-return-indent          .  0)
  329.      (rexx-do-offset                  . -3)
  330.      (rexx-end-offset              .  3)
  331.      (rexx-when-offset              .  3)
  332.      (rexx-continued-statement-offset .  2))
  333.     ("Wide"
  334.      (rexx-indent-level               .  4)
  335.      (rexx-procedure-indent-level     .  4)
  336.      (rexx-procedure-arg-indent-level .  2)
  337.      (rexx-return-indent          .  0)
  338.      (rexx-do-offset                  . -2)
  339.      (rexx-end-offset              .  0)
  340.      (rexx-when-offset              .  2)
  341.      (rexx-continued-statement-offset .  2))))
  342.  
  343. (defvar rexx-tab-always-indent t
  344.   "*Non-nil means TAB in REXX mode should always reindent the current line,
  345. regardless of where in the line point is when the TAB command is used.")
  346.  
  347.  
  348. (defun rexx-mode ()
  349.   "Major mode for editing REXX code.
  350. Comments are delimited with /* ... */.
  351. Delete converts tabs to spaces as it moves back.
  352. Line labels MUST start with '_' and procedure labels MUST not.
  353.  
  354. \\[rexx-indent-command]    indents for REXX code.
  355. \\[rexx-complete-symbol]    attempts completion on a partial command or function name.
  356. \\[electric-rexx-do]    inserts DO
  357. \\[electric-rexx-end]    insert END.
  358. \\[rexx-function-help]    displays help for REXX commands and functions.
  359.  
  360. Additional colons after a procedure name will insert PROCEDURE, then
  361. EXPOSE and finally the contents of rexx-expose-string (this defaults
  362. to \"(Globals)\".)
  363.  
  364. \\{rexx-mode-map}
  365.  
  366. Variables controlling automatic capitalization and completion:
  367.  rexx-command-auto-upper
  368.     If this is t, rexx-mode will automatically convert all REXX command and
  369.     internal function names to upper case.  If it is 1, it will capitalize.
  370.     If 2 or higher, it will capitalize functions and uppercase commands.
  371.  rexx-external-function-auto-capitilize
  372.     If non-nil, rexx-mode will automagically fix capitalization for any
  373.     external functions it knows about.
  374.  rexx-auto-build-procedure-table
  375.     If non-nil, rexx-mode will automatically build a local table of
  376.     procedures defined in the current buffer.  These are then added
  377.     to the completion table for this buffer.
  378.  
  379. Variables controlling indentation style:
  380.  rexx-tab-always-indent
  381.     Non-nil means TAB in REXX mode should always reindent the current line,
  382.     regardless of where in the line point is when the TAB command is used.
  383.  rexx-indent-level
  384.     Indentation of REXX statements within surrounding block.
  385.     The surrounding block's indentation is the indentation
  386.     of the line on which the open-brace appears.
  387.  rexx-procedure-indent-level
  388.     Indentation of REXX statements after a procedure label.
  389.  rexx-procedure-arg-indent-level
  390.     Indentation of ARG or PARSE ARG immediately after a procedure label.
  391.  rexx-return-indent
  392.     Indentation for return.
  393.  rexx-do-offset
  394.     Extra indentation for line if it starts with a DO.
  395.  rexx-end-offset
  396.     Indentation for END relative to DO.
  397.  rexx-when-offset
  398.     Indentation for WHEN relative to SELECT.
  399.  rexx-continued-statement-offset
  400.     Extra indentation given to a substatement, such as the
  401.     then-clause of an if or body of a while.
  402.  rexx-expose-string
  403.     Specifies what string to electrically put after PROCEDURE EXPOSE.
  404.  
  405. Settings for Maxwell, Cowlishaw and Wide indentation styles are:
  406.   rexx-indent-level                3    3    4
  407.   rexx-procedure-indent-level      3    0    4
  408.   rexx-procedure-arg-indent-level  0    0    2
  409.   rexx-return-indent               0    0    0
  410.   rexx-do-offset                  -3   -3   -2
  411.   rexx-end-offset           0    3    0
  412.   rexx-when-offset           1    3    2
  413.   rexx-continued-statement-offset  1    2    2
  414. Use set-rexx-style to choose.
  415.  
  416. Turning on REXX mode calls the value of the variable rexx-mode-hook with no
  417. args, if that value is non-nil."
  418.   (interactive)
  419.   (if (and (bobp) (eobp))
  420.       (progn
  421.     (insert "/* */")
  422.     (set-buffer-modified-p nil)))
  423.   (save-excursion
  424.     (goto-char (point-min))
  425.     (if (looking-at "/\\*")
  426.     (progn
  427.       (kill-all-local-variables)
  428.       (use-local-map rexx-mode-map)
  429.       (setq major-mode 'rexx-mode)
  430.       (setq mode-name "Rexx")
  431.       (setq local-abbrev-table rexx-mode-abbrev-table)
  432.       (set-syntax-table rexx-mode-syntax-table)
  433.       (make-local-variable 'rexx-expose-string)
  434.       (local-set-key "\C-h\C-f" 'rexx-function-help)
  435.       (make-local-variable 'paragraph-start)
  436.       (setq paragraph-start (concat "^$\\|" page-delimiter))
  437.       (make-local-variable 'paragraph-separate)
  438.       (setq paragraph-separate paragraph-start)
  439.       (make-local-variable 'paragraph-ignore-fill-prefix)
  440.       (setq paragraph-ignore-fill-prefix t)
  441.       (make-local-variable 'indent-line-function)
  442.       (setq indent-line-function 'rexx-indent-line)
  443.       (make-local-variable 'indent-region-function)
  444.       (setq indent-region-function 'rexx-indent-region)
  445.       (make-local-variable 'require-final-newline)
  446.       (setq require-final-newline t)
  447.       (make-local-variable 'comment-start)
  448.       (setq comment-start "/* ")
  449.       (make-local-variable 'comment-end)
  450.       (setq comment-end " */")
  451.       (make-local-variable 'comment-column)
  452.       (setq comment-column 32)
  453.       (make-local-variable 'comment-start-skip)
  454.       (setq comment-start-skip "/\\*+ *")
  455.       (make-local-variable 'comment-indent-function)
  456.       (setq comment-indent-function 'rexx-comment-indent)
  457.       (make-local-variable 'parse-sexp-ignore-comments)
  458.       (setq parse-sexp-ignore-comments t)
  459.       (make-local-variable 'rexx-build-eval)
  460.       (run-hooks 'rexx-mode-hook)
  461.       (if rexx-auto-build-procedure-table
  462.           (rexx-build-procedure-table)
  463.         (rexx-clear-procedure-table)))
  464.       (fundamental-mode))))
  465.  
  466. ;; This is used by indent-for-comment
  467. ;; to decide how much to indent a comment in REXX code
  468. ;; based on its context.
  469. (defun rexx-comment-indent ()
  470.   (if (or
  471.        (looking-at "^/\\*")        ;Existing comment at bol stays there.
  472.        (and (= comment-column 0)
  473.         (save-excursion
  474.           (skip-chars-backward " \t")
  475.           (bolp))))
  476.       ;; If comment-column is 0, and nothing but space
  477.       ;; before the comment, align it at 0 rather than 1.
  478.       0
  479.     (max (1+ (current-column))    ;Else indent at comment column
  480.      comment-column)))    ; except leave at least one space.
  481.  
  482.  
  483. (defun electric-rexx-paren (arg)
  484.   "If rexx-command-auto-upper is t, set all REXX commands to uppercase.
  485. If it is 1 capitalize commands.  If it is any other number, it will
  486. uppercase commands and capitalize functions.  It will also warn the
  487. user if he/she typed 'CALL funcname('."
  488.   (interactive "P")
  489.   (if (not arg)
  490.       (progn
  491.     (if (save-excursion
  492.           (and
  493.            last-command-char
  494.            (condition-case nil
  495.            (progn
  496.              (forward-sexp -2)
  497.              t)
  498.          (error nil))
  499.            (looking-at "call[ \t]+\\w")))
  500.         (progn
  501.           (message "Are you sure you want a '(' after a CALL?")
  502.           (beep))
  503.       (rexx-do-auto-upper))))
  504.   (if last-command-char
  505.       (self-insert-command (prefix-numeric-value arg))))
  506.  
  507.  
  508. (defun electric-rexx-space (arg)
  509.   "If rexx-command-auto-upper is t, set all REXX commands to uppercase.
  510. If it is 1 capitalize commands.  If it is any other number, it will
  511. uppercase commands and capitalize functions."
  512.   (interactive "P")
  513.   (if (not arg)
  514.       (rexx-do-auto-upper))
  515.   (if last-command-char
  516.       (self-insert-command (prefix-numeric-value arg))))
  517.  
  518.  
  519. (defun electric-rexx-newline (arg)
  520.   "If rexx-command-auto-upper is t, set all REXX commands to uppercase.
  521. If it is non-nil and not t, capitalize commands."
  522.   (interactive "P")
  523.   (if (not arg)
  524.       (progn
  525.     (rexx-do-auto-upper)
  526.     (rexx-indent-line)))
  527.   (if arg
  528.       (setq arg (prefix-numeric-value arg))
  529.     (setq arg 1))
  530.   (while (> arg 0)
  531.     (newline)
  532.     (setq arg (1- arg)))
  533.   (rexx-indent-line))
  534.  
  535.  
  536. (defun electric-rexx-do (arg)
  537.   "Insert 'do' and correct line's indentation."
  538.   (interactive "P")
  539.   (if (and (not arg)
  540.        (eolp))
  541.       (progn
  542.     (if (= (char-syntax (preceding-char)) ?\w)
  543.         (let ((last-command-char ?\ ))
  544.           (electric-rexx-space nil)))
  545.     (insert "do")
  546.     (rexx-do-auto-upper))
  547.     (self-insert-command (prefix-numeric-value arg))))
  548.  
  549.  
  550. (defun electric-rexx-end (arg)
  551.   "Insert 'end' and correct line's indentation.\n
  552. Blink 'do' if blink-matching-paren is non-nil."
  553.   (interactive "P")
  554.   (if (and (not arg)
  555.        (eolp))
  556.       (progn
  557.     (if (= (char-syntax (preceding-char)) ?\w)
  558.         (let ((last-command-char ?\ ))
  559.           (electric-rexx-space nil)))
  560.     (insert "end")
  561.     (rexx-do-auto-upper)
  562.     (rexx-indent-line)
  563.     (if blink-matching-paren
  564.         (save-excursion
  565.           (if (rexx-backward-sexp)
  566.           (sit-for 1)))))
  567.     (self-insert-command (prefix-numeric-value arg))))
  568.  
  569.  
  570. (defun electric-rexx-colon (arg)
  571.   "Insert colon and correct line's indentation."
  572.   (interactive "P")
  573.   (let ((here (point))
  574.     (state (parse-partial-sexp (point-min) (point)))
  575.     remainder)
  576.     (if (and
  577.      (not arg)
  578.      (eolp)
  579.      (not (nth 4 state)))
  580.     (progn
  581.       (save-excursion
  582.         (beginning-of-line)
  583.         (skip-chars-forward " \t")
  584.         (skip-chars-forward "a-zA-Z0-9_")
  585.         (setq remainder (upcase (buffer-substring (point) here))))
  586.       (cond
  587.        ((string= remainder "")
  588.         (let ((hold (copy-marker (point))))
  589.           (save-excursion
  590.         (beginning-of-line)
  591.         (delete-horizontal-space)
  592.         (if (and rexx-auto-build-procedure-table
  593.              (not (= (following-char) ?_)))
  594.             (rexx-add-to-procedure-table (buffer-substring (point) hold)))
  595.         (let* ((here (point))
  596.                (state (rexx-get-state (rexx-beginning-of-procedure) here)))
  597.           (if (car (cdr state))
  598.               (progn
  599.             (if (or (not rexx-warn-illegal-line-label)
  600.                 (= (following-char) ?_))
  601.                 (message "Label name within DO/END block. This may not work correctly.  See SIGNAL doc.")
  602.               (message "Label name within DO/END block. Non-procedure names should start with '_'."))
  603.             (beep)))))
  604.           (self-insert-command 1)))
  605.        ((string= remainder ":")
  606.         (insert " PROCEDURE"))
  607.        ((string= remainder ": PROCEDURE")
  608.         (insert " EXPOSE"))
  609.        ((string= remainder ": PROCEDURE EXPOSE")
  610.         (insert " ")
  611.         (insert rexx-expose-string))
  612.        (t
  613.         (self-insert-command 1))))
  614.       (self-insert-command (prefix-numeric-value arg)))))
  615.  
  616. (defun rexx-inside-parens-p ()
  617.   (condition-case ()
  618.       (save-excursion
  619.     (save-restriction
  620.       (narrow-to-region (point)
  621.                 (progn (rexx-beginning-of-procedure) (point)))
  622.       (goto-char (point-max))
  623.       (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
  624.     (error nil)))
  625.  
  626.  
  627. (defun rexx-indent-command (&optional whole-exp)
  628.   "Indent current line as REXX code, or in some cases insert a tab character.
  629. If `rexx-tab-always-indent' is non-nil (the default), always indent current
  630. line.  Otherwise, indent the current line only if point is at the left margin
  631. or in the line's indentation; otherwise insert a tab.
  632. A numeric argument, regardless of its value, means always indent line."
  633.   (interactive "P")
  634.   (rexx-do-auto-upper)
  635.   (if whole-exp
  636.       ;; If arg, always indent this line as C
  637.       ;; and shift remaining lines of expression the same amount.
  638.       (let ((shift-amt (rexx-indent-line))
  639.         beg end)
  640.     (save-excursion
  641.       (if rexx-tab-always-indent
  642.           (beginning-of-line))
  643.       ;; Find beginning of following line.
  644.       (save-excursion
  645.         (forward-line 1) (setq beg (point)))
  646.       ;; Find first beginning-of-sexp for sexp extending past this line.
  647.       (while (< (point) beg)
  648.         (rexx-forward-sexp 1)
  649.         (setq end (point))
  650.         (skip-chars-forward " \t\n")))
  651.     (if (> end beg)
  652.         (indent-code-rigidly beg end shift-amt "#")))
  653.     (if (and (not rexx-tab-always-indent)
  654.          (save-excursion
  655.            (skip-chars-backward " \t")
  656.            (not (bolp))))
  657.     (insert-tab)
  658.       (rexx-indent-line))))
  659.  
  660.  
  661. (defun rexx-indent-line ()
  662.   "Indent current line as REXX code.
  663. Return the amount the indentation changed by."
  664.   (let ((indent (calculate-rexx-indent))
  665.     beg shift-amt
  666.     (case-fold-search t)
  667.     (pos (- (point-max) (point))))
  668.     (beginning-of-line)
  669.     (setq beg (point))
  670.     (cond ((eq indent nil)
  671.        (setq indent (current-indentation)))
  672.       ((eq indent t)
  673.        (setq indent (calculate-rexx-indent-within-comment)))
  674.       (t
  675.        (skip-chars-forward " \t")
  676.        (cond ((or
  677.            (and (looking-at "when\\b")
  678.             (not (looking-at "when\\s_")))
  679.            (and (looking-at "otherwise\\b")
  680.             (not (looking-at "otherwise\\s_"))))
  681.           (setq indent
  682.             (+
  683.              (save-excursion
  684.                (goto-char (rexx-start-of-block))
  685.                (rexx-forward-sexp -1 t)
  686.                (rexx-back-to-indentation))
  687.              rexx-when-offset)))
  688.          ((and (looking-at "else\\b")
  689.                (not (looking-at "else\\s_")))
  690.           (setq indent (save-excursion
  691.                  (rexx-backward-to-start-of-if)
  692.                  (current-indentation))))
  693.          ((and (looking-at "do\\b")
  694.                (save-excursion
  695.              (end-of-line 0)
  696.              (rexx-forward-sexp -1 t)
  697.              (and (looking-at "\\(then\\|\\else\\|otherwise\\)\\b"))))
  698.           (setq indent (+ indent rexx-do-offset))))))
  699.     (skip-chars-forward " \t")
  700.     (setq shift-amt (- indent (current-column)))
  701.     (if (zerop shift-amt)
  702.     (if (> (- (point-max) pos) (point))
  703.         (goto-char (- (point-max) pos)))
  704.       (delete-region beg (point))
  705.       (indent-to indent)
  706.       ;; If initial point was within line's indentation,
  707.       ;; position after the indentation.  Else stay at same point in text.
  708.       (if (> (- (point-max) pos) (point))
  709.       (goto-char (- (point-max) pos))))
  710.     shift-amt))
  711.  
  712.  
  713. (defun calculate-rexx-indent ()
  714.   "Return appropriate indentation for current line as REXX code.
  715. In usual case returns an integer: the column to indent to.
  716. Returns nil if line starts inside a string, t if in a comment."
  717.   (save-excursion
  718.     (catch 'break
  719.       (beginning-of-line)
  720.       (let ((indent-point (point))
  721.         (case-fold-search t)
  722.         (start-of-prev (save-excursion
  723.                  (rexx-backward-to-noncomment (point-min) t)
  724.                  (rexx-start-of-line)))
  725.         state
  726.         temp
  727.         top-is-procedure
  728.         parse-start
  729.         calced-container
  730.         containing-sexp)
  731.     (rexx-beginning-of-procedure)
  732.     (if (looking-at "[a-z][a-z_0-9]*:")
  733.         (setq top-is-procedure t))
  734.     (if (>= (point) indent-point)
  735.         (throw 'break nil)
  736.       (setq parse-start (point))
  737.       (setq state (rexx-get-state (point) indent-point))
  738.       (setq containing-sexp (car (cdr state)))
  739.       (setq calced-container t)
  740.       (if (or (nth 3 state) (nth 4 state))
  741.           (throw 'break (nth 4 state))))
  742.     (cond 
  743.      ((looking-at "[ \t]*[a-z_][a-z_0-9]*:")
  744.          0)
  745.      ;; See if this is a continuation line
  746.      ((save-excursion
  747.         (end-of-line 0)
  748.         (eq (preceding-char) ?\,))
  749.       (+ (save-excursion
  750.            (goto-char start-of-prev)
  751.            (current-column))
  752.          rexx-continued-statement-offset))
  753.      ;; See if line is after a label
  754.      ((and (null containing-sexp)
  755.            (or
  756.         (cond
  757.          ((and (looking-at "[ \t]*\\(return\\|\\exit\\)\\b")
  758.                (<= (point)
  759.                (rexx-start-of-unenclosed-block)))
  760.           rexx-return-indent)
  761.          ((save-excursion
  762.             (rexx-backward-to-noncomment parse-start t)
  763.             (beginning-of-line)
  764.             (looking-at "[a-z][a-z_0-9]*:"))
  765.           (if (or (looking-at "[ \t]*arg[ \t]")
  766.               (looking-at "[ \t]*parse[ \t]"))
  767.               rexx-procedure-arg-indent-level
  768.             rexx-procedure-indent-level))
  769.          ((and top-is-procedure
  770.                (save-excursion
  771.              (rexx-backward-to-noncomment (or parse-start (point-min)) t)
  772.              (beginning-of-line)
  773.              (and
  774.               (looking-at "[ \t]*\\(arg\\|parse\\)[ \t]")
  775.               (progn
  776.                 (rexx-backward-to-noncomment (or parse-start (point-min)) t)
  777.                 (beginning-of-line)
  778.                 (looking-at "[a-z][a-z_0-9]*:")))))
  779.           rexx-procedure-indent-level)))))
  780.      ((looking-at "[ \t]*end\\b")
  781.       (goto-char (or containing-sexp
  782.              (rexx-calc-container)))
  783.       (+ (rexx-back-to-indentation) rexx-end-offset))
  784.      (t
  785.       ;; Statement level.  Is it a continuation or a new statement?
  786.       ;; Find previous non-comment character.
  787.       (if containing-sexp
  788.           (setq parse-start containing-sexp)
  789.         (or parse-start (setq parse-start (point-min))))
  790.       (rexx-backward-to-noncomment parse-start t)
  791.       (rexx-forward-sexp -1 t)
  792.          
  793.       ;; Now let's see what we're looking at
  794.       (cond
  795.        ((looking-at "\\(then\\|\\else\\|otherwise\\)\\b")
  796.         (goto-char start-of-prev)
  797.         (+ (current-column)
  798.            rexx-indent-level))
  799.        ((progn
  800.           (goto-char start-of-prev)
  801.           (save-excursion
  802.         (rexx-backward-to-noncomment)
  803.         (bobp)))
  804.         nil)
  805.        ((or (looking-at "[a-z][a-z_0-9]*:")
  806.         (<= (point) parse-start))
  807.         (+ (current-column) rexx-indent-level))
  808.        (t
  809.         (goto-char start-of-prev)
  810.         (goto-char (rexx-start-of-unenclosed-block))
  811.         (rexx-back-to-indentation)))))))))
  812.  
  813.  
  814. (defun rexx-calc-container ()
  815.   (if calced-container
  816.       containing-sexp
  817.     (setq calced-container t)
  818.     (setq containing-sexp
  819.       (save-excursion
  820.         (goto-char (rexx-start-of-block))
  821.         (cond ((looking-at "^[a-z][a-z_0-9]*:")
  822.            nil)
  823.           ((save-excursion
  824.              (rexx-forward-sexp -1 t)
  825.              (looking-at "\\(select\\|do\\)\\b"))
  826.            (rexx-forward-sexp -1 t)))))))
  827.  
  828.  
  829. (defun rexx-start-of-unenclosed-block (&optional parse-start)
  830.   (save-excursion
  831.     (or parse-start (setq parse-start (point-min)))
  832.     (let (temp)
  833.       (while
  834.       (progn
  835.         (beginning-of-line)
  836.         (setq temp (point))
  837.         (rexx-backward-to-noncomment parse-start t)
  838.         (forward-sexp -1)
  839.         (and (looking-at "\\(then\\|\\else\\|otherwise\\)\\b")
  840.          (> (rexx-start-of-line) parse-start))))
  841.       (goto-char (rexx-start-of-line temp)))))
  842.  
  843. (defun rexx-back-to-indentation ()
  844.   (back-to-indentation)
  845.   (current-column))
  846.  
  847. (defun rexx-start-of-line (&optional from)
  848.   (if from
  849.       (goto-char from))
  850.   (if (bobp)
  851.       (rexx-forward-to-noncomment)
  852.     (save-excursion
  853.       (end-of-line)
  854.       (let (botl botw)
  855.     (while
  856.         (and
  857.          (not (bobp))
  858.          (or
  859.           (progn
  860.         (setq botl (save-excursion (beginning-of-line)
  861.                        (rexx-back-to-indentation)
  862.                        (point)))
  863.         (setq botw -1)
  864.         (while (> (point) botl)
  865.           (setq botw (point))
  866.           (rexx-forward-sexp -1 t)
  867.           (if (= botw (point))
  868.               (goto-char (point-min))))
  869.         (if (= (point) botl)
  870.             (if
  871.             (save-excursion
  872.               (end-of-line 0)
  873.               (eq (preceding-char) ?\,))
  874.             (progn
  875.               (end-of-line 0)
  876.               t))
  877.           t)))))
  878.     (if (bobp)
  879.         (rexx-forward-to-noncomment)
  880.       botl)))))
  881.  
  882.  
  883. (defun calculate-rexx-indent-within-comment (&optional after-star)
  884.   "Return the indentation amount for line inside a block comment.
  885. Optional arg AFTER-STAR means, if lines in the comment have a leading star,
  886. return the indentation of the text that would follow this star."
  887.   (let (end star-start)
  888.     (save-excursion
  889.       (beginning-of-line)
  890.       (skip-chars-forward " \t")
  891.       (setq star-start (= (following-char) ?\*))
  892.       (skip-chars-backward " \t\n")
  893.       (setq end (point))
  894.       (beginning-of-line)
  895.       (skip-chars-forward " \t")
  896.       (if after-star
  897.       (and (looking-at "\\*")
  898.            (re-search-forward "\\*[ \t]*")))
  899.       (and (re-search-forward "/\\*[ \t]*" end t)
  900.        star-start
  901.        (not after-star)
  902.        (goto-char (1+ (match-beginning 0))))
  903.       (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\*))
  904.       (1+ (current-column))
  905.     (current-column)))))
  906.  
  907.  
  908. (defun rexx-backward-to-noncomment (&optional lim ignore-line-labels)
  909.   (or lim (setq lim (point-min)))
  910.   (let (opoint stop)
  911.     (while (not stop)
  912.       (setq opoint (point))
  913.       (skip-chars-backward " \t\n\f;:" lim)
  914.       (if ignore-line-labels
  915.       (if (save-excursion
  916.         (beginning-of-line)
  917.         (looking-at "_[a-z_0-9]*:"))
  918.         (beginning-of-line)))
  919.       (while (and (>= (point) (+ 2 lim))
  920.           (progn
  921.             (save-excursion
  922.               (forward-char -2)
  923.               (looking-at "\\*/"))))
  924.     (search-backward "/*" lim 'move))
  925.       (setq stop (or (<= (point) lim)
  926.              (= (point) opoint)))))
  927.   (point))
  928.  
  929. (defun rexx-forward-to-noncomment (&optional lim ignore-line-labels)
  930.   (or lim (setq lim (point-max)))
  931.   (let (opoint stop)
  932.     (while (not stop)
  933.       (setq opoint (point))
  934.       (skip-chars-forward " \t\n\f;:" lim)
  935.       (if ignore-line-labels
  936.       (while (looking-at "_[a-z_0-9]*:")
  937.         (rexx-forward-sexp)))
  938.       (while (and (<= (point) (+ 2 lim))
  939.           (looking-at "/\\*"))
  940.     (search-forward "*/" lim 'move))
  941.       (setq stop (or (>= (point) lim)
  942.              (= (point) opoint)))))
  943.   (point))
  944.  
  945. (defun rexx-looking-at-ignore-whitespace (str &optional lim ignore-line-labels)
  946.   (save-excursion
  947.     (rexx-forward-to-noncomment lim ignore-line-labels)
  948.     (looking-at str)))
  949.  
  950. (defun rexx-backward-to-start-of-if (&optional limit)
  951.   "Move to the start of the last \"unbalanced\" `if'."
  952.   (or limit (setq limit (save-excursion (rexx-beginning-of-procedure) (point))))
  953.   (let ((if-level 1)
  954.     (case-fold-search t))
  955.     (while (and (not (bobp)) (not (zerop if-level)))
  956.       (rexx-backward-sexp)
  957.       (cond ((looking-at "else\\b")
  958.          (setq if-level (1+ if-level)))
  959.         ((looking-at "if\\b")
  960.          (setq if-level (1- if-level)))
  961.         ((< (point) limit)
  962.          (setq if-level 0)
  963.          (goto-char limit))))))
  964.  
  965.  
  966. (defun mark-rexx-procedure ()
  967.   "Put mark at end of REXX procedure, point at beginning."
  968.   (interactive)
  969.   (push-mark (point))
  970.   (rexx-end-of-procedure)
  971.   (let ((where (point)))
  972.     (rexx-beginning-of-procedure)
  973.     (push-mark where nil t)))
  974.  
  975.  
  976. (defun rexx-start-of-block ()
  977.   "Find start of the block containing point."
  978.   (interactive)
  979.   (save-excursion
  980.     (let ((from (point)))
  981.       (while (and (not (bobp))
  982.           (not (looking-at "^[a-z][a-z_0-9]*:"))
  983.           (progn
  984.             (condition-case nil
  985.             (rexx-forward-sexp -1)
  986.               (error
  987.                (if (save-excursion
  988.                  (rexx-forward-sexp -1 t)
  989.                  (not (looking-at "\\(do\\|select\\)\\b")))
  990.                (rexx-forward-sexp -1 t)))))
  991.           (not (= from (point))))
  992.     (setq from (point)))
  993.       (point))))
  994.  
  995.  
  996. (defun rexx-indent-sexp ()
  997.   "Reindent the current block of REXX."
  998.   (interactive)
  999.   (save-excursion
  1000.     (if
  1001.     (save-excursion
  1002.       (skip-chars-forward "^\"'\n")
  1003.       (or (= (following-char) ?')
  1004.           (= (following-char) ?\")))
  1005.     (beginning-of-line 2))
  1006.     (let ((from (rexx-start-of-block)) to)
  1007.       (goto-char from)
  1008.       (cond ((looking-at "^[a-z][a-z_0-9]*:")
  1009.          (rexx-end-of-procedure)
  1010.          (setq to (point)))
  1011.         ((save-excursion
  1012.            (rexx-forward-sexp -1 t)
  1013.            (looking-at "\\(select\\|do\\)\\b"))
  1014.          (rexx-forward-sexp -1 t)
  1015.          (rexx-forward-sexp 1)
  1016.          (setq to (point)))
  1017.         (t
  1018.          (setq from (point-min))
  1019.          (setq to (point-max))))
  1020.       (rexx-indent-region from to))))
  1021.  
  1022.  
  1023. (defun rexx-indent-region (start end)
  1024.   "Indent every line whose first char is between START and END inclusive."
  1025.   (interactive "r")
  1026.   (save-excursion
  1027.     (condition-case nil
  1028.     (progn
  1029.       (goto-char start)
  1030.       ;; Advance to first nonblank line.
  1031.       (skip-chars-forward " \t\n")
  1032.       (beginning-of-line)
  1033.       (let ((rexx-tab-always-indent t)
  1034.         (endmark (copy-marker end))
  1035.         line last moved)
  1036.         (if (> (- end start) 1000)
  1037.         (progn
  1038.           (setq line 0)
  1039.           (setq last (count-lines start end))))
  1040.         (while (< (point) endmark)
  1041.           (cond ((looking-at "[ \t]*/\\*")
  1042.              (let ((here (point)))
  1043.                (rexx-forward-to-noncomment)
  1044.                (setq moved (1- (count-lines here (point))))
  1045.                (if (= moved 0)
  1046.                (progn
  1047.                  (beginning-of-line 2)
  1048.                  (setq moved 1)))))
  1049.             ((looking-at "[ \t]*\n")
  1050.              (forward-line)
  1051.              (setq moved 1))
  1052.             (t
  1053.              (rexx-indent-line)
  1054.              (forward-line)
  1055.              (setq moved 1)))
  1056.           (if line
  1057.           (progn
  1058.             (setq line (+ line moved))
  1059.             (message "Line %d of %d" line last))))
  1060.         (message "Done.")))
  1061.       (error
  1062.        (beep)
  1063.        (message "Parsing error around line %d" (count-lines (point-min) (point)))))))
  1064.  
  1065.  
  1066. (defun rexx-capitalize-sexp ()
  1067.   "Recapitalize the current block of REXX."
  1068.   (interactive)
  1069.   (save-excursion
  1070.     (if
  1071.     (save-excursion
  1072.       (skip-chars-forward "^\"'\n")
  1073.       (or (= (following-char) ?')
  1074.           (= (following-char) ?\")))
  1075.     (beginning-of-line 2))
  1076.     (let ((from (rexx-start-of-block)) to)
  1077.       (goto-char from)
  1078.       (cond ((looking-at "^[a-z][a-z_0-9]*:")
  1079.          (rexx-end-of-procedure)
  1080.          (setq to (point)))
  1081.         ((save-excursion
  1082.            (rexx-forward-sexp -1 t)
  1083.            (looking-at "\\(select\\|do\\)\\b"))
  1084.          (rexx-forward-sexp -1 t)
  1085.          (rexx-forward-sexp 1)
  1086.          (setq to (point)))
  1087.         (t
  1088.          (setq from (point-min))
  1089.          (setq to (point-max))))
  1090.       (rexx-capitalize-region from to))))
  1091.  
  1092.  
  1093. (defun rexx-capitalize-region (start end)
  1094.   "Correctly capitalize every command or function whose first char is between
  1095. START and END inclusive."
  1096.   (interactive "r")
  1097.   (let ((total (- end start))
  1098.     (rexx-warn-illegal-line-label nil))
  1099.     (save-excursion
  1100.       (goto-char start)
  1101.       (while (and (forward-word 1)
  1102.           (<= (point) end))
  1103.     (message "Scanned %d of %d characters." (- (point) start) total)
  1104.     (rexx-do-auto-upper))
  1105.       (message "Scanned %d characters." total))))
  1106.       
  1107.  
  1108.  
  1109. (defun set-rexx-style (style &optional global)
  1110.   "Set REXX-mode variables to use one of several different indentation styles.
  1111. The arguments are a string representing the desired style
  1112. and a flag which, if non-nil, means to set the style globally.
  1113. \(Interactively, the flag comes from the prefix argument.)
  1114. Available styles are Maxwell, Cowlishaw and Wide."
  1115.   (interactive (list (completing-read "Use which REXX indentation style? "
  1116.                                       rexx-style-alist nil t)
  1117.              current-prefix-arg))
  1118.   (let ((vars (cdr (assoc style rexx-style-alist))))
  1119.     (or vars
  1120.     (error "Invalid REXX indentation style `%s'" style))
  1121.     (while vars
  1122.       (or global
  1123.       (make-local-variable (car (car vars))))
  1124.       (set (car (car vars)) (cdr (car vars)))
  1125.       (setq vars (cdr vars)))))
  1126.  
  1127.  
  1128.  
  1129. (defmacro sign (count)
  1130.   (list 'max -1 (list 'min 1 count)))
  1131.  
  1132. (defun rexx-forward-sexp (&optional count noerr)
  1133.   "REXX mode replacement for forward-sexps so it will recognize DO/END pairs."
  1134.   (interactive "p")
  1135.   (or count (setq count 1))
  1136.   (if (= count 0)
  1137.       (setq count 1))
  1138.   (let ((parse-sexp-ignore-comments t)    ;always ignore comments
  1139.     (dir (sign count))        ;dir should be either 1 or -1
  1140.     hold)                ;this will track the current retval
  1141.     (while (/= count 0)            ;we have to loop here, not in old func.
  1142.       (setq count (- count dir))
  1143.       (if (> dir 0)            ;pick a direction and scan once
  1144.       (setq hold (rexx-scan-forward-sexp (point) noerr))
  1145.     (setq hold (rexx-scan-backward-sexp (point) noerr)))
  1146.       (if (not hold)            ;if we got nil, bail out
  1147.       (setq count 0)))
  1148.     (if hold
  1149.     (goto-char hold))))
  1150.  
  1151. (defun rexx-backward-sexp (&optional arg noerr)
  1152.   "REXX mode replacement for forward-sexps so it will recognize DO/END pairs."
  1153.   (interactive "p")
  1154.   (or arg (setq arg 1))
  1155.   (rexx-forward-sexp (- arg) noerr))
  1156.  
  1157.  
  1158. (defun rexx-scan-sexps (from count &optional noerr)
  1159.   (if noerr
  1160.       (condition-case nil
  1161.       (or (scan-sexps from count)
  1162.           (if (> count 0)
  1163.           (save-excursion
  1164.             (goto-char from)
  1165.             (beginning-of-line 2)
  1166.             (point))
  1167.         nil))
  1168.     (error
  1169.      (save-excursion
  1170.        (if (> count 0)
  1171.            (re-search-forward "\\(\\s\"\\|\\s\(\\)")
  1172.          (re-search-backward "\\(\\s\"\\|\\s\(\\)"))
  1173.        (point))))
  1174.     (or (scan-sexps from count)
  1175.     (if (> count 0)
  1176.         (save-excursion
  1177.           (goto-char from)
  1178.           (beginning-of-line 2)
  1179.           (point))
  1180.       nil))))
  1181.  
  1182. (defun rexx-scan-forward-sexp (from &optional noerr)
  1183.   ;;get simple value from old func.
  1184.   (save-excursion
  1185.     (goto-char from)
  1186.     (cond ((and (not noerr)
  1187.         (rexx-looking-at-ignore-whitespace "end\\b"))
  1188.        (error "Block ends prematurely"))
  1189.       ((not
  1190.         (rexx-looking-at-ignore-whitespace "\\(select\\|do\\)\\b"))
  1191.        (rexx-scan-sexps from 1 noerr)) ;if this isn't 'do', return scan-sexps
  1192.       ;;if 'do' or 'select', skip to matching 'end'
  1193.       (t
  1194.        (let ((depth 1))
  1195.          (while (and (> depth 0)
  1196.              (not (eobp)))
  1197.            (goto-char (rexx-scan-sexps (point) 1 t))
  1198.            (cond ((rexx-looking-at-ignore-whitespace "\\(select\\|do\\)\\b")
  1199.               (setq depth (1+ depth)))
  1200.              ((rexx-looking-at-ignore-whitespace "end\\b")
  1201.               (setq depth (1- depth))))))
  1202.        (if (eobp)
  1203.            (if noerr
  1204.            nil
  1205.          (error "Containing message ends prematurely"))
  1206.          (goto-char (scan-sexps (point) 1))
  1207.          (point))))))
  1208.  
  1209. (defun rexx-scan-backward-sexp (from &optional noerr)
  1210.   (save-excursion
  1211.     (let (hold last)
  1212.       ;;get simple value from old func.
  1213.       (setq hold (rexx-scan-sexps from -1 noerr))
  1214.       (if (not hold)            ;if old func returned nil, bail out
  1215.       ()
  1216.     (goto-char hold)
  1217.     (cond
  1218.      ;;are we trying to back out of a sexp illegally
  1219.      ((and (not noerr)
  1220.            (looking-at "\\(select\\|do\\)\\b"))
  1221.       (error "Block ends prematurely"))
  1222.      ;;see if we just skipped over 'end'; if not, return hold
  1223.      ((looking-at "end\\b")
  1224.       ;;if so, skip to matching 'do'
  1225.       (let ((depth 1))
  1226.         (while (> depth 0)
  1227.           (goto-char (scan-sexps (point) -1))
  1228.           (cond ((looking-at "\\(select\\|do\\)\\b")
  1229.              (setq depth (1- depth)))
  1230.             ((looking-at "end\\b")
  1231.              (setq depth (1+ depth))))))
  1232.       (setq hold (point)))
  1233.     ;;if we're not looking at anything special, just return hold
  1234.      (t hold))))))
  1235.  
  1236. (defun rexx-beginning-of-procedure ()
  1237.   "Move backward to the beginning of a REXX procedure or
  1238. to the top if point is not in a procedure.  Returns t.
  1239.  
  1240. A REXX procedure begins with a label followed by ':' i.e.
  1241. main:
  1242.  
  1243. Unfortunately, there is no distinction in REXX between the
  1244. beginning of a procedure and a line label.  Since line labels
  1245. are rarely used in REXX, I have adopted the convention that
  1246. a label preceeded by a '_' (i.e. '_aack:') is a line label,
  1247. anything else is a procedure label."
  1248.   (interactive)
  1249.   (if (not (bolp))
  1250.       (progn
  1251.     (beginning-of-line)
  1252.     (condition-case nil
  1253.         (forward-sexp 1)
  1254.       (error nil))))
  1255.   (condition-case nil
  1256.       (forward-sexp -1)
  1257.     (error nil))
  1258.   (re-search-backward "^[a-z][a-z_0-9]*:" nil 1)
  1259.   (point))
  1260.  
  1261.  
  1262. (defun rexx-end-of-procedure ()
  1263.   "Move forward to the end of a REXX procedure.  Returns t.
  1264.  
  1265. Since there is no definitive marker for the end of a procedure,
  1266. rexx-mode will assume that the current procedure ends before the
  1267. next one begins.  This is not always true but should usually
  1268. result in correct formatting anyway. (I hope-:)"
  1269.   (interactive)
  1270.   (condition-case nil
  1271.       (forward-sexp 1)
  1272.     (error nil))
  1273.   (if (re-search-forward "^[a-z][a-z_0-9]*:" nil 1)
  1274.       (condition-case nil
  1275.       (forward-sexp -2)
  1276.     (error nil)))
  1277.   (forward-line 1)
  1278.   (point))
  1279.  
  1280.  
  1281. (defun rexx-get-state (from to)
  1282.   "Parse REXX syntax starting at FROM until TO; return status of parse at TO.
  1283. Parsing stops at TO or when certain criteria are met;
  1284. Point is set to where parsing stops.
  1285. Parsing assumes that FROM is the beginning of a function.
  1286. Value is a list of eight elements describing final state of parsing:
  1287.  0. depth in parens.
  1288.  1. character address of start of innermost containing block; nil if none.
  1289.  2. character address of start of last complete block terminated.
  1290.  3. non-nil if inside a string.
  1291.     (it is the character that will terminate the string.)
  1292.  4. t if inside a comment.
  1293.  5. t if following a quote character.
  1294.  6. the minimum paren-depth encountered during this scan.
  1295.  7. t if in a comment of style `b'.
  1296.  
  1297. arguments: (from to)"
  1298.   (let (state
  1299.     stack
  1300.     (next from)
  1301.     (depth 0))
  1302.     (save-excursion
  1303.       (goto-char from)
  1304.       (setq state (parse-partial-sexp from to -1))
  1305.       (or (nth 3 state)
  1306.       (nth 4 state)
  1307.       (progn
  1308.         (goto-char to)
  1309.         (setq stack (rexx-start-of-block))
  1310.         (if (= stack from)
  1311.         (setq state nil)
  1312.           (if (car state)
  1313.           (setcar (cdr state) (scan-sexps stack -1)))))))
  1314.     (goto-char to)
  1315.     state))
  1316.        
  1317.  
  1318. (defun rexx-do-auto-upper (&optional arg)
  1319.   (interactive "P")
  1320.   (if (or (not (= (char-syntax (preceding-char)) ?w))
  1321.       (and (not rexx-command-auto-upper)
  1322.            (not rexx-external-function-auto-capitilize)))
  1323.       ()
  1324.     (let* ((to (point))
  1325.        (state (rexx-get-state (rexx-beginning-of-procedure) to))
  1326.        lookfunc)
  1327.       (if (nth 4 state)
  1328.       ()
  1329.     (setq lookfunc
  1330.           (or (and
  1331.            (char-or-string-p last-command-char)
  1332.            (= last-command-char ?\())
  1333.           (= (following-char) ?\()
  1334.           (save-excursion
  1335.             (and
  1336.              (condition-case nil
  1337.              (progn
  1338.                (forward-sexp -2)
  1339.                t)
  1340.                (error nil))
  1341.              (and
  1342.               (looking-at "call[ \t]+\\w")
  1343.               (not (looking-at "call[ \t]+\\(on\\|off\\)\\b")))))))
  1344.     (let* ((from
  1345.         (condition-case nil
  1346.             (scan-sexps (point) -1)
  1347.           (error to)))
  1348.            (word (downcase (buffer-substring from to)))
  1349.            (pmark (copy-marker (point)))
  1350.            comm
  1351.            scan
  1352.            scanstr
  1353.            precap)
  1354.       (if (and
  1355.            rexx-command-auto-upper
  1356.            (not (nth 3 state))
  1357.            (setq precap (assoc word rexx-command-table)))
  1358.           (progn
  1359.         (setq comm (or
  1360.                 (null (elt precap 2))
  1361.                 (and
  1362.                  (integerp (string-match "mm" (elt precap 2)))
  1363.                  (or
  1364.                   (not (setq scan (string-match " *sub-command" (elt precap 2))))
  1365.                   (save-excursion
  1366.                 (setq scanstr (substring (elt precap 2) (string-match "[a-z/A-Z]+ +sub-command" (elt precap 2)) scan))
  1367.                 (while
  1368.                     (setq scan (string-match "/" scanstr))
  1369.                   (setq scanstr (concat (substring scanstr  0 scan) "\\|" (substring scanstr (1+ scan)))))
  1370.                 (beginning-of-line)
  1371.                 (re-search-forward scanstr from t))))))
  1372.         (if (and comm
  1373.              lookfunc
  1374.              (elt precap 2)
  1375.              (not (string-match "function" (elt precap 2))))
  1376.             (setq lookfunc nil))
  1377.         (cond ((or (and
  1378.                 (eq rexx-command-auto-upper t)
  1379.                 (or lookfunc comm))
  1380.                (and
  1381.                 (> rexx-command-auto-upper 1)
  1382.                 (not lookfunc)
  1383.                 comm))
  1384.                (upcase-region from to)
  1385.                (rexx-do-super-completion precap))
  1386.               ((or
  1387.             lookfunc
  1388.             (and
  1389.              (eq rexx-command-auto-upper 1)
  1390.              comm))
  1391.                (if (stringp (car (cdr precap)))
  1392.                (progn
  1393.                  (goto-char from)
  1394.                  (delete-region from to)
  1395.                  (insert-before-markers (car (cdr precap)))
  1396.                  (goto-char pmark))
  1397.              (capitalize-region from to))
  1398.                (rexx-do-super-completion precap))))
  1399.         (if (and rexx-external-function-auto-capitilize
  1400.              (setq precap (assoc word rexx-user-procedure-table))
  1401.              (or arg
  1402.              (if (and (nth 3 state)
  1403.                   (= (char-syntax (char-after (1- from))) ?\"))
  1404.                  (elt precap 4)
  1405.                (and (null (elt precap 4))
  1406.                 lookfunc))))
  1407.         (progn
  1408.           (if (stringp (car (cdr precap)))
  1409.               (progn
  1410.             (goto-char from)
  1411.             (delete-region from to)
  1412.             (insert-before-markers (car (cdr precap)))
  1413.             (goto-char pmark))
  1414.             (capitalize-region from to))
  1415.           (if rexx-developing-mode-docs
  1416.               (setq precap (assoc word rexx-external-function-table)))
  1417.           (rexx-do-super-completion precap))))
  1418.       (if (and
  1419.            rexx-warn-illegal-line-label
  1420.            (not lookfunc)
  1421.            (save-excursion
  1422.          (and
  1423.           (condition-case nil
  1424.               (progn
  1425.             (forward-sexp -2)
  1426.             t)
  1427.             (error nil))
  1428.           (looking-at "signal[ \t]+\\w")
  1429.           (not (string= word "on"))
  1430.           (not (string= word "off")))))
  1431.           (progn
  1432.         (message "Be sure you put a '_' before all non-procedure names.")
  1433.         (beep))))))))
  1434.  
  1435.  
  1436. (defun rexx-do-super-completion (precap)
  1437.   "If rexx-super-completion-mode is non-nil, point is at eol and
  1438. last-command-char is either \" \" or \"(\" then insert the
  1439. character, execute any commands in (elt precap 5) and, if
  1440. the last-command-char was \"(\", insert \")\""
  1441.   (if (and (elt precap 5)
  1442.        rexx-super-completion-mode
  1443.        (eolp)
  1444.        (char-or-string-p last-command-char)
  1445.        (or
  1446.         (= last-command-char ?\ )
  1447.         (= last-command-char ?\()))
  1448.       (progn
  1449.     (self-insert-command 1)
  1450.     (let ((last-command-char nil))
  1451.       (funcall (eval (elt precap 5))))
  1452.     (if (= last-command-char ?\()
  1453.         (insert ")"))
  1454.     (setq last-command-char nil))))
  1455.  
  1456.  
  1457.  
  1458. (defun rexx-complete-symbol ()
  1459.   "Perform completion on Lisp symbol preceding point.  That symbol is
  1460. compared against the symbols that exist and any additional characters
  1461. determined by what is there are inserted.
  1462.    If the symbol starts just after an open-parenthesis, only symbols
  1463. with function definitions are considered.  Otherwise, all symbols with
  1464. function definitions, values or properties are considered."
  1465.   (interactive)
  1466.   (let* ((end (point))
  1467.      (beg (save-excursion
  1468.         (condition-case nil
  1469.             (backward-sexp 1)
  1470.           (error nil))
  1471.         (while (= (char-syntax (following-char)) ?\')
  1472.           (forward-char 1))
  1473.         (point)))
  1474.      (pattern (downcase (buffer-substring beg end)))
  1475.      (predicate-char
  1476.       (save-excursion
  1477.         (goto-char beg)
  1478.         (preceding-char)))
  1479.      (predicate-char-syntax (char-syntax predicate-char))
  1480.      (predicate
  1481.       (function (lambda (sym)
  1482.               (if (null (elt sym 4))
  1483.               (not (= predicate-char ?\"))
  1484.             (= predicate-char-syntax ?\")))))
  1485.      (completion (try-completion pattern rexx-user-procedure-table predicate)))
  1486.     (cond ((eq completion t)
  1487.        (rexx-do-auto-upper t)
  1488.        (while (get-buffer-window " *Completions*")
  1489.          (delete-window (get-buffer-window " *Completions*"))))
  1490.       ((null completion)
  1491.        (message "Can't find completion for \"%s\"" pattern)
  1492.        (ding))
  1493.       ((not (string= pattern completion))
  1494.        (delete-region beg end)
  1495.        (insert completion)
  1496.        (rexx-do-auto-upper t)
  1497.        (while (get-buffer-window " *Completions*")
  1498.          (delete-window (get-buffer-window " *Completions*"))))
  1499.       (t
  1500.        (message "Making completion list...")
  1501.        (let ((list (all-completions pattern rexx-user-procedure-table predicate)))
  1502.          (with-output-to-temp-buffer " *Completions*"
  1503.            (display-completion-list list)))
  1504.        (message "Making completion list...%s" "done")))))
  1505.  
  1506.  
  1507. (defun rexx-function-at-point()
  1508.   (if (not (or (= (char-syntax (following-char)) ?w)
  1509.            (= (char-syntax (preceding-char)) ?w)))
  1510.       nil
  1511.     (save-excursion
  1512.       (let* ((beg (progn
  1513.             (if (= (char-syntax (preceding-char)) ?w)
  1514.             (backward-sexp 1))
  1515.             (while (= (char-syntax (following-char)) ?\')
  1516.               (forward-char 1))
  1517.             (point)))
  1518.          (end (progn (forward-sexp 1) (point)))
  1519.          (pattern (downcase (buffer-substring beg end)))
  1520.          (precap (assoc pattern rexx-user-procedure-table)))
  1521.     (if precap
  1522.         (if (elt precap 1)
  1523.         (elt precap 1)
  1524.           (car precap)))))))
  1525.   
  1526. (defun rexx-function-help (function)
  1527.   "Display the full documentation of FUNCTION (a symbol)."
  1528.   (interactive
  1529.    (let ((fn (rexx-function-at-point))
  1530.      (enable-recursive-minibuffers t)         
  1531.      val)
  1532.      (setq val
  1533.        (completing-read
  1534.         (if fn
  1535.         (format "Describe function (default %s): " fn)
  1536.           "Describe function: ")
  1537.         rexx-user-procedure-table nil t))
  1538.      (list (if (equal val "")
  1539.            fn val))))
  1540.   (with-output-to-temp-buffer "*Help*"
  1541.     (princ function)
  1542.     (princ ": ")
  1543.     (let* ((var (assoc (downcase function) rexx-user-procedure-table))
  1544.        (doc (elt var 3))
  1545.        (type (elt var 2)))
  1546.       (cond ((assoc (downcase function) rexx-command-table)
  1547.          (if type
  1548.          (princ (format "an internal %s\n" type))
  1549.            (princ "an internal command or function\n")))
  1550.         (type
  1551.          (if rexx-developing-mode-docs
  1552.          (progn
  1553.            (setq var (assoc (downcase function) rexx-external-function-table))
  1554.            (setq doc (elt var 3))
  1555.            (setq type (elt var 2))))
  1556.          (cond ((not (= (char-syntax (string-to-char type)) ?w))
  1557.             (princ (substring type 1))
  1558.             (princ "\n"))
  1559.            ((string-match " " type)
  1560.             (princ type)
  1561.             (princ "\n"))
  1562.            (t
  1563.             (princ (format "an external function from the %s package" type)))))
  1564.         (t
  1565.          (princ "an external command or function\n")))
  1566.       (princ "\n")
  1567.       (if doc
  1568.       (princ doc)
  1569.     (princ "not documented")))))
  1570.  
  1571. (defun rexx-complete-external (desc)
  1572.   "Reads the name of an external function name from the minibuffer
  1573. with completion."
  1574.   (let ((enable-recursive-minibuffers t)         
  1575.     (val
  1576.      (completing-read desc rexx-external-function-table nil nil)))
  1577.     (rexx-capitalize-string val)))
  1578.  
  1579. (defun rexx-capitalize-string (str)
  1580.   "Capitalize string based on rexx-external-function-auto-capitilize."
  1581.   (if rexx-external-function-auto-capitilize
  1582.       (let ((ass (assoc (downcase str) rexx-user-procedure-table)))
  1583.     (if (elt ass 1)
  1584.         (elt ass 1)
  1585.       (capitalize str)))))
  1586.  
  1587. (defun rexx-clear-procedure-table ()
  1588.   "Clears the local procedure table."
  1589.   (interactive)
  1590.   (setq rexx-user-procedure-table rexx-command-and-function-table))
  1591.  
  1592. (defun rexx-build-procedure-table ()
  1593.   "Builds the local procedure table."
  1594.   (interactive)
  1595.   (setq rexx-user-procedure-table nil)
  1596.   (save-excursion
  1597.     (goto-char (point-min))
  1598.     (while (re-search-forward "^[a-z][a-z_0-9]*:" nil t)
  1599.       (rexx-add-to-procedure-table
  1600.        (buffer-substring (match-beginning 0) (1- (match-end 0))))))
  1601.   (eval rexx-build-eval)
  1602.   (setq rexx-user-procedure-table (append rexx-user-procedure-table rexx-command-and-function-table)))
  1603.  
  1604. (defun rexx-add-to-procedure-table (name)
  1605.   "Check the function table for the function name.  If it is not
  1606. there yet, add it."
  1607.   (if (assoc (downcase name) rexx-user-procedure-table)
  1608.       ()
  1609.     (setq rexx-user-procedure-table (cons (list (downcase name) name "User procedure") rexx-user-procedure-table))))
  1610.  
  1611. ;;; rexx-mode.el ends here
  1612.