home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 22 gnu
/
22-gnu.zip
/
rexxmd11.zip
/
rexx-mode.el
< prev
next >
Wrap
Lisp/Scheme
|
1994-07-24
|
54KB
|
1,612 lines
;;; rexx-mode.el --- REXX code editing commands for Emacs
;; Copyright (C) 1994 Scott Maxwell
;; Maintainer: Scott Maxwell - scottmax@netcom.com
;; Keywords: rexx
;;------------------------------------------------------------------------
;;; IMPORTANT NOTE: Since there is no difference between line labels and
;; procedure name labels in REXX, there is no way for
;; rexx-mode to know the difference. Therefore, I have
;; adopted the convention that a '_' preceding a label
;; indicates a line label. Otherwise, it's a procedure
;; name. If you don't precede your line labels with '_',
;; I can't predict what will happen to your formatting.
;;------------------------------------------------------------------------
;; This is a full featured rexx-mode. That means that it should format
;; your REXX code correctly in all cases (except the one mentioned above.)
;; Please let me know if it doesn't.
;; Everyone should probably look at the docs for this as it has detailed
;; information on all rexx-mode features. These include:
;; * indentation styles
;; * command/function name completion
;; * automatic capitalization options
;; * REXX command/function online help
;; * single key DO ('{') and END ('}')
;; * keymaps for going to the start/end of procedures/blocks
;; * keymaps for reindenting procedures/blocks/regions of code
;; Get into REXX mode and do M-x describe-mode for details.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; This REXX mode code began as the EMACS 19.22 build c-mode.el.
;; A smart editing mode for REXX code. It knows a lot about REXX syntax
;; and tries to position the cursor according to REXX layout conventions.
;; You can change the details of the layout style with option variables.
;; It also supports completion, auto-capitalization and REXX function help.
;; Load it and do M-x describe-mode for details.
;; If you want to enable all features of rexx-mode, as well as VX-Rexx
;; support, you can just add these lines to your .emacs:
;;
;; (setq auto-mode-alist (cons '("\\.cmd$" . rexx-mode) auto-mode-alist))
;; (setq auto-mode-alist (cons '("\\.vrx$" . rexx-mode) auto-mode-alist))
;; (setq auto-mode-alist (cons '("\\.vrm$" . rexx-mode) auto-mode-alist))
;; (autoload 'rexx-mode "rexx-mode")
;;
;; (setq rexx-command-auto-upper 2)
;; (setq rexx-external-function-auto-capitilize t)
;; (setq rexx-auto-build-procedure-table t)
;; (setq rexx-super-completion-mode t)
;; (setq rexx-additional-doc-files '("rexx-os2" "vxrexx-doc"))
;; (load "vxrexx-mode")
;; (setq vxrexx-build-master-table t)
;; To autoload, add this to your .emacs file:
;;
;; (setq auto-mode-alist (cons '("\\.cmd$" . rexx-mode) auto-mode-alist))
;; (autoload 'rexx-mode "rexx-mode")
;;
;; If you are not using OS/2, this "\\.cmd$" will probably be
;; something different. If you are using VX-REXX, you might also
;; find it valuable to add "\\.vrx$" and maybe even "\\.vrm$".
;; If you want to take advantage of automatic capitalization, you might
;; also want to add:
;;
;; (setq rexx-command-auto-upper t)
;; (setq rexx-external-function-auto-capitilize t)
;;
;; This will automatically convert all internal commands/functions to
;; uppercase and capitalize all external function names that it knows
;; about. To capitalize instead of uppercasing internal commands/
;; functions, change rexx-command-auto-upper to 1 instead of t.
;; I personally set this to 2 which will uppercase commands and
;; capitalize functions. Function names will only be capitalized
;; when rexx-mode thinks it is appropriate. This means after a
;; CALL or when followed by a '('. It also will not do completion
;; on function names in double quotes(") but will do so in single
;; quotes('). The reason for this is that quoted non-function names
;; may be added to external function expansion tables such as VX-Rexx
;; method and property names. These will only expand after quotes
;; (single or double.) See the rexx-doc.el file for more information.
;;
;; If you want rexx-mode to automatically add new procedures you write
;; to its local expansion table, add:
;; (setq rexx-auto-build-procedure-table t)
;;
;; Then, when you load a rexx file, rexx-mode will automatically scan
;; the file, adding any procedure names it finds to its local table.
;; Also, everytime you hit colon after a procedure name, it will add
;; the new procedure to the table as well. If you want to rebuild this
;; table from scratch, use M-x rexx-build-procedure-table. This is also
;; bound to M-C-Tab by default.
;; If you want to enable very high level completion, add:
;; (setq rexx-super-completion-mode)
;;
;; This will enable command specific completion. For instance, after
;; typing RxFuncAdd, the command specific completion function for
;; RxFuncAdd will kick in and prompt you for the name of the function
;; you want to add and the package it came from, defaulting to the
;; package name it finds in its expansion table if present.
;;
;; Also, you should be aware that both [ESC Tab] and [Ctrl Tab] are
;; mapped to REXX completion. Just type part of the command name and
;; hit one of these combinations and rexx-mode will spit out the rest
;; of the word or a list of choices. You can hit [Ctrl-x 1] to get
;; rid of the completion window.
;;
;; If you want help about any REXX command, try [Ctrl h] [Ctrl f].
;; If you don't plan to use this feature, you can save some memory
;; by using the nodoc completion file. Just add this to your .emacs:
;; (setq rexx-doc-file "rexx-sml")
;;; Code:
(defvar rexx-developing-mode-docs nil
"This should only be true if you are working on doc/completion tables
and you need them to be rebuilt every time you re-evaluate rexx-mode.")
(provide 'rexx-mode)
(defvar rexx-additional-doc-files nil
"*This specifies any additional doc/completion files you would
like loaded. For instance, I have included a completion
file for Watcom VX-Rexx with this package. If you wish to
define your own list, you should define a structure that
looks like this in your .emacs file:
(setq rexx-additional-doc-files '(\"rexx-os2\"
\"vxrexx-doc\"
\"unzipapi-doc\"
\"rxextras-doc\"))")
(defvar rexx-doc-file "rexx-doc"
"*Specifies file to use for REXX documentation and completion.\n
This currently defaults to "rexx-os2". The file "rexx-os2.el"
should have been included with this packet and contains
fairly complete documentation for OS/2 internal and external
commands as well as nicer capitalization for many function
names. If you wish to use stripped down tables to conserve
memory, add
(setq rexx-doc-file \"rexx-sml\")
to you .emacs file. Alternatively, if you wish to replace
this file with your own, add
(setq rexx-doc-file \"my-file\")
or something along those lines to your .emacs.
You can disable this feature altogether with
(setq rexx-doc-file nil)")
(defvar rexx-command-auto-upper nil
"*If this is t, rexx-mode will automatically convert all
REXX command and internal function names to upper case.
If it is 1, it will capitalize. If 2 or higher, it will
capitalize functions and uppercase commands.")
(defvar rexx-external-function-auto-capitilize nil
"*If non-nil, rexx-mode will automagically fix capitalization
for any external functions it knows about.")
(defvar rexx-auto-build-procedure-table nil
"*If non-nil, rexx-mode will automatically build a local table
of procedures defined in the current buffer. These are then
added to the completion table for this buffer.")
(defvar rexx-super-completion-mode nil
"*If non-nill, enables command specific completion functions.")
(defvar rexx-command-table nil
"Table of REXX commands for rexx-command-auto-upper.")
(defvar rexx-external-function-table nil
"Table of REXX external functions for rexx-external-function-auto-capitilize.")
(defconst rexx-user-procedure-table nil
"Table of REXX user procedures defined in the current file. This is
created automatically for each buffer if rexx-auto-build-procedure-table
is non-nil.")
(make-variable-buffer-local 'rexx-user-procedure-table)
(if (or (not rexx-command-table)
rexx-developing-mode-docs)
(progn
(if rexx-developing-mode-docs
(progn
(setq rexx-command-table nil)
(setq rexx-external-function-table nil)
(setq rexx-command-and-function-table nil)))
(if rexx-doc-file
(load rexx-doc-file))
(let ((scan rexx-additional-doc-files))
(while (car scan)
(load (car scan))
(setq scan (cdr scan))))))
(defconst rexx-command-and-function-table nil
"Combined table of REXX commands and external functions for help.")
(setq rexx-command-and-function-table
(append rexx-command-table rexx-external-function-table))
(defvar rexx-build-eval nil
"*If this is defined, it is evaluated (executed) just after the
rexx-user-procedure-table is cleared and recreated by scanning
the buffer but before it is appended to the command and external
function lists. I am using this instead of a hook so that this
can be buffer local.
You can use this to add names of your own from some other source
or to change the way the scan works altogether. My VX-Rexx
extensions take advantage of this.")
(defvar rexx-warn-illegal-line-label t
"*Warn the user if he might be using a line label that is not
preceded by a '_'.")
(defvar rexx-mode-abbrev-table nil
"Abbrev table in use in REXX mode.")
(define-abbrev-table 'rexx-mode-abbrev-table ())
(defvar rexx-mode-map ()
"Keymap used in REXX mode.")
(if rexx-mode-map
()
(setq rexx-mode-map (make-sparse-keymap))
(define-key rexx-mode-map ":" 'electric-rexx-colon)
(define-key rexx-mode-map "{" 'electric-rexx-do)
(define-key rexx-mode-map "}" 'electric-rexx-end)
(define-key rexx-mode-map " " 'electric-rexx-space)
(define-key rexx-mode-map ";" 'electric-rexx-space)
(define-key rexx-mode-map "(" 'electric-rexx-paren)
(define-key rexx-mode-map ")" 'electric-rexx-space)
(define-key rexx-mode-map "'" 'electric-rexx-space)
(define-key rexx-mode-map "\"" 'electric-rexx-space)
(define-key rexx-mode-map "" 'electric-rexx-newline)
(define-key rexx-mode-map "\177" 'backward-delete-char-untabify)
(define-key rexx-mode-map "\t" 'rexx-indent-command)
(define-key rexx-mode-map [C-tab] 'rexx-complete-symbol)
(define-key rexx-mode-map "\e\t" 'rexx-complete-symbol)
(define-key rexx-mode-map [M-C-tab] 'rexx-build-procedure-table)
(define-key rexx-mode-map "\M-\C-\\" 'rexx-indent-region)
(define-key rexx-mode-map [M-C-space] 'rexx-capitalize-sexp)
(define-key rexx-mode-map "\M-\C-q" 'rexx-indent-sexp)
(define-key rexx-mode-map "\M-\C-a" 'rexx-beginning-of-procedure)
(define-key rexx-mode-map "\M-\C-e" 'rexx-end-of-procedure)
(define-key rexx-mode-map "\M-\C-f" 'rexx-forward-sexp)
(define-key rexx-mode-map "\M-\C-b" 'rexx-backward-sexp))
(defvar rexx-mode-syntax-table nil
"Syntax table in use in REXX-mode buffers.")
(if rexx-mode-syntax-table
()
(setq rexx-mode-syntax-table (make-syntax-table))
(modify-syntax-entry ?\\ "." rexx-mode-syntax-table)
(modify-syntax-entry ?/ ". 14" rexx-mode-syntax-table)
(modify-syntax-entry ?* ". 23" rexx-mode-syntax-table)
(modify-syntax-entry ?+ "." rexx-mode-syntax-table)
(modify-syntax-entry ?- "." rexx-mode-syntax-table)
(modify-syntax-entry ?= "." rexx-mode-syntax-table)
(modify-syntax-entry ?% "." rexx-mode-syntax-table)
(modify-syntax-entry ?< "." rexx-mode-syntax-table)
(modify-syntax-entry ?> "." rexx-mode-syntax-table)
(modify-syntax-entry ?& "." rexx-mode-syntax-table)
(modify-syntax-entry ?| "." rexx-mode-syntax-table)
(modify-syntax-entry ?. "_" rexx-mode-syntax-table)
(modify-syntax-entry ?! "_" rexx-mode-syntax-table)
(modify-syntax-entry ?\' "\"" rexx-mode-syntax-table))
(defvar rexx-indent-level 3
"*Indentation of REXX statements with respect to containing block.")
(defvar rexx-procedure-indent-level 3
"*Indentation of REXX statements after a procedure label.")
(defvar rexx-procedure-arg-indent-level 0
"*Indentation of ARG or PARSE ARG immediately after a procedure label.")
(defvar rexx-return-indent 0
"*Indentation for RETURN.")
(defvar rexx-do-offset -3
"*Extra indentation for DO after a THEN or ELSE.")
(defvar rexx-end-offset 0
"*Indentation for END, compared with text being enclosed.")
(defvar rexx-when-offset 1
"*Indentation for WHEN relative to SELECT.")
(defvar rexx-continued-statement-offset 1
"*Extra indent for lines not starting new statements.")
(defvar rexx-expose-string "(Globals)"
"*String to automatically display after PROCEDURE.")
(defconst rexx-style-alist
'(("Maxwell"
(rexx-indent-level . 3)
(rexx-procedure-indent-level . 3)
(rexx-procedure-arg-indent-level . 0)
(rexx-return-indent . 0)
(rexx-do-offset . -3)
(rexx-end-offset . 0)
(rexx-when-offset . 1)
(rexx-continued-statement-offset . 1))
("Cowlishaw"
(rexx-indent-level . 3)
(rexx-procedure-indent-level . 0)
(rexx-procedure-arg-indent-level . 0)
(rexx-return-indent . 0)
(rexx-do-offset . -3)
(rexx-end-offset . 3)
(rexx-when-offset . 3)
(rexx-continued-statement-offset . 2))
("Wide"
(rexx-indent-level . 4)
(rexx-procedure-indent-level . 4)
(rexx-procedure-arg-indent-level . 2)
(rexx-return-indent . 0)
(rexx-do-offset . -2)
(rexx-end-offset . 0)
(rexx-when-offset . 2)
(rexx-continued-statement-offset . 2))))
(defvar rexx-tab-always-indent t
"*Non-nil means TAB in REXX mode should always reindent the current line,
regardless of where in the line point is when the TAB command is used.")
(defun rexx-mode ()
"Major mode for editing REXX code.
Comments are delimited with /* ... */.
Delete converts tabs to spaces as it moves back.
Line labels MUST start with '_' and procedure labels MUST not.
\\[rexx-indent-command] indents for REXX code.
\\[rexx-complete-symbol] attempts completion on a partial command or function name.
\\[electric-rexx-do] inserts DO
\\[electric-rexx-end] insert END.
\\[rexx-function-help] displays help for REXX commands and functions.
Additional colons after a procedure name will insert PROCEDURE, then
EXPOSE and finally the contents of rexx-expose-string (this defaults
to \"(Globals)\".)
\\{rexx-mode-map}
Variables controlling automatic capitalization and completion:
rexx-command-auto-upper
If this is t, rexx-mode will automatically convert all REXX command and
internal function names to upper case. If it is 1, it will capitalize.
If 2 or higher, it will capitalize functions and uppercase commands.
rexx-external-function-auto-capitilize
If non-nil, rexx-mode will automagically fix capitalization for any
external functions it knows about.
rexx-auto-build-procedure-table
If non-nil, rexx-mode will automatically build a local table of
procedures defined in the current buffer. These are then added
to the completion table for this buffer.
Variables controlling indentation style:
rexx-tab-always-indent
Non-nil means TAB in REXX mode should always reindent the current line,
regardless of where in the line point is when the TAB command is used.
rexx-indent-level
Indentation of REXX statements within surrounding block.
The surrounding block's indentation is the indentation
of the line on which the open-brace appears.
rexx-procedure-indent-level
Indentation of REXX statements after a procedure label.
rexx-procedure-arg-indent-level
Indentation of ARG or PARSE ARG immediately after a procedure label.
rexx-return-indent
Indentation for return.
rexx-do-offset
Extra indentation for line if it starts with a DO.
rexx-end-offset
Indentation for END relative to DO.
rexx-when-offset
Indentation for WHEN relative to SELECT.
rexx-continued-statement-offset
Extra indentation given to a substatement, such as the
then-clause of an if or body of a while.
rexx-expose-string
Specifies what string to electrically put after PROCEDURE EXPOSE.
Settings for Maxwell, Cowlishaw and Wide indentation styles are:
rexx-indent-level 3 3 4
rexx-procedure-indent-level 3 0 4
rexx-procedure-arg-indent-level 0 0 2
rexx-return-indent 0 0 0
rexx-do-offset -3 -3 -2
rexx-end-offset 0 3 0
rexx-when-offset 1 3 2
rexx-continued-statement-offset 1 2 2
Use set-rexx-style to choose.
Turning on REXX mode calls the value of the variable rexx-mode-hook with no
args, if that value is non-nil."
(interactive)
(if (and (bobp) (eobp))
(progn
(insert "/* */")
(set-buffer-modified-p nil)))
(save-excursion
(goto-char (point-min))
(if (looking-at "/\\*")
(progn
(kill-all-local-variables)
(use-local-map rexx-mode-map)
(setq major-mode 'rexx-mode)
(setq mode-name "Rexx")
(setq local-abbrev-table rexx-mode-abbrev-table)
(set-syntax-table rexx-mode-syntax-table)
(make-local-variable 'rexx-expose-string)
(local-set-key "\C-h\C-f" 'rexx-function-help)
(make-local-variable 'paragraph-start)
(setq paragraph-start (concat "^$\\|" page-delimiter))
(make-local-variable 'paragraph-separate)
(setq paragraph-separate paragraph-start)
(make-local-variable 'paragraph-ignore-fill-prefix)
(setq paragraph-ignore-fill-prefix t)
(make-local-variable 'indent-line-function)
(setq indent-line-function 'rexx-indent-line)
(make-local-variable 'indent-region-function)
(setq indent-region-function 'rexx-indent-region)
(make-local-variable 'require-final-newline)
(setq require-final-newline t)
(make-local-variable 'comment-start)
(setq comment-start "/* ")
(make-local-variable 'comment-end)
(setq comment-end " */")
(make-local-variable 'comment-column)
(setq comment-column 32)
(make-local-variable 'comment-start-skip)
(setq comment-start-skip "/\\*+ *")
(make-local-variable 'comment-indent-function)
(setq comment-indent-function 'rexx-comment-indent)
(make-local-variable 'parse-sexp-ignore-comments)
(setq parse-sexp-ignore-comments t)
(make-local-variable 'rexx-build-eval)
(run-hooks 'rexx-mode-hook)
(if rexx-auto-build-procedure-table
(rexx-build-procedure-table)
(rexx-clear-procedure-table)))
(fundamental-mode))))
;; This is used by indent-for-comment
;; to decide how much to indent a comment in REXX code
;; based on its context.
(defun rexx-comment-indent ()
(if (or
(looking-at "^/\\*") ;Existing comment at bol stays there.
(and (= comment-column 0)
(save-excursion
(skip-chars-backward " \t")
(bolp))))
;; If comment-column is 0, and nothing but space
;; before the comment, align it at 0 rather than 1.
0
(max (1+ (current-column)) ;Else indent at comment column
comment-column))) ; except leave at least one space.
(defun electric-rexx-paren (arg)
"If rexx-command-auto-upper is t, set all REXX commands to uppercase.
If it is 1 capitalize commands. If it is any other number, it will
uppercase commands and capitalize functions. It will also warn the
user if he/she typed 'CALL funcname('."
(interactive "P")
(if (not arg)
(progn
(if (save-excursion
(and
last-command-char
(condition-case nil
(progn
(forward-sexp -2)
t)
(error nil))
(looking-at "call[ \t]+\\w")))
(progn
(message "Are you sure you want a '(' after a CALL?")
(beep))
(rexx-do-auto-upper))))
(if last-command-char
(self-insert-command (prefix-numeric-value arg))))
(defun electric-rexx-space (arg)
"If rexx-command-auto-upper is t, set all REXX commands to uppercase.
If it is 1 capitalize commands. If it is any other number, it will
uppercase commands and capitalize functions."
(interactive "P")
(if (not arg)
(rexx-do-auto-upper))
(if last-command-char
(self-insert-command (prefix-numeric-value arg))))
(defun electric-rexx-newline (arg)
"If rexx-command-auto-upper is t, set all REXX commands to uppercase.
If it is non-nil and not t, capitalize commands."
(interactive "P")
(if (not arg)
(progn
(rexx-do-auto-upper)
(rexx-indent-line)))
(if arg
(setq arg (prefix-numeric-value arg))
(setq arg 1))
(while (> arg 0)
(newline)
(setq arg (1- arg)))
(rexx-indent-line))
(defun electric-rexx-do (arg)
"Insert 'do' and correct line's indentation."
(interactive "P")
(if (and (not arg)
(eolp))
(progn
(if (= (char-syntax (preceding-char)) ?\w)
(let ((last-command-char ?\ ))
(electric-rexx-space nil)))
(insert "do")
(rexx-do-auto-upper))
(self-insert-command (prefix-numeric-value arg))))
(defun electric-rexx-end (arg)
"Insert 'end' and correct line's indentation.\n
Blink 'do' if blink-matching-paren is non-nil."
(interactive "P")
(if (and (not arg)
(eolp))
(progn
(if (= (char-syntax (preceding-char)) ?\w)
(let ((last-command-char ?\ ))
(electric-rexx-space nil)))
(insert "end")
(rexx-do-auto-upper)
(rexx-indent-line)
(if blink-matching-paren
(save-excursion
(if (rexx-backward-sexp)
(sit-for 1)))))
(self-insert-command (prefix-numeric-value arg))))
(defun electric-rexx-colon (arg)
"Insert colon and correct line's indentation."
(interactive "P")
(let ((here (point))
(state (parse-partial-sexp (point-min) (point)))
remainder)
(if (and
(not arg)
(eolp)
(not (nth 4 state)))
(progn
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(skip-chars-forward "a-zA-Z0-9_")
(setq remainder (upcase (buffer-substring (point) here))))
(cond
((string= remainder "")
(let ((hold (copy-marker (point))))
(save-excursion
(beginning-of-line)
(delete-horizontal-space)
(if (and rexx-auto-build-procedure-table
(not (= (following-char) ?_)))
(rexx-add-to-procedure-table (buffer-substring (point) hold)))
(let* ((here (point))
(state (rexx-get-state (rexx-beginning-of-procedure) here)))
(if (car (cdr state))
(progn
(if (or (not rexx-warn-illegal-line-label)
(= (following-char) ?_))
(message "Label name within DO/END block. This may not work correctly. See SIGNAL doc.")
(message "Label name within DO/END block. Non-procedure names should start with '_'."))
(beep)))))
(self-insert-command 1)))
((string= remainder ":")
(insert " PROCEDURE"))
((string= remainder ": PROCEDURE")
(insert " EXPOSE"))
((string= remainder ": PROCEDURE EXPOSE")
(insert " ")
(insert rexx-expose-string))
(t
(self-insert-command 1))))
(self-insert-command (prefix-numeric-value arg)))))
(defun rexx-inside-parens-p ()
(condition-case ()
(save-excursion
(save-restriction
(narrow-to-region (point)
(progn (rexx-beginning-of-procedure) (point)))
(goto-char (point-max))
(= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
(error nil)))
(defun rexx-indent-command (&optional whole-exp)
"Indent current line as REXX code, or in some cases insert a tab character.
If `rexx-tab-always-indent' is non-nil (the default), always indent current
line. Otherwise, indent the current line only if point is at the left margin
or in the line's indentation; otherwise insert a tab.
A numeric argument, regardless of its value, means always indent line."
(interactive "P")
(rexx-do-auto-upper)
(if whole-exp
;; If arg, always indent this line as C
;; and shift remaining lines of expression the same amount.
(let ((shift-amt (rexx-indent-line))
beg end)
(save-excursion
(if rexx-tab-always-indent
(beginning-of-line))
;; Find beginning of following line.
(save-excursion
(forward-line 1) (setq beg (point)))
;; Find first beginning-of-sexp for sexp extending past this line.
(while (< (point) beg)
(rexx-forward-sexp 1)
(setq end (point))
(skip-chars-forward " \t\n")))
(if (> end beg)
(indent-code-rigidly beg end shift-amt "#")))
(if (and (not rexx-tab-always-indent)
(save-excursion
(skip-chars-backward " \t")
(not (bolp))))
(insert-tab)
(rexx-indent-line))))
(defun rexx-indent-line ()
"Indent current line as REXX code.
Return the amount the indentation changed by."
(let ((indent (calculate-rexx-indent))
beg shift-amt
(case-fold-search t)
(pos (- (point-max) (point))))
(beginning-of-line)
(setq beg (point))
(cond ((eq indent nil)
(setq indent (current-indentation)))
((eq indent t)
(setq indent (calculate-rexx-indent-within-comment)))
(t
(skip-chars-forward " \t")
(cond ((or
(and (looking-at "when\\b")
(not (looking-at "when\\s_")))
(and (looking-at "otherwise\\b")
(not (looking-at "otherwise\\s_"))))
(setq indent
(+
(save-excursion
(goto-char (rexx-start-of-block))
(rexx-forward-sexp -1 t)
(rexx-back-to-indentation))
rexx-when-offset)))
((and (looking-at "else\\b")
(not (looking-at "else\\s_")))
(setq indent (save-excursion
(rexx-backward-to-start-of-if)
(current-indentation))))
((and (looking-at "do\\b")
(save-excursion
(end-of-line 0)
(rexx-forward-sexp -1 t)
(and (looking-at "\\(then\\|\\else\\|otherwise\\)\\b"))))
(setq indent (+ indent rexx-do-offset))))))
(skip-chars-forward " \t")
(setq shift-amt (- indent (current-column)))
(if (zerop shift-amt)
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))
(delete-region beg (point))
(indent-to indent)
;; If initial point was within line's indentation,
;; position after the indentation. Else stay at same point in text.
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos))))
shift-amt))
(defun calculate-rexx-indent ()
"Return appropriate indentation for current line as REXX code.
In usual case returns an integer: the column to indent to.
Returns nil if line starts inside a string, t if in a comment."
(save-excursion
(catch 'break
(beginning-of-line)
(let ((indent-point (point))
(case-fold-search t)
(start-of-prev (save-excursion
(rexx-backward-to-noncomment (point-min) t)
(rexx-start-of-line)))
state
temp
top-is-procedure
parse-start
calced-container
containing-sexp)
(rexx-beginning-of-procedure)
(if (looking-at "[a-z][a-z_0-9]*:")
(setq top-is-procedure t))
(if (>= (point) indent-point)
(throw 'break nil)
(setq parse-start (point))
(setq state (rexx-get-state (point) indent-point))
(setq containing-sexp (car (cdr state)))
(setq calced-container t)
(if (or (nth 3 state) (nth 4 state))
(throw 'break (nth 4 state))))
(cond
((looking-at "[ \t]*[a-z_][a-z_0-9]*:")
0)
;; See if this is a continuation line
((save-excursion
(end-of-line 0)
(eq (preceding-char) ?\,))
(+ (save-excursion
(goto-char start-of-prev)
(current-column))
rexx-continued-statement-offset))
;; See if line is after a label
((and (null containing-sexp)
(or
(cond
((and (looking-at "[ \t]*\\(return\\|\\exit\\)\\b")
(<= (point)
(rexx-start-of-unenclosed-block)))
rexx-return-indent)
((save-excursion
(rexx-backward-to-noncomment parse-start t)
(beginning-of-line)
(looking-at "[a-z][a-z_0-9]*:"))
(if (or (looking-at "[ \t]*arg[ \t]")
(looking-at "[ \t]*parse[ \t]"))
rexx-procedure-arg-indent-level
rexx-procedure-indent-level))
((and top-is-procedure
(save-excursion
(rexx-backward-to-noncomment (or parse-start (point-min)) t)
(beginning-of-line)
(and
(looking-at "[ \t]*\\(arg\\|parse\\)[ \t]")
(progn
(rexx-backward-to-noncomment (or parse-start (point-min)) t)
(beginning-of-line)
(looking-at "[a-z][a-z_0-9]*:")))))
rexx-procedure-indent-level)))))
((looking-at "[ \t]*end\\b")
(goto-char (or containing-sexp
(rexx-calc-container)))
(+ (rexx-back-to-indentation) rexx-end-offset))
(t
;; Statement level. Is it a continuation or a new statement?
;; Find previous non-comment character.
(if containing-sexp
(setq parse-start containing-sexp)
(or parse-start (setq parse-start (point-min))))
(rexx-backward-to-noncomment parse-start t)
(rexx-forward-sexp -1 t)
;; Now let's see what we're looking at
(cond
((looking-at "\\(then\\|\\else\\|otherwise\\)\\b")
(goto-char start-of-prev)
(+ (current-column)
rexx-indent-level))
((progn
(goto-char start-of-prev)
(save-excursion
(rexx-backward-to-noncomment)
(bobp)))
nil)
((or (looking-at "[a-z][a-z_0-9]*:")
(<= (point) parse-start))
(+ (current-column) rexx-indent-level))
(t
(goto-char start-of-prev)
(goto-char (rexx-start-of-unenclosed-block))
(rexx-back-to-indentation)))))))))
(defun rexx-calc-container ()
(if calced-container
containing-sexp
(setq calced-container t)
(setq containing-sexp
(save-excursion
(goto-char (rexx-start-of-block))
(cond ((looking-at "^[a-z][a-z_0-9]*:")
nil)
((save-excursion
(rexx-forward-sexp -1 t)
(looking-at "\\(select\\|do\\)\\b"))
(rexx-forward-sexp -1 t)))))))
(defun rexx-start-of-unenclosed-block (&optional parse-start)
(save-excursion
(or parse-start (setq parse-start (point-min)))
(let (temp)
(while
(progn
(beginning-of-line)
(setq temp (point))
(rexx-backward-to-noncomment parse-start t)
(forward-sexp -1)
(and (looking-at "\\(then\\|\\else\\|otherwise\\)\\b")
(> (rexx-start-of-line) parse-start))))
(goto-char (rexx-start-of-line temp)))))
(defun rexx-back-to-indentation ()
(back-to-indentation)
(current-column))
(defun rexx-start-of-line (&optional from)
(if from
(goto-char from))
(if (bobp)
(rexx-forward-to-noncomment)
(save-excursion
(end-of-line)
(let (botl botw)
(while
(and
(not (bobp))
(or
(progn
(setq botl (save-excursion (beginning-of-line)
(rexx-back-to-indentation)
(point)))
(setq botw -1)
(while (> (point) botl)
(setq botw (point))
(rexx-forward-sexp -1 t)
(if (= botw (point))
(goto-char (point-min))))
(if (= (point) botl)
(if
(save-excursion
(end-of-line 0)
(eq (preceding-char) ?\,))
(progn
(end-of-line 0)
t))
t)))))
(if (bobp)
(rexx-forward-to-noncomment)
botl)))))
(defun calculate-rexx-indent-within-comment (&optional after-star)
"Return the indentation amount for line inside a block comment.
Optional arg AFTER-STAR means, if lines in the comment have a leading star,
return the indentation of the text that would follow this star."
(let (end star-start)
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t")
(setq star-start (= (following-char) ?\*))
(skip-chars-backward " \t\n")
(setq end (point))
(beginning-of-line)
(skip-chars-forward " \t")
(if after-star
(and (looking-at "\\*")
(re-search-forward "\\*[ \t]*")))
(and (re-search-forward "/\\*[ \t]*" end t)
star-start
(not after-star)
(goto-char (1+ (match-beginning 0))))
(if (and (looking-at "[ \t]*$") (= (preceding-char) ?\*))
(1+ (current-column))
(current-column)))))
(defun rexx-backward-to-noncomment (&optional lim ignore-line-labels)
(or lim (setq lim (point-min)))
(let (opoint stop)
(while (not stop)
(setq opoint (point))
(skip-chars-backward " \t\n\f;:" lim)
(if ignore-line-labels
(if (save-excursion
(beginning-of-line)
(looking-at "_[a-z_0-9]*:"))
(beginning-of-line)))
(while (and (>= (point) (+ 2 lim))
(progn
(save-excursion
(forward-char -2)
(looking-at "\\*/"))))
(search-backward "/*" lim 'move))
(setq stop (or (<= (point) lim)
(= (point) opoint)))))
(point))
(defun rexx-forward-to-noncomment (&optional lim ignore-line-labels)
(or lim (setq lim (point-max)))
(let (opoint stop)
(while (not stop)
(setq opoint (point))
(skip-chars-forward " \t\n\f;:" lim)
(if ignore-line-labels
(while (looking-at "_[a-z_0-9]*:")
(rexx-forward-sexp)))
(while (and (<= (point) (+ 2 lim))
(looking-at "/\\*"))
(search-forward "*/" lim 'move))
(setq stop (or (>= (point) lim)
(= (point) opoint)))))
(point))
(defun rexx-looking-at-ignore-whitespace (str &optional lim ignore-line-labels)
(save-excursion
(rexx-forward-to-noncomment lim ignore-line-labels)
(looking-at str)))
(defun rexx-backward-to-start-of-if (&optional limit)
"Move to the start of the last \"unbalanced\" `if'."
(or limit (setq limit (save-excursion (rexx-beginning-of-procedure) (point))))
(let ((if-level 1)
(case-fold-search t))
(while (and (not (bobp)) (not (zerop if-level)))
(rexx-backward-sexp)
(cond ((looking-at "else\\b")
(setq if-level (1+ if-level)))
((looking-at "if\\b")
(setq if-level (1- if-level)))
((< (point) limit)
(setq if-level 0)
(goto-char limit))))))
(defun mark-rexx-procedure ()
"Put mark at end of REXX procedure, point at beginning."
(interactive)
(push-mark (point))
(rexx-end-of-procedure)
(let ((where (point)))
(rexx-beginning-of-procedure)
(push-mark where nil t)))
(defun rexx-start-of-block ()
"Find start of the block containing point."
(interactive)
(save-excursion
(let ((from (point)))
(while (and (not (bobp))
(not (looking-at "^[a-z][a-z_0-9]*:"))
(progn
(condition-case nil
(rexx-forward-sexp -1)
(error
(if (save-excursion
(rexx-forward-sexp -1 t)
(not (looking-at "\\(do\\|select\\)\\b")))
(rexx-forward-sexp -1 t)))))
(not (= from (point))))
(setq from (point)))
(point))))
(defun rexx-indent-sexp ()
"Reindent the current block of REXX."
(interactive)
(save-excursion
(if
(save-excursion
(skip-chars-forward "^\"'\n")
(or (= (following-char) ?')
(= (following-char) ?\")))
(beginning-of-line 2))
(let ((from (rexx-start-of-block)) to)
(goto-char from)
(cond ((looking-at "^[a-z][a-z_0-9]*:")
(rexx-end-of-procedure)
(setq to (point)))
((save-excursion
(rexx-forward-sexp -1 t)
(looking-at "\\(select\\|do\\)\\b"))
(rexx-forward-sexp -1 t)
(rexx-forward-sexp 1)
(setq to (point)))
(t
(setq from (point-min))
(setq to (point-max))))
(rexx-indent-region from to))))
(defun rexx-indent-region (start end)
"Indent every line whose first char is between START and END inclusive."
(interactive "r")
(save-excursion
(condition-case nil
(progn
(goto-char start)
;; Advance to first nonblank line.
(skip-chars-forward " \t\n")
(beginning-of-line)
(let ((rexx-tab-always-indent t)
(endmark (copy-marker end))
line last moved)
(if (> (- end start) 1000)
(progn
(setq line 0)
(setq last (count-lines start end))))
(while (< (point) endmark)
(cond ((looking-at "[ \t]*/\\*")
(let ((here (point)))
(rexx-forward-to-noncomment)
(setq moved (1- (count-lines here (point))))
(if (= moved 0)
(progn
(beginning-of-line 2)
(setq moved 1)))))
((looking-at "[ \t]*\n")
(forward-line)
(setq moved 1))
(t
(rexx-indent-line)
(forward-line)
(setq moved 1)))
(if line
(progn
(setq line (+ line moved))
(message "Line %d of %d" line last))))
(message "Done.")))
(error
(beep)
(message "Parsing error around line %d" (count-lines (point-min) (point)))))))
(defun rexx-capitalize-sexp ()
"Recapitalize the current block of REXX."
(interactive)
(save-excursion
(if
(save-excursion
(skip-chars-forward "^\"'\n")
(or (= (following-char) ?')
(= (following-char) ?\")))
(beginning-of-line 2))
(let ((from (rexx-start-of-block)) to)
(goto-char from)
(cond ((looking-at "^[a-z][a-z_0-9]*:")
(rexx-end-of-procedure)
(setq to (point)))
((save-excursion
(rexx-forward-sexp -1 t)
(looking-at "\\(select\\|do\\)\\b"))
(rexx-forward-sexp -1 t)
(rexx-forward-sexp 1)
(setq to (point)))
(t
(setq from (point-min))
(setq to (point-max))))
(rexx-capitalize-region from to))))
(defun rexx-capitalize-region (start end)
"Correctly capitalize every command or function whose first char is between
START and END inclusive."
(interactive "r")
(let ((total (- end start))
(rexx-warn-illegal-line-label nil))
(save-excursion
(goto-char start)
(while (and (forward-word 1)
(<= (point) end))
(message "Scanned %d of %d characters." (- (point) start) total)
(rexx-do-auto-upper))
(message "Scanned %d characters." total))))
(defun set-rexx-style (style &optional global)
"Set REXX-mode variables to use one of several different indentation styles.
The arguments are a string representing the desired style
and a flag which, if non-nil, means to set the style globally.
\(Interactively, the flag comes from the prefix argument.)
Available styles are Maxwell, Cowlishaw and Wide."
(interactive (list (completing-read "Use which REXX indentation style? "
rexx-style-alist nil t)
current-prefix-arg))
(let ((vars (cdr (assoc style rexx-style-alist))))
(or vars
(error "Invalid REXX indentation style `%s'" style))
(while vars
(or global
(make-local-variable (car (car vars))))
(set (car (car vars)) (cdr (car vars)))
(setq vars (cdr vars)))))
(defmacro sign (count)
(list 'max -1 (list 'min 1 count)))
(defun rexx-forward-sexp (&optional count noerr)
"REXX mode replacement for forward-sexps so it will recognize DO/END pairs."
(interactive "p")
(or count (setq count 1))
(if (= count 0)
(setq count 1))
(let ((parse-sexp-ignore-comments t) ;always ignore comments
(dir (sign count)) ;dir should be either 1 or -1
hold) ;this will track the current retval
(while (/= count 0) ;we have to loop here, not in old func.
(setq count (- count dir))
(if (> dir 0) ;pick a direction and scan once
(setq hold (rexx-scan-forward-sexp (point) noerr))
(setq hold (rexx-scan-backward-sexp (point) noerr)))
(if (not hold) ;if we got nil, bail out
(setq count 0)))
(if hold
(goto-char hold))))
(defun rexx-backward-sexp (&optional arg noerr)
"REXX mode replacement for forward-sexps so it will recognize DO/END pairs."
(interactive "p")
(or arg (setq arg 1))
(rexx-forward-sexp (- arg) noerr))
(defun rexx-scan-sexps (from count &optional noerr)
(if noerr
(condition-case nil
(or (scan-sexps from count)
(if (> count 0)
(save-excursion
(goto-char from)
(beginning-of-line 2)
(point))
nil))
(error
(save-excursion
(if (> count 0)
(re-search-forward "\\(\\s\"\\|\\s\(\\)")
(re-search-backward "\\(\\s\"\\|\\s\(\\)"))
(point))))
(or (scan-sexps from count)
(if (> count 0)
(save-excursion
(goto-char from)
(beginning-of-line 2)
(point))
nil))))
(defun rexx-scan-forward-sexp (from &optional noerr)
;;get simple value from old func.
(save-excursion
(goto-char from)
(cond ((and (not noerr)
(rexx-looking-at-ignore-whitespace "end\\b"))
(error "Block ends prematurely"))
((not
(rexx-looking-at-ignore-whitespace "\\(select\\|do\\)\\b"))
(rexx-scan-sexps from 1 noerr)) ;if this isn't 'do', return scan-sexps
;;if 'do' or 'select', skip to matching 'end'
(t
(let ((depth 1))
(while (and (> depth 0)
(not (eobp)))
(goto-char (rexx-scan-sexps (point) 1 t))
(cond ((rexx-looking-at-ignore-whitespace "\\(select\\|do\\)\\b")
(setq depth (1+ depth)))
((rexx-looking-at-ignore-whitespace "end\\b")
(setq depth (1- depth))))))
(if (eobp)
(if noerr
nil
(error "Containing message ends prematurely"))
(goto-char (scan-sexps (point) 1))
(point))))))
(defun rexx-scan-backward-sexp (from &optional noerr)
(save-excursion
(let (hold last)
;;get simple value from old func.
(setq hold (rexx-scan-sexps from -1 noerr))
(if (not hold) ;if old func returned nil, bail out
()
(goto-char hold)
(cond
;;are we trying to back out of a sexp illegally
((and (not noerr)
(looking-at "\\(select\\|do\\)\\b"))
(error "Block ends prematurely"))
;;see if we just skipped over 'end'; if not, return hold
((looking-at "end\\b")
;;if so, skip to matching 'do'
(let ((depth 1))
(while (> depth 0)
(goto-char (scan-sexps (point) -1))
(cond ((looking-at "\\(select\\|do\\)\\b")
(setq depth (1- depth)))
((looking-at "end\\b")
(setq depth (1+ depth))))))
(setq hold (point)))
;;if we're not looking at anything special, just return hold
(t hold))))))
(defun rexx-beginning-of-procedure ()
"Move backward to the beginning of a REXX procedure or
to the top if point is not in a procedure. Returns t.
A REXX procedure begins with a label followed by ':' i.e.
main:
Unfortunately, there is no distinction in REXX between the
beginning of a procedure and a line label. Since line labels
are rarely used in REXX, I have adopted the convention that
a label preceeded by a '_' (i.e. '_aack:') is a line label,
anything else is a procedure label."
(interactive)
(if (not (bolp))
(progn
(beginning-of-line)
(condition-case nil
(forward-sexp 1)
(error nil))))
(condition-case nil
(forward-sexp -1)
(error nil))
(re-search-backward "^[a-z][a-z_0-9]*:" nil 1)
(point))
(defun rexx-end-of-procedure ()
"Move forward to the end of a REXX procedure. Returns t.
Since there is no definitive marker for the end of a procedure,
rexx-mode will assume that the current procedure ends before the
next one begins. This is not always true but should usually
result in correct formatting anyway. (I hope-:)"
(interactive)
(condition-case nil
(forward-sexp 1)
(error nil))
(if (re-search-forward "^[a-z][a-z_0-9]*:" nil 1)
(condition-case nil
(forward-sexp -2)
(error nil)))
(forward-line 1)
(point))
(defun rexx-get-state (from to)
"Parse REXX syntax starting at FROM until TO; return status of parse at TO.
Parsing stops at TO or when certain criteria are met;
Point is set to where parsing stops.
Parsing assumes that FROM is the beginning of a function.
Value is a list of eight elements describing final state of parsing:
0. depth in parens.
1. character address of start of innermost containing block; nil if none.
2. character address of start of last complete block terminated.
3. non-nil if inside a string.
(it is the character that will terminate the string.)
4. t if inside a comment.
5. t if following a quote character.
6. the minimum paren-depth encountered during this scan.
7. t if in a comment of style `b'.
arguments: (from to)"
(let (state
stack
(next from)
(depth 0))
(save-excursion
(goto-char from)
(setq state (parse-partial-sexp from to -1))
(or (nth 3 state)
(nth 4 state)
(progn
(goto-char to)
(setq stack (rexx-start-of-block))
(if (= stack from)
(setq state nil)
(if (car state)
(setcar (cdr state) (scan-sexps stack -1)))))))
(goto-char to)
state))
(defun rexx-do-auto-upper (&optional arg)
(interactive "P")
(if (or (not (= (char-syntax (preceding-char)) ?w))
(and (not rexx-command-auto-upper)
(not rexx-external-function-auto-capitilize)))
()
(let* ((to (point))
(state (rexx-get-state (rexx-beginning-of-procedure) to))
lookfunc)
(if (nth 4 state)
()
(setq lookfunc
(or (and
(char-or-string-p last-command-char)
(= last-command-char ?\())
(= (following-char) ?\()
(save-excursion
(and
(condition-case nil
(progn
(forward-sexp -2)
t)
(error nil))
(and
(looking-at "call[ \t]+\\w")
(not (looking-at "call[ \t]+\\(on\\|off\\)\\b")))))))
(let* ((from
(condition-case nil
(scan-sexps (point) -1)
(error to)))
(word (downcase (buffer-substring from to)))
(pmark (copy-marker (point)))
comm
scan
scanstr
precap)
(if (and
rexx-command-auto-upper
(not (nth 3 state))
(setq precap (assoc word rexx-command-table)))
(progn
(setq comm (or
(null (elt precap 2))
(and
(integerp (string-match "mm" (elt precap 2)))
(or
(not (setq scan (string-match " *sub-command" (elt precap 2))))
(save-excursion
(setq scanstr (substring (elt precap 2) (string-match "[a-z/A-Z]+ +sub-command" (elt precap 2)) scan))
(while
(setq scan (string-match "/" scanstr))
(setq scanstr (concat (substring scanstr 0 scan) "\\|" (substring scanstr (1+ scan)))))
(beginning-of-line)
(re-search-forward scanstr from t))))))
(if (and comm
lookfunc
(elt precap 2)
(not (string-match "function" (elt precap 2))))
(setq lookfunc nil))
(cond ((or (and
(eq rexx-command-auto-upper t)
(or lookfunc comm))
(and
(> rexx-command-auto-upper 1)
(not lookfunc)
comm))
(upcase-region from to)
(rexx-do-super-completion precap))
((or
lookfunc
(and
(eq rexx-command-auto-upper 1)
comm))
(if (stringp (car (cdr precap)))
(progn
(goto-char from)
(delete-region from to)
(insert-before-markers (car (cdr precap)))
(goto-char pmark))
(capitalize-region from to))
(rexx-do-super-completion precap))))
(if (and rexx-external-function-auto-capitilize
(setq precap (assoc word rexx-user-procedure-table))
(or arg
(if (and (nth 3 state)
(= (char-syntax (char-after (1- from))) ?\"))
(elt precap 4)
(and (null (elt precap 4))
lookfunc))))
(progn
(if (stringp (car (cdr precap)))
(progn
(goto-char from)
(delete-region from to)
(insert-before-markers (car (cdr precap)))
(goto-char pmark))
(capitalize-region from to))
(if rexx-developing-mode-docs
(setq precap (assoc word rexx-external-function-table)))
(rexx-do-super-completion precap))))
(if (and
rexx-warn-illegal-line-label
(not lookfunc)
(save-excursion
(and
(condition-case nil
(progn
(forward-sexp -2)
t)
(error nil))
(looking-at "signal[ \t]+\\w")
(not (string= word "on"))
(not (string= word "off")))))
(progn
(message "Be sure you put a '_' before all non-procedure names.")
(beep))))))))
(defun rexx-do-super-completion (precap)
"If rexx-super-completion-mode is non-nil, point is at eol and
last-command-char is either \" \" or \"(\" then insert the
character, execute any commands in (elt precap 5) and, if
the last-command-char was \"(\", insert \")\""
(if (and (elt precap 5)
rexx-super-completion-mode
(eolp)
(char-or-string-p last-command-char)
(or
(= last-command-char ?\ )
(= last-command-char ?\()))
(progn
(self-insert-command 1)
(let ((last-command-char nil))
(funcall (eval (elt precap 5))))
(if (= last-command-char ?\()
(insert ")"))
(setq last-command-char nil))))
(defun rexx-complete-symbol ()
"Perform completion on Lisp symbol preceding point. That symbol is
compared against the symbols that exist and any additional characters
determined by what is there are inserted.
If the symbol starts just after an open-parenthesis, only symbols
with function definitions are considered. Otherwise, all symbols with
function definitions, values or properties are considered."
(interactive)
(let* ((end (point))
(beg (save-excursion
(condition-case nil
(backward-sexp 1)
(error nil))
(while (= (char-syntax (following-char)) ?\')
(forward-char 1))
(point)))
(pattern (downcase (buffer-substring beg end)))
(predicate-char
(save-excursion
(goto-char beg)
(preceding-char)))
(predicate-char-syntax (char-syntax predicate-char))
(predicate
(function (lambda (sym)
(if (null (elt sym 4))
(not (= predicate-char ?\"))
(= predicate-char-syntax ?\")))))
(completion (try-completion pattern rexx-user-procedure-table predicate)))
(cond ((eq completion t)
(rexx-do-auto-upper t)
(while (get-buffer-window " *Completions*")
(delete-window (get-buffer-window " *Completions*"))))
((null completion)
(message "Can't find completion for \"%s\"" pattern)
(ding))
((not (string= pattern completion))
(delete-region beg end)
(insert completion)
(rexx-do-auto-upper t)
(while (get-buffer-window " *Completions*")
(delete-window (get-buffer-window " *Completions*"))))
(t
(message "Making completion list...")
(let ((list (all-completions pattern rexx-user-procedure-table predicate)))
(with-output-to-temp-buffer " *Completions*"
(display-completion-list list)))
(message "Making completion list...%s" "done")))))
(defun rexx-function-at-point()
(if (not (or (= (char-syntax (following-char)) ?w)
(= (char-syntax (preceding-char)) ?w)))
nil
(save-excursion
(let* ((beg (progn
(if (= (char-syntax (preceding-char)) ?w)
(backward-sexp 1))
(while (= (char-syntax (following-char)) ?\')
(forward-char 1))
(point)))
(end (progn (forward-sexp 1) (point)))
(pattern (downcase (buffer-substring beg end)))
(precap (assoc pattern rexx-user-procedure-table)))
(if precap
(if (elt precap 1)
(elt precap 1)
(car precap)))))))
(defun rexx-function-help (function)
"Display the full documentation of FUNCTION (a symbol)."
(interactive
(let ((fn (rexx-function-at-point))
(enable-recursive-minibuffers t)
val)
(setq val
(completing-read
(if fn
(format "Describe function (default %s): " fn)
"Describe function: ")
rexx-user-procedure-table nil t))
(list (if (equal val "")
fn val))))
(with-output-to-temp-buffer "*Help*"
(princ function)
(princ ": ")
(let* ((var (assoc (downcase function) rexx-user-procedure-table))
(doc (elt var 3))
(type (elt var 2)))
(cond ((assoc (downcase function) rexx-command-table)
(if type
(princ (format "an internal %s\n" type))
(princ "an internal command or function\n")))
(type
(if rexx-developing-mode-docs
(progn
(setq var (assoc (downcase function) rexx-external-function-table))
(setq doc (elt var 3))
(setq type (elt var 2))))
(cond ((not (= (char-syntax (string-to-char type)) ?w))
(princ (substring type 1))
(princ "\n"))
((string-match " " type)
(princ type)
(princ "\n"))
(t
(princ (format "an external function from the %s package" type)))))
(t
(princ "an external command or function\n")))
(princ "\n")
(if doc
(princ doc)
(princ "not documented")))))
(defun rexx-complete-external (desc)
"Reads the name of an external function name from the minibuffer
with completion."
(let ((enable-recursive-minibuffers t)
(val
(completing-read desc rexx-external-function-table nil nil)))
(rexx-capitalize-string val)))
(defun rexx-capitalize-string (str)
"Capitalize string based on rexx-external-function-auto-capitilize."
(if rexx-external-function-auto-capitilize
(let ((ass (assoc (downcase str) rexx-user-procedure-table)))
(if (elt ass 1)
(elt ass 1)
(capitalize str)))))
(defun rexx-clear-procedure-table ()
"Clears the local procedure table."
(interactive)
(setq rexx-user-procedure-table rexx-command-and-function-table))
(defun rexx-build-procedure-table ()
"Builds the local procedure table."
(interactive)
(setq rexx-user-procedure-table nil)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^[a-z][a-z_0-9]*:" nil t)
(rexx-add-to-procedure-table
(buffer-substring (match-beginning 0) (1- (match-end 0))))))
(eval rexx-build-eval)
(setq rexx-user-procedure-table (append rexx-user-procedure-table rexx-command-and-function-table)))
(defun rexx-add-to-procedure-table (name)
"Check the function table for the function name. If it is not
there yet, add it."
(if (assoc (downcase name) rexx-user-procedure-table)
()
(setq rexx-user-procedure-table (cons (list (downcase name) name "User procedure") rexx-user-procedure-table))))
;;; rexx-mode.el ends here