home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / gnu / emacs / help / 4902 < prev    next >
Encoding:
Text File  |  1992-11-23  |  21.8 KB  |  615 lines
  1. Xref: sparky gnu.emacs.help:4902 comp.lang.pascal:6842
  2. Newsgroups: gnu.emacs.help,comp.lang.pascal
  3. Path: sparky!uunet!cs.utexas.edu!csc.ti.com!tilde.csc.ti.com!fstop.csc.ti.com!fstop.csc!adam
  4. From: adam@dadhb1.ti.com (Adam Hudd)
  5. Subject: Re: pascal mode for emacs ??
  6. In-Reply-To: jbiggs@armltd.uucp's message of 20 Nov 92 11:46:03 GMT
  7. Message-ID: <ADAM.92Nov23111540@node_48dc0.dadhb1.ti.com>
  8. Lines: 599
  9. Sender: usenet@csc.ti.com
  10. Nntp-Posting-Host: 192.48.249.30
  11. Organization: Texas Instruments, Inc., Houston, TX
  12. References: <9911@armltd.uucp>
  13. Distribution: gnu
  14. Date: Mon, 23 Nov 1992 17:15:40 GMT
  15.  
  16. I think that this was also on the wuarchive...
  17.  
  18. ;;; Here's the pascal-mode I wrote, with capabilities to scan blocks and
  19. ;;; do a reasonably good job of auto-indenting code.  I also modified the
  20. ;;; etags program to build tags for Pascal code (unfortunately, not for
  21. ;;; type-declarations, I didn't have time to get to that); I'll post the
  22. ;;; etags program separately.
  23. ;;; 
  24. ;;; Enjoy!  -- Mohan.   {uunet!mntgfx!mosurm}
  25. ;;;                     {Mosur Mohan, Mentor Graphics, Beaverton, OR}
  26. ;;; Modified by Mosur Mohan 15-Apr-88 <uunet!mntgfx!mosurm> 
  27. ;;; Pascal editing support package, based on:
  28.  
  29. ;; Originally, Modula-2 editing support package
  30. ;; Author Mick Jordan
  31. ;; Amended Peter Robinson
  32. ;; Ported to GNU Michael Schmidt
  33. ;; From: "Michael Schmidt" <michael@pbinfo.UUCP>
  34. ;;; Modified by Tom Perrine <Perrin@LOGICON.ARPA> (TEP)
  35.  
  36. (defvar pas-mode-syntax-table nil
  37.   "Syntax table in use in Pascal-mode buffers.")
  38. (defvar pas-mode-abbrev-table nil
  39.   "Abbrev table in use in pas-mode buffers.")
  40. (define-abbrev-table 'pas-mode-abbrev-table ())
  41.  
  42. (if pas-mode-syntax-table
  43.     ()
  44.   (let ((table (make-syntax-table)))
  45.     (modify-syntax-entry ?\\ "\\" table)
  46.     (modify-syntax-entry ?\( "() 1" table)
  47.     (modify-syntax-entry ?\) ")( 4" table)
  48.     (modify-syntax-entry ?\[ "(]" table)
  49.     (modify-syntax-entry ?\] ")[" table)
  50.     (modify-syntax-entry ?* ". 23" table)
  51.     (modify-syntax-entry ?+ "." table)
  52.     (modify-syntax-entry ?- "." table)
  53.     (modify-syntax-entry ?= "." table)
  54.     (modify-syntax-entry ?% "." table)
  55.     (modify-syntax-entry ?< "." table)
  56.     (modify-syntax-entry ?> "." table)
  57.     (modify-syntax-entry ?{ "<" table)
  58.     (modify-syntax-entry ?} ">" table)
  59.     (modify-syntax-entry ?_ "w" table)
  60.     (modify-syntax-entry ?\' "\"" table)
  61.     (setq pas-mode-syntax-table table)))
  62.  
  63. ;;; Added by MKM
  64. (defvar pas-mode-map nil
  65.   "Keymap used in Pascal-mode.")
  66.  
  67. (if pas-mode-map ()
  68.   (let ((map (make-sparse-keymap)))
  69.     (define-key map "\C-i" 'pas-indent-line)
  70.     (define-key map "\C-c\C-i" 'pas-tab-to-tab-col)
  71.     (define-key map "\C-j" 'pas-newline)
  72.     (define-key map "\C-cb" 'pas-begin)
  73.     (define-key map "\C-c\C-b" 'backward-block)
  74.     (define-key map "\C-c\C-f" 'forward-block)
  75.     (define-key map "\C-c\C-d" 'down-block)
  76.     (define-key map "\C-c\C-e" 'up-block)
  77.     (define-key map "\C-c\C-u" 'back-up-block)
  78.     (define-key map "\C-c\C-@" 'mark-block)
  79.     (define-key map "\C-c\C-n" 'narrow-to-block)
  80.     (define-key map "\C-c~" 'self-assign-stmt)
  81.     (define-key map "\C-c\[" 'open-comment-box)
  82.     (define-key map "\C-c\C-m" 'continue-comment-box)
  83.     (define-key map "\C-c\>" 'set-end-comment-col)
  84.     (define-key map "\C-c}" 'pas-end-comment)
  85.     (setq pas-mode-map map)))
  86.  
  87. (defvar pas-indent 2 "*This variable gives the indentation in Pascal-mode")
  88.  
  89. (defun pas-mode ()
  90. "Mode to support program development in Pascal.
  91. The prefix-key for pas-mode is Ctrl-C.
  92.  
  93.   TAB            pas-indent-line       Ctrl-c TAB     pas-tab-to-tab-col
  94.   Ctrl-j         pas-newline           Ctrl-c b       pas-begin
  95.   Ctrl-c Ctrl-f  forward-block         Ctrl-c Ctrl-b  backward-block
  96.   Ctrl-c Ctrl-d  down-block            Ctrl-c Ctrl-u  back-up-block
  97.   Ctrl-c Ctrl-e  up-block              Ctrl-c Ctrl-@  mark-block
  98.   Ctrl-c Ctrl-n  narrow-to-block       Ctrl-c ~       self-assign-stmt
  99.   Ctrl-c Ctrl-[  open-comment-box      Ctrl-c Ctrl-m  continue-comment-box
  100.   Ctrl-c }       pas-end-comment       Ctrl-c >       set-end-comment-column
  101.  
  102.   pas-indent controls the number of spaces for each indentation."
  103.   (interactive)
  104.   (kill-all-local-variables)
  105.   (use-local-map pas-mode-map)
  106.   (setq major-mode 'pas-mode)
  107.   (setq mode-name "Pascal")
  108.   (setq local-abbrev-table pas-mode-abbrev-table)
  109.   (make-local-variable 'comment-column)
  110.   (setq comment-column 41)
  111.   (make-local-variable 'box-com-col)
  112.   (setq box-com-col 2)
  113.   (make-local-variable 'end-comment-column)
  114.   (setq end-comment-column 66)
  115.   (set-syntax-table pas-mode-syntax-table)
  116.   (make-local-variable 'paragraph-start)
  117.   (setq paragraph-start (concat "^$\\|" page-delimiter))
  118.   (make-local-variable 'paragraph-separate)
  119.   (setq paragraph-separate paragraph-start)
  120.   (make-local-variable 'require-final-newline)
  121.   (setq require-final-newline t)
  122.   (make-local-variable 'comment-start)
  123.   (setq comment-start "(*")
  124.   (make-local-variable 'comment-end)
  125.   (setq comment-end "*)")
  126.   (make-local-variable 'comment-start-skip)
  127.   (setq comment-start-skip "(\\*+ *")
  128.   (setq indent-tabs-mode nil)
  129.   (make-local-variable 'pas-tab-col)
  130.   (setq pas-tab-col 20)
  131.   (make-local-variable 'comment-indent-hook)
  132.   (setq comment-indent-hook 'c-comment-indent)
  133.   (make-local-variable 'parse-sexp-ignore-comments)
  134.   (setq parse-sexp-ignore-comments t)
  135.   (run-hooks 'pas-mode-hook))
  136.  
  137.  
  138. (defun pas-indent-line ()
  139.   "Indent the current line based on the indentation of the
  140. surrounding Pascal block, and on whether the previous line
  141. ended a Pascal statement."
  142.   (interactive)
  143.   (let (blk-ind blk-beg prev-ind prev-beg shift-amt keep-going fishy)
  144.     (save-excursion
  145.       (beginning-of-line)
  146.       (setq fishy (not (backward-scan-blocks 1 nil nil)))
  147.       (beginning-of-line)
  148.       (setq blk-beg (point))
  149.       (setq blk-ind (current-indentation))
  150.       (if fishy
  151.         (setq indent (+ blk-ind pas-indent)) );; E-O-IF
  152.       );; E-O-SAVE EXCURSION
  153.     (if fishy nil
  154.       (save-excursion
  155.         (forward-line -1)
  156.         (setq prev-beg (point))
  157.         (setq prev-ind (current-indentation))
  158.         (if (<= prev-beg blk-beg)       ; prev line is containing block
  159.           (setq indent (+ blk-ind pas-indent))
  160.           (skip-chars-forward " \t")
  161.           (if (looking-at "\\<if\\>\\|\\<case\\>\\|\\<with\\>\\|\\<for\\>\\|\\<while\\>\\|\\<repeat\\>")
  162.             (setq indent (+ prev-ind pas-indent)) ; then
  163.             (setq indent (+ blk-ind pas-indent)) ; else
  164.             (end-of-line)
  165.             (if (or
  166.                   (re-search-backward ";[ \t]*\\((\\*.*\\*)\\)*$" prev-beg t 1)
  167.                   (re-search-backward "^ *(\\*.*\\*)$" prev-beg t 1)
  168.                   (re-search-backward "^$" prev-beg t 1)
  169.                   (= (point) prev-beg) )
  170.               nil                       ; then block-indent will do
  171.               (setq indent (+ prev-ind pas-indent)) ; else use previous-line indent
  172.               )));; E-O-3 IFs
  173.         ));; E-O-SAVE EXCURSION & IF
  174.     (save-excursion
  175.       (beginning-of-line)
  176.       (setq prev-beg (point))
  177.       (skip-chars-forward " \t")
  178.       (if (and (not fishy) (looking-at "end\\|until"))
  179.         (setq indent blk-ind)
  180.         (save-excursion
  181.           (cond ((looking-at "then")
  182.                  (backward-find-kwd "\\<if\\>" nil)
  183.                  (setq indent (+ (current-indentation) pas-indent)) )
  184.                 ((looking-at "else")
  185.                  (setq then-cnt 1)
  186.                  (setq keep-going t)
  187.                  (while keep-going
  188.                    (backward-find-kwd "\\<then\\>\\|\\<else\\>" nil)
  189.                    (if (looking-at "then")
  190.                        (setq then-cnt (1- then-cnt))
  191.                      (setq then-cnt (1+ then-cnt)) )
  192.                    (if (> then-cnt 0) nil
  193.                      (setq keep-going nil)
  194.                      (setq indent (current-indentation)) ));; E-O-WHILE
  195.                  )
  196.                 (t nil) );; E-O-COND
  197.           ));; E-O-SAVE EXCURSION & IF
  198.       ;; install the right indentation
  199.       (setq shift-amt (- indent (current-column)))
  200.       (if (zerop shift-amt) nil
  201.         (delete-region prev-beg (point))
  202.         (indent-to indent) )
  203.       );; E-O-SAVE EXCURSION
  204.     (if (bolp) (back-to-indentation))
  205.     ));; E-O-LET & PAS-INDENT-LINE
  206.  
  207. (defun pas-tab-to-tab-col (&optional arg)
  208.   "Insert space to force indent to specified ARG column,
  209. or to pas-tab-col."
  210.   (interactive "P")
  211.   (if arg
  212.     (if (integerp arg)
  213.       (setq pas-tab-col arg)            ; then
  214.       (setq pas-tab-col (current-column)) ; else
  215.       ))
  216.   (indent-to pas-tab-col));; E-O-PAS TAB TO TAB-COL
  217.  
  218. (defun pas-newline ()
  219.   "Insert a newline and indent it appropriately."
  220.   (interactive)
  221.   (newline)
  222.   (pas-indent-line) );; E-O-PAS-NEWLINE
  223.  
  224. (defun pas-end-comment ()
  225.   "Finish this comment correctly right-aligned."
  226.   (interactive)
  227.   (if (not (bolp))
  228.       (indent-to end-comment-column 1))
  229.   (insert "*)"))
  230.  
  231. (defun set-end-comment-column ()
  232.   "Set the Pascal mode local variable end-comment-column
  233.    to the column that point is on."
  234.   (interactive)
  235.   (message (concat "end-comment-column set to "
  236.     (setq end-comment-column (current-column)) )))
  237.  
  238. (defun open-comment-box (arg)
  239.   "Open a box comment: set box-com-col to the current
  240. column.  Now, read the char to use for the comment line,
  241. then insert two lines and open an aligned comment box."
  242.   (interactive "cComment-line char: ")
  243.   (setq box-com-col (current-column))
  244.   (insert "(*")
  245.   (let ( (counter 1)
  246.          (lsize (- end-comment-column box-com-col)) )
  247.     (while (< (setq counter (1+ counter)) lsize)
  248.       (insert arg) )
  249.     (insert "*)\n")
  250.     (indent-to box-com-col 0)
  251.     (insert "(*")
  252.     (setq counter 1)
  253.     (while (< (setq counter (1+ counter)) lsize)
  254.       (insert arg) )
  255.     (insert "*)")
  256.     (beginning-of-line)
  257.     (open-line 1)
  258.     (indent-to box-com-col)
  259.     (insert "(*  ") )                   ;; E-O-LET
  260.   )   ;; E-O-OPEN-COMMENT-BOX
  261.  
  262.  
  263. (defun continue-comment-box ()
  264.   "Close current-line comment correctly right-aligned, open a new
  265. indented comment on the next line, and indent to pas-tab-col."
  266.   (interactive)
  267.   (indent-to end-comment-column 1)
  268.   (insert "*)\n")
  269.   (indent-to box-com-col)
  270.   (insert "(*")
  271.   (indent-to pas-tab-col 2) )   ;; E-O-CONTINUE-COMMENT-BOX
  272.  
  273. (defun pas-begin (&optional arg)
  274.   "Insert a 'begin' keyword & its comment at point, and
  275. matching 'end'.  If ARG >= 1, insert the 'end' ARG lines
  276. elow 'begin'.  If ARG < 0, insert 'end' at mark, and indent."
  277.   (interactive "P")
  278.   (let ((cmnt (read-string "Comment: "))
  279.          (cur-pt 0)
  280.          (cur-ind (current-indentation))
  281.          (argval (if arg
  282.                    (if (eq arg '-) -1 arg)
  283.                    0)) )
  284.     (insert "begin")
  285.     (if (string-equal cmnt "") nil
  286.       (setq cmnt (concat "   (* " cmnt " *)"))
  287.       (insert cmnt) )                   ;; E-O-IF
  288.     (setq cur-pt (point))
  289.     (cond
  290.       ((> argval 0)
  291.         (next-line argval)
  292.         (end-of-line) )
  293.       ((< argval 0)
  294.         (exchange-point-and-mark)
  295.         (beginning-of-line)
  296.         (backward-char 1) ))
  297.     (newline)
  298.     (indent-to cur-ind)
  299.     (insert "end;")
  300.     (if (string-equal cmnt "") nil
  301.       (insert cmnt) )                   ;; E-O-IF
  302.     (goto-char cur-pt)
  303.     (if (= argval 0) (pas-newline))
  304.     );; E-O-LET
  305.   );; E-O-PAS BEGIN
  306.  
  307.  
  308. (defun forward-find-kwd (target lim)
  309.   "Leave point at the end of a keyword and return the position
  310. of the beginning of the matched keyword, skipping comments
  311. and literal strings en route.  If TARGET is specified, find it
  312. outside comments & strings until limit LIM is reached.  If not
  313. found, return NIL."
  314.   (let ( (keep-looking t)
  315.          (reg-str
  316.            (concat (or target "\\<begin\\>\\|\\<end\\>\\|\\<record\\>\\|\\<case\\>\\|\\<repeat\\>\\|\\<until\\>")
  317.              "\\|(\\*\\|{\\|""\\|'"))
  318.          found mbeg mend next-target)
  319.     (while keep-looking
  320.       (setq found (re-search-forward reg-str lim t 1))
  321.       (if (not found)
  322.         ;;; then... didn't find any of the REG-STR components
  323.         (setq keep-looking nil)
  324.         ;;; else... goto beginning of match, check it out
  325.         (setq mend (match-end 0))
  326.         (goto-char (match-beginning 0))
  327.         (setq mbeg (point))
  328.         (cond
  329.           ((and target (looking-at target))
  330.             (setq keep-looking nil) )
  331.           ((looking-at "(\\*") (setq next-target "*)"))
  332.           ((looking-at "{") (setq next-target "}"))
  333.           ((looking-at "'") (setq next-target "'"))
  334.           ((looking-at """") (setq next-target """"))
  335.           (t  (setq keep-looking nil)) );; E-O-COND
  336.         (goto-char mend)
  337.         (if keep-looking (search-forward next-target nil t 1)) );; E-O-OUTER IF
  338.       )   ;; E-O-WHILE
  339.     (and found mbeg)                    ; return-value = match-beginning
  340.     );; E-O-LET
  341.   );; E-O-FORWARD-FIND-KWD
  342.  
  343. (defun backward-find-kwd (target lim)
  344.   "Leave point at the beginning of a keyword and return the
  345. position of the end of the matched keyword, skipping comments
  346. and literal strings en route.  If TARGET is specified, find it
  347. outside comments & strings until limit LIM is reached.  If not
  348. found, return NIL."
  349.   (let ( (keep-looking t)
  350.          (reg-str
  351.            (concat (or target "\\<begin\\>\\|\\<end\\>\\|\\<record\\>\\|\\<case\\>\\|\\<repeat\\>\\|\\<until\\>")
  352.              "\\|\\*)\\|}\\|""\\|'"))
  353.          found mbeg mend next-target)
  354.     (while keep-looking
  355.       (setq found (re-search-backward reg-str lim t 1))
  356.       (if (not found)
  357.         ;;; then... didn't find any of the REG-STR components
  358.         (setq keep-looking nil)
  359.         ;;; else... we're at beginning of match, check it out
  360.         (setq mend (match-end 0))
  361.         (setq mbeg (point))
  362.         (cond
  363.           ((and target (looking-at target))
  364.             (setq keep-looking nil) )
  365.           ((looking-at "\\*)") (setq next-target "(*"))
  366.           ((looking-at "}") (setq next-target "{"))
  367.           ((looking-at "'") (setq next-target "'"))
  368.           ((looking-at """") (setq next-target """"))
  369.           (t  (setq keep-looking nil)) );; E-O-COND
  370.         (if keep-looking (search-backward next-target nil t 1)) );; E-O-OUTER IF
  371.       )   ;; E-O-WHILE
  372.     (and found mend)                    ; return-value = match-end
  373.     );; E-O-LET
  374.   );; E-O-BACKWARD-FIND-KWD
  375.  
  376.  
  377. (defun forward-scan-blocks (depth target lim)
  378.   "Move forward:
  379.    down into blocks if DEPTH < 0,
  380.    across one block if DEPTH = 0,
  381.    up out of blocks if DEPTH > 0.
  382. Second arg TARGET = nil initially, used internally
  383. to distinguish between until and end.
  384. LIM bounds the search."
  385.   (or target (setq target ""))
  386.   (let (mbeg mend done fishy)
  387.     (if (not (setq mbeg (forward-find-kwd nil lim)))
  388.       (setq fishy t)                    ; bad location
  389.       (setq mend (point))               ; else process kwd
  390.       (goto-char mbeg)
  391.       (cond
  392.         ((looking-at "begin\\|case\\|record\\|repeat")
  393.           (setq depth (1+ depth))
  394.           (if (= depth 0) (setq done t)
  395.             (if (looking-at "repeat")
  396.               (setq target "until")     ; then
  397.               (setq target "end") ))    ; else
  398.           (goto-char mend) )
  399.         ((looking-at "end\\|until")
  400.           (if (<= depth 0)
  401.             (setq fishy t)              ; bad location
  402.             (setq depth (1- depth))     ; else...
  403.             (if (and (= depth 0) (looking-at target))
  404.               (setq done t) )
  405.             (goto-char mend)
  406.             (setq target nil) ))
  407.         );; E-O-COND
  408.       (if fishy nil                     ; return bad status
  409.         (or done (forward-scan-blocks depth target lim)) ) ; else recurse
  410.       );; E-O-MAIN IF
  411.     );; E-O-LET
  412.   );; E-O-FORWARD-SCAN-BLOCKS
  413.  
  414. (defun backward-scan-blocks (depth target lim)
  415.   "Move backward:
  416.    down into blocks if DEPTH < 0,
  417.    across one block if DEPTH = 0,
  418.    up out of blocks if DEPTH > 0.
  419. Second arg TARGET = nil initially, used internally
  420. to distinguish between until and end.
  421. LIM bounds the search."
  422.   (or target (setq target ""))
  423.   (or lim (setq lim nil))
  424.   (let (mend done fishy)
  425.     (if (not (setq mend (backward-find-kwd nil lim)))
  426.       (setq fishy t)                    ; bad location
  427.       (cond                             ; else process kwd
  428.         ((looking-at "end\\|until")
  429.           (setq depth (1+ depth))
  430.           (if (= depth 0) (setq done t)
  431.             (if (looking-at "until")
  432.               (setq target "repeat")    ; then
  433.               (setq target "begin\\|case\\|record\\|repeat") ; else
  434.               )))
  435.         ((looking-at "begin\\|case\\|record\\|repeat")
  436.           (if (<= depth 0)
  437.             (setq fishy t)
  438.             (setq depth (1- depth))
  439.             (if (and (= depth 0) (looking-at target))
  440.               (setq done t) )
  441.             (setq target nil) ))
  442.         );; E-O-COND
  443.       (if fishy nil                     ; return bad status
  444.         (or done (backward-scan-blocks depth target lim)) ) ; else recurse
  445.       );; E-O-MAIN IF
  446.     );; E-O-LET
  447.   );; E-O-BACKWARD SCAN BLOCKS
  448.  
  449.  
  450. (defun forward-block (&optional numblks)
  451.   "Move forward across NUMBLKS balanced begin-end blocks."
  452.   (interactive "p")
  453.   (or numblks (setq numblks 1))
  454.   (if (< numblks 0) (backward-block (- numblks))
  455.     (let (found-pos fishy)
  456.       (save-excursion
  457.         (while (> numblks 0)
  458.           (if (forward-scan-blocks 0 nil nil)
  459.             (setq numblks (1- numblks)) ; then... all's well
  460.             (setq fishy t)              ; else exit
  461.             (setq numblks 0) )
  462.           );; E-O-WHILE
  463.         (setq found-pos (point)) );; E-O-SAVE-EXCURSION
  464.       (if (not fishy)
  465.         (goto-char found-pos)           ; happy ending
  466.         (push-mark (point) t)           ; else mark and warn
  467.         (goto-char found-pos)
  468.         (send-string-to-terminal "")
  469.         (message "Bad block structure, mark set.") )
  470.       ));; E-O-LET & IF
  471.   );; E-O-FORWARD-BLOCK
  472.  
  473. (defun backward-block (&optional numblks)
  474.   "Move backward across NUMBLKS balanced begin-end block."
  475.   (interactive "p")
  476.   (or numblks (setq numblks 1))
  477.   (if (< numblks 0) (forward-block (- numblks))
  478.     (let (found-pos fishy)
  479.       (save-excursion
  480.         (while (> numblks 0)
  481.           (if (backward-scan-blocks 0 nil nil)
  482.             (setq numblks (1- numblks)) ; then... all's well
  483.             (setq fishy t)              ; else exit
  484.             (setq numblks 0) )
  485.           );; E-O-WHILE
  486.         (setq found-pos (point)) );; E-O-SAVE-EXCURSION
  487.       (if (not fishy)
  488.         (goto-char found-pos)           ; happy ending
  489.         (push-mark (point) t)           ; else mark and warn
  490.         (goto-char found-pos)
  491.         (send-string-to-terminal "")
  492.         (message "Bad block structure, mark set.") )
  493.       ));; E-O-LET & IF
  494.   );; E-O-BACKWARD-BLOCK
  495.  
  496. (defun down-block (&optional arg)
  497.   "Move forward down ARG levels of begin-end block.
  498. A negative argument means move backward but still down."
  499.   (interactive "p")
  500.   (or arg (setq arg 1))
  501.   (let (found-pos all-swell)
  502.     (save-excursion
  503.       (setq all-swell
  504.         (if (> arg 0)
  505.           (forward-scan-blocks (- arg) nil nil) ; then
  506.           (backward-scan-blocks arg nil nil) ; else
  507.           ));; E-O-IF & SETQ
  508.       (setq found-pos (point)) );; E-O-SAVE-EXCURSION
  509.       (if all-swell
  510.         (goto-char found-pos)           ; happy ending
  511.         (push-mark (point) t)           ; else mark and warn
  512.         (goto-char found-pos)
  513.         (send-string-to-terminal "")
  514.         (message "Bad block structure, mark set.") );; E-O-IF
  515.     );; E-O-LET
  516.   );; E-O-DOWN-BLOCK
  517.  
  518. (defun back-up-block (&optional arg)
  519.   "Move backward out of ARG levels of begin-end blocks.
  520.    A negative argument means move forward but still up."
  521.   (interactive "p")
  522.   (or arg (setq arg 1))
  523.   (up-block (- arg)))
  524.  
  525. (defun up-block (&optional arg)
  526.   "Move forward out of ARG levels of begin-end blocks.
  527.    A negative argument means move backward but still up."
  528.   (interactive "p")
  529.   (or arg (setq arg 1))
  530.   (let (found-pos all-swell)
  531.     (save-excursion
  532.       (setq all-swell
  533.         (if (> arg 0)
  534.           (forward-scan-blocks arg nil nil) ; then
  535.           (backward-scan-blocks (- arg) nil nil)
  536.           ));; E-O-IF & SETQ
  537.       (setq found-pos (point)) );; E-O-SAVE-EXCURSION
  538.       (if all-swell
  539.         (goto-char found-pos)           ; happy ending
  540.         (push-mark (point) t)           ; else mark and warn
  541.         (goto-char found-pos)
  542.         (send-string-to-terminal "")
  543.         (message "Bad block structure, mark set.") );; E-O-IF
  544.     );; E-O-LET
  545.   );; E-O-UP-BLOCK
  546.  
  547.  
  548. (defun mark-block (&optional arg)
  549.   "Set mark at the end of the next block from point.
  550. With argument, do this that many blocks away.  Leave
  551. the cursor at top-of-region."
  552.   (interactive "p")
  553.   (or arg (setq arg 1))
  554.   (let (save-loc all-swell)
  555.     (save-excursion
  556.       (setq all-swell
  557.             (forward-block arg))
  558.       (end-of-line)
  559.       (setq save-loc (point)) );; E-O-IF & SAVE-EXCURSION
  560.     (push-mark save-loc 1)
  561.     (if all-swell
  562.         (message "Block marked.")
  563.       (send-string-to-terminal "")
  564.       (message "Bad block structure, mark set.") )
  565.     );; E-O-LET
  566.   );;E-O-MARK-BLOCK
  567.  
  568. (defun narrow-to-block (&optional arg)
  569.   "Narrow window down to the next block ahead from the cursor.
  570.    With argument, do this that many blocks ahead (or back)."
  571.   (interactive "p")
  572.   (or arg (setq arg 1))
  573.   (let ( (reg-beg (point))
  574.          (reg-end 0)
  575.          all-swell)
  576.     (save-excursion
  577.       (cond
  578.         ((< arg 0)
  579.           (setq all-swell (backward-block (- arg)))
  580.           (beginning-of-line)
  581.           (setq reg-end (point)) )
  582.         (t
  583.           (setq all-swell (forward-block arg))
  584.           (end-of-line)
  585.           (setq reg-end (point)) ));; E-O-COND
  586.       );; E-O-SAVE-EXCURSION
  587.     (cond
  588.       (all-swell
  589.         (narrow-to-region reg-beg reg-end)
  590.         (goto-char (min reg-beg reg-end)) )
  591.       (t
  592.         (push-mark reg-end)
  593.         (send-string-to-terminal "")
  594.         (message "Bad block structure, mark set.") )
  595.       );; E-O-COND
  596.     );; E-O-LET
  597.   );; E-O-NARROW-TO-BLOCK
  598.  
  599. (defun self-assign-stmt ()
  600.   "Given variable X typed in, generate X := X."
  601.   (interactive)
  602.   (let (cur-pt var-end tmpstr)
  603.     (setq cur-pt (point))
  604.     (skip-chars-backward " \t")
  605.     (setq var-end (point))
  606.     (skip-chars-backward "^ \t\n")
  607.     (setq tmpstr (buffer-substring (point) var-end))
  608.     (goto-char cur-pt)
  609.     (insert " := " tmpstr " ") ))
  610. --
  611. Cheers,
  612. Adam Hudd               adam@dadhb1.ti.com             __o
  613. Texas Instruments Inc,                                -\<,
  614. Houston, TX                                     .....O / O
  615.