Return to bpage.cmd CVS log

Up to [MW Coherent from dump] / coherent / f / usr / lib

Annotation of coherent/f/usr/lib/bpage.cmd, revision 1.1

1.1     ! root        1: ;      BPAGE.CMD:      Box Macro and rectangualr region page
        !             2: ;                      for MicroEMACS 3.9d and above
        !             3: ;                      (C)opyright 1987 by Suresh Konda and Daniel M Lawrence
        !             4: ;                      Last Update: 11/02/87
        !             5: 
        !             6: ; make sure the function key window is up
        !             7:        set %rcfkeys FALSE
        !             8:        execute-macro-1
        !             9:        write-message "Loading..."
        !            10: 
        !            11: ; set the clean procedure up
        !            12: store-procedure clean
        !            13:        delete-buffer "[Macro 10]"
        !            14:        delete-buffer "[Macro 11]"
        !            15:        delete-buffer "[Macro 12]"
        !            16:        delete-buffer "[getblock]"
        !            17:        delete-buffer "[putblock]"
        !            18:        delete-buffer "[Macro 13]"
        !            19:        delete-buffer "[Macro 14]"
        !            20:        delete-buffer "[Macro 15]"
        !            21:        delete-buffer "[Macro 16]"
        !            22:        delete-buffer "[Macro 17]"
        !            23:        delete-buffer "[Macro 18]"
        !            24:        delete-buffer "[Macro 19]"
        !            25:        delete-buffer "[drawbox]"
        !            26:        delete-buffer "[setpoints]"
        !            27:        delete-buffer "[horizontal]"
        !            28:        delete-buffer "[vertical]"
        !            29:        delete-buffer "[horline]"
        !            30:        delete-buffer "[vertline]"
        !            31:        delete-buffer "[delcol]"
        !            32:        delete-buffer "[iline]"
        !            33: !endm
        !            34: 
        !            35: ; Write out the page instructions
        !            36:        save-window
        !            37:        1 next-window
        !            38:        beginning-of-file
        !            39:        set $curcol 25
        !            40:        overwrite-string " F1 Line type [DOUBLE]    F2 kill block   "
        !            41:        next-line
        !            42:        set $curcol 25
        !            43:        overwrite-string " F3 draw box              F4 copy block   "
        !            44:        next-line
        !            45:        set $curcol 25
        !            46:        overwrite-string " F5 insert line           F6 yank block   "
        !            47:        next-line
        !            48:        set $curcol 18
        !            49:        overwrite-string "BOX "
        !            50:        set $curcol 25
        !            51:        overwrite-string " F7 insert space          F8 insert block "
        !            52:        next-line
        !            53:        set $curcol 25
        !            54:        overwrite-string "                                          "
        !            55:        unmark-buffer
        !            56:        beginning-of-file
        !            57:        !force restore-window
        !            58:        update-screen
        !            59: 
        !            60: ; this sets overwrite mode to off.  to change it, set rcinsert to 1
        !            61: set %rcinsert 0
        !            62: 
        !            63: ;      change line type
        !            64: 
        !            65: 10     store-macro
        !            66:        !if &equ %rcltype 1
        !            67:                set %rcltype 2
        !            68:                set %rctmp "DOUBLE"
        !            69:        !else
        !            70:                !if &equ %rcltype 2
        !            71:                        set %rcltype 3
        !            72:                        set %rctmp "C-CMNT"
        !            73:                !else
        !            74:                        set %rcltype 1
        !            75:                        set %rctmp "SINGLE"
        !            76:                !endif
        !            77:        !endif
        !            78:        set %cbuf $cbufname
        !            79:        set %cline $cwline
        !            80:        select-buffer "Function Keys"
        !            81:        beginning-of-file
        !            82:        1 goto-line
        !            83:        40 forward-character
        !            84:        6 delete-next-character
        !            85:        insert-string %rctmp
        !            86:        unmark-buffer
        !            87:        select-buffer %cbuf     
        !            88:        %cline redraw-display
        !            89:        !return
        !            90: !endm
        !            91: 
        !            92: ;      Draw a box
        !            93: 
        !            94: 12     store-macro
        !            95:        !if &equal %rcltype  1
        !            96:                set %c1 "�"
        !            97:                set %c2 "�"
        !            98:                set %c3 "�"
        !            99:                set %c4 "�"
        !           100:                set %c5 "�"
        !           101:                set %c6 "�"
        !           102:        !else
        !           103:                !if &equal %rcltype 2
        !           104:                        set %c1 "�"
        !           105:                        set %c2 "�"
        !           106:                        set %c3 "�"
        !           107:                        set %c4 "�"
        !           108:                        set %c5 "�"
        !           109:                        set %c6 "�"
        !           110:                !else
        !           111:                        set %c1 "/"
        !           112:                        set %c2 "*"
        !           113:                        set %c3 "\"
        !           114:                        set %c4 "\"
        !           115:                        set %c5 "/"
        !           116:                        set %c6 "*"
        !           117:                !endif
        !           118:        !endif
        !           119:        run drawbox     
        !           120: !endm
        !           121: 
        !           122: ;      insert a line in a box
        !           123: 
        !           124: 14     store-macro
        !           125:        run iline
        !           126: !endm
        !           127: 
        !           128: ;      insert a blank line in a box
        !           129: 
        !           130: 16     store-macro
        !           131:        set %rctmp %rcltype
        !           132:        set %rcltype 0
        !           133:        run iline
        !           134:        set %rcltype %rctmp
        !           135: !endm
        !           136: 
        !           137: store-procedure        iline
        !           138:        run setpoints
        !           139:        !if &equal %pcol %mcol
        !           140:                run vertical
        !           141:        !else
        !           142:                !if &equal %pline %mline
        !           143:                        run horizontal
        !           144:                !else
        !           145:                        write-message "Illegal point and mark for lines"
        !           146:                !endif
        !           147:        !endif
        !           148: !endm
        !           149: 
        !           150: store-procedure setpoints
        !           151: ; procedure will set pcol, pline, mcol and mline. currently at point
        !           152: ; it will also detab the region
        !           153:        set %pcol $curcol
        !           154:        set %pline $curline
        !           155:        exchange-point-and-mark
        !           156:        set %mcol $curcol
        !           157:        set %mline $curline
        !           158:        exchange-point-and-mark
        !           159:        detab-region
        !           160:        set $curline %pline
        !           161:        set $curcol %pcol
        !           162: !endm
        !           163: 
        !           164: store-procedure drawbox
        !           165:        run setpoints
        !           166:        set $curline %mline
        !           167:        set $curcol %mcol
        !           168: ;draw top horizontal line
        !           169:        insert-string %c1
        !           170: ;      set %width &sub &sub %pcol %mcol 1
        !           171:        set %width &add 2 &sub %pcol %mcol
        !           172:        %width insert-string %c2
        !           173:        insert-string %c3
        !           174:        newline-and-indent
        !           175: ;draw bottom horizontal line
        !           176:        %pline goto-line
        !           177:        next-line
        !           178:        end-of-line
        !           179:        newline
        !           180:        %mcol insert-string " "
        !           181: ;      set $curcol %mcol
        !           182:        insert-string %c4
        !           183:        %width insert-string %c2
        !           184:        insert-string %c5
        !           185: ; bump pline 
        !           186:        set %pline &add %pline 1
        !           187: ;draw verticals -- go to top and work our way down
        !           188:        %mline goto-line
        !           189:        !while &less $curline %pline
        !           190:                next-line
        !           191:                end-of-line
        !           192:                !if &less $curcol %pcol
        !           193:                        &sub %pcol $curcol insert-string " "
        !           194:                !endif
        !           195:                set $curcol %pcol
        !           196:                insert-string " "
        !           197:                insert-string %c6
        !           198:                set $curcol %mcol
        !           199:                insert-string %c6
        !           200:                insert-string " "
        !           201:        !endwhile
        !           202: ;return to point
        !           203:        %pline goto-line
        !           204:        next-line
        !           205:        beginning-of-line
        !           206:        %width forward-character
        !           207:        6 forward-character
        !           208: !endm
        !           209: 
        !           210: ; user procedure to draw a horizontal from mark to point making spaces for
        !           211: ; the characters.
        !           212: store-procedure horizontal
        !           213:        set %s1 "�"
        !           214:        set %s2 "�"
        !           215:        set %s3 "*"
        !           216:        !if &equal %rcltype  0
        !           217: ;      then insert blanks
        !           218:                set %c1 "�"
        !           219:                set %c2 "�"
        !           220:                set %c3 " "
        !           221:                set %c4 "�"
        !           222:                set %c5 "�"
        !           223:                set %c6 "�"
        !           224:                set %c7 "�"
        !           225:                set %c8 "*"
        !           226:        !else
        !           227:                !if &equal %rcltype  1
        !           228: ;              then insert a single line
        !           229:                        set %c1 "�"
        !           230:                        set %c2 "�"
        !           231:                        set %c3 "�"
        !           232:                        set %c4 "�"
        !           233:                        set %c5 "�"
        !           234:                        set %c6 "�"
        !           235:                        set %c7 "�"
        !           236:                        set %c8 "*"
        !           237:                !else
        !           238:                        !if &equal %rcltype 2
        !           239: ;              then insert a double line
        !           240:                                set %c1 "�"
        !           241:                                set %c2 "�"
        !           242:                                set %c3 "�"
        !           243:                                set %c4 "�"
        !           244:                                set %c5 "�"
        !           245:                                set %c6 "�"
        !           246:                                set %c7 "�"
        !           247:                                set %c8 "*"
        !           248:                        !else
        !           249:                                set %c1 "*"
        !           250:                                set %c2 "*"
        !           251:                                set %c3 "*"
        !           252:                                set %c4 "*"
        !           253:                                set %c5 "*"
        !           254:                                set %c6 "*"
        !           255:                                set %c7 "*"
        !           256:                                set %c8 "*"
        !           257:                        !endif
        !           258:                !endif
        !           259:        !endif
        !           260:        run horline
        !           261: !endm
        !           262: 
        !           263: store-procedure vertical
        !           264:        set %s1 "�"
        !           265:        set %s2 "�"
        !           266:        set %s3 "*"
        !           267:        !if &equal %rcltype  0
        !           268:                set %c1 "�"
        !           269:                set %c2 "�"
        !           270:                set %c3 " "
        !           271:                set %c4 "�"
        !           272:                set %c5 "�"
        !           273:                set %c6 "�"
        !           274:                set %c7 "�"
        !           275:                set %c8 "*"
        !           276:        !else
        !           277:                !if &equal %rcltype  1
        !           278:                        set %c1 "�"
        !           279:                        set %c2 "�"
        !           280:                        set %c3 "�"
        !           281:                        set %c4 "�"
        !           282:                        set %c5 "�"
        !           283:                        set %c6 "�"
        !           284:                        set %c7 "�"
        !           285:                        set %c8 "*"
        !           286:                !else
        !           287:                        !if &equal %rcltype 2
        !           288:                                set %c1 "�"
        !           289:                                set %c2 "�"
        !           290:                                set %c3 "�"
        !           291:                                set %c4 "�"
        !           292:                                set %c5 "�"
        !           293:                                set %c6 "�"
        !           294:                                set %c7 "�"
        !           295:                                set %c8 "*"
        !           296:                        !else
        !           297:                                set %c1 "*"
        !           298:                                set %c2 "*"
        !           299:                                set %c3 "*"
        !           300:                                set %c4 "*"
        !           301:                                set %c5 "*"
        !           302:                                set %c6 "*"
        !           303:                                set %c7 "*"
        !           304:                                set %c8 "*"
        !           305:                        !endif
        !           306:                !endif
        !           307:        !endif
        !           308:        run verline
        !           309: !endm
        !           310: 
        !           311: store-procedure horline
        !           312: ; procedure to draw a line from beginning of line to point
        !           313:        !if &equal %mcol %pcol
        !           314:                !return
        !           315:        !endif
        !           316:        set $curline %pline
        !           317:        set $curcol %pcol
        !           318:        !if &less %pcol %mcol
        !           319: ;      then point was to left of mark.  exchange and reset variables
        !           320:                exchange-point-and-mark
        !           321:                run setpoints
        !           322:        !endif
        !           323:        !if %rcinsert
        !           324:                set $curcol %mcol
        !           325:        !else
        !           326:                beginning-of-line
        !           327:                newline
        !           328:                previous-line
        !           329: ;              end-of-line
        !           330: ;              newline
        !           331:                ; move to under mark
        !           332:                %mcol insert-string " "
        !           333:        !endif
        !           334: ; see if first char is a vertical line
        !           335:        previous-line
        !           336:        set %char &chr $curchar
        !           337:        next-line
        !           338:        %rcinsert delete-next-character
        !           339:        !if &sequal %char %s1
        !           340:                        insert-string %c1
        !           341:        !else
        !           342:                !if &sequal %char %s2
        !           343:                        insert-string %c2
        !           344:                !else
        !           345:                        !if &sequal %char %s3
        !           346:                                insert-string %c8
        !           347:                        !else
        !           348:                                insert-string %c3
        !           349:                        !endif
        !           350:                !endif
        !           351:        !endif
        !           352: ; now for all chars but the last character i.e., char at point
        !           353:        !while &less $curcol %pcol
        !           354:                previous-line
        !           355:                set %char  &chr $curchar
        !           356:                next-line
        !           357:                %rcinsert delete-next-character
        !           358:                !if &sequal %char %s1
        !           359:                        insert-string %c4
        !           360:         !else 
        !           361:                        !if &sequal %char %s2
        !           362:                                insert-string %c5
        !           363:                        !else
        !           364:                                !if &sequal %char %s3
        !           365:                                        insert-string %c8
        !           366:                                !else
        !           367:                                        insert-string %c3
        !           368:                                !endif
        !           369:                        !endif
        !           370:                !endif
        !           371:        !endwhile
        !           372: ; see if last char is a vertical line
        !           373:        previous-line
        !           374:        set %char  &chr $curchar
        !           375:        next-line
        !           376:        %rcinsert delete-next-character
        !           377:        !if &sequal %char %s1
        !           378:                        insert-string %c6
        !           379:        !else
        !           380:                !if &sequal %char %s2
        !           381:                        insert-string %c7
        !           382:                !else
        !           383:                        !if &sequal %char %s3
        !           384:                                insert-string %c8
        !           385:                        !else
        !           386:                                insert-string %c3
        !           387:                        !endif
        !           388:                !endif
        !           389:        !endif
        !           390: !endm
        !           391: 
        !           392: store-procedure verline
        !           393: ;  proc to draw vertical line from mark to point.  mark should be above point.
        !           394:        !if &equal %mline %pline
        !           395:                !return
        !           396:        !endif
        !           397: ;      if point was above mark exchange and reset variables
        !           398:        !if &less %pline %mline
        !           399:                exchange-point-and-mark
        !           400:                run setpoints
        !           401:        !endif
        !           402: ;top line
        !           403:        %mline goto-line
        !           404:        set $curcol %pcol
        !           405:        backward-character
        !           406:        set %char &chr $curchar
        !           407:        forward-character
        !           408:        %rcinsert delete-next-character
        !           409:        !if &sequal %char %s1
        !           410:                insert-string %c1
        !           411:        !else
        !           412:                !if &sequal %char %s2
        !           413:                        insert-string %c2
        !           414:                !else
        !           415:                        !if &sequal %char %s3
        !           416:                                insert-string %c8
        !           417:                        !else
        !           418:                                insert-string %c3
        !           419:                        !endif
        !           420:                !endif
        !           421:        !endif
        !           422: ;all but pline
        !           423:        !while &less $curline &sub %pline 1
        !           424:                next-line
        !           425:                beginning-of-line
        !           426:                set $curcol %pcol
        !           427:                backward-character
        !           428:                set %char &chr $curchar
        !           429:                forward-character
        !           430:                %rcinsert delete-next-character
        !           431:                !if &sequal %char %s1
        !           432:                        insert-string %c4
        !           433:                !else
        !           434:                        !if &sequal %char %s2
        !           435:                                insert-string %c5
        !           436:                        !else
        !           437:                                !if &sequal %char %s3
        !           438:                                        insert-string %c8
        !           439:                                !else
        !           440:                                        insert-string %c3
        !           441:                                !endif
        !           442:                        !endif
        !           443:                !endif
        !           444:        !endwhile
        !           445: ; bottom line
        !           446:        next-line
        !           447:        beginning-of-line
        !           448:        set $curcol %pcol
        !           449:        backward-character
        !           450:        set %char &chr $curchar
        !           451:        forward-character
        !           452:        %rcinsert delete-next-character
        !           453:        !if &sequal %char %s1
        !           454:                insert-string %c6
        !           455:        !else
        !           456:                !if &sequal %char %s2
        !           457:                        insert-string %c7
        !           458:                !else
        !           459:                        !if &sequal %char %s3
        !           460:                                insert-string %c8
        !           461:                        !else
        !           462:                                insert-string %c3
        !           463:                        !endif
        !           464:                !endif
        !           465:        !endif
        !           466: !endm
        !           467: 
        !           468: store-procedure delcol 
        !           469: ; proc to delete column.  we will use the getblock procedure with the column of
        !           470: ; the point set to one beyond the column point
        !           471:        set-points
        !           472:        !if &equal %mcol %pcol
        !           473:                ; same columns
        !           474:                forward-character
        !           475:                run getblock
        !           476:                !return
        !           477:        !else
        !           478:                !if &equal %mline %pline
        !           479:                run getblock
        !           480:                !return
        !           481:        !endif
        !           482: !endm
        !           483: 
        !           484: ;      delete a rectangular block of text
        !           485: 
        !           486: 11     store-macro
        !           487:        set %bkcopy FALSE
        !           488:        run getblock
        !           489:        write-message "[Block deleted]"
        !           490: !endm
        !           491: 
        !           492: ;      copy a rectangular region
        !           493: 
        !           494: 13     store-macro
        !           495:        set %bkcopy TRUE
        !           496:        run getblock
        !           497:        write-message "[Block copied]"
        !           498: !endm
        !           499: 
        !           500: ;      yank a rectangular region
        !           501: 
        !           502: 15     store-macro
        !           503:        set %bkcopy TRUE
        !           504:        run putblock
        !           505: !endm
        !           506: 
        !           507: ;      insert a rectangular region
        !           508: 
        !           509: 17     store-macro
        !           510:        set %bkcopy FALSE
        !           511:        run putblock
        !           512: !endm
        !           513: 
        !           514: store-procedure getblock
        !           515:        ;set up needed variables
        !           516:        set $discmd FALSE
        !           517:        delete-buffer "[block]"
        !           518:        set %rcbuf $cbufname
        !           519:        set %cline $cwline
        !           520: 
        !           521:        ;save block boundries
        !           522:        set %endpos $curcol
        !           523:        set %endline $curline
        !           524:        detab-region
        !           525:        exchange-point-and-mark
        !           526:        set %begpos $curcol
        !           527:        set %begline $curline
        !           528:        set %blwidth &sub %endpos %begpos
        !           529: 
        !           530:        ;scan through the block
        !           531:        set $curline %begline
        !           532:        !while &less $curline &add %endline 1
        !           533:                ;grab the part of this line needed
        !           534:                !force set $curcol %begpos
        !           535:                set-mark
        !           536:                !force set $curcol %endpos
        !           537:                kill-region
        !           538: 
        !           539:                ;bring it back if this is just a copy
        !           540:                !if %bkcopy
        !           541:                        yank
        !           542:                !endif
        !           543: 
        !           544:                ;put the line in the block buffer
        !           545:                select-buffer "[block]"
        !           546:                yank
        !           547: 
        !           548:                ;and pad it if needed
        !           549:                !if &less $curcol %blwidth
        !           550:                        &sub %blwidth $curcol insert-space
        !           551:                        end-of-line
        !           552:                !endif
        !           553:                forward-character
        !           554: 
        !           555:                ;onward...
        !           556:                select-buffer %rcbuf
        !           557:                next-line
        !           558:        !endwhile
        !           559: 
        !           560:         ;unmark the block
        !           561:         select-buffer "[block]"
        !           562:         unmark-buffer
        !           563:         select-buffer %rcbuf
        !           564:         previous-line
        !           565:         %cline redraw-display
        !           566:        set $discmd TRUE
        !           567: !endm
        !           568: 
        !           569: ;      insert/overlay a rectangular block of text
        !           570: 
        !           571: store-procedure putblock
        !           572:        ;set up needed variables
        !           573:        set $discmd FALSE
        !           574:        set %rcbuf $cbufname
        !           575:        set %cline $cwline
        !           576: 
        !           577:        ;save block boundries
        !           578:        set %begpos $curcol
        !           579:        set %begline $curline
        !           580: 
        !           581:        ;scan through the block
        !           582:        select-buffer "[block]"
        !           583:        beginning-of-file
        !           584:        set %endpos &add %begpos $lwidth
        !           585:        !while &not &equ $lwidth 0
        !           586: 
        !           587:                ;pad the destination if it is needed
        !           588:                select-buffer %rcbuf
        !           589:                beginning-of-line
        !           590:                !if &not &equ $lwidth 0
        !           591:                        1 detab-line
        !           592:                        previous-line
        !           593:                !endif
        !           594:                !force set $curcol %begpos
        !           595:                !if &less $curcol %begpos
        !           596:                        &sub %begpos $curcol insert-space
        !           597:                        end-of-line
        !           598:                !endif
        !           599: 
        !           600:                ;delete some stuff if this should overlay
        !           601:                !if %bkcopy
        !           602:                        set-mark
        !           603:                        !force set $curcol %endpos
        !           604:                        kill-region
        !           605:                !endif
        !           606: 
        !           607:                ;grab the line from the block buffer
        !           608:                select-buffer "[block]"
        !           609:                beginning-of-line
        !           610:                set-mark
        !           611:                end-of-line
        !           612:                copy-region
        !           613:                forward-character
        !           614: 
        !           615:                ;put the line in the destination position
        !           616:                select-buffer %rcbuf
        !           617:                yank
        !           618:                next-line
        !           619: 
        !           620:                ;onward...
        !           621:                select-buffer "[block]"
        !           622:        !endwhile
        !           623: 
        !           624:        select-buffer %rcbuf
        !           625:        set $curline %begline
        !           626:        set $curcol %begpos
        !           627:        %cline redraw-display
        !           628:        set $discmd TRUE
        !           629: !endm
        !           630: 
        !           631:        ; and init some variables
        !           632:        set %rcltype 2
        !           633:        write-message "[Block mode loaded]"
        !           634: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.