Google
 

Trailing-Edge - PDP-10 Archives - mit_emacs_170_teco_1220 - emacs/cobol.emacs
There are no other files named cobol.emacs in the archive.
!* Hey EMACS, this is a -*-TECO-*- file. *!

!* v2 11-Mar-81 *!

!~FILENAME~:! !C EMACS macros for COBOL (version 2).
Do a Meta-X COBOL Library Description for more information.!

COBOL
!COBOL Library Description:! !C Miscellaneous information about this Library.
The documentation for this entire library can be obtained by loading the
ABSTR Library, and doing:

	Meta-X Alphabetical AbstractCOBOL

The above command will leave the abstract in your buffer.  It is the same
documentation that is available on line with EMACS.

	Comments and suggestions to:

	STAPLETON at DORA
		or
	John T. Stapleton  PK3-2/F29
	Digital Equipment Corp.
	129 Parker St.
	Maynard, Mass.  01754

	(617) 493-9172	  DTN: 223-9172

Update History:

Ver 1	Original version - not much to say about it.
Ver 2	Removed all keypad stuff, so that people may use their favorite
	keypad library instead.  The keypad stuff went to a new library
	called, appropriately enough, KEYPAD.!

  M(M.MDescribe)COBOL_Library_Description

!COBOL Mode:! !C Commands to edit COBOL programs
Puts:                   on:

 ^R COBOL Comment       Meta-;
 ^R COBOL Level Number  C-M-L
 ^R COBOL OCCURS        C-M-O
 ^R COBOL PIC           C-M-P
 ^R COBOL VALUE         C-M-V
 ^R COBOL VALUE SPACE   C-M-S
 ^R COBOL VALUE ZERO    Meta-Z!

  M(M.M&_Init_Buffer_Locals)

  1,(M.M^R_Tab_to_Tab_Stop)M.QI
!*  M.M&_Indent_Without_TabsM.LMM_&_Indent!
!*  M.M&_Xindent_Without_TabsM.LMM_&_Xindent!
  -1UIndent_Tabs_Mode
  QCOBOL_Tab_Stop_DefinitionsM.LTab_Stop_Definitions
  1,(M.M^R_COBOL_Comment)M.Q..;

  1M.VCOBOL_Level_Number_Increment
  1,(M.M^R_COBOL_Level_Number)M.Q...L

  45M.V COBOL_OCCURS_Column
  1M.V COBOL_OCCURS_New_Line
  1,(M.M^R_COBOL_OCCURS)M.Q...O

  29M.VCOBOL_PIC_Column
  1M.VCOBOL_PIC_New_Line
  1,(M.M^R_COBOL_PIC)M.Q..P
  1,(M.M^R_COBOL_PIC)M.Q...P

  10M.VCOBOL_VALUE_Offset
  1,(M.M^R_COBOL_VALUE)M.Q...V
  1,(M.M^R_COBOL_VALUE_SPACE)M.Q...S
  1,(M.M^R_COBOL_VALUE_ZERO)M.Q..Z

  Q.0,1M(M.M&_Set_Mode_Line)COBOL

!^R COBOL Comment:! !^R Create or go to COBOL Comment!

  0L				    !* This is really!
  5F=*____ "E		    !*   bletcherous!
    5C '			    !* but, I haven't thought!
  3F=*			    !*   of a way to!
     "E			    !* improve it!
      C I____ '
  I*____
  
!^R COBOL Level Number:! !^R Set COBOL Level Number Increment.
The COBOL Level Number Increment is for use by other
commands, but is set with this command.

With no arg    -  Set to 1 (default).
With one ^U    -  Add 1 to it.
With two ^U's  -  Subtract 1 from it.
With arg >0    -  Set to <arg>.
With arg <1    -  Set to 1 (default).!

  FS ^R EXPT "N			!* Any Control-U's!
    FS ^R EXPT-1 "E			!* One Control-U!
      %COBOL_Level_Number_Increment '

    FS ^R EXPT-2 "E			!* Two Control-U's!
      QCOBOL_Level_Number_Increment-1UCOBOL_Level_Number_Increment '

    O Display '

  FF "N				!* Argument present!
    UCOBOL_Level_Number_Increment '	!*  set to <arg>!
  "#					!* No argument!
    1UCOBOL_Level_Number_Increment '	!*  set to 1!

!Display!
  QCOBOL_Level_Number_Increment-1 "L	!* If less than 1!
    1UCOBOL_Level_Number_Increment '	!*  set to 1!
  QCOBOL_Level_Number_Increment:\[0	!* Push onto q0 for disp!
  :I*CFS ECHO DISPLAY
  @FT COBOL_Level_Number_Increment_=_0
  0FS ECHO ACTIVE
0
!^R COBOL OCCURS:! !^R Make OCCURS clause for COBOL.
Inserts "OCCURS " clause at COBOL column 52 (default),
but can be changed to new column.  Will guarnatee
that preceding character is space or tab.  Inserts
"OCCURS " on new line (default) if already past spec-
ified column, but tries to back up first.  New line
option can be changed.

With no arg    -  Inserts "OCCURS "
With one ^U    -  Sets COBOL OCCURS Column to current column
With two ^U's  -  Complements the new line option
With >2  ^U's  -  Shows status of COBOL OCCURS Column and
                        COBOL OCCURS New Line
With arg>0     -  Inserts "OCCURS arg."
With arg<1     -  Same as no arg.!

  FS ^R EXPT "N			!* If any Control-U's!
    FS ^R EXPT-1 "E			!* One Control-U!
      FS H POSITIONUCOBOL_OCCURS_Column '
    FS ^R EXPT-2 "E			!* 2 Control-U's!
      QCOBOL_OCCURS_New_Line*(-1)UCOBOL_OCCURS_New_Line '
    QCOBOL_OCCURS_Column+7:\[C
    QCOBOL_OCCURS_New_Line "G
      :I*Yes '
    "#
      :I*No '
    :I*CFS ECHO DISPLAY
    @FT COBOL_OCCURS_Column_=_C_____
    FS ECHO LINES-1 "N @FT
     '
    @FT COBOL_OCCURS_New_Line_=_N
    0FS ECHO ACTIVE
    0'

  FF "N
    [A '
  "#
    0[A '

  FS H POSITION-QCOBOL_OCCURS_Column "G
    -@F_	K '
  .[F
  QCOBOL_OCCURS_New_Line,QCOBOL_OCCURS_ColumnM(M.M&_Goto_COBOL_Column)
  IOCCURS_
  QA "G
    GA I. '
  QF,. 
!^R COBOL PIC:! !^R Make PIC clause for COBOL.
Inserts "PIC " clause at COBOL column 36 (default),
but can be changed to new column.  Will guarnatee
that preceding character is space or tab.  Inserts
"PIC " on new line (default) if already past spec-
ified column, but tries to back up first.  New line
option can be changed.

With no arg   -  Inserts "PIC "
With 1  ^U    -  Sets COBOL PIC Column to current column
With 2  ^U's  -  Complements the new line option
With >2 ^U's  -  Shows status of COBOL PIC Column and
                       COBOL PIC New Line
With arg>1    -  Inserts "PIC X(arg)"
With arg=1    -  Inserts "PIC X"
With arg=0    -  Same as no arg
With arg=-1   -  Inserts "PIC S9"
With arg<-1   -  Inserts "PIC S9(arg)"!

  FS ^R EXPT "N			!* If any Control-U's!
    FS ^R EXPT-1 "E			!* One Control-U!
      FS H POSITION UCOBOL_PIC_Column '	!* Set column!
    FS ^R EXPT-2 "E			!* 2 Control-U's!
      QCOBOL_PIC_New_Line*(-1)UCOBOL_PIC_New_Line '	!* Complement!
    QCOBOL_PIC_Column+7:\[C
    QCOBOL_PIC_New_Line "G
      :I*Yes '
    "#
      :I*No '
    :I*CFS ECHO DISPLAY
    @FT COBOL_PIC_Column_=_C_____
    FS ECHO LINES-1 "N @FT
     '
    @FT COBOL_PIC_New_Line_=_N
    0FS ECHO ACTIVE
    0'

  F:M(M.M&_COBOL_PIC)
!^R COBOL VALUE:! !^R Make VALUE for COBOL.
Inserts "VALUE " at COBOL PIC column + 10 (default).  Will
guarantee that preceeding character is space or tab.

With no arg    - Inserts "VALUE "
With any ^U's  - Does nothing
With arg>0     - Inserts "PIC X(arg) VALUE "
With arg=0     - Same as no arg
With arg<0     - Inserts "PIC S9(arg) VALUE "

Note: If anyone can think of what to do with ^U args,
I am willing to listen.!

  FS ^R EXPT "N 0 '			!* Control-U's are no-ops!
  .[F					!* Save 'from' point!
  [T					!* Temporary work!
  FF&1 "N
    QF,M(M.M&_COBOL_PIC)UTUT QF,QTFUFUF '
  QF,M(M.M&_COBOL_VALUE)UTUT QF,QTFUFUF
QF,.
!^R COBOL VALUE SPACE:! !^R Make VALUE SPACE for COBOL.
Inserts "VALUE SPACE." at COBOL PIC Column + 10 (default).
Will guarantee that preceding character is space or tab.

With no arg    - Inserts "VALUE SPACE."
With any ^U's  - Does nothing
With arg>0     - Inserts "PIC X(arg) VALUE SPACE."
With arg=0     - Same as no arg
With arg<0     - Inserts "PIC S9(arg) VALUE SPACE." (certainly useless)

Note: If anyone can think of what to do with ^U args,
I am willing to listen.!

  FS ^R EXPT "N 0 '			!* Control-U's are no-ops!
  .[F					!* Save 'from' point!
  [T					!* Temporary work!
  FF&1 "N
    QF,M(M.M&_COBOL_PIC)UTUT QF,QTFUFUF '
  QF,M(M.M&_COBOL_VALUE)UTUT QF,QTFUFUF
  ISPACE.
QF,.
!^R COBOL VALUE ZERO:! !^R Make VALUE ZERO for COBOL.
Inserts "VALUE ZERO." at COBOL PIC Column + 10 (default).
Will guarantee that preceeding character is space or tab.

With no arg    - Inserts "VALUE ZERO."
With any ^U's  - Does nothing
With arg>0     - Inserts "PIC X(arg) VALUE ZERO."
With arg=0     - Same as no arg
With arg<0     - Inserts "PIC S9(arg) VALUE ZERO."

Note: If anyone can think of what to do with ^U args,
I am willing to listen.!

  .[F
  [T
  FF&1 "N
    QF,M(M.M&_COBOL_PIC)UTUT QF,QTFUFUF '
  QF,M(M.M&_COBOL_VALUE)UTUT QF,QTFUFUF
  IZERO.
QF,. 
!& CBL Mode:! !& COB Mode:! !S Set-up for COBOL on FN2!
  :M(M.MCOBOL_Mode)
!& COBOL PIC:! !S Inserts "PIC" clause.
This is the routine that actually does the insertion.

Called by:

 ^R COBOL FILLER (not implemented yet)
 ^R COBOL PIC
 ^R COBOL REDEFINES (not implemented yet)
 ^R COBOL VALUE
 ^R COBOL VALUE SPACE
 ^R COBOL VALUE ZERO

Returns <m>,<n> as part of buffer changed.!

  FF&3 "N			    !* Argument present!
    [A '			    !*  Save it in q-reg A!
  "#				    !* No argument!
    0[A '			    !*  Store zero instead!
  FS H POSITION-QCOBOL_PIC_Column "G	    !* Past column!
    -@F_	K '		    !*  kill spaces to left!
  FF&2 "E
    .[F '
  "#
    [F '
  QF,.FUFUF
  QCOBOL_PIC_New_Line,QCOBOL_PIC_ColumnM(M.M&_Goto_COBOL_Column)
  IPIC_
  QA "N				    !* Argument present!
    QA "G
      IX '			    !*  it is now "PIC X"!
    "#
      IS9 '			    !*  it is now "PIC S9"!
    QAUA
    QA-1 "G			    !*   greater than 1!
      I( GA I) ''		    !*    put it in parens!

  QF,. 
!& COBOL VALUE:! !S Inserts "VALUE".
This is the routine that actually does the insertion of "VALUE ".

Called by:

 ^R COBOL VALUE
 ^R COBOL VALUE SPACE
 ^R COBOL VALUE ZERO

Returns <m>,<n> as part of buffer changed.!

  FF&2 "E
    .[F '
  "#
    [F '
  QF,.FUFUF
  QCOBOL_PIC_Column+QCOBOL_VALUE_Offset-FS H POSITION
    QS F"G,40.I ''
  0A-40. "N
    0A-11. "N
      40.I ''
  IVALUE_
QF,.
!& Goto COBOL Column:! !S Internal routine used for alignment.!

  [O [C			    !* Save option and column!
  FS H POSITION		    !* Save current column!
  QH-QC "L			    !* Haven't reached column yet!
    QH,QCM(M.M&_XINDENT)  '	    !*   so; get to it!

  QH-QC "E			    !* At column, and preceeding!
    (0A-32)*(0A-9) "E  ''	    !*   is space or tab!

  QO "G				    !* New line option?!
    M(M.M^R_CRLF)		    !*   Yes!
    0,QC-1M(M.M&_XINDENT) '	    !*   Get to column - 1!

  32I 			    !* Put in a space and return!
!& Setup COBOL Library:! !S Sets up the COBOL Library
Defines variables:            to be:

COBOL Level Number Increment  1
COBOL OCCURS Column           52
COBOL OCCURS New Line         1
COBOL PIC Column              36
COBOL PIC New Line            1
COBOL Tab Stop Definitions    at COBOL columns 12,16,36,40,48,52,56,60
      Note: Because there are no sequence numbers, the first 6
            columns are not on the screen; therefore the tabs
            will stop at columns 6,10,30 etc.  You can define
            your own tab stops (see Edit Tab Stops) by defining
            this variable (string, not buffer) in your Init file.
COBOL VALUE Offset            10!

  1  M.CCOBOL_Level_Number_Increment Add_this_number_for_new_Level_Number.
  45 M.CCOBOL_OCCURS_Column COBOL_Column_for_OCCURS_clause_(default_52).
  1  M.CCOBOL_OCCURS_New_Line =pos_New_Line_if_past_column;_else,_same_line.
  29 M.CCOBOL_PIC_Column COBOL_Column_for_PIC_clause_(default_36).
  1  M.CCOBOL_PIC_New_Line =pos_New_Line_if_past_column;_else,_same_line.
  10 M.CCOBOL_VALUE_Offset Number_of_columns_away_from_PIC_to_aim_for.
  :FO..QCOBOL_Tab_Stop_Definitions "L
    [T
    :IT_____:___:___________________:___:_______:___:___:___:
    QTM.VCOBOL_Tab_Stop_Definitions '