From ncr-sd!hp-sdd!hplabs!ucbvax!VB.CC.CMU.EDU!SCS7317%OCVAXB Fri May 27 13:28:37 PDT 1988 $!.............................................................................. $! VAX/VMS archive file created by VMS_SHAR V-5.01 01-Oct-1987 $! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au) $! To unpack, simply save and execute (@) this file. $! $! This archive was created by SCS7317 $! on Tuesday 24-MAY-1988 18:55:41.32 $! $! It contains the following 3 files: $! MAP.BAS MAP.PAS NEWS.TPU $!============================================================================== $ Set Symbol/Scope=(NoLocal,NoGlobal) $ Version=F$GetSYI("VERSION") ! See what VMS version we have here: $ If Version.ges."V4.4" then goto Version_OK $ Write SYS$Output "Sorry, you are running VMS ",Version, - ", but this procedure requires V4.4 or higher." $ Exit 44 $Version_OK: CR[0,8]=13 $ Pass_or_Failed="failed!,passed." $ Goto Start $Convert_File: $ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd $No_Error1: Define/User_Mode SYS$Output NL: $ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' - VMS_SHAR_DUMMY.DUMMY f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f); o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o); Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V"; Move_Vertical(1);x:=Erase_Character(1);Append_Line; Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1); ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1); If Current_Character='`' then Move_Horizontal(1);else Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit; $ Delete VMS_SHAR_DUMMY.DUMMY;* $ Checksum 'File_is $ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR $ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd $No_Error2: Return $Start: $ File_is="MAP.BAS" $ Check_Sum_is=1149044145 $ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY X10 rem MAP - hack tolook for news on a DECNET X20 rem it isn't pretty (and it doesn't use DAP (which it should)) but X30 rem it works. Which is the number one important thing in the real world X40 rem and all you programmers out there had better not forget it. X100 print "Map -- Check your entire DECNET for sites running USENET" X105 print X130 print "It checks invisible nodes...and dead nodes....infact" X140 print "It checks every possible node........" X150 print X200 for a = 1 to 74000 X202 if a = 68 then goto 400 X205 e = 0 X207 close #1 X210 when error in X220 open str$(a)+'::"/usr/lib/news/active"' as file #1, access read X230 use X240 e = 1 X250 print a ,ert$(err) X260 end when X300 if e = 0 then close #1 X305 if e = 1 then goto 400 X310 print using "######",a; X320 print " active" X330 ac$=ac$ + " " + str$(a) X400 next a X510 print V520 if ac$="" then print "No news easily found. A more sophisticated utility i Xs needed." X530 if ac$<>"" then print "news at "; ac$ X540 print X550 print "done." $ GoSub Convert_File $ File_is="MAP.PAS" $ Check_Sum_is=1867919516 $ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY Xprogram map (input,output); X X(* MAP.PAS`009This is a unsupported part of the NEWS(DECNET/VMS) suite. X X MAP.PAS`009Looks around your DECNET from any node suitably configured X`009 `009for NEWS(DECNET/VMS). You should pick the one closest to X`009`009you, and DEFINE it as NEWS_FARSITE. X X MAP.PAS`009works in the most crude way possible. A more sophisticated X`009`009technique (using DAP) would be nice, but...then again, X`009`009this works. X*) X XVAR node, stat : integer; X node_spec : varying [200] of char :=''; X infil : text; X XBEGIN X WRITELN('MAP X01 -- Map Your DECNET'); X WRITELN(' Looking for sites suitable to be NEWS_FARSITE'); X WRITELN; X for node := 1 TO 99000 DO X`009BEGIN X`009 node_spec := dec(node,5) + '::"/usr/lib/news/active"'; X`009 write(dec(node,5) + ':: '); X`009 OPEN(`009file_variable `009:= infil, X`009`009`009file_name`009:= node_spec, X`009`009`009history`009`009:= READONLY, X`009`009`009sharing`009`009:= READONLY, X`009`009 `009error`009`009:= CONTINUE); X`009 stat := status(infil); X`009 IF (stat = 0) X`009`009THEN writeln('SUCCESS!!! This could be used as news_farsite') X`009`009ELSE X`009`009`009begin X`009`009`009write ('Not this node. STATUS :='); X`009`009`009writeln (stat); X`009`009`009end; X`009 CLOSE(infil, error`009`009:= CONTINUE); X`009 X X`009END; X X XEND. X $ GoSub Convert_File $ File_is="NEWS.TPU" $ Check_Sum_is=1728655159 $ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY X! NEWS-news.tpu - a program to let people read news in comfort (scrolling X! backwards, automatic pause, etc) X! X!`009news.tpu Copyright 1988 (c) Christopher Seline X!`009ALL RIGHTS RESERVED X! X!`009TO USE THIS PRODUCT YOU MUST OBTAIN A LICENSE X! X!`009USE OF THIS PRODUCT MORE THAN FIVE (5) TIMES X!`009WITHOUT A LICENSE IS A CRIME. TO OBTAIN A LICENSE X!`009SEND THE LICENSING FEE TO: X!`009`009Christopher Seline X!`009`009127 Green Bay Rd. X!`009`009Winnetka, IL 60093 X! X!`009LICENSING FEE: X!`009`009Cluster license $250`009(per cluster) X!`009`009Machine license $100`009(per machine) X!`009`009Personal license$020`009(per user) X! X! X X`012 V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ X! installing this program V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ X! X! If you have lost the detailed instructions: X! rename this file to SYS$LOGIN:NEWS.TPU X! issue the DCL command EDIT/TPU/NOSEC/COM=SYS$LOGIN:NEWS.TPU X!`009Now, the following command will invoke news X!`009`009$ edit/tpu/sec=sys$login:news X!`009Don't forget to define NEWS_FARSITE to some decnet node. X!`009`009use MAP.PAS or MAP.BAS to figureout what to name it. X! X X`012 V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ X! INITIALIZATION PROCEDURES V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ X X XPROCEDURE tpu$init_procedure; X! TPU calls this procedure automatically when it starts up. X! After it exits, TPU will wait for bound keys and do their routines. X init_define_constants; X init_first; X init_determine_mode; X init_PopUp_intro_text; X init_subscribe; X init_moveto_first_group_with_news; XENDPROCEDURE; X X!---------- XPROCEDURE init_define_constants; X V message_window_length := 3; `009`009`009`009! size of the message window, Xin lines V status_text := "(X03.50) ^Z to exit ? for help ";`009! text to be dis Xplayed on the window's status line X spool_dir := "news_spool:";`009`009`009`009! spool area if enabled X page_scroll_amount := 19; X V $remote := 1; $sync := 2; $local := 3; $unknown := -1; $mode := $unknown;` X009`009`009! GLOBAL MODE V!`009$mode indicates what mode NEWS operates in. That is, where it looks for f Xiles X!`009`009$remote`009`009-- All files are on NEWS_FARSITE V!`009`009$sync`009`009-- active. is on NEWS_FARSITE, but some news articles ar Xe kept in NEWS_SPOOL, X!`009`009`009`009 so check there first X!`009`009$local`009`009-- All files are in NEWS_SPOOL (including active). V!`009`009`009`009 In $local mode, NEWS does not use DECNET at all. (unless Xyou've defined X!`009`009`009`009 NEWS_SPOOL to be on a DECNET NODE. X V no := 0; yes := 1; help_visited := no; keypad_help_visited := no;`009`009! XGLOBAL HELP BUFFER STATUS V X ! change these to $ form XENDPROCEDURE; X X!--------- XPROCEDURE init_first XLOCAL main_window_length; Xon_error`009! kill error messages Xendon_error; X V main_window_length := GET_INFO(SCREEN, "visible_length") - message_window_l Xength; X SET(PROMPT_AREA, main_window_length+1, 1, NONE); X V text_buffer := CREATE_BUFFER("Text");`009`009! create a buffer to hold the Xtext X SET(EOB_TEXT, text_buffer, "[END OF NEWS ITEM]"); X SET(NO_WRITE, text_buffer); X V text_window := CREATE_WINDOW(1, main_window_length, ON);`009! create the ma Xin text window X MAP(text_window, text_buffer); X V message_buffer := CREATE_BUFFER("Message Buffer");`009! Create a message bu Xffer for TPU messages, V SET(NO_WRITE, message_buffer); `009`009`009! for debugging, and map it into X a window X SET(SYSTEM, message_buffer); X SET(EOB_TEXT, message_buffer, ""); V message_window := CREATE_WINDOW(25-message_window_length, message_window_le Xngth, OFF); X MAP(message_window, message_buffer); X X XSET(FACILITY_NAME, "NEWS");`009`009`009`009! some initializtion XSET(MESSAGE_FLAGS, 15);`009`009`009`009`009! all message info XSET(SUCCESS, OFF); XSET(INFORMATIONAL, OFF); X Vjournal_open('nl:');`009`009`009`009`009! hack to prevent W-TPU$NOJOURNAL messa Xge X Xenable_bell; X XENDPROCEDURE; X X X!---------- XPROCEDURE init_determine_mode Xlocal junk, junk1; Xon_error Vjunk1 := 1;`009`009`009`009`009! indicate error, we expect an error when checki Xng for local spooling Xendon_error; X Xunmap(message_window);`009`009`009`009! stiffle RMS error messages X X! this procedure also creates active Xactive := CREATE_BUFFER ('active');`009`009! buffer holds /usr/lib/news/active XPOSITION (active); XSET (NO_WRITE, active); XSET (SYSTEM, active); XSET (TIMER, ON, "Loading active"); X Vmessage("");message("");message("");message("");! why can we intercept them w/ Xon ERR!!!! X XREAD_FILE(spool_dir + 'active.'); XIF beginning_of(active) = end_of(active) THEN X READ_FILE('news_farsite::"/usr/lib/news/active"'); X $mode := $remote X ELSE X $mode := $local; XENDIF; X XSET (TIMER, OFF); X XIF end_of(active) = beginning_of(active) THEN X message("I could not load active."); X message("USE q TO ABORT"); X message("USE q TO ABORT"); X message("USE q TO ABORT"); X five_map; X abort; XENDIF; X X XIF $mode = $remote THEN X! determine if spooling exists..... Xjunk := create_buffer("junk"); Xposition(junk); Xjunk1 := 0; XREAD_FILE (spool_dir + 'news-spooling-exists.'); VIF junk1 <> 1 then $mode := $sync; ENDIF;`009! if the file was sucessfully open Xed then we have local spooling of remote files X XENDIF; X XIF $mode = $remote THEN`009MESSAGE("NEWS(DECNET/VMS) V00.90 (remote)") ELSE XIF $mode = $local THEN`009MESSAGE("NEWS(DECNET/VMS) V00.90 (local)") ELSE XIF $mode = $sync THEN`009MESSAGE("NEWS(DECNET/VMS) V00.90 (sync)") ELSE X`009`009`009MESSAGE("NEWS(DECNET/VMS) V00.90 (BUG)"); XENDIF;ENDIF;ENDIF;`009! why can't the CASE statement deal with variables! X Xmap(message_window,message_buffer);`009`009! UNstiffle messages X XENDPROCEDURE; X X!---------- XPROCEDURE init_PopUp_intro_text; XPOSITION (BEGINNING_OF(text_buffer)); X X! THIS IS WHERE INTRODUCTORY TEXT GOES X V copy_text(" news.tpu Copyright (c) 1988 Christopher Seline"); s Xplit_line; X copy_text(" ALL RIGHTS RESERVED "); split_line; X copy_text(" "); split_line; V!copy_text(" USE OF THIS PRODUCT MORE THAN FIVE (5) TIMES WITHOUT A LICENSE XIS A"); split_line; V!copy_text(" CRIME. TO OBTAIN A LICENSE SEND THE LICENSING FEE TO: "); spli Xt_line; X!copy_text(" `009Christopher Seline "); split_line; X!copy_text("`009127 Green Bay Rd."); split_line; X!copy_text("`009Winnetka, IL 60093 "); split_line; X!copy_text(" "); split_line; X!copy_text(" LICENSING FEE:"); split_line; X!copy_text(" Cluster license $250`009(per cluster)"); split_line; X!copy_text(" Machine license $100`009(per machine)"); split_line; X!copy_text(" Personal license$020`009(per user)"); split_line; X copy_text(" "); split_line; X copy_text(" "); split_line; X V copy_text(" Press the SPACE BAR for next USENET message"); sp Xlit_line; X! XENDPROCEDURE; X X X!---------- XPROCEDURE init_subscribe X Xsubscribe := CREATE_BUFFER ('subscribe','sys$login:News_Subscribe.dat'); XSET (NO_WRITE, subscribe); XSET (SYSTEM, subscribe); XPOSITION (subscribe); XIF (BEGINNING_OF (subscribe) = END_OF (subscribe)) ! null or file not found X THEN X message ("Can't find your news subscription -- subscribing for you."); X message ("This takes several minutes -- so sit back and relax..."); X subscribe_create; XENDIF; Xupdate_banner; XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE subscribe_create XLOCAL a,b; XPOSITION (subscribe); VCOPY_TEXT (active);`009`009`009`009`009! copy active buffer into subscribe buff Xer X XIF (BEGINNING_OF (subscribe) = END_OF (subscribe)) ! null or file not found X THEN X message ("!!BUG -- reached subscribe_create with NULL active buffer"); X abort; XENDIF; X X X! now we need to massage the data VMAP (text_window, subscribe);`009`009`009`009! let them watch us massage the da Xta VPOSITION (BEGINNING_OF (subscribe));`009`009`009! leave only column one and two X, delete column three and four Xloop X exitif mark(none) = END_OF(subscribe);`009`009! exit loop at end of buffer X X a := select_column_two;`009`009`009`009! set last message read column V b := INT(a) - 20;`009`009 `009`009`009! 20 is a magic number for how many X messages to mark as unread X IF b < 1 THEN b := 1; ENDIF; X replace_column_two (b); X X position (search(' ',FORWARD));`009`009`009! delete last two columns X move_horizontal (+1); X position (search(' ',FORWARD)); X split_line; X erase_line; Xupdate(current_window); Xendloop; X V!move_group_to_top ("comp.os.vms"); ! these groups will be X read first X!move_group_to_top ("rec.arts.comics"); X!move_group_to_top ("rec.humor"); X!move_group_to_top ("rec.arts.drwho"); X!move_group_to_top ("rec.arts.startrek"); Xmove_group_to_top ("news.announce.newusers"); X VPOSITION (BEGINNING_OF (subscribe)); `009`009`009`009! unsubscribe control grou Xp Xposition(SEARCH (LINE_BEGIN & 'control', FORWARD, NO_EXACT)); Xreplace_column_two (99999);`009! 99999 magic number for unsubscribed X X XPOSITION (BEGINNING_OF (subscribe)); Xmap(text_window,text_buffer); XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE move_group_to_top (group_name) XLOCAL group_name, j1, j2; X! move a group to the top of subscribe buffer V! note, unlike most routines, this one does not restore original position in bu Xffers X XPOSITION (BEGINNING_OF (subscribe)); Xj1 := SEARCH (LINE_BEGIN & group_name & ' ', FORWARD, NO_EXACT); XIF j1 = 0 THEN return; ENDIF;`009`009`009! return if it doesn't exist Xposition(j1); X Xj2 := current_line; Xerase_line; XPOSITION (BEGINNING_OF (subscribe)); Xcopy_text(j2); Xsplit_line; XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- VPROCEDURE init_moveto_first_group_with_news;`009`009! move to first group w Xith something in it to read X Xmove_to_group_with_pending_news; X XENDPROCEDURE; X X`012 V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ V! PROCEDURES -- MANY BOUND TO KEYS -- MANY H XELPER FUNCTIONS V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ X X X V!------------------------------------------------------------------------------ X- XPROCEDURE page_down; X! scroll down almost one screensworth X SCROLL(text_window, page_scroll_amount); XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE page_up; X! scroll up almost one screensworth X SCROLL(text_window, -page_scroll_amount); XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE line_down Xlocal a; X! scroll down one line X a:=mark(none); X SCROLL(text_window, 1); X If a = mark(none) THEN`009`009`009`009! we haven't moved X move_vertical(+1); X ENDIF; XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE line_up Xlocal a; X! scroll up one line X a:=mark(none); X SCROLL(text_window, -1); X If (a = mark(none)) THEN`009`009`009`009! we haven't moved X move_vertical(-1); X ENDIF; XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE go_to_group; Xmessage("Go to exact group is no longer supported"); XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE go_to_group_NOexact XLOCAL group_name, j1,j2,j3; X! go to a new group....no need to find exact name X Xon_error`009! kill error messages X! if error = tpu$_strnotfound then X!`009message ("couldn't find it"); X! endif; Xendon_error; X X Xj1 := CURRENT_BUFFER; XPOSITION (subscribe); Xj3 := MARK (none);`009! where we were if search fails X Xgroup_name := READ_LINE ('GO TO WHICH GROUP (NOexact name): '); X Xmove_vertical(+1);`009`009`009! so we don't find current line Xj2 := SEARCH ( group_name , FORWARD, NO_EXACT); X XIF j2 = 0 THEN `009`009`009`009! try from beginning of buffer X`009POSITION (BEGINNING_OF (subscribe)); X`009j2 := SEARCH ( group_name , FORWARD, NO_EXACT); XENDIF; X XIF j2 = 0 THEN`009`009`009`009`009! couldn't find it anywhere X MESSAGE ("Can't find the group you refered to: "+ group_name); X POSITION (j3);`009! move to old place in subscribe X POSITION (j1);`009! move to old buffer X RETURN(0); XENDIF; X XPOSITION (j2); Xposition (search (LINE_BEGIN, REVERSE, EXACT)); X Vif mark(none) = j3 then message ("This is the only group that matches: "+ group X_name); X endif; X Xposition(text_buffer); Xzero_text_buffer; Xupdate_banner;`009`009`009`009`009! indicate new group and position X `009 XENDPROCEDURE; X V!------------------------------------------------------------------------------ X- XPROCEDURE update_banner`009`009! update status_line to current grp & position VLOCAL s1,s2, subs_current, a2, active_top, active_bot, diff,arg; X X Vposition (subscribe); `009`009`009`009! get subscribed group & next mesg. num Xber Xs1 := select_column_one; Xs2 := select_column_two; Xsubs_current := INT(s2); X Vposition (BEGINNING_OF(active));`009`009`009!move to same group in active as in X subscribe Xarg := SEARCH (LINE_BEGIN & s1 & ' ', FORWARD, NO_EXACT); Vif arg = 0 THEN `009`009`009`009`009! subscribe has groups that no longer exi Xst in active; X sync_subscribe; X return(0); XENDIF; Xposition(arg); Xa2 := select_column_two; Xactive_top := int (a2); Xactive_bot := int (select_column_three); XIF active_bot > subs_current THEN subs_current := active_bot; ENDIF; Xdiff := active_top - subs_current; XIF diff < 0 THEN diff := 0; ENDIF; X XIF subs_current = 99999 then VSET(STATUS_LINE, text_window, REVERSE, status_text + ' ' + s1 + ': Unsubscri Xbed'); X`009ELSE VSET(STATUS_LINE, text_window, REVERSE, status_text + ' ' + s1 + ':' + STR(su Xbs_current)+' '+str(diff)+' left'); X `009ENDIF; Xupdate(current_window); XENDPROCEDURE; X X V`012 X V!------------------------------------------------------------------------------ X- Xprocedure sync_subscribe`009`009`009`009! called if subscribe is out of whack V;!!!!!LOCAL ac_tmp, sub_tmp, a, b;`009 `009`009! this happens if a new gr Xoup is added or deleted from active X Xdisable_bell; Xmessage("Since I last checked groups have been added or deleted from active"); Xmessage("So, I'm going to sync subscribe to active."); Xmessage ("This takes several minutes -- so sit back and relax..."); X X! first makes copies of subscribe and active X X Xac_tmp := CREATE_BUFFER("ac_tmp"); Xset(No_write, ac_tmp); Xposition(ac_tmp); copy_text(active); X Xsub_tmp := CREATE_BUFFER("sub_tmp"); set(No_write, sub_tmp); Xposition(sub_tmp); copy_text(subscribe); X Xmap(text_window,sub_tmp); Xposition(beginning_of(sub_tmp)); Vloop`009`009`009! check each group in subscribe, if it isn't in active then del Xete it from subscribe X exitif mark(none) = END_OF(sub_tmp); X a1:= mark(none); X a := select_column_one; X position(beginning_of(ac_tmp)); X b := search(LINE_BEGIN & a & ' ', FORWARD, NO_EXACT); X if b = 0 then X position(a1); X erase_line; X message ("Deleted "+a); X ELSE X position(b); X erase_line;`009! erase each line -- any left will be not in subscribe X position(a1); X move_vertical (+1); X ENDIF; X update(text_window); Xendloop; X Xif beginning_of(ac_tmp) <> end_of(ac_tmp) THEN X map(text_Window,ac_tmp); V POSITION (BEGINNING_OF (ac_tmp));`009`009`009! leave only column one and two X, delete column three and four X loop X exitif mark(none) = END_OF(ac_tmp);`009`009! exit loop at end of buffer X message('Added ' + select_column_one); X a := select_column_two;`009`009`009`009! set last message read column V b := INT(a) - 20;`009`009 `009`009! 20 is a magic number for how many Xmessages to mark as unread X IF b < 1 THEN b := 1; ENDIF; X replace_column_two (b); X X position (search(' ',FORWARD));`009`009`009! delete last two columns X move_horizontal (+1); X position (search(' ',FORWARD)); X split_line; X erase_line; X update(text_window); X endloop; X position(sub_tmp); X copy_text(ac_tmp); X update(text_window); XENDIF; X Xerase(subscribe); Xposition(subscribe); Xcopy_text(sub_tmp); X Xposition(beginning_of(subscribe)); Xposition(beginning_of(active)); Xposition(beginning_of(text_buffer)); Xmap(text_window,text_buffer); Xenable_bell; XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE catch_up`009`009! mark current group as read XLOCAL s1, a2, active_top,x; Xx := mark(none); Xposition (subscribe); `009! get subscribed group & next mesg. # Xs1 := select_column_one; X Xposition (BEGINNING_OF(active));! move to same group in active Xposition(SEARCH (LINE_BEGIN & s1 & ' ', FORWARD, NO_EXACT)); Xa2 := select_column_two; Xactive_top := int (a2); X Xposition(subscribe); Xreplace_column_two (active_top);`009! update subscribe mesg# X Xupdate_banner; Xzero_text_buffer; Xposition(x); XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE UN_catch_up`009`009! mark this group as UNread XLOCAL s1, a3, active_bottom, old_pos; X Xold_pos := mark(none); Xposition (subscribe); `009! get subscribed group & next mesg. # Xs1 := select_column_one; X Xposition (BEGINNING_OF(active));! move to same group in active Xposition(SEARCH (LINE_BEGIN & s1 & ' ', FORWARD, NO_EXACT)); Xa3 := select_column_three; Xactive_bottom := int (a3); X Xposition(subscribe); Xreplace_column_two (active_bottom);`009! update subscribe mesg# X Xposition(old_pos); Xzero_text_buffer; Xupdate_banner; XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE Unsubscribe XLOCAL x; Xx := mark(none); Xposition(subscribe); Xreplace_column_two (99999);`009! 99999 magic number for unsubscribed Xposition(x); `009 `009`009! This will be a bug when a group his 99999 Xzero_text_buffer; Xupdate_banner; XENDPROCEDURE X X V!------------------------------------------------------------------------------ X- VPROCEDURE Subscribe_proc`009`009`009`009! resubscribe to unsubscribed news grou Xp XLOCAL x; Xx := mark(none); Xposition(subscribe); XUn_catch_up; Xposition(x); Xupdate_banner; XENDPROCEDURE X X X X X`012 V!------------------------------------------------------------------------------ X- XPROCEDURE next_news_message VLOCAL i3,j1,j2,j3,s1,s2,s1a, s4,spool,news_file,subs_current,i,a1,a2,a3,active_ Xbottom,active_top,spool_file; X! read in next message X X Xupdate_banner;`009`009`009! Indicate which group and message this is Xdisable_bell;`009`009`009! no beeping X Xposition (subscribe); `009! get subscribed group & next mesg. # Xs1 := select_column_one; Xs1a:= s1; Xs2 := select_column_two; Xsubs_current := INT(s2); X XIF subs_current = 99999 THEN `009! if unsubscribed then recurse till OK X`009next_group; X `009next_news_message; X`009return(0); XENDIF; X X!move to same group in active as in subscribe Xposition (BEGINNING_OF(active)); Xi := SEARCH (LINE_BEGIN & s1 & ' ', FORWARD, NO_EXACT); Xposition(i); X Xa1 := select_column_one; Xa2 := select_column_two; Xa3 := select_column_three; Xactive_bottom := int (a3); Xactive_top := int (a2); X X! create file name XIF subs_current < active_bottom THEN subs_current := active_bottom; ENDIF; XIF subs_current > active_top THEN`009! Nothing Left to READ? V`009message('Nothing left to read in group ' + s1 + ' -- Moving to next Group') X; X`009next_group; RETURN; ENDIF; X Xspool := s1; XTRANSLATE(spool,'_', '.');`009`009! convert to VMS Name XTRANSLATE(s1, '/', '.'); `009! convert to Unix Name X Vnews_file := 'news_farsite::"/usr/spool/news/' + s1 + '/' + STR(subs_current) + X '"' ; X Xspool_file := spool_dir + spool + '_' + STR(subs_current)+ '.'; X Xsubs_current := subs_current + 1; Xposition(subscribe); Xreplace_column_two (subs_current);`009! update subscribe mesg# X X!read in file XPOSITION (text_buffer); XERASE (text_buffer); XSET (TIMER, ON, 'Retrieving.'); X XIf ($mode = $local) or ($mode = $sync) THEN READ_FILE ( spool_file ); ENDIF; X XIf ($mode = $remote) `009`009`009THEN READ_FILE ( news_file ); ENDIF; X XIf ($mode = $sync) and (BEGINNING_OF (text_buffer)= END_OF (text_buffer)) X THEN READ_FILE ( news_file ); ENDIF; X XPOSITION (BEGINNING_OF (text_buffer)); VIF (BEGINNING_OF (text_buffer)= END_OF (text_buffer))`009! null or file not fou Xnd X THEN X message ("Null News Body -- Hope that's OK"); X message(""); X ELSE V underline_subject_line; `009`009`009! underline subject if got ne Xws XENDIF; X X XSET (TIMER, OFF); Xenable_bell; X XENDPROCEDURE; X X X`012 V!------------------------------------------------------------------------------ X- VPROCEDURE next_group;`009`009`009 ! still needs to skip comletely read gro Xups X Xposition(subscribe); Xif mark(none) = end_of(current_buffer)then X`009message ('ARGH -- End of News Groups (no more to read)'); X`009move_vertical(-1); X`009return(0); XENDIF; Xmove_vertical(+1);`009`009`009`009! move to next group Xmove_to_group_with_pending_news; X Xupdate_banner; X XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE move_to_group_with_pending_news X! checks current group -- if current group has news it does not move forward X XLOCAL s1,s2,subs_current,a2,active_top,active_bot,diff; X Xposition(subscribe); X! check for end of news groups Xif mark(none) = end_of(current_buffer)then X`009message ('argh -- End of News Groups (no more to read)'); X`009move_vertical(-1); X`009return(0); XENDIF; X X! if its an unsubscribed group, skip it Xs1 := select_column_one; Xs2 := select_column_two; Xsubs_current := INT(s2); X XIF subs_current = 99999 THEN `009! if unsubscribed then recurse till OK X`009next_group; X`009return(0); XENDIF; X Vposition (BEGINNING_OF(active));`009`009`009!move to same group in active as in X subscribe Xposition(SEARCH (LINE_BEGIN & s1 & ' ', FORWARD, NO_EXACT)); Xa2 := select_column_two; Xactive_top := int (a2); Xactive_bot := int (select_column_three); XIF active_bot > subs_current THEN subs_current := active_bot; ENDIF; Xdiff := active_top - subs_current; XIF diff < 0 THEN diff := 0; ENDIF; X XIF diff = 0 THEN`009`009`009! recurse till locate group with items to read X next_group; X return(0); XENDIF; X XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE zero_text_buffer;`009`009`009`009! erase text buffer VIF end_of(text_buffer) <> beginning_of(text_buffer) THEN! but don't bother unle Xss there is text in it X erase(text_buffer); XENDIF; XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE space_bar XLOCAL here; Xhere := MARK(none); Xpage_down; XIF here = mark(none) THEN`009`009`009`009! we didn't move X next_news_message;`009`009`009`009`009! so at end of mesg XENDIF; XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE exit_news; X XWRITE_FILE (subscribe, 'sys$login:NEWS_SUBSCRIBE.dat'); Xdisable_bell; Xmessage ('Thank You For Using NEWS(DECNET/VMS)`009 `009:-)'); Xquit; XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE keypad_help; X XIf keypad_help_visited = no THEN X keypad_help_init; X keypad_help_visited := yes; X return; XENDIF; X XMAP(text_window, keypad_help_buffer); X XENDPROCEDURE X X X XPROCEDURE keypad_help_init; Xkeypad_help_buffer := create_buffer('keypad_help_buffer'); XSET(NO_WRITE, keypad_help_buffer); XSET(SYSTEM, keypad_help_buffer); XSET(EOB_TEXT, keypad_help_buffer, ""); X XMAP(text_window, keypad_help_buffer); Xposition(keypad_help_buffer); X X!`012 Xcopy_text ('NEWS keypad for VT100 series terminals'); split_line; Xcopy_text (''); split_line; Vcopy_text (' _________________________________ _______________________ X__________'); split_line; Vcopy_text (' | ^ | | | | | | | | X | |'); split_line; Vcopy_text (' | | | V | | | | Find | Help | Pause X | |'); split_line; Vcopy_text (' |_______|_______|_______|_______| |_______|_______|______ X_|_______|'); split_line; Vcopy_text (' | | | X | |'); split_line; Vcopy_text (' | | | X | |'); split_line; Vcopy_text (' |_______|_______|______ X_|_______|'); split_line; Vcopy_text (' | | | X | Next |'); split_line; Vcopy_text (' | | | X | Group |'); split_line; Vcopy_text (' |_______|_______|______ X_|_______|'); split_line; Vcopy_text (' | | | X | |'); split_line; Vcopy_text (' | | | X | |'); split_line; Vcopy_text (' CTRL/R - Refresh |_______|_______|______ X_| Next |'); split_line; Vcopy_text (' CTRL/Z - Exit | Next |Prev X |Message|'); split_line; Vcopy_text (' | Screen |Screen X | |'); split_line; Vcopy_text (' |_______________|______ X_|_______|'); split_line; Xcopy_text (''); split_line; Xposition(beginning_of(keypad_help_buffer)); X X! XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE news_help; X! give them help X XIf help_visited = no THEN X news_help_init; X help_visited := yes; X return; XENDIF; X XMAP(text_window, help_buffer); X XENDPROCEDURE X X X XPROCEDURE news_help_init; Xhelp_buffer := create_buffer('help_buffer'); XSET(NO_WRITE, help_buffer); XSET(SYSTEM, help_buffer); XSET(EOB_TEXT, help_buffer, ""); X XMAP(text_window, help_buffer); Xposition(help_buffer); X Vcopy_text(' NEWS keyboard help: X '); split_line; Vcopy_text(' n - get next message X '); split_line; Vcopy_text(' N - moves to next group X '); split_line; Vcopy_text(' X '); split_line; Vcopy_text(' s - Saves current message to a file X '); split_line; Vcopy_text(' g - go to a group by name X '); split_line; Vcopy_text(' X '); split_line; Vcopy_text(' c - Catch-up (marks all messages in current gr Xoup as read)'); split_line; Vcopy_text(" u - Unsubscribe (you'll never see this Xgroup again)"); split_line; Vcopy_text(' # - read article by number (skips interveni Xng articles)'); split_line; Vcopy_text(' X '); split_line; Vcopy_text(' CTRL/W - refresh screen X '); split_line; Vcopy_text(' CTRL/Z - exit X '); split_line; Vcopy_text(' X '); split_line; Vcopy_text(' - Displays next screen full of text X '); split_line; Vcopy_text(' - If there is no more text, it gets next messag Xe '); split_line; Vcopy_text(' X '); split_line; Vcopy_text(' X '); split_line; Xcopy_text(" Press <1> to Exit Help"); XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE disable_bell; VSET (BELL, ALL ,OFF); X XSET (BELL, BROADCAST, ON); XENDPROCEDURE; X XPROCEDURE enable_bell; XSET (BELL, ALL ,ON ); XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE my_undefined_key; Xmessage ('');`009`009`009! this rings bell as long as broadcast is set = all XENDPROCEDURE; X XPROCEDURE one_map;`009`009! map text_buffer with USENET news to screen XMAP(text_window, text_buffer); Xupdate_banner; XENDPROCEDURE; X XPROCEDURE two_map;`009`009! map subscribe to screen X`009`009`009`009! allow arrows keys to select group XMAP (text_window, subscribe); XENDPROCEDURE; X XPROCEDURE three_map; XMAP (text_window, active); XENDPROCEDURE; X XPROCEDURE five_map; XMAP (text_window, message_buffer); XENDPROCEDURE; X XPROCEDURE six_map; XMAP (text_window, ac_tmp); XENDPROCEDURE; X XPROCEDURE seven_map; XMAP (text_window, sub_tmp); XENDPROCEDURE; X X X XPROCEDURE end_of_line Xposition (search (LINE_END, FORWARD, EXACT)); XENDPROCEDURE; X X XPROCEDURE begin_of_line; Xposition (search (LINE_BEGIN, REVERSE, EXACT)); XENDPROCEDURE; X X XPROCEDURE save_mesg`009`009`009! write current message to disk XLOCAL save_name; Xsave_name := READ_LINE ('Save current message to file: '); Xif length(save_name) = 0 then return(0); endif; XWRITE_FILE (text_buffer, save_name); Xmessage('file written');`009! add: check if written sucessfully XENDPROCEDURE; X X XPROCEDURE select_column_one XLOCAL j1; `009`009`009`009! returns column one as a string Xposition (search (LINE_BEGIN, REVERSE, EXACT)); Xj1 := search (LINE_BEGIN & SCAN(' '),FORWARD); XRETURN (SUBSTR(j1,1,999)); XENDPROCEDURE; X X XPROCEDURE select_column_two XLOCAL a, b, c, d; ! returns column two as a string X Xposition (search (LINE_BEGIN, REVERSE, EXACT)); X Xa := current_line + ' '; Xb := INDEX (a, ' '); Xa := SUBSTR (a, b+1, 999); X Xc := INDEX (a, ' '); Xd := SUBSTR (a, 1, c - 1); X XRETURN(SUBSTR(d,1,999)); XENDPROCEDURE; X X XPROCEDURE select_column_three XLOCAL a, b, c, d, e; `009`009`009`009`009! returns column three as a string X Xposition (search (LINE_BEGIN, REVERSE, EXACT));`009`009! LINE ->> STRING Xa := current_line + ' '; X Xb := INDEX (a, ' '); Xa := SUBSTR (a, b+1, 999); X Xc := INDEX (a, ' '); Xa := SUBSTR (a, c+1, 999); X Xd := INDEX (a, ' ');`009`009`009! extract column three Xe := SUBSTR (a, 1, d-1); X XRETURN (SUBSTR(e,1,999)); XENDPROCEDURE; X X XPROCEDURE replace_column_two (thing) XLOCAL a, aa, aaa, line, x3, b, c, d, thing1; X Xthing1 := STR(thing);`009`009`009! precede w/ 0's XIF LENGTH(thing1) < 5 THEN thing1 := "0"+thing1; ENDIF; XIF LENGTH(thing1) < 5 THEN thing1 := "0"+thing1; ENDIF; XIF LENGTH(thing1) < 5 THEN thing1 := "0"+thing1; ENDIF; XIF LENGTH(thing1) < 5 THEN thing1 := "0"+thing1; ENDIF; XIF LENGTH(thing1) < 5 THEN thing1 := "0"+thing1; ENDIF; X Xposition (search (LINE_BEGIN, REVERSE, EXACT)); `009! LINE ->> STRING Xa := current_line + ' '; X Xb := INDEX (a, ' '); Xaa := SUBSTR (a, b+1, 999); X Xc := INDEX (aa, ' '); Xaaa:= SUBSTR (aa, c, 999); X Xline := SUBSTR(a,1,b) + thing1 + aaa; Xedit (line, TRIM_TRAILING); Xposition (search (LINE_BEGIN, REVERSE, EXACT)); Xcopy_text(line); Xsplit_line; Xerase_line; Xmove_vertical (-1); XENDPROCEDURE; X X XPROCEDURE go_to_article XLOCAL a1, numb , x; X Xa1 := READ_LINE ('Go to which article number: '); Xif a1 = "" THEN return(0); ENDIF; Xnumb := INT(a1); Xif numb = 0 then return; endif; X Xx := mark(none); Xposition(subscribe); Xreplace_column_two (numb); Xposition(x); Xnext_news_message; X XENDPROCEDURE; X X XPROCEDURE top_of_buf; Xposition(beginning_of(current_buffer)); XENDPROCEDURE; X X XPROCEDURE bot_of_buf; Xposition(end_of(current_buffer)); XENDPROCEDURE; X X Xprocedure author; Xmessage("Written By Christopher Seline (11/Apr/88)"); Xmessage("SCS7317@oberlin.bitnet"); XENDPROCEDURE; X XPROCEDURE try; Xmessage('try1'); X XENDPROCEDURE; X XPROCEDURE underline_line XLOCAL r1,r2; X! bug -- only underlines in one buffer at a time Xposition (search (LINE_BEGIN, REVERSE, EXACT)); Xr1 := MARK (none); Xposition (search (LINE_END, FORWARD, EXACT)); Xr2 := MARK (none); X Xunderline_x2 := CREATE_RANGE (r1,r2,UNDERLINE); Xr1 := 0; Xr2 := 0; XENDPROCEDURE; X XPROCEDURE underline_subject_line XLOCAL X r1,r2,j3 ; X Xj3 := mark (none); Xr1 := search ('subject',FORWARD,NO_EXACT); XIF r1 = 0 THEN return(0); ENDIF; !No Subject Xposition (r1); X Xposition (search (LINE_BEGIN, REVERSE, EXACT)); Xr1 := MARK (none); Xposition (search (LINE_END, FORWARD, EXACT)); Xr2 := MARK (none); X Xunderline_i1 := CREATE_RANGE (r1,r2,UNDERLINE); Xr1 := 0; Xr2 := 0; X Xposition (j3); XENDPROCEDURE; X X X X VPROCEDURE scroll_line_to(dest_line)`009`009`009`009! scrolls the screen so that X the current line is at the line # specified by dest_line VLOCAL old_position;`009`009`009`009`009`009! preserves the cursor position thro Xugh the scroll X old_position := MARK(NONE); X SCROLL(CURRENT_WINDOW, X GET_INFO(CURRENT_WINDOW, "current_row")-dest_line); X POSITION(old_position); XENDPROCEDURE; X X X`012 V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X+++++++++++++++++++++++++++++++++++++++++++++++++ X! K E Y B I N D I N G S V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X+++++++++++++++++++++++++++++++++++++++++++++++++ X VSET(SELF_INSERT, "TPU$KEY_MAP_LIST", OFF);`009! make it so typing keys won't se Xlf-insert VSET(UNDEFINED_KEY, "TPU$KEY_MAP_LIST", "my_undefined_key");`009! and specify wh Xat to do when an undefined key is pressed XDEFINE_KEY("exit_news", CTRL_Z_KEY);`009`009! exit XDEFINE_KEY("quit",KEY_NAME('q')); XDEFINE_KEY("author", KEY_NAME("A")); XDEFINE_KEY("page_down", KP0);`009`009`009! page down XDEFINE_KEY("page_up", PERIOD);`009`009`009! page up XDEFINE_KEY("line_down", DOWN);`009`009`009! scroll down XDEFINE_KEY("line_up", UP);`009`009`009! scroll up XDEFINE_KEY("go_to_article", KEY_NAME("#"));`009! goto article # XDEFINE_KEY("go_to_group", KEY_NAME("G"));`009! Goto Group EXACT XDEFINE_KEY("go_to_group_NOexact", KEY_NAME("g"));! Goto Group NOEXACT XDEFINE_KEY("go_to_group_NOexact", PF1);`009`009! Goto Group NOEXACT XDEFINE_KEY("next_group", KEY_NAME('N'));`009! next group XDEFINE_KEY("next_group", COMMA );`009! next group XDEFINE_KEY("space_bar", KEY_NAME(" "));`009 `009! NEXT THING XDEFINE_KEY("next_news_message", ENTER); XDEFINE_KEY("next_news_message", KEY_NAME('n')); XDEFINE_KEY("attach", KEY_NAME('P'));`009`009! PAUSE news XDEFINE_KEY("attach", PF3 ); XDEFINE_KEY("catch_up",KEY_NAME('c')); `009`009! mark group as read XDEFINE_KEY("UN_catch_up",KEY_NAME('C'));`009`009! mark group as UNread XDEFINE_KEY("keypad_help", PF2); XDEFINE_KEY("news_help", KEY_NAME('?')); XDEFINE_KEY("news_help", KEY_NAME('h')); XDEFINE_KEY ("one_map", KEY_NAME("1")); XDEFINE_KEY ("two_map", KEY_NAME("2")); XDEFINE_KEY ("three_map", KEY_NAME("3")); XDEFINE_KEY ("five_map", KEY_NAME("5")); XDEFINE_KEY ("six_map", KEY_NAME("6")); XDEFINE_KEY ("seven_map", KEY_NAME("7")); X XDEFINE_KEY ("top_of_buf",KEY_NAME("<")); XDEFINE_KEY ("bot_of_buf",KEY_NAME(">")); XDEFINE_KEY ("save_mesg", KEY_NAME('s'));`009`009! save to disk XDEFINE_KEY ("subscribe_proc", KEY_NAME('U'));`009`009! UNunsubscribe XDEFINE_KEY ("unsubscribe", KEY_NAME('u')); XDEFINE_KEY ("refresh", CTRL_L_KEY); XDEFINE_KEY ("refresh", CTRL_R_KEY); XDEFINE_KEY ("refresh", CTRL_W_KEY); X X! for debugging X XDEFINE_KEY ("try" , KEY_NAME("~")); X X X V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X+++++++++++++++++++++++++++++++++++++++++++++++++ X X!SAVE("SYS$LOGIN:news"); XSAVE("students:[scs7317.trans]news_inprog"); XQUIT; X $ GoSub Convert_File $ Exit From ncr-sd!hp-sdd!ucsdhub!ucsd!ames!mailrus!uwmcsd1!dogie!dorl@vms.macc.wisc.edu Sun Jul 31 18:14:00 PDT 1988 ******** copyright.doc ******** Copyright (C) 1988, University of Wisconsin Board of Regents, all rights reserved. Anyone may reproduce this work, in whole or in part, provided that: (1) any copy of the entire work must show University of Wisconsin as the source, and must include this notice; and (2) any other use of this work must acknowledge the fact that the material is coprighted by the University of Wisconsin Board of Regents and is used by permission. ******** install.doc ******** News - A Native VMS News Reading Program 1.0 Introduction News is a user agent program for reading News. The news database is not kept on the VMS machine, instead the nntp protocol is used to access the data on a server machine. The VMS machine must be connected to an IP network and must run the Wollongong WIN/VX network software. 2.0 Distribution Description The distribution consists of 19 files. Each file is preceded by a line of the form... ******** file_name ******** The following files are included... FileName ND Description COPYRIGHT.DOC Copyright notice INSTALL.DOC This file CONFIG.DAT * Configuration data CONVERT.COM * Com file to rename Eunice save files GETUSERNAME.FOR News source (subroutine) INSTALL.COM * Com file to install news.exe LINKNEWS.COM Com file to link News.Exe MAKE.COM Com file to compile News source NEWS.CLD * News command syntax definition NEWS.DEF News source (include) NEWS.DOC A user description of News NEWS.FOR News source (main program and subroutines) NEWS_CLD_INSTALL.COM * Com file to add News command syntax to system SMG.DEF News source (include) SMG_ROUTINES.FOR News source (include) TNEWS.CLD Com file to define TNews command for testing UP_DN_PRIV.FOR News source (subroutine) USER_OPEN.COMMON News source (include) USER_OPEN.FOR News source (subroutine ) Use an editor to break up the distribution into its parts. I keep the file in directory .xxnews in my home directory. 3.0 Building News The source code needs to be compiled, use the make.com file to do this. Make accpets a list of Fortran options. If you want a listing of the source do... @make list otherwise do @make Now link News using the linknews.com. If you intend to install News sytem wide, you might want to include the notraceback parameter.... @linknews notraceback 4.0 Configuring Site Dependent News Data All site dependent data is kept in newsdir:config.dat. This includes... siteid the name of the machine, used when posting articles. Include everything needed after the username. eg. @a.b.c.edu distribution a list of valid distributions. organization text describing the organization controlling your machine. Used when posting articles. server the numeric ip number of the server. Edit config.dat to use your definitions. 5.0 Running News You can run News from your account or you can install it in a system directory. 5.1 Running News without Installing It Define symbol newsdir pointing to the directory containing news.exe and config.dat. Edit config.dat so that contains data for your site. Edit TNews.Cld so that it points at the file containing news.ex. Define the TNews parameter with... $set command tnews Now run News with the TNews command. 5.2 Running News after Installing It In order to install news on a system wide basis you need to do the following... compile news. link news with the notraceback option. edit config.dat to conform to data at your site. create a system wide logical name, newsdir, pointing at a file containing files news.exe and those marked in the ND column in section 2.0. install news.exe using newsdir:install.com. This is not strictly required but does allow News to obtain the user personal name from the Sys$Sytem:VMSMail.Dat file for use when posting articles. add the News command to the system command tables using newsdir:news_cld_install.com. update your boot procedure to define newsdir and to install news. 6.0 User Documentation File news.doc contains a user description of the program. This file was written to describe News to the editor developing a final user document. Its quite terse, contains instructions to the editor, and is probably full of gramatical and spelling errors. The final user document may be made available at a later date. 7.0 Copyright Notice Copyright (C) 1988, University of Wisconsin Board of Regents, all rights reserved. Anyone may reproduce this work, in whole or in part, provided that: (1) any copy of the entire work must show University of Wisconsin as the source, and must include this notice; and (2) any other use of this work must acknowledge the fact that the material is coprighted by the University of Wisconsin Board of Regents and is used by permission. ******** config.dat ******** siteid: @vms.macc.wisc.edu distribution: local, cs, uw, wi, usa, na, net, world, mod, comp, news distribution: sci, rec, misc, soc, talk, macc organization: University of Wisconsin Academic Computing Center server: 128.104.30.17 ******** convert.com ******** $ ! Convert.Com $ ! $ ! Renames files in sys$login:news.dir form Eunice rrn form to $ ! VMS news form. $ $ ! Get next file $ $NextFile: $ File = F$Search ("*.*;*") $ If File .eqs. "" Then Goto Exit $ L = F$Length(File) $ X = F$Locate ("]",File)+1 $ Dir = F$Extract(0,X,File) $ File = F$Extract (X,L-X,File) $ $ ! Change all $5 to _ $ $ NewFile = File $ $NextDot: $ L = F$Length (NewFile) $ X = F$Locate ("$5",NewFile) $ If X .eq. L Then Goto ExitDot $ NewFile = F$Extract(0,X,NewFile) + "_" + F$Extract(X+2,L-X-2,NewFile) $ Goto NextDot $ExitDot: $ $ ! Change rest of $ to nothing $ $NextDollar: $ L = F$Length (NewFile) $ X = F$Locate ("$",NewFile) $ If X .eq. L Then Goto ExitDollar $ NewFile = F$Extract(0,X,NewFile) + F$Extract(X+1,L-X-1,NewFile) $ Goto NextDollar $ExitDollar: $ $ ! Now display result $ $ If File .eqs. NewFile Then Goto NoChange $ Rename/Log 'File' 'NewFile' $ $NoChange: $ Goto NextFile $ $Exit: $ Exit ******** getusername.for ******** Integer Function GetUserName (UserId) C Description: C C Function to obtain the user's name C Returns success or failure. Include 'News.Def' C Parameter Definitions Character *32 UserId C External Routines External Sys$GetJPI Integer Sys$GetJPI C Local Definitions Include '($JPIDEF)' Character *(UserIdSz) LUserId Integer *4 LUserIdLg Integer *2 WJPIItmLst(12) Integer *4 JPIItmLst(6) Equivalence (JPIItmLst,WJPIItmLst) C Begin GetUserName WJPIItmLst(1) = UserIdSz WJPIItmLst(2) = JPI$_UserName JPIItmLst(2) = %Loc(LUserId) JPIItmLst(3) = %Loc(LUserIdLg) JPIItmLst(4) = 0 GetUserName = Sys$GetJPI (,,,JPIItmLst,,,) If (GetUserName) Then UserId = LUserId(1:LUserIdLg) EndIf Return End ! GetUserName ******** install.com ******** $Run Sys$system:Install NewsDir:News/Delete NewsDir:News/Open/Shared/Header/Priv=Bypass $ $Run Sys$System:Install NewsDir:News/Full $ ******** linknews.com ******** $If P1 .nes. "" Then P1 = "/" + P1 $Link'P1 news.obj,smg_routines,user_open,Up_Dn_Priv,- twg$tcp:[netdist.lib]libnet.olb/lib,- twg$tcp:[netdist.lib]libnetacc.olb/lib,- twg$tcp:[netdist.lib]libnet.olb/lib,- twg$tcp:[netdist.lib]libnetacc.olb/lib,- twg$tcp:[netdist.lib]libnet.olb/lib,- twg$tcp:[netdist.lib]libnetacc.olb/lib,- twg$tcp:[netdist.lib]libnet.olb/lib,- twg$tcp:[netdist.lib]libnetacc.olb/lib,- twg$tcp:[netdist.lib]libnet.olb/lib,- twg$tcp:[netdist.lib]libnetacc.olb/lib,- twg$tcp:[netdist.lib]libnet.olb/lib,- twg$tcp:[netdist.lib]libnetacc.olb/lib,- twg$tcp:[netdist.lib]libnet.olb/lib $ ******** make.com ******** $If P1 .nes. "" Then P1 = "/" + P1 $For'P1 news $For'P1 getusername $For'P1 smg_routines $For'P1 up_dn_priv $For'P1 user_open $ ******** news.cld ******** Define Verb News Image "NewsDir:News" Qualifier Header Value(List) Qualifier Mark Value(Type=$Rest_Of_Line) ******** news.def ******** Implicit None C VMS Constants Parameter UserIdSz = 31 ! Length of a username C Define incore group control structure Structure /GroupDef/ Character *32 Name ! Name Logical Subscribed ! User has subscribed Logical Newsrc_File ! Found in Newsrc file Logical Active_File ! Found in active file Integer *4 Active_Start ! Active file start Integer *4 Active_End ! Active file end Logical Active_Post ! Active file post flag Integer *2 Range_First ! Newsrc range list start Integer *2 Range_Last ! Newsrc range list end End Structure ! GroupDef C Define group article range structure Structure /RangeDef/ Integer *2 Next Integer *2 Start Integer *2 End End Structure ! RangeDef C Define Socket Structure Structure /Socket_IN_Def/ Integer *2 SIN_Family Integer *2 SIN_Port Integer *4 SIN_Address Byte SIN_Fill(8) End Structure ! Socket_IN_Def C Define news parameters Parameter LU_Newsrc = 10 Parameter LU_Save = 11 Parameter LU_EditIn = 12 Parameter LU_EditOut = 13 Parameter LU_Init = 14 Parameter LU_VMSMail = 15 Parameter LU_Signature = 16 Parameter File_Name_Size = 128 Parameter Mx_Range = 10000 Parameter Mx_Group = 1000 C Define News common block Integer *4 Group_Count Record /GroupDef/ Group(Mx_Group) Integer *4 Range_Count Record /RangeDef/ Range(Mx_Range) Integer *4 Range_Free_List Integer *4 Distribution_Count Character *16 Distribution(50) Character *31 UserName Character *64 UserDirectory Character *128 UserPersonalName Character *64 UserMailDirectory Character *64 SiteId Character *64 Organization Byte Server_IP_Number(4) Logical Newsrc_Is_Open ! .true. if user had a ! xx.newsrc file Character *20 Newsrc_CDT_VMS ! xx.newsrc creation date time ! 'dd-mmm-yyyy hh:mm:ss' Character *13 Newsrc_CDT_News ! xx.newsrc creation date time ! 'ddmmyy hhmmss' Character *16 Header(16) ! /Header = fields Integer *4 Header_Count ! Number of /header fields Logical Header_Present ! .true. if /header present Character Mark_Character ! Followup mark character ! .true. if logical name ! MAIL$EDIT defined Logical Mail_Cmd_Mail$Edit Logical Rotated ! .true. if article last seen ! in rotated mode Logical Debug ! .true. if debug mode turned ! on by J command Logical FirstFlag ! Used to skip multiple ! copies of subject line ! in Cmd_ArticleList Common /News/ $ Group_Count, Group, $ Range_Count, Range, Range_Free_List, $ Distribution_Count, Distribution, $ UserName, UserDirectory, UserPersonalName, UserMailDirectory, $ SiteId, Organization, $ Server_IP_Number, $ Newsrc_CDT_VMS, Newsrc_CDT_News, Newsrc_Is_Open, $ Header_Present, Header_Count, Header, $ Mark_Character, Mail_Cmd_Mail$Edit, Rotated, Debug, FirstFlag C WIN TCP/IP Services Integer Connect External Connect Integer HtoNS External HtoNS Integer Recv External Recv Integer Send External Send Integer Socket External Socket C WIN TCP/IP Constants Parameter AF_INet = 2 Parameter Sock_Stream = 1 Parameter Sock_DGram = 2 C TCP/IP Common Definitions Integer *4 Channel Character *512 Recv_Buf Integer *4 Recv_BufE Integer *4 Recv_BufS Common /Server/ Channel, Recv_Buf, Recv_BufS, Recv_BufE ******** news.doc ******** News 1.0 Introduction News is a native VMS news reading client that uses the network news transport protocol to access news stored on a remote server. It was written by Michael Dorl at the Madison Academic Computing Center, University of Wisconsin as a personal project to gain familiarity with The Wollongong WIN/VX program interface to the TCP/IP network. Much of the look and feel of the user interface was shamelessly borrowed from the many fine news reading programs in the Unix world. 2.0 User Documentation News works best on screen oriented terminal. It uses the DEC SMG routines and supports all of the standard VMS terminal types. The best way to learn about news is to try it. But before you do that, a few words on converting from your current Eunice rrn news environment to your new news environment. 2.1 Converting from Eunice rrn to news News keeps your news database in file sys$login:xx.newsrc. This file has the same format as a rrn .newsrc file except that its in RMS format rather than in Eunice stream format. To make a xx.newsrc: $ Set default sys$login $ Copy .newsrc xx.newsrc $ Unixtovms xx.newsrc News keeps your saved articles in directory sys$login:news.dir instead of the Eunice rrn sys$login:$n$ews.dir directory. Create this directory and copy your saved news articles there with the following commands: $ Set default sys$login $ Create/Dir [.news] $ Copy [.$n$ews]*.*;* [.news]*.*;* $ Set default [.news] $ Unixtovms *.*;* The files in your [.news] directory still have the old Eunice names. These include $ characters used as shift markers and also $5 pairs used as second and subsequent . characters. For example if you have been saving your comp.os.vms articles in the default file, you will have file $c$omp.os$5vms. Since the news equivalent of this file is comp.os_vms, you may want to rename files in your .news directory to the news equivalents. No set of wild card cards will do this for you but there is a command procedure which you can run to convert these names. $ Set default sys$login $ Set default [.news] $ @newsdir:convert Once you satisfy yourself that news works and want to switch from Eunice and rrn, don't forget to go back and delete the files in your sys$login:$n$ews.dir and that directory. 2.2 First Time News Users If you are a first time news user, you need take no special action. The best thing to do is to dive right in. News will notice that you have no xx.newsrc file and assumme you want to look at all groups. Run news and start reading. If a group looks like you are not interested in it, unsubscribe by typing a u command. Try not to be offended by anything you see, the news system serves a diverse set of users. Groups that might offend the faint of heart include ???, ???, and ???. You might want to unsubscribe to these without reading anything in them. 2.3 News Operation To run news, type: $ News News starts up and performs a series of initialization operations. Since some of these might take a while, news tells you what's going on: Reading your XX.Newsrc file... Connecting to remote news server... 200 dogie.macc.wisc.edu NNTP server version 1.5 GAMMA (6 feb 88) ready at Tue Apr 26 21:47:46 1988 (posting ok). Retrieving active file... Last News execution at 25 Apr 1988 21:12:13 News now goes through the news groups you have subscribed to prompting you for an action for each one. For example: Group comp.os.vms available 242 - 396 unread: 1 Group comp.os.vms action ( b c d g h p n q u): Legal actions at the group prompt include: Start reading b Go back to the previous group c catchup, mark all articles as read c # catchup through and including article # d directory of unread articles d/g directory of groups d/g pattern directory of groups matching pattern. Pattern may include * match any number of any character or $ match any single character p post an article p/x post a rotated article g group go to group 'group' h help n next group q quit u unsubscribe from this group # display article # ^ first unread article $ last unread article If you answer with a , news will cycle through the unread articles in this group. After displaying each article, news will prompt you for an action. Group comp.os.vms available: 242 - 396 unread: 0 Article 396 From: jackjones@vms3.macc.wisc.edu Subject: Has anyone ever figured out how logical names work? ... Action ( b c d f p g h k m n q r s u x): Legal actions at the article prompt include: Next article b Go back to the previous article c catchup, mark all articles as read c # catchup through and including article # d directory of unread articles d/g directory of groups d/g pattern directory of groups matching pattern. Pattern may include * match any number of any character or $ match any single character f post a follow up article p post an article p/x post a rotated article g group go to group 'group' h help k kill, mark as read, articles with this subject m mark this article unread n next group q quit r refresh this article s save this article u unsubscribe from this group x refresh this article in rotate 13 mode. z next article with the same subject # display article # ^ first unread article $ last unread article When news has processed all groups, it displays a end of groups prompt: End groups, action (q p g): Legal actions at the end of groups prompt include: exit from news b Go back to the previous group d/g directory of groups d/g pattern directory of groups matching pattern. Pattern may include * match any number of any character or $ match any single character p post an article p/x post a rotated article g group go to group 'group' h help q quit When you answer or q, news writes an updated xx.newsrc to your home directory and exits. Closing News server connection... 205 dogie.macc.wisc.edu closing connection. Goodbye. Updating XX.Newsrc 3.0 Customizing News News accepts the following qualifiers: /Header=(list) /Mark Header selects which header lines you wish to see. Since most articles contain 10 - 15 header lines most of which you have no interest in, you probably want to select only the few lines you need. The following works well for most folks: /Header=(Subject, From, Sender) Mark allows you to select the character to be used to 'mark' the original text in followup articles. Its mainly used to defeat certain smart news software attempting to limit the amount of followup text posted to the net. A good way to customize news is to include a line such as: news = "news/header=(from,subject,sender)/mark=""{""" in your login.com file. News uses the editor specified by MAIL$EDIT when composing posted or followup articles. It also appends the signature.mai file from your VMS mail directory to articles you post. 4.0 Helpfull Hints One of the most productive ways to use news is to print a directory of unread articles in the group with the d command. Look at these and decide which ones you want to read. Read these by specifying their numbers or by using the z command to follow all articles with the same subject. When you have seen all you want, answer c to skip the remainder in the group. An alternative is to do a c # to catchup to all articles before the one you wish to read, read that one with a , do another d to get a refreshed list, and repeat until done. 5.0 Netiquette ******** news.for ******** Include 'News.Def/list' Include 'SMG.Def/list' C External Routines Integer CLI$Get_Value Integer CLI$Present Integer Close_Newsrc Logical Cmd_ArticleCatchUp Logical Cmd_ArticleFirst Logical Cmd_ArticleLast Integer Cmd_ArticleNumber Integer Cmd_ArticleSameSubj Integer GetUserName Integer GetUserDirectory Integer GetInteger Integer Group_Find Integer Open_Newsrc Integer Range_Find Integer Range_Allocate Logical SMG_More_Print Integer SMG_Prompt Integer Srv_Cmd Integer Srv_Connect Integer Srv_NetClose Integer Srv_RdTxt Integer Srv_Recv Integer Srv_Send Integer TransLog Integer TrimLg Integer UnRead C Local Definitions Logical A_Continue Logical Action Logical Any Character *512 Buf Logical ByReadChk Logical BySubscribedChk Integer *4 C Character *1 Ch Character *2 CRLF Logical Done Integer *4 E Integer *4 G Logical G_Continue Integer *4 Next_G Integer *4 I Character *512 Image Integer *4 Lg Integer *4 Lg2 Integer *4 Lg3 Integer *4 N Character *8 Num Character *8 Num2 Character *8 Num3 Logical Ok Integer *4 R Logical RefreshArticle Logical RefreshGroup Integer *4 RS, RE, RU Integer *4 S Integer *4 Status Integer *4 U Integer *4 Unavail_Start Integer *4 Unavail_End Integer *4 X C Begin News Debug = .false. ! Debug is off Range_Free_List = 0 ! Initialize Range item free list Group_Count = 0 ! Initialize next group Range_Count = 0 ! Initialize next range Header_Count = 0 ! Number of /Header fields Call SetUpPriv ! Initialize privileges C Determine if logical name MAIL$EDIT is defined If (TransLog('MAIL$EDIT',Buf,0)) Then Mail_Cmd_Mail$Edit = .true. Else Mail_Cmd_Mail$Edit = .false. EndIf C Get our user name Status = GetUserName (UserName) If (.not. Status) Then Call SMG_All_Print ('Error obtaining your username', '|') Stop EndIf C Get our .news directory Status = GetUserDirectory (UserDirectory) If (.not. Status) Then Call SMG_All_Print $ ('Error obtaining your login directory', '|') Stop EndIf Call Get_Mail_Control ! Get Mail directory and ! personal name Call Ctrl_C ! Initialize control C handler Call SMG_Initialize ! Initialize screen routines Call SMG_All_Print ! Welcome user to news $ ('News', '|') Call SMG_All_Print (' ', '|') Call Read_Init ! Read News configuration file CRLF(1:1) = Char (13) CRLF(2:2) = Char (10) C Get /Header parameter telling us what header lines to print Status = 1 Do While (Status) Header_Count = Header_Count + 1 Status = CLI$Get_Value ('HEADER', Header(Header_Count)) EndDo Header_Count = Header_Count - 1 Header_Present = Cli$Present ('HEADER') C Get followup command mark character Status = CLI$Get_Value ('MARK', Mark_Character) If (.not. Status) Then Mark_Character = '>' EndIf C Read users XX.NEWSRC file Call SMG_All_Print ('Reading your XX.Newsrc file...', '|') Call SMG_All_Print (' ', '|') Status = Open_Newsrc() If (.not. Status) Then Write (Buf, '(A,I)') $ ' Can''t open xx.newsrc, status = ', Status Call SMG_All_Print (Buf, '|') EndIf C Connect to server Call SMG_All_Print $ ('Connecting to remote news server...', '|') Status = Srv_Connect() If (.not. Status) Then Call SMG_All_Print $ ( $ ' Can not connect to remote news server!', $ '|' $ ) Stop EndIf C Get initial signon line Status = Srv_Recv (Buf, Lg) If (.not. Status) Then Write (Buf, '(A,I)') $ ' Error receiving data from news server, status = ', $ Status Call SMG_All_Print (Buf, '|') Stop EndIf If (Lg .gt. 0) Then Call SMG_All_Print (Buf (1:Lg), '|') EndIf Call SMG_All_Print (' ', '|') C Send a list command Call SMG_All_Print ('Retrieving active file...', '|') If (.not. Srv_Cmd('list',Buf,Lg)) Then Stop 'Server failed' EndIf If (Buf(1:3) .ne. '215') Then Call SMG_All_Print $ ( $ ' Unexpected LIST command result, ' // Buf(1:Lg), $ '|' $ ) Stop EndIf C Retrieve list output and update group Status = Srv_Recv (Buf, Lg) Do While (Status .and. (Buf(1:Lg) .ne. '.')) I = Index (Buf(1:Lg), ' ') If (I .eq. 0) Then Stop 'Bad active file entry' EndIf X = 1 Do While $ ( $ (X .le. Group_Count) $ .and. $ (Group(X).Name .ne. Buf(1:I)) $ ) X = X + 1 EndDo If (X .gt. Group_Count) Then Group_Count = X Group(X).Name = Buf(1:I) Group(X).Active_File = .true. Group(X).Newsrc_File = .false. Group(X).Subscribed = .false. Group(X).Range_First = 0 Group(X).Range_Last = 0 End If C If user had no XX.Newsrc file, assumme he is subscribed to this group If (.not. Newsrc_Is_Open) Then Group(X).Subscribed = .true. EndIf C Now get last first and p flags Group(X).Active_End = GetInteger (Buf, I, Lg) Group(X).Active_Start = GetInteger (Buf, I, Lg) Call GetField (C, Buf, I, Lg) If ((C .eq. 'y') .or. (C .eq. 'Y')) Then Group(X).Active_Post = .true. Else Group(X).Active_File = .true. EndIf Status = Srv_Recv (Buf, Lg) End Do C Now get list of groups created since XX.NEWSRC created If (Newsrc_Is_Open) Then Call SMG_All_Print (' ', '|') Call SMG_All_Print $ ( $ 'Last News execution at ' // Newsrc_CDT_VMS // '.', $ '|' $ ) Call SMG_All_Print (' ', '|') Call SMG_All_Print ('Retrieving new groups...', '|') Buf = 'newgroups ' // Newsrc_CDT_News If (.not. Srv_Cmd(Buf(1:23),Buf,Lg)) Then Stop 'Server failed' EndIf If (Buf(1:3) .ne. '231') Then Call SMG_All_Print $ ( $ ' Unexpected LIST command result, ' // Buf(1:Lg), $ '|' $ ) Stop EndIf C Retrieve newgroups output and update group Any = .false. Status = Srv_Recv (Buf, Lg) Do While (Status .and. (Buf(1:Lg) .ne. '.')) If (Buf(1:Lg) .ne. '.') Then G = Group_Find (Buf(1:Lg)) If (G .ne. 0) Then Any = .true. Group(G).Subscribed = .true. Call SMG_All_Print ('New group ' // Buf(1:Lg), '|') EndIf EndIf Status = Srv_Recv (Buf, Lg) EndDo C If any new groups found, give user a chance to see them If (Any) Then Call SMG_Prompt (Buf, 'Type to continue',Lg) EndIf EndIf C Scan through groups displaying new messages G = 1 G_Continue = .true. BySubscribedChk = .false. More_Input = ' ' Done = .false. 1 Do While (G_Continue .and. (G .le. Group_Count)) Next_G = G + 1 If (BySubscribedChk .or. (Group(G).Subscribed)) Then Call CacheHdr_Init (G) ! Initialize header cache S = Group(G).Active_Start ! Starting article E = Group(G).Active_End ! Ending article R = Group(G).Range_First If (S .eq. 0) Then S = 1 End If C Adjust S depending on articles we have read to avoid some overhead Do While (R .ne. 0) C Trim range S:E if S is in this range If $ ( $ (S .ge. Range(R).Start) $ .and. $ (S .le. Range(R).End) $ ) $ Then S = Range(R).End + 1 EndIf C Do next range R = Range(R).Next End Do U = UnRead (G) C If there is something to read, open the group If (BySubscribedChk .or. (S .le. E)) Then BySubscribedChk = .false. C Attempt to select group If $ (.not. Srv_Cmd ('group ' // Group(G).Name, Buf, Lg)) $ Then Stop 'Server failed' End If If (Buf(1:3) .eq. '211') Then C Good status indicates group selected A_Continue = .true. C Find out what user wants with this group ByReadChk = .false. Action = .false. RefreshGroup = .true. Do While (.not. Action) If (RefreshGroup) Then RefreshGroup = .false. Call ItoS (Group(G).Active_Start, Num, Lg) Call ItoS (Group(G).Active_End, Num2, Lg2) Call ItoS (U, Num3, Lg3) More_Hdg_One = 'Group ' // Group(G).Name // $ ' available: ' // Num(1:Lg) // $ ' - ' // Num2(1:Lg2) // $ ' unread: ' // Num3(1:Lg3) More_Hdg_Two = '@' Call More_Heading EndIf If (More_Input .ne. ' ') Then Buf = More_Input Lg = TrimLg(More_Input) More_Input = ' ' Else Status = SMG_Prompt $ ( $ Buf, $ 'Group ' // $ Group(G).Name(1:TrimLg(Group(G).Name)) // $ ' action ( b c d g h n p q u): ', $ Lg $ ) EndIf Action = .true. If (Buf(1:1) .eq. ' ') Then ! Process group Else If (Buf(1:1) .eq. 'b') Then ! Backup Next_G = G - 1 BySubscribedChk = .true. A_Continue = .false. Else If (Buf(1:1) .eq. 'c') Then ! Catchup Action = Cmd_ArticleCatchUp (G, S, Buf(1:Lg), U) RefreshGroup = .true. ! Need new heading Next_G = G + 1 Else If (Buf(1:3) .eq. 'd/g') Then ! Dir/Group Call Cmd_GroupList (Buf(1:Lg)) Action = .false. Else If (Buf(1:1) .eq. 'd') Then ! Dir Call Cmd_ArticleList (G, Buf(1:Lg)) Action = .false. Else If (Buf(1:1) .eq. 'f') Then ! Followup Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 'p') Then ! Post Call Cmd_ArticlePost (G, Buf(1:Lg)) Action = .false. Else If (Buf(1:1) .eq. 'g') Then ! Group g I = Group_Find (Buf(3:34)) If (I .eq. 0) Then Action = .false. Call SMG_All_Print $ ( $ ' No such group as ' // $ Buf (3:2+TrimLg(Buf(3:34))), $ '|' $ ) Else BySubscribedChk = .true. Next_G = I A_Continue = .false. Group(G).Subscribed = .true. End If Else If (Buf(1:1) .eq. 'h') Then ! Help Call Cmd_Help Action = .false. Else If (Buf(1:1) .eq. 'k') Then ! Kill Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 'm') Then ! Mark unread Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 'n') Then ! Next group A_Continue = .false. Else If (Buf(1:1) .eq. 'q') Then ! Quit G_Continue = .false. A_Continue = .false. Else If (Buf(1:1) .eq. 'r') Then ! Refresh Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 's') Then ! Save Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 'u') Then ! Unsubscribe Group(G).Subscribed = .false. A_Continue = .false. Else If (Buf(1:1) .eq. 'x') Then ! Refresh rot mode Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 'z') Then ! Next article Call Cmd_ArticleNone ! same subject Action = .false. Else If (Buf(1:1) .eq. '^') Then ! First unread article Action = Cmd_ArticleFirst (G,S) Else If (Buf(1:1) .eq. '$') Then ! Last unread article Action = Cmd_ArticleLast (G,S) Else If $ ( $ (Buf(1:1) .ge. '0') $ .and. $ (Buf(1:1) .le. '9') $ ) $ Then If (Cmd_ArticleNumber (G, Buf(1:Lg), S)) Then ByReadChk = .true. Else Action = .false. EndIf Else If (Buf(1:1) .eq. 'j') Then Action = .false. Debug = .not. Debug If (Debug) Then Call SMG_All_Print ('Debug is on', '|') Else Call SMG_All_Print ('Debug is off', '|') EndIf Else Call SMG_All_Print ('Huh?', '|') Action = .false. End If End Do C Now page through the articles in range S - E Unavail_Start = 0 ! No unavailable articles Unavail_End = 0 ! so far Do While ((E .gt. 0 ) .and. (S .le. E) .and. A_Continue) If $ ( $ ByReadChk $ .or. $ (Range_Find(G, S, .false.) .eq. 0) $ ) $ Then ByReadChk = .false. Write (Buf, '(A, I7)') 'stat ', S If (.not. Srv_Cmd (Buf(1:15), Buf, Lg)) Then Stop 'Server failed' End If If (Buf(1:3) .ne. '223') Then If (Unavail_Start .eq. 0) Then Unavail_Start = S End If Unavail_End = S Status = Range_Find (G, S, .true., U) EndIf If $ ( $ ((Unavail_Start .ne. 0) .and. (S .eq. E)) $ .or. $ (Buf(1:3) .eq. '223') $ ) $ Then More_Input = ' ' If (Unavail_Start .ne. 0) Then S = Unavail_End c If (Buf(1:3) .eq. '220') Then c Call Srv_RdTxt c $ (.false., .false., %Val(0)) ! Skip article c EndIf Call Unavail_Print (Unavail_Start, Unavail_End) Else Status = Range_Find (G, S, .true., U) Call ItoS (Group(G).Active_Start, Num, Lg) Call ItoS (Group(G).Active_End, Num2, Lg2) Call ItoS (U, Num3, Lg3) More_Hdg_One = 'Group ' // Group(G).Name // $ ' available: ' // Num(1:Lg) // $ ' - ' // Num2(1:Lg2) // $ ' unread: ' // Num3(1:Lg3) Call ItoS (S, Num, Lg) More_Hdg_Two = 'article ' // Num Rotated = .false. Call Cmd_ArticleDisplay (G, S, Rotated) EndIf C What does user want to do with this article? Action = .false. RefreshArticle = .false. Do While (.not. Action) Call ItoS (Group(G).Active_Start, Num, Lg) Call ItoS (Group(G).Active_End, Num2, Lg2) Call ItoS (U, Num3, Lg3) More_Hdg_One = 'Group ' // Group(G).Name // $ ' available: ' // Num(1:Lg) // $ ' - ' // Num2(1:Lg2) // $ ' unread: ' // Num3(1:Lg3) Call ItoS (S, Num, Lg) More_Hdg_Two = 'article ' // Num If (RefreshArticle) Then RefreshArticle = .false. Call More_Heading EndIf Call ItoS (S, Num, Lg) If (More_Input .ne. ' ') Then Buf = More_Input Lg = TrimLg (More_Input) More_Input = ' ' Else Call SMG_Print (' ','|') Status = SMG_Prompt $ ( $ Buf, $ 'End article ' // Num(1:Lg) // $ ' action ( ' // $ 'b c d f g h k m n p q r s u x z): ', $ Lg $ ) EndIf Action = .true. If (Buf(1:1) .eq. ' ') Then ! Next article S = S + 1 Else If (Buf(1:1) .eq. 'b') Then ! Backup S = S - 1 ByReadChk = .true. Else If (Buf(1:1) .eq. 'c') Then ! Catchup Action = Cmd_ArticleCatchUp(G, S, Buf(1:Lg), U) RefreshArticle = .true. Else If (Buf(1:3) .eq. 'd/g') Then ! Dir/Group Call Cmd_GroupList (Buf(1:Lg)) Action = .false. Else If (Buf(1:1) .eq. 'd') Then ! Dir Call Cmd_ArticleList (G, Buf(1:Lg)) Action = .false. Else If (Buf(1:1) .eq. 'f') Then ! Followup Call Cmd_ArticleFollowUp (G, S, Buf(1:Lg)) Action = .false. Else If (Buf(1:1) .eq. 'p') Then ! Post Call Cmd_ArticlePost (G, Buf(1:Lg)) Action = .false. Else If (Buf(1:1) .eq. 'g') Then ! Group g I = Group_Find (Buf(3:34)) If (I .eq. 0) Then Action = .false. Call SMG_All_Print $ ( $ 'No such group as ' // $ Buf(2:2+TrimLg(Buf(3:34))), $ '|' $ ) Else BySubscribedChk = .true. Next_G = I A_Continue = .false. Group(G).Subscribed = .true. End If Else If (Buf(1:1) .eq. 'h') Then ! Help Call Cmd_Help Action = .false. Else If (Buf(1:1) .eq. 'k') Then ! Kill Call Cmd_ArticleKill (G, S, U) RefreshArticle = .true. Action = .false. Else If (Buf(1:1) .eq. 'm') Then ! Mark unread Call Cmd_ArticleMark (G, S, U) RefreshArticle = .true. Action = .false. Else If (Buf(1:1) .eq. 'n') Then ! Next article S = S + 1 Else If (Buf(1:1) .eq. 'q') Then ! Quit A_Continue = .false. Else If (Buf(1:1) .eq. 'r') Then ! Refresh ByReadChk = .true. Else If (Buf(1:1) .eq. 's') Then ! Save Call Cmd_ArticleSave (G,S,Buf) Action = .false. Else If (Buf(1:1) .eq. 'u') Then ! Unsubscribe Group(G).Subscribed = .false. A_Continue = .false. Else If (Buf(1:1) .eq. 'x') Then ! Refresh rot mode Rotated = .true. Call Cmd_ArticleDisplay (G, S, Rotated) Action = .false. Else If (Buf(1:1) .eq. 'z') Then ! Next article ! same subject Action = Cmd_ArticleSameSubj (G, S) Else If (Buf(1:1) .eq. '^') Then ! First unread article Action = Cmd_ArticleFirst (G, S) Else If (Buf(1:1) .eq. '$') Then ! Last unread article Action = Cmd_ArticleLast (G,S) Else If ! Article number $ ( $ (Buf(1:1) .ge. '0') $ .and. $ (Buf(1:1) .le. '9') $ ) $ Then If (Cmd_ArticleNumber (G, Buf(1:Lg), S)) Then ByReadChk = .true. Else Action = .false. EndIf Else If (Buf(1:1) .eq. 'j') Then Action = .false. Debug = .not. Debug If (Debug) Then Call SMG_All_Print ('Debug is on', '|') Else Call SMG_All_Print ('Debug is off', '|') EndIf Else Call SMG_All_Print ('Huh?', '|') Action = .false. End If End Do ! (.not. Action) Else S = S + 1 End If Else S = S + 1 End If End Do ! (S .le. E) If (Unavail_Start .ne. 0) Then Call Unavail_Print (Unavail_Start, Unavail_End) EndIf Else If (Buf(1:3) .eq. '411') Then Call SMG_All_Print $ ( $ 'No such group as ' // Group(G).Name, $ '|' $ ) Call SMG_All_Print (Buf(1:Lg), '|') Else Call SMG_All_Print (Buf(1:Lg), '|') Stop 'Unexpected GROUP command response ' End If End If End If G = Next_G End Do ! (G_Continue .and. (G .le. Group_Count)) C Done with news groups, find out what user want's to do now More_Input = ' ' Action = .false. Do While (.not. Action) If (More_Input .ne. ' ') Then Buf = More_Input Lg = TrimLg (More_Input) More_Input = ' ' Else Status = SMG_Prompt $ ( $ Buf, $ 'End groups, action ( h p q g): ', $ Lg $ ) EndIf Action = .true. If (Buf(1:1) .eq. ' ') Then ! Process group Done = .true. Else If (Buf(1:1) .eq. 'b') Then ! Backup G = G - 1 Else If (Buf(1:1) .eq. 'c') Then ! Catchup Call Cmd_GroupNone Action = .false. Else If (Buf(1:3) .eq. 'd/g') Then ! Dir/Group Call Cmd_GroupList (Buf(1:Lg)) Action = .false. Else If (Buf(1:1) .eq. 'd') Then ! Dir Call Cmd_GroupNone Action = .false. Else If (Buf(1:1) .eq. 'f') Then ! Followup Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 'p') Then ! Post Call Cmd_ArticlePost (G, Buf(1:Lg)) Action = .false. Else If (Buf(1:1) .eq. 'g') Then ! Group g I = Group_Find (Buf(3:34)) If (I .eq. 0) Then Action = .false. Call SMG_All_Print $ ( $ ' No such group as ' // $ Buf (3:2+TrimLg(Buf(3:34))), $ '|' $ ) Else BySubscribedChk = .true. G = I A_Continue = .false. Group(G).Subscribed = .true. End If Else If (Buf(1:1) .eq. 'h') Then ! Help Call Cmd_Help Action = .false. Else If (Buf(1:1) .eq. 'k') Then ! Kill Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 'm') Then ! Mark unread Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 'n') Then ! Next group Done = .true. Else If (Buf(1:1) .eq. 'q') Then ! Quit Done = .true. Else If (Buf(1:1) .eq. 'r') Then ! Refresh Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 's') Then ! Save Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 'u') Then ! Unsubscribe Call Cmd_GroupNone Action = .false. Else If (Buf(1:1) .eq. 'x') Then ! Refresh rot mode Call Cmd_ArticleNone Action = .false. Else If (Buf(1:1) .eq. 'z') Then ! Next article Call Cmd_ArticleNone ! same subject Action = .false. Else If (Buf(1:1) .eq. '^') Then ! First unread article Call Cmd_ArticleNone ! same subject Action = .false. Else If (Buf(1:1) .eq. '$') Then ! Last unread article %% end part a Michael Dorl (608) 262-0466 dorl@vms.macc.wisc.edu dorl@wiscmacc.bitnet From ncr-sd!hp-sdd!ucsdhub!ucsd!ames!mailrus!uwmcsd1!dogie!dorl@vms.macc.wisc.edu Sun Jul 31 18:14:35 PDT 1988 End Do If (.not. Done) Then Goto 1 EndIf C Disconnect from server Status = Srv_Cmd ('quit', Buf, Lg) If (.not. Status) Then Print '(A)', ' Server failed' Stop EndIf Call SMG_All_Print (' ', '|') Call SMG_All_Print $ ('Closing News server connection...', '|') Call SMG_All_Print (Buf(1:Lg), '|') Status = Srv_NetClose () If (.not. Status) Then Print '(A)', ' Socket failure' Stop EndIf C Update xx.newsrc Call SMG_All_Print (' ', '|') Call SMG_All_Print ('Updating XX.Newsrc...', '|') Status = Close_Newsrc () If (.not. Status) Then Print '(A)', ' Error closing XX.NEWSRC' Stop End If End ! News Integer Function UnRead (G) Include 'News.Def' C Parameter definitions Integer G C Local definitions Integer *4 E, R, RS, RE, RU, S C Begin UnRead S = Group(G).Active_Start E = Group(G).Active_End If (S .eq. 0) Then S = 1 EndIf UnRead = E - S + 1 R = Group(G).Range_First Do While (R .ne. 0) If (Range(R).Start .lt. S) Then RS = S Else RS = Range(R).Start EndIf If (Range(R).End .gt. E) Then RE = E Else RE = Range(R).End EndIf RU = RE - RS + 1 If (RU .gt. 0) Then UnRead = UnRead - RU EndIf R = Range(R).Next EndDo If (UnRead .lt. 0) Then UnRead = 0 EndIf End ! Unread Subroutine Down_Case (Str) Implicit None C Parameter definitions Character *(*) Str C Local definitions Integer *4 X, Lg C Begin Down_Case Lg = Len (Str) Do X = 1, Lg If ((Str(X:X) .ge. 'A') .and. (Str(X:X) .le. 'Z')) Then Str(X:X) = Char (IChar(Str(X:X)) + IChar(' ')) EndIf EndDo End ! Down_Case Subroutine Rotate (Str) C Parameter definitions Character *(*) Str C Local definitions Integer *4 Lg, N, X Character *(1) C C Begin Rotate Lg = Len(Str) Do X = 1, Lg C = Str(X:X) If ( $ ((C .ge. 'a') .and. (C .le. 'z')) $ .or. $ ((C .ge. 'A') .and. (C .le. 'Z')) $ ) Then N = IChar(C) If (IAnd(N,31) .le. 13) Then N = N + 13 Else N = N - 13 EndIf Str(X:X) = Char(N) EndIf EndDo End ! Rotate Subroutine Read_Init Include 'News.Def' C Local definitions Logical Eof Integer *4 Status Integer *4 I Character *256 Img Integer *4 Img_Lg Character *64 Img_Field Integer *4 IP Byte IP_Byte Equivalence (IP,IP_Byte) Character *15 IP_Number Integer *4 X C Begin Read_Init SiteId = ' ' Distribution_Count = 0 Open $ ( $ Unit = LU_Init, $ File = 'NewsDir:Config.Dat', $ ReadOnly, $ Shared, $ Status = 'Old', $ IOStat = Status $ ) If (Status .ne. 0) Then Call SMG_All_Print ('Error opening NewsDir:Config.Dat', '|') Stop EndIf Eof = .false. Do While (.not. Eof) Read (LU_Init, '(Q,A)', IOStat = Status) Img_Lg, Img If (Status .eq. 0) Then X = Index (Img(1:Img_Lg),':') If (X .eq. 0) Then X = Img_Lg EndIf If (Img(1:X) .eq. 'distribution:') Then X = X + 1 Do While (X .lt. Img_Lg) Call Field (Img(1:Img_Lg), X, Img_Field) If (Img_Field .ne. ' ') Then Distribution_Count = Distribution_Count + 1 Distribution(Distribution_Count) = Img_Field EndIf EndDo ElseIf (Img(1:X) .eq. 'siteid:') Then X = X + 1 Call Field (Img(1:Img_Lg), X, SiteId) ElseIf (Img(1:X) .eq. 'organization:') Then X = X + 1 Organization = Img(X:Img_Lg) ElseIf (Img(1:X) .eq. 'server:') Then X = X + 1 Call Field (Img(1:Img_Lg), X, IP_Number) IP = 0 I = 1 Do X = 1,15 If (IP_Number(X:X) .eq. '.') Then Server_IP_Number(I) = IP_Byte IP = 0 I = I + 1 Else If (IP_Number(X:X) .eq. ' ') Then Else If $ ( $ (IP_Number(X:X) .ge. '0') $ .and. $ (IP_Number(X:X) .le. '9') $ ) $ Then IP = 10 * IP + IChar(IP_Number(X:X)) - IChar('0') EndIF EndDo Server_IP_Number(I) = IP_Byte ElseIf (Img(1:X) .eq. ' ') Then Else Call SMG_All_Print $ ('Unrecognized initialization image', '|') Call SMG_All_Print (Img(1:Img_Lg), '|') Stop EndIf Else Eof = .true. EndIf EndDo Close (LU_Init) Return End ! Read_Init Subroutine Field (Src, Src_X, Dst) Implicit None C Parameter definition Character *(*) Src,Dst Integer *4 Src_X C Local definitions Integer *4 Src_Lg, Dst_Lg, Dst_X Logical Done C Begin Field Done = .false. Src_Lg = Len (Src) Dst_Lg = Len (Dst) Dst_X = 1 Dst= ' ' Do While ((.not. Done) .and. (Src_X .le. Src_Lg)) If (Src(Src_X:Src_X) .eq. ' ') Then Else If (Src(Src_X:Src_X) .eq. ',') Then Done = .true. Else If (Dst_X .le. Dst_Lg) Then Dst(Dst_X:Dst_X) = Src(Src_X:Src_X) Dst_X = Dst_X + 1 EndIf EndIf Src_X = Src_X + 1 EndDo End ! Field Subroutine Unavail_Print (S,E) Implicit None Integer *4 S, E C Local definitions Character *8 S_C, E_C Integer *4 S_Lg, E_Lg C Begin Unavail_Print Call ItoS (S, S_C, S_Lg) If (E .eq. S) Then Call SMG_All_Print $ ( $ 'Skipped unavailable article ' // $ S_C(1:S_Lg), $ '|' $ ) Else Call ItoS (E, E_C, E_Lg) Call SMG_All_Print $ ( $ 'Skipped unavailable articles ' // $ S_C(1:S_Lg) // '-' // E_C(1:E_Lg), $ '|' $ ) EndIf S = 0 E = 0 End ! Unavail_Print Integer Function GetUserName (UserId) C Description: C C Function to obtain the user's name C Returns success or failure. Include 'News.Def' C Parameter Definitions Character *32 UserId C External Routines External Sys$GetJPI Integer Sys$GetJPI C Local Definitions Include '($JPIDEF)' Character *32 LUserId Integer *4 LUserIdLg Integer *2 WJPIItmLst(12) Integer *4 JPIItmLst(6) Equivalence (JPIItmLst,WJPIItmLst) C Begin GetUserName WJPIItmLst(1) = 32 WJPIItmLst(2) = JPI$_UserName JPIItmLst(2) = %Loc(LUserId) JPIItmLst(3) = %Loc(LUserIdLg) JPIItmLst(4) = 0 GetUserName = Sys$GetJPI (,,,JPIItmLst,,,) If (GetUserName) Then UserId = LUserId(1:LUserIdLg) Call Down_Case (UserName) EndIf Return End ! GetUserName Integer Function GetUserDirectory (Dir) Include 'News.Def' C Parameter definitions Character *(*) Dir C External definitions Integer Sys$GetUAI Integer TrimLg C Local Definitions Include '($UAIDEF)' Character *16 Device Integer *4 DeviceLg Character *64 Directory Integer *4 DirectoryLg Integer *4 DirItmLst(9) Integer *2 WDirItmLst(18) Equivalence (DirItmLst,WDirItmLst) C Begin GetUserDirectory WDirItmLst(1) = 64 WDirItmLst(2) = UAI$_DefDir DirItmLst(2) = %Loc(Directory) DirItmLst(3) = %Loc(DirectoryLg) WDirItmLst(7) = 16 WDirItmLst(8) = UAI$_DefDev DirItmLst(5) = %Loc(Device) DirItmLst(6) = %Loc(DeviceLg) DirItmLst(7) = 0 GetUserDirectory = Sys$GetUAI (,,UserName,DirItmLst,,,) If (GetUserDirectory) Then Else Return EndIf DeviceLg = IChar(Device(1:1)) DirectoryLg = IChar(Directory(1:1)) Dir = Device(2:DeviceLg+1) // 1 Directory(2:DirectoryLg) // 2 '.NEWS]' Return End ! GetUserDirectory Integer Function Group_Find (Name) Include 'News.Def' C Parameter definition Character *(*) Name C Local definitions Integer *4 I C Begin Group_Find Group_Find = 0 I = 1 Do While ((I .le. Group_Count) .and. (Group_Find .eq. 0)) If (Name .eq. Group(I).Name) Then Group_Find = I Else I = I + 1 EndIf EndDo Return End ! Group_Find Subroutine Cmd_GroupNone Implicit None Call SMG_All_Print ('No group selected.', '|') End ! Cmd_GroupNone Subroutine Cmd_GroupList (Cmd) Include 'News.Def' C Parameter definition Character *(*) Cmd C External routines Logical SMG_More_Print Integer Str$Match_Wild Integer TrimLg C Local definitions Character *1 Active Logical Any Integer *4 G Character *80 Text Integer *4 R Character *1 Subscribed Logical Ok Character *32 Pattern Character *1 Post Integer *4 X C Begin Cmd_GroupList Pattern = ' ' X = Index (Cmd,' ') If (X .ne. 0) Then Do While ((X .lt. Len(Cmd)) .and. (Cmd(X:X) .eq. ' ')) X = X + 1 EndDo Pattern = Cmd(X:Len(Cmd)) Call Down_Case (Pattern) EndIf Ok = .true. G = 0 Any = .false. Do While (Ok .and. (G .lt. Group_Count)) G = G + 1 If $ ( $ (Pattern .eq. ' ') $ .or. $ ( $ Str$Match_Wild $ ( $ Group(G).Name(1:TrimLg(Group(G).Name)), $ Pattern(1:TrimLg(Pattern)) $ ) $ ) $ ) $ Then Any =.true. If (Group(G).Subscribed) Then Subscribed = 'y' Else Subscribed = 'n' EndIf If (Group(G).Active_File) Then Active = 'y' Else Active = 'n' EndIf If (Group(G).Active_Post) Then Post = 'y' Else Post = 'n' EndIf Write (Text,'(4(x,A),2I7)') $ Group(G).Name, $ Active, $ Subscribed, $ Post, $ Group(G).Active_Start, $ Group(G).Active_End Ok = SMG_More_Print (Text, '|') R = Group(G).Range_First Do While (Ok .and. (R .ne. 0)) Write (Text, '(x,I,A,I)') $ Range(R).Start, ':', Range(R).End Ok = SMG_More_Print (Text, '|') R = Range(R).Next End Do EndIf EndDo If (.not. Any) Then Call SMG_All_Print $ ( $ 'No groups matching ' // Pattern(1:TrimLg(Pattern)) // $ ' found.', $ '|' $ ) EndIf Return End ! Cmd_GroupList Subroutine Cmd_ArticleList (G, CatchUp_Cmd) Include 'News.Def' Include 'SMG.Def' C Description C C Handles the.... C C Dir [article] C C command. Produces a short list of the subject lines C of un read articles in the group starting with article. C Default article is first available from the active file. C Parameter definitions Integer *4 G Character *(*) CatchUp_Cmd C External Routines Integer Range_Find Integer Srv_Cmd Integer Srv_RdTxt Integer TrimLg C Local definitions Integer *4 A Integer *4 X Integer *4 Subject_Lg Character *128 Subject C Begin Cmd_ArticleList Call More_Heading More_Input = ' ' C Get the article number X = Index (CatchUp_Cmd, ' ') A = 0 Do While ((X .ne. 0) .and. (X .le. Len(CatchUp_Cmd))) If $ ( $ (CatchUp_Cmd(X:X) .ge. '0') $ .and. $ (CatchUp_Cmd(X:X) .le. '9') $ ) $ Then A = 10 * A + IChar(CatchUp_Cmd(X:X)) - IChar('0') EndIf X = X + 1 EndDo If (A .eq. 0) Then A = Group(G).Active_Start EndIf C Get all the subject lines Do While $ ( $ (A .le. Group(G).Active_End) $ .and. $ (More_Input .eq. ' ') $ ) If (Range_Find (G, A, .false.) .eq. 0) Then Call CacheHdr (G, A, Subject, Subject_Lg) Call SMG_More_Print (Subject(1:Subject_Lg), '|') EndIf A = A + 1 End Do Return End ! Cmd_ArticleList Subroutine Cmd_ArticleMark (G, A, U) Include 'News.Def' C Parameter definition Integer *4 G ! Group number Integer *4 A ! Article number Integer *4 U ! Unread article count, updated C External routines Integer Range_Allocate C Local definitions Logical Found Integer *4 P, Q, R C Begin Cmd_ArticleMark C Find range contining this article Found = .false. P = 0 R = Group(G).Range_First Do While ((.not. Found) .and. (R .ne. 0)) If ((A .ge. Range(R).Start) .and. (A .le. Range(R).End)) Then Found = .true. Else P = R R = Range(R).Next EndIf EndDo C If no range found for this article, then we are done since its already C marked as unread. If (.not. Found) Then Return EndIf C Range found, three cases can arise If (A . eq. Range(R).Start) Then C Article is first in range Range(R).Start = Range(R).Start + 1 ElseIf (A .eq. Range(R).End) Then C Article is last in range Range(R).End = Range(R).End - 1 Else C Article is within the range but not at either end point C Get a new range and set it up from the old start through A - 1 Q = Range_Allocate () Range(Q).Start = Range(R).Start Range(Q).End = A - 1 C The old range becomes the end of the range from A+1 through the old end Range(R).Start = A + 1 C Chain P -> Q -> R Range(Q).Next = R If (P .ne. 0) Then Range(P).Next = Q Else Group(G).Range_First = Q EndIf P = Q EndIf C Now, we may have left a nonsense group at R If (Range(R).Start .gt. Range(R).End) Then If (P .ne. 0) Then Range(P).Next = Range(R).Next If (Group(G).Range_Last .eq. R) Then Group(G).Range_Last = P EndIf Else Group(G).Range_First = Range(R).Next If (Group(G).Range_Last .eq. R) Then Group(G).Range_Last = Group(G).Range_First EndIf EndIf Range(R).Next = 0 Call Range_Deallocate (R) EndIf C Finally, update unread count U = U + 1 C That's all folks Return End ! Cmd_ArticleMark Subroutine Cmd_ArticlePost (G, Cmd) Include 'News.Def' C Parameter definitions Integer G ! Group number Integer A ! Article number Character *(*)Cmd ! Command text C External routines Integer Edt$Edit Integer Group_Find Integer SMG_Prompt Integer Srv_Cmd Integer Srv_Recv Integer Srv_Send Integer TrimLg Integer User_Edit C Local definitions Character *22 Date_Time Character *128 Distribution_Fld Logical Eof Character *(File_Name_Size) File_In Character *(File_Name_Size) File_Out Character *32 Fld Logical FollowUp Character *128 From Character *128 Group_Name Integer *4 Group_Name_Lg Integer *4 I Character *256 Img Integer *4 Img_Lg Logical *4 InHeader Character *128 MessageID Logical *4 Rotx Integer *4 Status Character *128 Subject Integer *4 Subject_Lg Integer *4 X C Begin Cmd_ArticlePost FollowUp = .false. Group_Name = ' ' Group_Name_Lg = 0 Subject = ' ' Distribution_Fld = ' ' Goto 1 C Begin Cmd_ArticleFollowUp Entry Cmd_ArticleFollowUp (G, A, Cmd) FollowUp = .true. Write (Img, '(A,I8)') 'head ', A Status = Srv_Cmd (Img(1:13), Img, Img_Lg) If (.not. Status) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf If (Img(1:3) .ne. '221') Then Call SMG_All_Print ('Unexpected server reply', '|') Call Smg_All_Print (Img(1:Img_Lg), '|') Stop EndIf From = ' ' Group_Name = ' ' Group_Name_Lg = 0 MessageID = ' ' Subject = ' ' Distribution_Fld = ' ' Do While (Img(1:Img_Lg) .ne. '.') Status = Srv_Recv (Img, Img_Lg) If (.not. Status) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf If (Img(1:13) .eq. 'Distribution:') Then If (Img_Lg .ge. 15) Then Distribution_Fld = Img(15:Img_Lg) EndIf Else If (Img(1:8) .eq. 'Subject:') Then If (Img_Lg .ge. 10) Then Subject = Img(10:Img_Lg) If (Subject(1:4) .ne. 'Re: ') Then Subject = 'Re: ' // Subject EndIf EndIf ElseIf (Img(1:11) .eq. 'Newsgroups:') Then If (Img_Lg .ge. 13) Then Group_Name = Img(13:Img_Lg) Group_Name_Lg = Img_Lg - 12 EndIf ElseIf (Img(1:5) .eq. 'From:') Then If (Img_Lg .ge. 7) Then From = Img(7:Img_Lg) EndIf ElseIf (Img(1:11) .eq. 'Message-ID:') Then If (Img_Lg .ge. 13) Then MessageID = Img(13:Img_Lg) EndIf EndIf EndDo Goto 1 C Begin common Cmd_ArticlePost - Cmd_ArticleFollowUp 1 If ((Len(Cmd) .lt. 3) .or. (Cmd(2:3) .ne. '/x')) Then Rotx = .false. Else Rotx = .true. EndIf File_In = 'Sys$Login:News$In.News' File_Out = 'Sys$Login:News$Out.News' Call Smg_Erase C Get group to post to If (Group_Name_Lg .eq. 0) Then I = 0 Do While (I .eq. 0) Status = SMG_Prompt $ ( $ Group_Name, $ 'Group (' // Group(G).Name(1:TrimLg(Group(G).Name)) $ // ') ', $ Group_Name_Lg $ ) If (.not. Status) Then Call SMG_All_Print ('Post aborted.', '|') Return EndIf C Make sure group is legal If (Group_Name(1:Group_Name_Lg) .eq. ' ') Then Group_Name = Group(G).Name Group_Name_Lg = TrimLg(Group(G).Name) I = G Else I = Group_Find (Group_Name(1:Group_Name_Lg)) If (I .eq. 0) Then Call SMG_All_Print $ ( $ 'No such group as ' // Group_Name(1:Group_Name_Lg), $ '|' $ ) EndIf EndIf EndDo EndIf C Get subject If (Subject .eq. ' ') Then Status = SMG_Prompt (Subject, 'Subject: ', Subject_Lg) If (.not. Status) Then Call SMG_All_Print ('Post aborted.', '|') Return EndIf EndIf C Get distribution If (Distribution_Fld .eq. ' ') Then Distribution_Fld = ' ' Status = SMG_Prompt (Img, 'Distribution: ', Img_Lg) X = 1 Do While (X .le. Img_Lg) Call Field (Img(1:Img_Lg), X, Fld) If (Fld .ne. ' ') Then I = 1 Do While $ ( $ (I .le. Distribution_Count) $ .and. $ (Distribution(I) .ne. Fld) $ ) I = I + 1 EndDo If (I .le. Distribution_Count) Then If (Distribution_Fld .ne. ' ') Then Distribution_Fld = $ Distribution_Fld(1:TrimLg(Distribution_Fld)) // ', ' EndIf Distribution_Fld = $ Distribution_Fld(1:TrimLg(Distribution_Fld)) // Fld Else Call SMG_All_Print $ ( $ 'Illegal Distribution field ' // Fld(1:TrimLg(Fld)), $ '|' $ ) Return EndIf EndIf EndDo EndIf C Build date and time header Date_Time = ' ' Call Date (Date_Time(1:9)) Call Time (Date_Time(11:18)) Date_Time(3:3) = ' ' Date_Time(7:7) = ' ' C Open the edit input file Open $ ( $ Unit = LU_EditIn, $ File = File_In, $ Status = 'New', $ Form = 'Formatted', $ CarriageControl = 'List', $ Recl = 1024, $ IOStat = Status $ ) If (Status .ne. 0) Then Call SMG_All_Print $ ( $ 'Error opening file ' // File_In(1:TrimLg(File_In)) // $ '. Post aborted.', '|' $ ) Return EndIf C Write the article header If (UserPersonalName .ne. ' ') Then Write (LU_EditIn, '(A)') $ 'From: ' // $ UserName(1:TrimLg(UserName)) // $ SiteId(1:TrimLg(SiteId)) // $ ' (' // $ UserPersonalName(1:TrimLg(UserPersonalName)) // $ ')' Else Write (LU_EditIn, '(A)') $ 'From: ' // $ UserName(1:TrimLg(UserName)) // $ SiteId(1:TrimLg(SiteId)) EndIf Write (LU_EditIn, '(A)') 'Newsgroups: ' // $ Group_Name(1:Group_Name_Lg) Write (LU_EditIn, '(A)') 'Subject: ' // Subject(1:TrimLg(Subject)) Write (LU_EditIn, '(A)') 'Date: ' // Date_Time If (Distribution_Fld .ne. ' ') Then Write (LU_EditIn, '(A)') 'Distribution: ' // $ Distribution_Fld(1:TrimLg(Distribution_Fld)) EndIf Write (LU_EditIn, '(A)') 'Organization: ' // $ Organization(1:TrimLg(Organization)) Write (LU_EditIn, '(A)') ' ' If (FollowUp) Then Write (LU_EditIn, '(A)') $ 'In article ' // MessageID(1:TrimLg(MessageID)) // ', ' // $ From(1:TrimLg(From)) // ' writes...' Write (LU_EditIn, '(A)') ' ' EndIf C If followup, copy the article to the file If (Followup) Then Write (Img, '(A,I8)') 'body ', A Status = Srv_Cmd (Img(1:13), Img, Img_Lg) If (.not. Status) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf If (Img(1:3) .ne. '222') Then Call SMG_All_Print ('Unexpected server reply', '|') Call Smg_All_Print (Img(1:Img_Lg), '|') Stop EndIf Call Srv_CopyTxt (LU_EditIn, Mark_Character, Rotated) EndIf C Copy Signature file if any Open $ ( $ Unit = LU_Signature, $ File = 'SIGNATURE.MAI', $ DefaultFile = UserMailDirectory, $ Form = 'Formatted', $ CarriageControl = 'None', $ Status = 'Old', $ ReadOnly, $ IOStat = Status $ ) If (Status .eq. 0) Then Do While (Status .eq. 0) Read $ ( $ Unit = LU_Signature, $ Fmt = '(Q,A)', $ IOStat = Status $ ) Img_Lg, Img If (Status .eq. 0) Then Write (LU_EditIn, '(A)') Img(1:Img_Lg) EndIf EndDo Close (LU_Signature) EndIf C Done building edit input file Close (LU_EditIn) C Edit the file If (.not. Mail_Cmd_Mail$Edit) Then Status = Edt$Edit (File_In,File_Out,,,4,,,) Else Status = User_Edit (File_In, File_Out) EndIf Call SMG_Erase If (.not. Status) Then Call Smg_All_Print $ ( $ ' Error editing file, post aborted.', '|' $ ) Return EndIf C Open the output file Open $ ( $ Unit = LU_EditOut, $ File = File_Out, $ Status = 'Old', $ IOStat = Status, $ Dispose = 'Delete' $ ) If (Status .ne. 0) Then Call SMG_All_Print $ ( $ 'Error opening file ' // File_Out(1:TrimLg(File_Out)) // $ '. Post aborted.', '|', $ ) Return EndIf C Start a post command on the server Status = Srv_Cmd ('post', Img, Img_Lg) If (.not. Status) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf If (Img(1:3) .eq. '340') Then C Copy the file to the server postnews process Call SMG_All_Print ('Sending article to server', '|') Call SMG_All_Print (Img(1:Img_Lg), '|') InHeader = .true. Eof = .false. Do While (.not. Eof) Read $ ( $ Unit = LU_EditOut, $ Fmt = '(Q,A)', $ IOStat = Status $ ) Img_Lg, Img If ((Img_Lg .eq. 0) .or. (Img(1:Img_Lg) .eq. ' ')) Then InHeader = .false. EndIf If ((.not. InHeader) .and. RotX) Then Call Rotate (Img(1:Img_Lg)) EndIf If (Status .eq. 0) Then If (Img(1:Img_Lg) .eq. '.') Then Img = '..' Img_Lg = 2 EndIf Status = Srv_Send (Img(1:Img_Lg)) If (.not. Status) Then Call SMG_All_Print ('Server failed.', '|') Stop EndIf c Call Smg_All_Print (Img(1:Img_Lg), '|') Else Eof = .true. EndIf EndDo C Mark end of input with a . Status = Srv_Send ('.') If (.not. Status) Then Call SMG_All_Print ('Server failed.', '|') Stop EndIf C Retrieve final status Status = Srv_Recv (Img, Img_Lg) If (.not. Status) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf Call SMG_All_Print (Img(1:Img_Lg), '|') C Server not accepting postings Else Call SMG_All_Print ('Server refusing posting requests.', '|') Call SMG_All_Print (Img(1:Img_Lg), '|') EndIf C Close the edit output file Close (LU_EditOut) C Return Return End ! Cmd_ArticlePost Subroutine Cmd_ArticleSave (G, A, Cmd) Include 'News.Def' C Description C C Handles the S filename command. C C Parameter definitions Integer *4 G ! Group number Integer *4 A ! Article number Character *(*) Cmd ! Save command line C External routines Integer Srv_Cmd Integer Srv_Recv Integer Lib$Create_Dir Integer TrimLg Integer User_Open External User_Open Integer User_Open_Get_What_Happened C Local definitions Character *64 FileName Character *128 Buf Logical FirstDot Integer *4 Lg Integer *4 Status Integer *4 X Logical SecondTry Character *128 Msg Logical FileOpen C Begin Cmd_ArticleSave C Get the file name from the command line X = 1 Lg = Len(Cmd) Call GetField (FileName, Cmd, X, Lg) Call GetField (FileName, Cmd, X, Lg) C If user specified no file name, build default from group name If (FileName .eq. ' ') Then FileName = Group(G).Name FirstDot = .true. X = 1 Lg = TrimLg (FileName) Do While (X .le. Lg) If (FileName(X:X) .eq. '.') Then If (FirstDot) Then FirstDot = .false. Else FileName(X:X) = '_' EndIf EndIf X = X + 1 EndDo EndIf C Open the file FileOpen = .false. SecondTry = .false. Do While (.not. FileOpen) Call User_Open_Init ('STATUS_UNKNOWN',0,0,0,0,0,0,0,0) Open $ ( $ Unit = LU_Save, $ File = FileName, $ DefaultFile = UserDirectory, $ Status = 'Unknown', $ Form = 'Formatted', $ CarriageControl = 'List', $ Recl = 1024, $ Access = 'Append', $ UserOpen = User_Open, $ IOStat = Status $ ) If (Status .ne. 0) Then If $ ( $ (Index(FileName,':') .eq. 0) $ .and. $ (Index(FileName,'[') .eq. 0) $ .and. $ (.not. SecondTry) $ ) Then SecondTry = .true. Status = Lib$Create_Dir $ ( $ UserDirectory(1:TrimLg(UserDirectory)), ! Name $ , ! Owner $ 'FF00'X, ! Prot enable $ 'FF00'X, ! Prot mask $ , ! Max versions $ ! Rvn $ ) If (Status) Then Call SMG_All_Print $ ('Created directory ' // $ UserDirectory(1:TrimLg(UserDirectory)), $ '|' $ ) Else Call SMG_All_Print $ ('Error creating directory ' // $ UserDirectory(1:TrimLg(UserDirectory)), $ '|' $ ) Return EndIf Else Call SMG_All_Print $ ( $ 'Error opening file ' // FileName(1:TrimLg(FileName)), $ '|' $ ) Return EndIf Else FileOpen = .true. EndIf End Do If (.not. Srv_Cmd('head',Buf,Lg)) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf If (Buf(1:3) .ne. '221') Then Call SMG_All_Print ('Unexpected server response', '|') Call SMG_All_Print (Buf(1:Lg), '|') Stop EndIf Call Srv_CopyTxt (LU_Save, ' ', .false.) If (.not. Srv_Cmd('body',Buf,Lg)) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf Write (LU_Save, '(A)') ' ' If (Buf(1:3) .ne. '222') Then Call SMG_All_Print ('Unexpected server response', '|') Call SMG_All_Print (Buf(1:Lg), '|') Stop EndIf Call Srv_CopyTxt (LU_Save, ' ', Rotated) Msg = 'Article ' Call ItoS (A, Msg(9:Len(Msg)), Lg) Lg = 8 + Lg If (User_Open_Get_What_Happened() .eq. 1) Then Msg (Lg+1:Len(Msg)) = ' appended' Lg = Lg + 9 Else Msg (Lg+1:Len(Msg)) = ' saved' Lg = Lg + 6 EndIf Msg (Lg+1:Len(Msg)) = ' to file ' // FileName Lg = TrimLg(Msg) Call SMG_All_Print (Msg(1:Lg), '|') Close (LU_Save) Return End ! Cmd_ArticleSave Logical Function Cmd_ArticleCatchUp (G, A, Cmd, U) Include 'News.Def' C Description C C Handles the catchup command... C C Catchup [article] C C Marks all articles through and including article as read. C Default article is last article in the group. C C Returns: C C .true. all articles read C .false. some articles remain C Parameter definitions Integer *4 G ! Group number Integer *4 A ! Article Character *(*) Cmd ! Catchup command string Integer *4 U ! Unread article count, updated C External routines Integer Range_Allocate Integer UnRead C Local definitions Integer *4 L, R, X C Begin Cmd_ArticleCatchUp C Get the last article to be caught up from the command X = Index (Cmd, ' ') L = 0 Do While ((X .ne. 0) .and. (X .le. Len(Cmd))) If ((Cmd(X:X) .ge. '0') .and. (Cmd(X:X) .le. '9')) Then L = 10 * L + IChar(Cmd(X:X)) - IChar('0') EndIf X = X + 1 EndDo C If no last article, use entire group active file range If (L .eq. 0) Then L = Group(G).Active_End EndIf C Calulate return value %%end part b Michael Dorl (608) 262-0466 dorl@vms.macc.wisc.edu dorl@wiscmacc.bitnet From ncr-sd!hp-sdd!ucsdhub!ucsd!ames!mailrus!uwmcsd1!dogie!dorl@vms.macc.wisc.edu Sun Jul 31 18:14:48 PDT 1988 If (L .ge. Group(G).Active_End) Then Cmd_ArticleCatchUp = .true. Else Cmd_ArticleCatchUp = .false. EndIf C Find the first range beyond L R = Group(G).Range_First X = 0 Do While ((R .ne. 0) .and. (L .ge. Range(R).End)) X = R R = Range(R).Next EndDo C R is the Range following L or zero, X is the Range in front of C L or zero. C Release all ranges from Group(G).Range_First - X. These ranges C contain articles less than L. If (X .ne. 0) Then Range(X).Next = 0 X = Group(G).Range_First Call Range_Deallocate (X) Group(G).Range_First = R EndIf C Several cases can arise. C C R = 0 All ranges have been released, get C a new one and set it to 1-L C C L < R.Start Add a new range to the C Group from 1-L C C R.Start <= L < R.End Set R.Start = 1 C C L >= R.End Impossible If (R .eq. 0) Then R = Range_Allocate () Range(R).Start = 1 Range(R).End = L Range(R).Next = 0 Group(G).Range_First = R Group(G).Range_Last = R Else If (L .lt. Range(R).Start) Then X = Range_Allocate () Group(G).Range_First = X Range(X).Start = 1 Range(X).End = L Range(X).Next = R Call Range_Combine (X, R) Else If $ ((L .ge. Range(R).Start) .and. (L .lt. Range(R).End)) Then Range(R).Start = 1 Else Stop 'Catchup error' EndIf A = L U = UnRead (G) ! Update unread mail count Return End ! Cmd_ArticleCatchUp Subroutine Cmd_ArticleDisplay (G, A, Rotate_Flag) Include 'News.Def' C Parameter definitions Integer *4 G ! Group number Integer *4 A ! Article number Logical Rotate_Flag C External routines Integer Srv_Cmd External Header_Check C Local definitions Character *128 Cmd Integer *4 Lg Integer *4 Status Character *8 Num C Begin Cmd_ArticleDisplay Call More_Heading Write (Cmd, '(A, I6)') 'head ', A Status = Srv_Cmd (Cmd(1:11), Cmd, Lg) If (.not. Status) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf If (Cmd(1:3) .eq. '221') Then Call Srv_RdTxt (.true., .false., Header_Check) Else Call SMG_All_Print ('Unexpected server response', '|') Call SMG_All_Print (Cmd(1:Lg), '|') Stop EndIf Call SMG_All_Print (' ', '|') Write (Cmd, '(A, I6)') 'body ', A Status = Srv_Cmd (Cmd(1:11), Cmd, Lg) If (.not. Status) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf If (Cmd(1:3) .eq. '222') Then Call Srv_RdTxt (.true., Rotate_Flag, %Val(0)) Else Call SMG_All_Print ('Unexpected server response', '|') Call SMG_All_Print (Cmd(1:Lg), '|') Stop EndIf End ! Cmd_ArticleDisplay Integer Function Header_Check (Img) Include 'News.Def' C Parameter definition Character *(*) Img C Local definitions Integer *4 X Character *16 Fld C Begin Header_Check Header_Check = .true. If ((Img .eq. ' ') .or. (.not. Header_Present)) Then Return EndIf X = Index (Img, ':') - 1 If (X .le. 0) Then Fld = Img Else Fld = Img(1:X) EndIf Call Str$Upcase (Fld, Fld) X = 1 Do While (X .le. Header_Count) If (Header(X) .eq. Fld) Then Return EndIf X = X + 1 EndDo Header_Check = .false. Return End ! Header_Check Subroutine Cmd_ArticleNone Call SMG_All_Print ('No article selected', '|') End ! Cmd_ArticleNone Integer Function Cmd_ArticleNumber (G, Text, S) Include 'News.Def' C Parameter definition Integer *4 G Character *(*) Text Integer *4 S C Local delinitions Integer *4 Lg Integer *4 N Integer *4 X Character *8 Num C Begin Cmd_ArticleNUmber Lg = Len(Text) X = 1 N = 0 Cmd_ArticleNumber = .true. Do While ((X .le. Lg) .and. Cmd_ArticleNumber) If ((Text(X:X) .ge. '0') .and. (Text(X:X) .le. '9')) Then N = 10 * N + IChar(Text(X:X)) - IChar('0') Else Cmd_ArticleNumber = .false. EndIf X = X + 1 EndDo If (Cmd_ArticleNumber) Then If $ ( $ (N .ge. Group(G).Active_Start) $ .and. $ (N .le. Group(G).Active_End) $ ) $ Then S = N Else Call ItoS (N, Num, Lg) Print '(A)', ' Article ' // Num(1:Lg) // ' not available' Cmd_ArticleNumber = .false. EndIf EndIf End ! Cmd_ArticleNumber Subroutine Cmd_ArticleKill (G, A, U) Include 'News.Def' C Parameter definition Integer *4 G ! Group number Integer *4 A ! Article number Integer *4 U ! Unread article count, updated C External routines Integer Range_Find C Local definitions Logical Any Integer *4 I Integer *4 I_Lg Character *8 I_C Integer *4 Subject_Lg Integer *4 Status Character *128 Subject Integer *4 XSubject_Lg Character *128 XSubject C Begin Cmd_ArticleKill Any = .false. C Send XHdg Subject command to retrieve subject line for article Call CacheHdr (G, A, Subject, Subject_Lg) C% Call XHdr (A, 'subject', Subject, Subject_Lg) C Remove article number from front of subject line Call ItoS (A, I_C, I_Lg) If (I_Lg .lt. Subject_Lg) Then Subject(1:Subject_Lg-I_Lg) = Subject(1+I_Lg:Subject_Lg) Subject_Lg = Subject_Lg - I_Lg C Display subject being killed Call SMG_All_Print $ ('Searching for: ' // Subject(1:Subject_Lg), '|') C Page through articles looking for this subject Do I = Group(G).Active_Start, Group(G).Active_End If (Range_Find(G, I, .false.) .eq. 0) Then c Write (XSubject, '(A,I)') 'Looking at article ', I c Call SMG_ALL_Print (XSubject, '|') Call CacheHdr (G, I, XSubject, XSubject_Lg) c% Call XHdr (I, 'subject', XSubject, XSubject_Lg) c Call SMG_All_Print (XSubject(1:XSubject_Lg), '|') C Remove article number from front of subject line Call ItoS (I, I_C, I_Lg) If (XSubject_Lg .gt. I_Lg) Then XSubject(1:XSubject_Lg-I_Lg) = $ XSubject(1+I_Lg:XSubject_Lg) XSubject_Lg = XSubject_Lg - I_Lg If $ (Subject(1:Subject_Lg) .eq. XSubject(1:XSubject_Lg)) $ Then Status = Range_Find (G, I, .true., U) Call ItoS (I, I_C, I_Lg) Call SMG_All_Print ('Killed: ' // I_C(1:I_Lg), '|') Any = .true. EndIf EndIf ! (XSubject_Lg .gt. I_Lg) EndIf ! (Range_Find(G, I, .false.) .eq. 0) End Do EndIf ! (I_Lg .lt. Subject_Lg) If (.not. Any) Then Call SMG_All_Print ('No articles killed', '|') End If End ! Cmd_ArticleKill Integer Function Cmd_ArticleSameSubj (G, A) Include 'News.Def' C Parameter definition Integer *4 G ! Group number Integer *4 A ! Article number C External routines Integer Range_Find C Local definitions Integer *4 I Integer *4 I_Lg Character *8 I_C Integer *4 Subject_Lg Integer *4 Status Character *128 Subject Integer *4 XSubject_Lg Character *128 XSubject C Begin Cmd_ArticleSameSubj C Send XHdg Subject command to retrieve subject line for article Call CacheHdr (G, A, Subject, Subject_Lg) C Remove article number from front of subject line Call ItoS (A, I_C, I_Lg) If (I_Lg .lt. Subject_Lg) Then Subject(1:Subject_Lg-I_Lg) = Subject(1+I_Lg:Subject_Lg) Subject_Lg = Subject_Lg - I_Lg C Display subject being looked for Call SMG_All_Print $ ('Searching for: ' // Subject(1:Subject_Lg), '|') C Page through articles looking for this subject Do I = Group(G).Active_Start, Group(G).Active_End If (Range_Find(G, I, .false.) .eq. 0) Then Call CacheHdr (G, I, XSubject, XSubject_Lg) C Remove article number from front of subject line Call ItoS (I, I_C, I_Lg) If (XSubject_Lg .gt. I_Lg) Then XSubject(1:XSubject_Lg-I_Lg) = $ XSubject(1+I_Lg:XSubject_Lg) XSubject_Lg = XSubject_Lg - I_Lg If $ (Subject(1:Subject_Lg) .eq. XSubject(1:XSubject_Lg)) $ Then Cmd_ArticleSameSubj = .true. A = I Return EndIf EndIf ! (XSubject_Lg .gt. I_Lg) EndIf ! (Range_Find(G, I, .false.) .eq. 0) End Do EndIf ! (I_Lg .lt. Subject_Lg) Call SMG_All_Print ('No other articles found', '|') Cmd_ArticleSameSubj = .false. Return End ! Cmd_ArticleSameSubj Integer Function Cmd_ArticleFirst (G, A) Include 'News.Def' C Parameter definition Integer *4 G ! Group number Integer *4 A ! Article number C Entry point definitions Integer Cmd_ArticleLast C External routines Integer Range_Find C Local definitions Integer *4 E, D, I, S C Begin Cmd_ArticleFirst S = Group(G).Active_Start E = Group(G).Active_End D = +1 Goto 1 C Begin Cmd_ArticleLast Entry Cmd_ArticleLast (G, A) S = Group(G).Active_End E = Group(G).Active_Start D = -1 Goto 1 C Page through articles looking for first unread 1 Do I = S, E, D If (Range_Find(G, I, .false.) .eq. 0) Then A = I Cmd_ArticleFirst = .true. Return EndIf End Do C No unread articles found Call SMG_All_Print ('No unread articles found', '|') Cmd_ArticleFirst = .false. Return End ! Cmd_ArticleFirst Subroutine XHdr (A, What, Result, Lg) Include 'News.Def' C Parameter definitions Integer *4 A Character *(*) What Character *(*) Result Integer *4 Lg C External routines Integer Srv_Cmd Integer Srv_Recv Integer Srv_RdTxt C local definitions Integer *4 Status C Begin XHdr C Request header line with a 'xhdr what article_number' command Write (Result, '(A,I)') 'xhdr ' // What // ' ', A Status = Srv_Cmd (Result, Result, Lg) If (.not. Status) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf If (Result(1:3) .ne. '221') Then Call SMG_All_Print (Result(1:Lg), '|') Call SMG_All_Print ('Unexpect server response', '|') Stop EndIf C Get header line Status = Srv_Recv (Result, Lg) If (.not. Status) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf C Skip rest of response If (Result(1:Lg) .ne. '.') Then Status = Srv_RdTxt (.false., .false., %Val(0)) If (.not. Status) Then Call SMG_All_Print ('Server failed', '|') Stop EndIf EndIf C Return Return End ! XHdr Subroutine Cmd_Help Include 'News.Def' C Begin Cmd_Help Call SMG_Erase Call SMG_All_Print ('b backup', '|') Call SMG_All_Print ('c [#] catchup', '|') Call SMG_All_Print ('d directory', '|') Call SMG_All_Print ('d/g pattern group directory', '|') Call SMG_All_Print ('f followup', '|') Call SMG_All_Print ('g group go group', '|') Call SMG_All_Print ('h help', '|') Call SMG_All_Print ('k kill', '|') Call SMG_All_Print ('m mark unread', '|') Call SMG_All_Print ('n next', '|') Call SMG_All_Print ('p post', '|') Call SMG_All_Print ('q quit', '|') Call SMG_All_Print ('r refresh', '|') Call SMG_All_Print ('s save', '|') Call SMG_All_Print ('u unsubscribe', '|') Call SMG_All_Print ('x rotate', '|') Call SMG_All_Print ('z next article same subject', '|') Call SMG_All_Print ('# article number', '|') Call SMG_All_Print ('^ first unread article', '|') Call SMG_All_Print ('$ last unread article', '|') Call SMG_All_Print (' ', '|') Return End ! Cmd_Help Integer Function Open_Newsrc () Include 'News.Def' C External routines Integer Range_Allocate Integer TrimLg External User_Open C Local Definitions Character *1 C Integer *4 Status Character *512 Image Integer *4 R Integer *4 S, L, N, E, X C Begin Open_Newsrc Call User_Open_Init ('STATUS_OLD',0,0,0,0,0,0,0,0) Open $ ( $ Unit = LU_Newsrc, $ File = 'Sys$Login:XX.Newsrc', $ Status = 'Old', $ Form = 'Formatted', $ Recl = 512, $ UserOpen = User_Open, $ IOStat = Status $ ) Group_Count = 0 If (Status .ne. 0) Then Newsrc_Is_Open = .false. Open_Newsrc = 0 Return EndIf Newsrc_Is_Open = .true. C Get date of creation of XX.Newsrc Call User_Open_Get_CDT (LU_Newsrc, Newsrc_CDT_VMS) Newsrc_CDT_News(1:2) = Newsrc_CDT_VMS(10:11) ! Year X = Index $ ( $ 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC', $ Newsrc_CDT_VMS(4:6) $ ) Write (Newsrc_CDT_News(3:4), '(I2.2)') X/3 + 1 ! Month Newsrc_CDT_News( 5: 6) = Newsrc_CDT_VMS(1:2) ! Day If (Newsrc_CDT_News(5:5) .eq. ' ') Then Newsrc_CDT_News(5:5) = '0' EndIf Newsrc_CDT_News( 7: 7) = ' ' Newsrc_CDT_News( 8: 9) = Newsrc_CDT_VMS(13:14) ! Hour If (Newsrc_CDT_News(8:8) .eq. ' ') Then Newsrc_CDT_News(8:8) = '0' EndIf Newsrc_CDT_News(10:11) = Newsrc_CDT_VMS(16:17) ! Minute If (Newsrc_CDT_News(10:10) .eq. ' ') Then Newsrc_CDT_News(10:10) = '0' EndIf Newsrc_CDT_News(12:13) = Newsrc_CDT_VMS(19:20) ! Second If (Newsrc_CDT_News(12:12) .eq. ' ') Then Newsrc_CDT_News(12:12) = '0' EndIf C Now read users XX.Newsrc Status = 1 Do While (Status) Read $ ( $ Unit = LU_Newsrc, $ Fmt = '(A)', $ IOStat = Status $ ) $ Image If (Status .lt. 0) Then Open_Newsrc = 1 Status = 0 Else If (Status .ne. 0) Then Close (LU_Newsrc) Open_Newsrc = 0 Status = 0 Else Status = 1 X = Index (Image, ':') If (X .eq. 0) Then X = Index (Image, '!') EndIf If (X .ne. 0) Then C We have a new group Group_Count = Group_Count + 1 Group(Group_Count).Range_First = 0 Group(Group_Count).Range_Last = 0 Group(Group_Count).Newsrc_File = .true. C Record group's name Group(Group_Count).Name = Image (1:X-1) C Get subscribed information If (Image(X:X) .eq. ':') Then Group(Group_Count).Subscribed = .true. Else Group(Group_Count).Subscribed = .false. EndIf C Clear moderated and activefile flags, they will get set properly C when we page through the news groups later. Group(Group_Count).Active_Post = .false. Group(Group_Count).Active_File = .false. C Get article ranges S = 0 N = 0 E = 0 L = 0 Do While (X .le. 512) X = X + 1 If (X .eq. 512) Then C = ',' Else C = Image (X:X) EndIf If ((C .ge. '0') .and. (C .le. '9')) Then N = 10 * N + IChar(C) - IChar('0') Else If (C .eq. '-') Then S = N N = 0 Else If (C .eq. ',') Then E = N If (S .eq. 0) Then S = E EndIf C Now add a new range entry to this group's control structure If (S .ne. 0) Then If ((S .le. L) .or. (S .gt. E)) Then Call SMG_All_Print $ ( $ 'Error in XX.Newsrc entry for group ' // $ Group(Group_Count).Name $ (1:TrimLg(Group(Group_Count).Name)), $ '|' $ ) Else R = Range_Allocate () Range(R).Next = 0 Range(R).Start = S Range(R).End = E If (Group(Group_Count).Range_First .eq. 0) Then Group(Group_Count).Range_First = R Else Range(Group(Group_Count).Range_Last).Next $ = R EndIf Group(Group_Count).Range_Last = R L = E EndIf EndIf C Get ready for next range S = 0 E = 0 N = 0 EndIf EndDo Else EndIf EndIf End Do End ! Open_Newsrc Integer Function Close_Newsrc () Include 'News.Def' C External definitions Integer TrimLg C Local Definitions Logical First Integer *4 G Character *512 Image Integer *4 R Integer *4 Status Integer *4 X Integer *4 S, E Character *8 S_C, E_C Integer *4 S_Lg, E_Lg C Begin Close_Newsrc If (Newsrc_Is_Open) Then Close (LU_Newsrc) EndIf Open $ ( $ Unit = LU_Newsrc, $ File = 'Sys$Login:XX.Newsrc', $ Status = 'New', $ Form = 'Formatted', $ CarriageControl = 'List', $ Recl = 512, $ IOStat = Status $ ) G = 1 If (Status .ne. 0) Then Close_Newsrc = 0 Return EndIf C Wander through all groups Do While (G .le. Group_Count) If $ ( $ (Group(G).Active_File .and. Group(G).Subscribed) $ .or. $ Group(G).Newsrc_File $ ) $ Then C Start image with group name X = TrimLg (Group(G).Name) Image(1:X) = Group(G).Name(1:X) C Now add subscribed flag X = X + 1 If (Group(G).Subscribed) Then Image(X:X) = ':' Else Image(X:X) = '!' EndIf C Wander through all ranges for this group R = Group(G).Range_First First = .true. Do While (R .ne. 0) If (.not. First) Then X = X + 1 Image(X:X) = ',' Else First = .false. EndIf S = Range(R).Start Call ItoS (S, S_C, S_Lg) Image(X+1:X+S_Lg) = S_C(1:S_Lg) X = X + S_Lg If (Range(R).End .ne. Range(R).Start) Then X = X + 1 Image(X:X) = '-' E = Range(R).End Call ItoS (E, E_C, E_Lg) Image(X+1:X+E_Lg) = E_C(1:E_Lg) X = X + E_Lg EndIf R = Range(R).Next End Do ! (R .ne. 0) Write (LU_Newsrc, '(A)') Image(1:X) EndIf G = G + 1 End Do ! (G .le. Group_Count) C Return success Close_Newsrc = 1 End ! Close_Newsrc Integer Function Range_Allocate Include 'News.Def' C Begin Range_Allocate If (Range_Free_List .ne. 0) Then Range_Allocate = Range_Free_List Range_Free_List = Range(Range_Free_List).Next Else If (Range_Count .lt. Mx_Range) Then Range_Count = Range_Count + 1 Range_Allocate = Range_Count Else Call SMG_All_Print ('Range array exceeded', '|') Stop EndIf EndIf Range(Range_Allocate).Next = 0 Range(Range_Allocate).Start = 0 Range(Range_Allocate).End = 0 Return End ! Range_Allocate Subroutine Range_Deallocate (R) Include 'News.Def' C Parameter definitions Integer *4 R ! Range index C Local definitions Integer *4 N, X C Begin Range_Deallocate X = R Do While (X .ne. 0) N = Range(X).Next Range(X).Next = Range_Free_List Range_Free_List = X X = N End Do End ! Range_Deallocate Integer Function Range_Find (G, A, Create, U) Include 'News.Def' C Description C C Locates the Range entry for article number A in group G. C If a range entry does not exist for A and Create is true, C one is created. C C Returns the Range entry index or zero if none. C C Parameter definitions Integer *4 G ! Group number Integer *4 A ! Article number Logical Create ! .true. if create on no find Integer *4 U ! Unread article count, updated C External routines Integer Range_Allocate C Local definitions Integer *4 P Integer *4 R, RR Logical Found C Begin Range_Find P = 0 R = Group(G).Range_First Found = .false. Range_Find = 0 Do While ((R .ne. 0) .and. (.not. Found)) If ((A .ge. Range(R).Start) .and. (A .le. Range(R).End)) Then Found = .true. Range_Find = R Else If (A .lt. Range(R).Start) Then Found = .true. Else P = R R = Range(R).Next End If End Do If ((Range_Find .eq. 0) .and. Create) Then If $ ( $ (P .ne. 0) $ .and. $ ((Range(P).End+1) .eq. A) $ ) Then Range(P).End = Range(P).End + 1 Range_Find = P Call Range_Combine (P, R) Else If $ ( $ (R .ne. 0) $ .and. $ ((Range(R).Start-1) .eq. A) $ ) Then Range(R).Start = Range(R).Start - 1 Range_Find = R Call Range_Combine (P, R) Else RR = Range_Allocate () Range_Find = RR Range(RR).Start = A Range(RR).End = A Range(RR).Next = R If (P .eq. 0) Then Group(G).Range_First = Range_Find Group(G).Range_Last = Range_Find Else Range(P).Next = Range_Find EndIf EndIf U = U - 1 If (U .lt. 0) Then U = 0 EndIf EndIf End ! Range_Find Subroutine Range_Combine (P, R) Include 'News.Def' C Parameter definitions Integer *4 P Integer *4 R C Begin Range_Combine If ((P .ne. 0) .and. (R .ne. 0)) Then C Are range entries ajacent? If ((Range(P).End + 1) .eq. Range(R).Start) Then C Mark entry P with entire range Range(P).End = Range(R).End C Remove entry R from the chain Range(P).Next = Range(R).Next C Release entry R Range(R).Next = 0 Call Range_Deallocate (R) EndIf EndIf End ! Range_Combine Integer Function Srv_Connect Include 'News.Def' C Description C C Connects to the Remote News server. C C Returns success or failure. C C Local Variables Integer *4 I Integer *4 Lg Record /Socket_IN_Def/ Server_Socket Integer *4 Status Integer *4 IP_Address Equivalence (IP_Address, Server_IP_Number) C Empty Recv buffer Recv_BufS = 2 Recv_BufE = 1 C Open a channel to INET0: Channel = Socket $ ( $ %Val(AF_INet), $ %Val(Sock_Stream), $ %Val(0) $ ) If (Channel .eq. -1) Then Srv_Connect = 2 Return EndIf C Connect to remote machine Server_Socket.SIN_Family = AF_INet Server_Socket.SIN_Port = HtoNS (%Val(119)) Server_Socket.SIN_Address = IP_Address ! '111e6880'X Do I = 1,8 Server_Socket.SIN_Fill(I) = 0 EndDo Status = Connect $ ( $ %Val(Channel), $ Server_Socket, $ %Val(16) $ ) If (Status .ne. 0) Then Srv_Connect = 4 Return EndIf C Return success Srv_Connect = 1 Return End ! Srv_Connect Integer Function Srv_NetClose() Include 'News.Def' C Description C C Close Connection to the Remote News server. C C Returns success or failure. C C External routines Integer NetClose C Local variables Integer *4 Status C Begin Srv_NetClose C Disconnect from remote machine Status = NetClose (%Val(Channel)) If (Status .ne. 0) Then Srv_NetClose = 4 Return EndIf C Return success Srv_NetClose = 1 Return End ! Srv_NetClose Integer Function Srv_Recv (Buf, Lg) Include 'News.Def' C Description C C Read data form server to Buf. C C Returns success or failure. C Parameter Definitions Character *(*) Buf Integer *4 Lg C Local definitions Integer *4 Buf_Lg Character *2 CRLF Logical CR Logical Done Integer *4 I Integer *4 III Integer *4 N Integer *4 NN Integer *4 Recv_Buf_Addr Integer *4 Recv_Buf_Lg Logical Skip C Begin Srv_Recv Buf_Lg = Len(Buf) CRLF(1:1) = Char(13) CRLF(2:2) = Char(10) Lg = 0 ! No bytes xferred so far Done = .false. CR = .false. Do While (.not. Done) C If there is no data in the receive buffer, get some If (Recv_BufS .gt. Recv_BufE) Then Recv_Buf_Addr = %Loc(Recv_Buf) Recv_Buf_Lg = Len(Recv_Buf) I = Recv $ ( $ %Val(Channel), $ %Val(Recv_Buf_Addr), $ %Val(Recv_Buf_Lg), $ %Val(0) $ ) If (I .eq. -1) Then Srv_Recv = 0 Else Srv_Recv = 1 If (Debug) Then Print '(8(x,o3.3))', (IChar(Recv_Buf(III:III)),III=1,I) EndIf EndIf Recv_BufS = 1 Recv_BufE = I EndIf C Now we have some data C If we last saw a carriage return and the next character is a LF C then we have found the end of the image and we are done If (CR .and. (Recv_Buf(Recv_BufS:Recv_BufS) .eq. CRLF(2:2))) Then Done = .true. Recv_BufS = Recv_BufS + 1 Else C No terminator, look for the next hunk to transfer. CR = .false. I = Index (Recv_Buf(Recv_BufS:Recv_BufE), CRLF(1:1)) If (I .eq. 0) Then N = Recv_BufE - Recv_BufS + 1 Skip = 0 Else N = I - 1 Skip = 1 CR = .true. EndIf C Anything to tranfer? If (N .gt. 0) Then NN = Buf_Lg - Lg If (NN .gt. N) Then NN = N EndIf If (NN .gt. 0) Then Buf(Lg+1:Lg+NN) = Recv_Buf(Recv_BufS:Recv_BufS+NN-1) Lg = Lg + NN EndIf EndIf Recv_BufS = Recv_BufS + N + Skip EndIf EndDo If (Lg .le. 0) Then Lg = 1 Buf(1:1) = ' ' EndIf Return End ! Srv_Recv Integer Function Srv_Send (Msg) Include 'News.Def' C Description C C Send data from Buffer to News Server C C Returns success or failure. C Parameter Definitions Character *(*) Msg C Local definitions Character *512 Buf Integer *4 Buf_Addr Integer *4 Buf_Lg Integer *4 CC C Begin Srv_Send Buf_Lg = Len(Msg) Buf = Msg(1:Buf_Lg) // Char(13) // Char(10) Buf_Addr = %Loc(Buf) Buf_Lg = Buf_Lg+2 CC = Send $ ( $ %Val(Channel), $ %Val(Buf_Addr), $ %Val(Buf_Lg), $ %Val(0) $ ) If (CC .eq. -1) Then Srv_Send = 0 Else Srv_Send = 1 EndIf Return End ! Srv_Send Integer Function Srv_Cmd (Cmd, Rsp, Lg) Include 'News.Def' C Description C C Send Cmd to the news server and retrieve its response in Rsp C C Returns C C Srv_Cmd Success or failure C Rsp Response text from server C Lg Length of Rsp text C Parameter definitions Character *(*) Cmd Character *(*) Rsp Integer *4 Lg C External Routines Integer Srv_Send Integer Srv_Recv C Begin Srv_Cmd Srv_Cmd = Srv_Send (Cmd) If (.not. Srv_Cmd) Then Return EndIf Srv_Cmd = Srv_Recv (Rsp, Lg) C Return Return End ! Srv_Cmd Integer Function Srv_RdTxt (P, Rot, Image_Routine) Include 'News.Def' C Parameters Logical P ! .true. means print ! .false. means skip Logical Rot ! .true. means rotate External Image_Routine ! Called for each image Integer Image_Routine C External Routines Integer Srv_Recv Logical SMG_More_Print C Local definitions Character *512 Buf Integer *4 Lg Logical Ok C Begin Srv_RdTxt Buf(1:1) = ' ' Ok = P Do While (Buf(1:Lg) .ne. '.') Srv_RdTxt = Srv_Recv (Buf, Lg) If (.not. Srv_RdTxt) Then Return EndIf If (Buf(1:Lg) .ne. '.') Then If (Ok) Then If (Rot) Then Call Rotate (Buf(1:Lg)) EndIf If $ ( $ (%Loc(Image_Routine) .eq. 0) $ .or. $ (Image_Routine(Buf(1:Lg))) $ ) $ Then If (Debug) Then Call SMG_More_Print ('RdTxt image:', '|') EndIf OK = SMG_More_Print (Buf(1:Lg), '|') EndIf EndIf EndIf EndDo C All done, return End ! Srv_RdTxt Subroutine Srv_CopyTxt (LU, Pre, Rotate_Flag) Include 'News.Def' C Parameter definitions Integer *4 LU Character *(*) Pre Logical Rotate_Flag C External routines Integer Srv_Recv C Local definitions Character *1024 Buf Integer *4 Buf_S, Buf_E ! Buf pointers Integer *4 Lg Integer *4 MxLg ! Recl for LU_Save Integer *4 Pre_Lg Integer *4 X C Begin Srv_CopyTxt If (Pre .eq. ' ') Then Pre_Lg = 0 Else Pre_Lg = Len (Pre) EndIf Inquire (Unit = LU, Recl = MxLg) MxLg = MxLg - 4 Buf = ' ' Lg = 1 Do While ((Buf(1:Lg) .ne. '.') .and. (Srv_Recv(Buf,Lg))) If (Lg .eq. 0) Then Lg = 1 Buf(1:1) = ' ' EndIf If (Buf(1:lg) .ne. '.') Then If (Rotate_Flag) Then Call Rotate (Buf(1:Lg)) %%end part c Michael Dorl (608) 262-0466 dorl@vms.macc.wisc.edu dorl@wiscmacc.bitnet From ncr-sd!hp-sdd!ucsdhub!ucsd!ames!pasteur!agate!ig!uwmcsd1!dogie!dorl@vms.macc.wisc.edu Sun Jul 31 18:15:05 PDT 1988 EndDo End ! Srv_CopyTxt Integer Function GetInteger (Buf, X, Lg) Implicit None C Parameter definitions Character *(*) Buf Integer *4 X Integer *4 Lg C Begin GetInteger GetInteger = 0 C Skip leading blanks Do While ((X .le. Lg) .and. (Buf(X:X) .eq. ' ')) X = X + 1 End Do C Accumulate field Do While $ ( $ (X .le. Lg) $ .and. $ ((Buf(X:X) .ge. '0') .and. (Buf(X:X) .le. '9')) $ ) GetInteger = 10 * GetInteger + IChar(Buf(X:X)) - IChar('0') X = X + 1 EndDo Return End ! GetInteger Subroutine GetField (Rsl, Src, Src_X, Src_Lg) Implicit None C Parameter definitions Character *(*) Rsl ! Result Character *(*) Src ! Source of data Integer *4 Src_X ! Source index Integer *4 Src_Lg ! Source length C Local variables Integer Rsl_X Integer Rsl_Lg C Begin GetField Rsl = ' ' Rsl_X = 1 Rsl_Lg = Len(Rsl) C Skip leading blanks Do While $ ((Src_X .le. Src_Lg) .and. (Src(Src_X:Src_X) .eq. ' ')) Src_X = Src_X + 1 EndDo C Accumulate field Do While $ ((Src_X .le. Src_Lg) .and. (Src(Src_X:Src_X) .ne. ' ')) If (Rsl_X .le. Rsl_Lg) Then Rsl(Rsl_X:Rsl_X) = Src(Src_X:Src_X) Rsl_X = Rsl_X + 1 EndIf Src_X = Src_X + 1 EndDo Return End ! GetField Integer Function TrimLg (S) Implicit None Character *(*) S TrimLg = Len(S) Do While ((TrimLg .gt. 1) .and. (S(TrimLg:TrimLg) .eq. ' ')) TrimLg = TrimLg - 1 End Do End Subroutine ItoS (I,S,L) C Description C C Converts integer I to a left justified space filled string S. C Number of non blank charcaters returned in L Implicit None C Parameter definitions Integer *4 I Character *(*) S Integer *4 L C Local Definitions Character *8 B Integer *4 N C Begin ItoS Write (B, '(I8)') I S = ' ' L = 0 Do N = 1,8 If (B(N:N) .ne. ' ') Then If (L .lt. Len(S)) Then L = L + 1 S(L:L) = B(N:N) EndIf EndIf EndDo End ! ItoS Subroutine Get_Mail_Control Include 'News.Def' C External routines External User_Open Integer TrimLg C Define the structure of the entries in the Sys$System:VMSMail.Dat file. Structure /VMDDef/ Union Map Character *512 All EndMap Map Character *31 UserName ! User Id Integer *2 Flags ! Flags = self copy, edit, etc. Integer *2 Mail ! New mail count Integer *4 Spare(7) Byte Spare1(2) Byte DirLng ! Directory length Byte FNmLng ! Full user name Byte FwdLng ! Forward name length Character *444 CMiscData ! Space for directory name, ! Full user name, and ! Forward name EndMap EndUnion Integer *4 Lg ! Length of VMD record Integer *4 DirX ! Directory index Integer *4 FNmX ! Full name index Integer *4 FwdX ! Forward index End Structure ! VMDDef C Length of fixed portion of VMS record Parameter VMD_FxLng = 68 C values for VMD Flags Parameter VMD_Flags_SendSelf = 1 Parameter VMD_Flags_ReplySelf = 2 Parameter VMD_Flags_NoPurge = 4 C Local definitions Integer *4 Lg Integer *4 Status Record /VMDDef/ Vmd Integer *4 X C Begin Read_Mail_Control Call UpPriv Call User_Open_Init ('STATUS_OLD',0,0,0,0,0,0,0,0) Call User_Open_Param ('EXEC_LOG',0,0,0,0,0,0,0,0,0) Open $ ( $ Unit = LU_VMSMail, $ File = 'Sys$System:VMSMail.Dat', $ Form = 'Formatted', $ Status = 'Old', $ Access = 'Keyed', $ Shared, $ UserOpen = User_Open, $ IOStat = Status $ ) Call DownPriv UserPersonalName = ' ' UserMailDirectory = ' ' If (Status .ne. 0) Then Return EndIf VMD.UserName = UserName Call STR$UpCase (VMD.UserName, VMD.UserName) Read $ ( $ Unit = LU_VMSMail, $ KeyId = 0, $ KeyEq = VMD.UserName, $ IOStat = Status, $ Fmt = '(Q,A)' $ ) $ VMD.Lg, VMD.All If (Status .eq. 0) Then Unlock (LU_VMSMail) X = 1 If (VMD.FwdLng .ne. 0) Then VMD.FwdX = X Else VMD.FwdX = 0 EndIf X = X + VMD.FwdLng If (VMD.FnmLng .ne. 0) Then VMD.FnmX = X UserPersonalName = $ VMD.CMiscData(VMD.FnmX:VMD.FnmX+VMD.FnmLng-1) Else VMD.FnmX = 0 EndIf X = X + VMD.FnmLng If (VMD.DirLng .ne. 0) Then VMD.DirX = X Lg = TrimLg (UserDirectory) - 6 UserMailDirectory = UserDirectory(1:Lg) // $ VMD.CMiscData(VMD.DirX+1:VMD.DirX+VMD.DirLng-1) Else UserMailDirectory = 'Sys$Login:' VMD.DirX = 0 EndIf EndIf Close (LU_VMSMail) End ! Read_Mail_Control Integer Function TransLog (In, Out, Table) Implicit None Include '($PSLDef)' Include '($LNMDef)' C Parameter definitions Character *(*) In ! name to be translated Character *(*) Out ! resulting translated name Integer *4 Table ! table 0 = User 'LNM$FILE_DEV' ! 1 = Exec 'LNM$SYSTEM_TABLE' C Local definitions Structure /ItmDef/ Integer *2 Length Integer *2 Code Integer *4 Address Integer *4 ReturnLength End Structure ! /ItmDef/ Integer *4 AcMode Integer *4 Attr Integer *4 InLg Record /ItmDef/ ItmList(2) Character *32 LogNameTable Integer *4 LogNameTableLg Integer *4 ResultLg Integer TrimLg, Sys$TrnLnm C Begin Attr = LNM$M_Case_Blind If (Table .eq. 0) Then LogNameTable = 'LNM$FILE_DEV' AcMode = PSL$C_User Else If (Table .eq. 1) Then LogNameTable = 'LNM$SYSTEM_TABLE' AcMode = PSL$C_Exec Else Call Lib$Stop (%Val(0)) EndIf LogNameTableLg = TrimLg (LogNameTable) ItmList(1).Code = LNM$_String ItmList(1).Length = Len(Out) ItmList(1).Address = %Loc (Out) ItmList(1).ReturnLength = %Loc(ResultLg) ItmList(2).Code = 0 ItmList(2).Length = 0 Out = ' ' InLg = TrimLg (In) TransLog = Sys$TrnLnm (Attr, $ LogNameTable(1:LogNameTableLg), $ In(1:InLg), $ AcMode, $ ItmList $ ) End ! TransLog Integer Function User_Edit (InFile, OutFile) Implicit None Include 'SMG.Def' C Parameter Definition Character *(*) InFile, OutFile C External Routines External Lib$Spawn Integer Lib$Spawn External SMG$Disable_Broadcast_Trapping Integer SMG$Disable_Broadcast_Trapping External SMG$Set_Broadcast_Trapping Integer SMG$Set_Broadcast_Trapping External SMG_Broadcast_AST External TrimLg Integer TrimLg C Local Definitions Character *128 Cmd Integer Status C Begin User_Edit If (InFile .eq. ' ') Then Cmd = '@MAIL$EDIT "" ' // OutFile Else Cmd = '@MAIL$EDIT ' // $ Infile(1:TrimLg(InFile)) // $ ' ' // $ OutFile EndIf Status = SMG$Disable_Broadcast_Trapping (SMG_PBId) User_Edit = Lib$Spawn $ ( $ Cmd, ! Command String $ , ! Input File $ , ! Output File $ , ! Flags $ , ! Process Name $ , ! Process Id $ , ! Completion Status $ , ! Completion EFN $ , ! Completion ASTAdr $ , ! Completion ASTArg $ , ! Prompt $ ! CLI $ ) Status = SMG$Set_Broadcast_Trapping $ ( $ SMG_PBId, ! Pasteboard-Id $ SMG_Broadcast_AST, ! AST-Routine $ ! AST-Argument $ ) If (.not. Status) Then Call Lib$Stop (%Val(Status)) EndIf End ! User_Edit Subroutine CacheHdr (G, Article, Subject, Subject_Lg) Include 'News.Def' C Parameter definition Integer *4 G Integer *4 Article Character *(*) Subject Integer *4 Subject_Lg C External routines Integer TrimLg C Local definitions Integer *4 NCache Character *128 Cache_Subject (500) Integer *4 Cache_Article (500) Integer *4 I C Begin CacheHdr C Is the requested information in the cache? If (NCache .gt. 0) Then Do I = 1, NCache If (Cache_Article(I) .eq. Article) Then Subject = Cache_Subject(I) Subject_Lg = TrimLg(Subject) c Call SMG_All_Print ('hdr cache hit', '|') Return EndIf EndDo EndIf C Requested information not cached, we have to read it. Call XHdr (Article, 'subject', Subject, Subject_Lg) If (NCache .lt. 500) Then NCache = NCache + 1 I = NCache Else I = 1 EndIf C Call SMG_All_Print ('Hdr cache no hit', '|') Cache_Subject(I) = Subject(1:Subject_Lg) Cache_Article(I) = Article Return C Begin CacheHdr_Init Entry CacheHdr_Init (G) NCache = 0 C Call SMG_All_Print ('Hdr cache init', '|') Return End ! CacheHdr ******** news_cld_install.com ******** $ Set command/Table=sys$common:[syslib]dcltables - /Output=sys$common:[syslib]dcltables - NewsDir:News.CLD $ Dir/Date sys$common:[syslib]dcltables.exe $ mcr install sys$common:[syslib]dcltables.exe/replace sys$common:[syslib]dcltables.exe/full $ ******** smg.def ******** C Define string descriptor, mainly used in places that need a C zero length string Structure /String_Def/ Integer *2 Length Byte DType Byte Class Integer *4 Address End Structure ! String_Def C Screen management and terminal control information Integer *4 SMGKeyDefId ! Define Key table id Integer *4 SMGKeyBdId ! Virtual keyboard id Integer *4 SMG_PBId ! Pasteboard Id Integer *4 SMG_PBCols ! Pasteboard columns Integer *4 SMG_PBRows ! Pastaboard rows Logical SMG_Video ! .true. if video terminal Logical SMG_Term ! .true. if interactive terminal Integer *4 SMG_Line ! Screen line number Character *132 PrintLine ! Work area for building print ! lines C More information Character *132 More_Input ! More response Character *132 More_Hdg_One ! Heading line 1 Character *132 More_Hdg_Two ! Heading line 2 C Control C definition Integer *4 TT_Chan Integer *4 Control_C C Common definition Common /SMG/ $ $ SMGKeyDefId, SMGKeyBdId, SMG_PBId, $ SMG_PBRows, SMG_PBCols, SMG_Video, $ SMG_Term, SMG_Line, $ $ PrintLine, $ $ More_Input, More_Hdg_One, More_Hdg_Two, $ $ Control_C, TT_Chan ******** smg_routines.for ******** Subroutine SMG_Initialize Implicit None Include 'SMG.Def' Include '($RMSDef)' Include '($SMGDef)/list' C External definitions Integer SMG$Create_Key_Table Integer SMG$Create_PasteBoard Integer SMG$Create_Virtual_Keyboard Integer SMG$Define_Key Integer SMG$Get_PasteBoard_Attributes Integer SMG$Load_Key_Defs Integer SMG$Set_Broadcast_Trapping External SMG_Broadcast_Ast External SMG$S_Pasteboard_Info_Block External DC$_Term C Local Definitions Integer *4 Status Record /SMGDef/ PB_Info C Begin SMG_Initialize Status = SMG$Create_PasteBoard $ (SMG_PBId,,SMG_PBRows,SMG_PBCols,0) If (.not. Status) Then Call Lib$Stop(%Val(Status)) EndIf If (SMG_PBCols .eq. 0) Then SMG_PBCols = 132 EndIf Status = SMG$Get_PasteBoard_Attributes $ (SMG_PBId,PB_Info,%Loc(SMG$S_PasteBoard_Info_Block)) If (Status) Then If (PB_Info.SMG$B_DevClass .eq. %Loc(DC$_Term)) Then SMG_Term = .true. Else SMG_Term = .false. EndIf If ((PB_Info.SMG$B_DevClass .ne. %Loc(DC$_Term)) .or. $ (PB_Info.SMG$B_SMG_DevType .eq. SMG$K_Unknown) .or. $ (PB_Info.SMG$B_SMG_DevType .eq. SMG$K_HardCopy) $ ) Then SMG_Video = .false. Else SMG_Video = .true. EndIf Else Call Lib$Stop(%Val(Status)) EndIf Status = SMG$Create_Key_Table (SMGKeyDefId) If (SMG_Term) Then Status = SMG$Set_Broadcast_Trapping $ (SMG_PBId, ! Pasteboard-Id $ SMG_Broadcast_AST, ! AST-Routine $ ! AST-Argument $ ) If (.not. Status) Call Lib$Stop(%Val(Status)) Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key PF1 ""/Echo/Set_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key PF2 "Help"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key PF2 "Dir/Folder"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key PF3 "Extract/Mail"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key PF3 "Extract"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key PF4 "Erase"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key PF4 "Select Mail"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP0 "Next"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP0 "Next/Edit"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP1 "Back"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP1 "Back/Edit"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP2 "Print"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP2 "Print/Print/Notify"' // $ '/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP3 "Dir"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP3 "Dir/Start=999999"' // $ '/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP4 "Current"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP4 "Current/Edit"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP5 "First"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP5 "First/Edit"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP6 "Last"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP6 "Last/Edit"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP7 "Send"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP7 "Send/Edit"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP8 "Reply"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP8 "Reply/Edit/Extract"' // $ '/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP9 "Forward"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key KP9 "Forward/Edit"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key Enter "Select "/Echo/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key Minus "Read/New"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key Minus "Show New"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key Comma "Dir/New"/Echo/Terminate') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key Comma "Dir Mail"/Echo/Terminate/If_State=Gold') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key Period "File "/Echo') Status = SMG$Define_Key (SMGKeyDefId, $ 'Define/Key Period "Delete "/Echo/If_State=Gold') Status = SMG$Load_Key_Defs $ ( $ SMGKeyDefId, ! Table $ 'MAIL$INIT', ! File $ 'MAIL$INIT', ! Default file (so '.' is not used) $ 1 ! File spec is logical name $ ) If (.not. Status) Then If (Status .ne. RMS$_FNF) Then Call Lib$Signal (%Val(Status)) EndIf EndIf Call CLI$DCL_Parse ! Restore the parse state of the command ! that originally invoked the image. ! Load_Key_Def destroys the state and restores ! it if no error occurs; it does not restore ! it if an error does occur. EndIf ! (SMG_Term) Status = SMG$Create_Virtual_KeyBoard (SMGKeyBdId) End ! SMG_Initialize Subroutine SMG_Broadcast_AST Implicit None Include 'SMG.Def' C Description C AST Routine established by SMG_Initialize to trap and handle C broadcast messages. C External Routines and Symbols External SMG$_No_MorMsg Integer SMG$_No_MorMsg External SMG$Get_Broadcast_Message Integer SMG$Get_Broadcast_Message External SMG$Cancel_Input Integer SMG$Cancel_Input External TrimLg Integer TrimLg C Local definitions Integer Status Character *132 Msg Integer I C Begin SMG_Broadcast_AST Status = SMG$Cancel_Input (SMGKeyBdId) Status = 1 Do While ((Status) .and. (Status .ne. %Loc(SMG$_No_MorMsg))) Status = SMG$Get_Broadcast_Message (SMG_PBId, Msg) If ((Status) .and. (Status .ne. %Loc(SMG$_No_MorMsg))) Then Call SMG_Print (' ') Call SMG_Print (Msg) EndIf EndDo End ! SMG_Broadcast_AST Subroutine SMG_Print_X (Buffer) Implicit None Include 'SMG.Def' Include '($IODef)' C Parameter definitions Character *(*) Buffer C External routines Integer Sys$QIOW C Local definitions Integer *4 CC Integer *4 L Integer *4 IOSB(2) Integer *4 Status C Begin SMG_Print_X L = Len(Buffer) If (L .gt. SMG_PBCols) Then ! SMG_PBCols seems to be L = SMG_PBCols ! defined even if EndIf ! SMG_Video is .false. If (.not. SMG_Term) Then Print '(x,A)', Buffer(1:L) Else CC = '01000000'x Status = Sys$QIOW $ ( $ , ! efn $ %Val(TT_Chan), ! channel $ %Val(IO$_WriteVBlk), ! function $ IOSB, ! IO status block $ , ! astadr $ , ! astprm $ %Val(%Loc(Buffer)), ! p1 = buffer address $ %Val(L), ! p2 = character count $ , ! p3 $ %Val(CC), ! p4 = carriage control $ , ! p5 $ ! p6 $ ) EndIf SMG_Line = SMG_Line + 1 End ! SMG_Print_X Integer Function SMG_More_Print (Text, Continuation) Implicit None Include 'SMG.Def' C Description SMG_More_Print C C Breaks Text down into CR/LF separated pieces of maximum size C SMG_PBCols. Calls more for each one. Second and subsequent C pieces are prefaced by Continuation. C C Returns More status. C C Description SMG_Print C C Same as above but More is not called. C Integer SMG_Print C Parameter Definitions Character *(*) Text Character *(*) Continuation C External Routines External More Integer More External TrimLg Integer TrimLg C Local Variables Integer S ! Start of hunk in Text Integer E ! End of hunk in Text Integer L ! Length of Text Integer LC ! Length of Continuation Integer X ! Length of extra stuff for current hunk Integer FF ! Location of form feeds Character *512 Buffer Character *2 CRLF Integer CR Integer NE Logical More_Flag C Begin SMG_More_Print LC = Len(Continuation) More_Flag = .true. Goto 1 C Begin SMG_Print Entry SMG_Print (Text) LC = 0 More_Flag = .false. C Begin common SMG_More_Print - SMG_Print 1 CRLF(1:1) = Char (13) ! CRLF(2:2) = Char (10) ! Call Expand_Tabs (Text, Buffer) L = TrimLg (Buffer) C Replace any form feed characters with blanks FF = Index (Buffer,Char(12)) Do While (FF .ne. 0) Buffer(FF:FF) = ' ' SMG_Line = 999 FF = Index (Buffer,Char(12)) End Do S = 1 L = TrimLg(Buffer) X = 0 SMG_More_Print = .true. Do While (S .le. L) C Attempt to print whatever is left E = L NE = E + 1 C But limit to SMG_PBCols If ((E-S+1+X) .gt. SMG_PBCols) Then E = S + SMG_PBCols - X - 1 NE = E + 1 EndIf C But also take into account CR LF separated hunks CR = Index (Buffer(S:L), CRLF) If (CR .ne. 0) Then CR = S + CR - 1 If (CR .eq. S) Then E = S NE = S + 2 Buffer (CR:CR+1) = ' ' Else If (CR .le. (E+1)) Then E = CR - 1 NE = CR + 2 Else ! Don't care, this CR/LF outside of hunk EndIf EndIf C Call more to see if this hunk fits on screen If (More_Flag) Then SMG_More_Print = More () If (.not. SMG_More_Print) Then Return EndIf Else SMG_More_Print = 1 EndIf C Now, print this hunk If (X .eq. 0) Then Call SMG_Print_X (Buffer(S:E)) Else Call SMG_Print_X (Continuation // Buffer(S:E)) End If C New start is end of last line ignoring any trailing CR/LF S = NE C Length of extra stuff now includes continuation characters X = LC End Do Return End ! SMG_More_Print Subroutine SMG_All_Print (Text, Continuation) Implicit None Include 'SMG.Def' C Description C C Breaks Text down into SMG_PBCols sized pieces and prints same. C Parameter Definitions Character *(*) Text Character *(*) Continuation C External Routines External TrimLg Integer TrimLg C Local Variables Integer S ! Start of hunk in Text Integer E ! End of hunk in Text Integer L ! Length of Text Integer LC ! Length of Continuation Integer X ! Length of extrac stuff for current hunk C Begin SMG_More_Print S = 1 L = TrimLg(Text) LC = Len(Continuation) X = 0 Do While (S .le. L) E = L If (SMG_Video) Then If ((E-S+1+X) .gt. SMG_PBCols) Then E = S + SMG_PBCols - X - 1 EndIf EndIf If (X .eq. 0) Then Call SMG_Print (Text(S:E)) Else Call SMG_Print (Continuation // Text(S:E)) End If S = E + 1 X = LC End Do End ! SMG_All_Print Subroutine SMG_Erase Implicit None Include 'SMG.Def' C Description: C C Erase the display if appropriate C C External Definitions: External SMG$Erase_Pasteboard Integer SMG$Erase_Pasteboard C Local Definitions Integer Status C Begin SMG_Erase If (SMG_Video) Then Status = SMG$Erase_Pasteboard (SMG_PBId) If (.not. Status) Then Call Lib$Stop (%Val(Status)) End If End If SMG_Line = 1 End ! SMG_Erase Integer Function More Implicit None Include 'SMG.Def' C External Definitions External SMG_Prompt Integer SMG_Prompt C Local Definitions Integer Status C Begin More If (Control_C) Then More = 0 Return EndIf More = 1 If (.not. SMG_Video) Then Return EndIf If (SMG_Line .ge. (SMG_PBRows-4)) Then SMG_Line = 0 Call SMG_Print_X (' ') Call SMG_Print_X ('Press RETURN for more...') Call SMG_Print_X (' ') Status = SMG_Prompt $ (More_Input, '> ', ) If ((More_Input .ne. ' ') .or. (.not. Status)) Then More = 0 Else Call More_Heading EndIf EndIf Return End ! More Subroutine More_Heading Implicit None Include 'SMG.Def' C Begin More_Heading Call SMG_Erase If (More_Hdg_One .ne. '@') Then Call SMG_Print_X (More_Hdg_One) EndIf If (More_Hdg_Two .ne. '@') Then Call SMG_Print_X (More_Hdg_Two) EndIf Call SMG_Print_X (' ') End ! More_Heading Subroutine Expand_Tabs (In, Out) Implicit None C Parameter Definitions Character *(*) In, Out C Local Definitions Integer X_In, L_In, T_In, X_Out, L_Out, E_Out, L, T Integer HT Parameter (HT=9) C Begin Expand_Tabs X_In = 1 L_In = Len(In) X_Out = 1 L_Out = Len(Out) Do While (X_In .le. L_In) C Find the next tab T_In = Index (In(X_In:L_In), Char(HT)) If (T_In .ne. 0) Then T_In = T_In + X_In - 1 C Tab, found move text before tab (if any) to output L = T_In - X_In If (L .gt. 0) Then If (X_Out .le. L_Out) Then E_Out = X_Out + L - 1 If (E_Out .gt. L_Out) Then E_Out = L_Out End If Out(X_Out:E_Out) = In(X_In:X_In+L-1) X_Out = X_Out + L End If End If C Now advance to the next tab stop if not already there T = 8 * ((X_Out-1)/8 + 1) + 1 L = T - X_Out If (L .gt. 0) Then If (X_Out .le. L_Out) Then E_Out = X_Out + L - 1 If (E_Out .gt. L_Out) Then E_Out = L_Out End If Out(X_Out:E_Out) = ' ' X_Out = X_Out + L End If End If X_In = T_In + 1 Else C No tab found, copy remaider of text to output L = L_In - X_In + 1 If (L .gt. 0) Then If (X_Out .le. L_Out) Then E_Out = X_Out + L - 1 If (E_Out .gt. L_Out) Then E_Out = L_Out End If Out(X_Out:E_Out) = In(X_In:L_In) X_In = X_In + L X_Out = X_Out + L End If End If End If End Do C Blank fill rest of output If (X_Out .le. L_Out) Then Out(X_Out:L_Out) = ' ' End If Return End ! Expand_Tabs Integer Function SMG_Prompt $ (Get_String, Prompt_String, Get_Length) Implicit None Include 'SMG.Def' Include '($SSDef)' C Parameter Definitions Character *(*) Get_String Character *(*) Prompt_String Integer *4 Get_Length C External Definitions External SMG$Read_Composed_Line Integer SMG$Read_Composed_Line External TrimLg Integer TrimLg C Local Definitions Record /String_Def/ Init_Desc, Prompt_Desc Character *128 Init_String Integer *4 Get_String_Length C Begin SMG_Prompt Prompt_Desc.DType = 14 Prompt_Desc.Class = 1 Prompt_Desc.Address = %Loc(Prompt_String) If (Prompt_String .eq. ' ') Then Prompt_Desc.Length = 0 Else Prompt_Desc.Length = Len(Prompt_String) EndIf Init_Desc.DType = 14 Init_Desc.Class = 1 Init_Desc.Address = %Loc(Init_String) Init_Desc.Length = 0 1 SMG_Prompt = SMG$Read_Composed_Line $ ( $ SMGKeyBdId, ! Keyboard Id $ SMGKeyDefId, ! Key Table Id $ Get_String, ! Received text $ Prompt_Desc, ! Prompt text $ Get_String_Length, ! received text length $ , ! display id $ , ! function key flags $ Init_Desc ! ini string $ ) SMG_Line = SMG_Line + 1 If ((SMG_Prompt .eq. SS$_Abort) $ .or. $ (SMG_Prompt .eq. SS$_Cancel) $ ) Then Init_String = Get_String Init_Desc.Length = Get_String_Length Goto 1 EndIf If (Control_C) Then Call SMG_Print (' ') EndIf If (%Loc(Get_Length) .ne. 0) Then Get_Length = TrimLg(Get_String) EndIf End ! SMG_Prompt Subroutine Ctrl_C Implicit None Include 'SMG.Def' Include '($SysSrvNam)' C Local Definitions Integer *4 Status C Begin Ctrl_C Status = Sys$Assign ('TT', TT_Chan,,) If (.not. Status) Then Call Lib$Stop (%Val(Status)) EndIf Call CtrlC_Enable Control_C = 0 Return End ! Ctrl_C Subroutine CtrlC_Routine Implicit None Include 'SMG.Def' C Begin CtrlC_Routine Call CtrlC_Enable Control_C = 1 Return End ! CtrlC_Routine Subroutine CtrlC_Enable Implicit None Include 'SMG.Def' Include '($SysSrvNam)' Include '($IODef)' C External Definitions External CtrlC_Routine C Local Definitions Integer *4 Status, Mode C Begin CtrlC_Enable Mode = IO$_SetMode .or. IO$M_CtrlCAst Status = Sys$QIOW (, $ %Val(TT_Chan), $ %Val(Mode), $ ,,,CtrlC_Routine, $ ,%Val(3),,, $ ) If (.not. Status) Then C Ignore bad status so we can run from batch c Call Lib$Stop (%Val(Status)) EndIf Return End ! CtrlC_Enable ******** tnews.cld ******** Define Verb TNews Image "Dsk$User1:[MaccNet.Dorl.XXNews]News" Qualifier Header Value(List) Qualifier Mark Value(Type=$Rest_Of_Line) ******** up_dn_priv.for ******** Subroutine UpPriv Implicit None Include '($PrvDef)' Include '($JPIDef)' C External Definitions External Sys$SetPrv Integer Sys$SetPrv External Sys$GetJpiW Integer Sys$GetJpiW External Lib$ExtV Integer Lib$ExtV C Local Definitions Structure /ItmLstDef/ Integer *2 Buffer_Lg Integer *2 Item_Code Integer *4 Buffer_Addr Integer *4 Return_Lg End Structure ! ItmLstDef Record /ItmLstDef/ ItemList(2) Integer *4 Status, Privs(2), OldPrivs(2), ClrPrivs(2), PID Logical PrivsAreUp C Begin Privs(1) = 0 Privs(2) = 0 Call Lib$InsV (1, Prv$V_Bypass, 1, Privs) Call Lib$InsV (1, Prv$V_World, 1, Privs) Call Lib$InsV (1, Prv$V_Oper, 1, Privs) Status = Sys$SetPrv (%Val(1), Privs, %Val(0), OldPrivs) If (.not. Status) Then Call Lib$Stop (Status) EndIf ClrPrivs(1) = IAnd(Privs(1),.not. OldPrivs(1)) ClrPrivs(2) = IAnd(Privs(2),.not. OldPrivs(2)) If ((ClrPrivs(1) .ne. 0) .or. (ClrPrivs(2) .ne. 0)) Then PrivsAreUp = .true. Else PrivsAreUp = .false. EndIf Return Entry DownPriv If (PrivsAreUp) Then Status = Sys$SetPrv (%Val(0), ClrPrivs, %Val(0),) EndIf PrivsAreUp = .False. Return Entry SetUpPriv ItemList(1).Item_Code = JPI$_ProcPriv ItemList(1).Buffer_Lg = 8 ItemList(1).Buffer_Addr = %Loc(OldPrivs(1)) ItemList(1).Return_Lg = 0 ItemList(2).Item_Code = 0 ItemList(2).Buffer_Lg = 0 PID = 0 Status = Sys$GetJpiW $ (, ! efn $ PID, ! pidaddr $ , ! prcnam $ ItemList(1), ! itmlist $ , ! iosb $ , ! astadr $ ! astprm $ ) If (.not. Status) Then Call Lib$Stop (%Val(Status)) EndIf OldPrivs(1) = .not. OldPrivs(1) ! Clear all privileges OldPrivs(2) = .not. OldPrivs(2) ! not in the process set. Status = Sys$SetPrv (%Val(0), OldPrivs(1), %Val(0),) If (.not. Status) Then Call Lib$Stop (%Val(Status)) EndIf %%end part d Michael Dorl (608) 262-0466 dorl@vms.macc.wisc.edu dorl@wiscmacc.bitnet From ncr-sd!hp-sdd!ucsdhub!ucsd!ames!pasteur!agate!ig!uwmcsd1!dogie!dorl@vms.macc.wisc.edu Sun Jul 31 18:15:19 PDT 1988 ******** user_open.common ******** C Common Declarations to communicate between User_Open_Init/Param and C User_Open Include '($XABDef)' Include '($XABKeyDef)' Include '($XABProDef)' Include '($XABDatDef)' Include '($FABDef)' Include '($RABDef)' Include '($PSLDef)' Integer Status, Status_Value ! 1=new, 2=old, 3=unknown Integer LogNames, LogNames_Value ! Integer Prot ! protection flag Integer *2 Prot_Value ! mask Integer Prot_Active ! active Integer DupKeys, DupKeys_Value ! duplicate key Record /XABProDef1/ LUNXABPro(100) Record /XABDatDef/ LUNXABDat(100) Integer *4 LUNFab(100) ! LUN FAB Pointers Integer *4 Unit ! Logical unit Integer *4 User_Open_Status_Value ! Last status returned by ! User_Open Character *256 ESA_Name ! Resultant file name Integer *4 ESA_Name_L ! Length of above Integer *4 What_Happened ! What happened on last open ! 0 = failed ! 1 = Open ! 2 = Create Common /User_Open_Common/ $ Status, Status_Value, $ LogNames, LogNames_Value, $ Prot, Prot_Value, Prot_Active, $ DupKeys, DupKeys_Value, $ LUNXABPro,LUNFAB, $ Unit, User_Open_Status_Value, $ ESA_Name,ESA_Name_L, What_Happened, $ LUNXABDat ******** user_open.for ******** Integer Function User_Open (Fab, Rab, Lun) Implicit None Include 'User_Open.Common' Include '($IODef)/list' C Parameter Definitions Record /FABDef/ Fab Record /RABDef/ Rab Integer Lun C Description C User_Open is designed to be called from a Fortran Open statement C through a UserOpen clause. Since it must do several different C things, calls on it must be preceded with calls on User_Open_Init C and User_Open_Param to tell it what needs to be done. These C routines have the same calling sequence... C C Call User_Open_Init (What_String, P1, P2, ... P8) C Call User_Open_Init (What_String, P1, P2, ... P8) C C What_String tells what kind of action User_Open should take while C P1 - P8 provide provide parameters for that action. C C What_String Explanation C C 'Status_New' File to be created C 'Status_Old' File exists C 'Status_Unknown' Use old file or create C 'Exec_Log' Don't use user logicals C 'Protection' Set protection to P1 C 'Dup_Keys' Allow duplicate keys for key P1 C External Definitions External Sys$Open, Sys$Create, Sys$Connect Integer Sys$Open, Sys$Create, Sys$Connect external Sys$put, Sys$Close integer Sys$put, Sys$Close C Local Definitions Integer *4 X, Off, Byte, XAB_Addr, XAB_Last Integer *2 Prot_IOSB Integer *4 XABSave Integer *4 Old_Prot C Begin User_Open Unit = Lun ! save unit in common LUNFab(Lun) = %Loc(FAB) C Set exec mode translate If (LogNames) Then X = PSL$C_EXEC Off = FAB$V_LNm_Mode Byte = Fab.FAB$B_ACModes Call MvBits (X,0,FAB$S_LNm_Mode,Byte,Off) Fab.FAB$B_AcModes = Byte EndIf C Wander through all of the XAB's doing whatever needs to be done XAB_Last = 0 XAB_Addr = Fab.FAB$L_XAB Do While (XAB_Addr .ne. 0) XAB_Last = XAB_Addr Call User_Open_XAB $ (%Val(XAB_Addr), $ %Val(XAB_Addr), $ %Val(XAB_Addr), $ XAB_Addr $ ) EndDo C If any options were not handled, handle them now! Call User_Open_XAB_Last (%Val(XAB_Last), Fab) C Open the file If ((Status_Value .eq. 2) .or. (Status_Value .eq. 3)) Then User_Open = Sys$Open (Fab) If (User_Open) Then What_Happened = 1 If (Prot_Active) Then Old_Prot = LUNXABPro(Lun).XAB$W_Pro ! Put the protection flags back in the XAB since the ! Open filled in existing values. LUNXABPro(Lun).XAB$W_Pro = Prot_Value If ((User_Open) .and. (Old_Prot .ne. Prot_Value)) Then User_Open = Sys$Close (Fab) User_Open = Sys$Open (Fab) EndIf EndIf ! (Prot_Active) EndIf ! (User_Open) EndIf If ((Status_Value .eq. 1) .or. $ ((Status_Value .eq. 3) .and. (.not. User_Open)) $ ) Then User_Open = Sys$Create (Fab) If (User_Open) Then What_Happened = 2 EndIf EndIf C If open worked, attach a record stream to it If (User_Open) Then User_Open = Sys$Connect (RAB) Call User_Open_Name (%Val(Fab.Fab$L_Nam)) ! Glom onto the name Else What_Happened = 0 EndIf User_Open_Status_Value = User_Open ! save status value for ! User_Open_Status End ! User_Open Subroutine User_Open_Init (What, P1, P2, P3, P4, P5, P6, P7, P8) Implicit None Include 'User_Open.Common' C Description C C Call User_Open_Init (What_String, P1, P2, ... P8) C Call User_Open_Init (What_String, P1, P2, ... P8) C C What_String tells what kind of action User_Open should take while C P1 - P8 provide provide parameters for that action. C C What_String Explanation C C 'Status_New' File to be created C 'Status_Old' File exists C 'Status_Unknown' Use old file or create C 'Exec_Log' Don't use user logicals C 'Protection' Set protection to P1 C 'Dup_Keys' Allow duplicate keys for key P1 C C Parameter Definition Character *(*) What Integer *4 P1, P2, P3, P4, P5, P6, P7, P8 C Local Definitions Integer *4 LWord Integer *2 Word Equivalence (Word, LWord) C Begin User_Open_Init Status = 0 LogNames = 0 Prot = 0 Prot_Active = 0 DupKeys = 0 C Begin User_open_Param Entry User_Open_Param (What, P1, P2, P3, P4, P5, P6, P7, P8) If (What .eq. 'STATUS_NEW') Then Status = 1 Status_Value = 1 Else If (What .eq. 'STATUS_OLD') Then Status = 1 Status_Value = 2 Else If (What .eq. 'STATUS_UNKNOWN') Then Status = 1 Status_Value = 3 Else If (What .eq. 'EXEC_LOG') Then LogNames = 1 Else If (What .eq. 'PROTECTION') Then Prot = 1 Prot_Active = 1 LWord = P1 ! nonsense to prevent Prot_Value = Word ! integer overflow Else If (What .eq. 'DUP_KEYS') Then DupKeys = 1 DupKeys_Value = 1 Else Print '(A)', ' Unknown User_Open_Parameter: ' // What Call Lib$Stop (%Val(0)) EndIf Return End ! User_Open_Init User_Open_Param Subroutine User_Open_XAB (XABKey, XABPro, XAB, XAB_Ptr) Implicit None Include 'User_Open.Common' C External Definitions Integer IOr C Parameter Definitions Record /XABDef/ XAB Record /XABKeyDef/ XABKey Record /XABProDef1/ XABPro Integer XAB_Ptr C Local Definitions Integer T, B C Begin User_Open_XAB If (DupKeys) Then If ( $ (XAB.XAB$B_Cod .eq. XAB$C_Key) $ .and. $ (XABKey.XAB$B_Ref .eq. DupKeys_Value) $ ) $ Then T = XAB$M_Dup B = XABKey.XAB$B_Flg B = IOr (B, T) XABKey.XAB$B_Flg = B DupKeys = 0 EndIf EndIf If (Prot) Then If (XAB.XAB$B_Cod .eq. XAB$C_Pro) Then XABPro.XAB$W_Pro = Prot_Value Prot = 0 EndIf EndIf XAB_Ptr = XAB.XAB$L_Nxt End ! User_Open_XAB Subroutine User_Open_XAB_Last (XAB, FAB) Implicit None Include 'User_Open.Common' C Parameter Definitions Record /XABDef/ XAB Record /FABDef/ FAB c Call User_Open_XAB_Last (%Val(XAB_Last), Fab) C If end of XABs and Protection not already handled, chain on a new XAB If (Prot) Then Call User_Open_XAB_Prot $ (%Val(%Loc(LUNXABPro(Unit))), $ %Val(%Loc(LUNXABPro(Unit)))) Prot = 0 If (%Loc(XAB) .ne. 0) Then XAB.XAB$L_Nxt = %Loc(LUNXABPro(Unit)) Else Fab.FAB$L_XAB = %Loc(LUNXABPro(Unit)) EndIf C Add a date XAB Call Set_XAB_L_Nxt (LUNXABPro(Unit), %Loc(LUNXABDat(Unit))) Else If (%Loc(XAB) .ne. 0) Then XAB.XAB$L_Nxt = %Loc(LUNXABDat(Unit)) Else Fab.FAB$L_XAB = %Loc(LUNXABDat(Unit)) EndIf EndIf Call Set_XAB_B_Cod (LUNXABDat(Unit), XAB$C_Dat) Call Set_XAB_B_BLn (LUNXABDat(Unit), XAB$C_DatLen) Call Set_XAB_L_Nxt (LUNXABDat(Unit), 0) End ! User_Open_XAB_Last Subroutine Set_XAB_B_Cod (XAB, V) Implicit None Include 'User_Open.Common' Record /XABDef/ XAB Byte V XAB.XAB$B_Cod = V End Subroutine Set_XAB_B_BLn (XAB, V) Implicit None Include 'User_Open.Common' Record /XABDef/ XAB Byte V XAB.XAB$B_BLn = V End Subroutine Set_XAB_L_Nxt (XAB, V) Implicit None Include 'User_Open.Common' Record /XABDef/ XAB Integer *4 V XAB.XAB$L_Nxt = V End Subroutine User_Open_XAB_Prot (XAB, XABP) Implicit None Include 'User_Open.Common' C Parameter Definition Record /XABDef/ XAB Record /XABProDef1/ XABP C Begin User_Open_XAB_Prot Call Lib$Movc5 (0,0,0,XAB$C_ProLen,XAB) XAB.XAB$B_Cod = XAB$C_Pro XAB.XAB$B_BLN = XAB$C_ProLen XABP.XAB$W_Pro = Prot_Value Return End ! User_Open_XAB_Prot Subroutine User_Close (Lun) Implicit None Integer Lun Include 'User_Open.Common' Call User_Open_exfab (%Val(LunFab(Lun))) Call Sys$Close (%Val(LUNFAB(Lun))) End Subroutine user_open_exfab (fab) implicit none Include 'User_open.common' integer xab_addr Record /fabdef/ fab XAB_Addr = Fab.FAB$L_XAB Do While (XAB_Addr .ne. 0) Call User_Open_exxab $ (%Val(XAB_Addr),%Val(XAB_Addr),XAB_Addr) EndDo Return End Subroutine user_open_exxab (xab,xabpro,addr) implicit none include 'user_open.common' record /xabdef/ xab record /xabprodef1/ xabpro integer addr addr = XAB.XAB$L_Nxt return end Subroutine User_Open_Name (N) Implicit None Include '($NamDef)' Include 'User_Open.Common' Record /NamDef/ N Integer A Integer L A = N.Nam$L_ESA L = N.Nam$B_ESL Call User_Open_NameX (%Val(A), L) Return End ! User_Open_Name Subroutine User_Open_NameX (A, L) Implicit None Include 'User_Open.Common' Integer I Byte A(255) Integer L If ((%Loc(A) .eq. 0) .or. (L .eq. 0)) Then Esa_Name = ' ' Esa_Name_L = 0 Else Do I = 1,L Esa_Name(I:I) = Char(A(I)) EndDo Esa_Name_L = L End If Return End ! User_Open_NameX Integer Function User_Open_Get_Status_Value () Implicit None Include 'User_Open.Common' User_Open_Get_Status_Value = User_Open_Status_Value Return End Subroutine User_Open_Get_Name (S) Implicit None Include 'User_Open.Common' Character *(*) S Integer X X = ESA_Name_L If (X .gt. Len(S)) Then X = Len(S) EndIf If (X .gt. 0) Then S = ESA_Name(1:X) Else S = ' ' EndIf Return End ! User_Open_Get_Name Integer Function User_Open_Get_What_Happened Implicit None Include 'User_Open.Common' User_Open_Get_What_Happened = What_Happened Return End ! User_Open_Get_What_Happened Subroutine User_Open_Get_CDT (LUN, CDT) Implicit None Include 'User_Open.Common' C Parameter definitions Integer *4 LUN Character *(*) CDT C External routines Integer Sys$AscTim C Local definitions Integer *4 XStatus, CDT_Lg C Begin User_Open_Get_CDT CDT = ' ' XStatus = Sys$AscTim $ (CDT_Lg, CDT, LUNXABDat(LUN).XAB$Q_CDT, 0) End ! User_Open_Get_CDT ******** end ******** %%end part e thats all folks... Michael Dorl (608) 262-0466 dorl@vms.macc.wisc.edu dorl@wiscmacc.bitnet From ncr-sd!ncrcae!ece-csc!ncsuvx!lll-winken!lll-tis!ames!ll-xn!husc6!uwvax!dogie!dorl@vms.macc.wisc.edu Sun Jul 31 18:16:54 PDT 1988 some missing lines at the very front of parts b, d, and e. Here are the differences between what should have been sent and what did get sent. Sorry about any inconvenience this might have caused! Part B what should have been sent ************ File DSK$USER1:[MACCNET.DORL.XXNEWS]DIST.B;1 1 Call Cmd_ArticleNone ! same subject 2 Action = .false. 3 Else If 4 $ ( 5 $ (Buf(1:1) .ge. '0') 6 $ .and. 7 $ (Buf(1:1) .le. '9') 8 $ ) 9 $ Then 10 Call Cmd_ArticleNone 11 Action = .false. 12 Else 13 Call SMG_All_Print ('Huh?', '|') 14 Action = .false. 15 End If 16 ****** Part B what did get sent File DSK$USER1:[MACCNET.DORL.XXNEWS]X.B;2 1 ************ Number of difference sections found: 1 Number of difference records found: 15 DIFFERENCES /IGNORE=(TRAILING_SPACES)/MERGED=1/OUTPUT=DSK$USER1:[MACCNET.DORL.XXNEWS]DIFF.B;1- DSK$USER1:[MACCNET.DORL.XXNEWS]DIST.B;1- DSK$USER1:[MACCNET.DORL.XXNEWS]X.B;2 ************ Part d what should have been sent File DSK$USER1:[MACCNET.DORL.XXNEWS]DIST.D;1 1 EndIf 2 Buf_S = 1 3 Do While (Buf_S .le. Lg) 4 Buf_E = Lg 5 X = Buf_E - Buf_S + 1 + Pre_Lg 6 If (X .gt. MxLg) Then 7 Buf_E = Buf_S + MxLg - 1 - Pre_Lg 8 EndIf 9 If (Pre_Lg .ne. 0) Then 10 Write (LU, '(A)') Pre // Buf(Buf_S:Buf_E) 11 Else 12 Write (LU, '(A)') Buf(Buf_S:Buf_E) 13 EndIf 14 Buf_S = Buf_E + 1 15 EndDo 16 EndIf 17 ****** Part d what did get sent File DSK$USER1:[MACCNET.DORL.XXNEWS]X.D;2 1 ************ Number of difference sections found: 1 Number of difference records found: 16 DIFFERENCES /IGNORE=(TRAILING_SPACES)/MERGED=1/OUTPUT=DSK$USER1:[MACCNET.DORL.XXNEWS]DIFF.D;1- DSK$USER1:[MACCNET.DORL.XXNEWS]DIST.D;1- DSK$USER1:[MACCNET.DORL.XXNEWS]X.D;2 ************ Part e what did get sent File DSK$USER1:[MACCNET.DORL.XXNEWS]DIST.E;1 1 End 2 ******** user_open.common ******** ****** Part e what did get sent File DSK$USER1:[MACCNET.DORL.XXNEWS]X.E;2 1 ******** user_open.common ******** ************ Number of difference sections found: 1 Number of difference records found: 1 DIFFERENCES /IGNORE=(TRAILING_SPACES)/MERGED=1/OUTPUT=DSK$USER1:[MACCNET.DORL.XXNEWS]DIFF.E;1- DSK$USER1:[MACCNET.DORL.XXNEWS]DIST.E;1- DSK$USER1:[MACCNET.DORL.XXNEWS]X.E;2 Michael Dorl (608) 262-0466 dorl@vms.macc.wisc.edu dorl@wiscmacc.bitnet From ncr-sd!hp-sdd!ucsdhub!ucsd!rutgers!uwvax!dogie!dorl@vms.macc.wisc.edu Tue Aug 2 15:49:39 PDT 1988 The news program I distributed last week is subject to the infamous line eater problem. The fix is to replace function srv_send found in file news.for with the following code: Integer Function Srv_Send (Msg) Include 'News.Def' C Description C C Send data from Buffer to News Server C C Returns success or failure. C Parameter Definitions Character *(*) Msg C Local definitions Character *512 Buf Integer *4 Buf_Addr Integer *4 Buf_Lg Integer *4 CC C Begin Srv_Send Buf_Lg = Len(Msg) If (Msg(1:Buf_Lg) .eq. ' ') Then Buf = Char(13) // Char(10) Buf_Lg = 0 Else Buf = Msg(1:Buf_Lg) // Char(13) // Char(10) EndIf Buf_Addr = %Loc(Buf) Buf_Lg = Buf_Lg+2 CC = Send $ ( $ %Val(Channel), $ %Val(Buf_Addr), $ %Val(Buf_Lg), $ %Val(0) $ ) If (CC .eq. -1) Then Srv_Send = 0 Else Srv_Send = 1 EndIf Return End ! Srv_Send PS I'd be interested to know if anyone got the program to work. I'll be on vacation from 8/2 to 8/10 so don't expect any response to queries during that period. Michael Dorl (608) 262-0466 dorl@vms.macc.wisc.edu dorl@wiscmacc.bitnet From ncr-sd!hp-sdd!hplabs!ucbvax!LBL.GOV!SCS7317%OCVAXB%VB.CC.CMU.EDU%KL.SRI.COM%lbl%sfsu1.hepnet Mon May 30 12:49:38 PDT 1988 Received: from KL.SRI.COM by LBL.Gov with INTERNET ; Thu, 26 May 88 16:20:30 PDT Received: from VB.CC.CMU.EDU by KL.SRI.COM with TCP; Tue 24 May 88 16:00:11-PDT Date: Tue, 24 May 88 19:00 EDT >From: Christopher Seline Subject: NEWS(DECNET/VMS) USENET on VMS reader user agent and DECNET mapper To: info-vax@KL.SRI.COM X-VMS-To: CMCCVB::IN%"info-vax@kl.sri.com" $!.............................................................................. $! VAX/VMS archive file created by VMS_SHAR V-5.01 01-Oct-1987 $! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au) $! To unpack, simply save and execute (@) this file. $! $! This archive was created by SCS7317 $! on Tuesday 24-MAY-1988 18:55:41.32 $! $! It contains the following 3 files: $! MAP.BAS MAP.PAS NEWS.TPU $!============================================================================== $ Set Symbol/Scope=(NoLocal,NoGlobal) $ Version=F$GetSYI("VERSION") ! See what VMS version we have here: $ If Version.ges."V4.4" then goto Version_OK $ Write SYS$Output "Sorry, you are running VMS ",Version, - ", but this procedure requires V4.4 or higher." $ Exit 44 $Version_OK: CR[0,8]=13 $ Pass_or_Failed="failed!,passed." $ Goto Start $Convert_File: $ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd $No_Error1: Define/User_Mode SYS$Output NL: $ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' - VMS_SHAR_DUMMY.DUMMY f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f); o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o); Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V"; Move_Vertical(1);x:=Erase_Character(1);Append_Line; Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1); ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1); If Current_Character='`' then Move_Horizontal(1);else Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit; $ Delete VMS_SHAR_DUMMY.DUMMY;* $ Checksum 'File_is $ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR $ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd $No_Error2: Return $Start: $ File_is="MAP.BAS" $ Check_Sum_is=1149044145 $ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY X10 rem MAP - hack tolook for news on a DECNET X20 rem it isn't pretty (and it doesn't use DAP (which it should)) but X30 rem it works. Which is the number one important thing in the real world X40 rem and all you programmers out there had better not forget it. X100 print "Map -- Check your entire DECNET for sites running USENET" X105 print X130 print "It checks invisible nodes...and dead nodes....infact" X140 print "It checks every possible node........" X150 print X200 for a = 1 to 74000 X202 if a = 68 then goto 400 X205 e = 0 X207 close #1 X210 when error in X220 open str$(a)+'::"/usr/lib/news/active"' as file #1, access read X230 use X240 e = 1 X250 print a ,ert$(err) X260 end when X300 if e = 0 then close #1 X305 if e = 1 then goto 400 X310 print using "######",a; X320 print " active" X330 ac$=ac$ + " " + str$(a) X400 next a X510 print V520 if ac$="" then print "No news easily found. A more sophisticated utility i Xs needed." X530 if ac$<>"" then print "news at "; ac$ X540 print X550 print "done." $ GoSub Convert_File $ File_is="MAP.PAS" $ Check_Sum_is=1867919516 $ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY Xprogram map (input,output); X X(* MAP.PAS`009This is a unsupported part of the NEWS(DECNET/VMS) suite. X X MAP.PAS`009Looks around your DECNET from any node suitably configured X`009 `009for NEWS(DECNET/VMS). You should pick the one closest to X`009`009you, and DEFINE it as NEWS_FARSITE. X X MAP.PAS`009works in the most crude way possible. A more sophisticated X`009`009technique (using DAP) would be nice, but...then again, X`009`009this works. X*) X XVAR node, stat : integer; X node_spec : varying [200] of char :=''; X infil : text; X XBEGIN X WRITELN('MAP X01 -- Map Your DECNET'); X WRITELN(' Looking for sites suitable to be NEWS_FARSITE'); X WRITELN; X for node := 1 TO 99000 DO X`009BEGIN X`009 node_spec := dec(node,5) + '::"/usr/lib/news/active"'; X`009 write(dec(node,5) + ':: '); X`009 OPEN(`009file_variable `009:= infil, X`009`009`009file_name`009:= node_spec, X`009`009`009history`009`009:= READONLY, X`009`009`009sharing`009`009:= READONLY, X`009`009 `009error`009`009:= CONTINUE); X`009 stat := status(infil); X`009 IF (stat = 0) X`009`009THEN writeln('SUCCESS!!! This could be used as news_farsite') X`009`009ELSE X`009`009`009begin X`009`009`009write ('Not this node. STATUS :='); X`009`009`009writeln (stat); X`009`009`009end; X`009 CLOSE(infil, error`009`009:= CONTINUE); X`009 X X`009END; X X XEND. X $ GoSub Convert_File $ File_is="NEWS.TPU" $ Check_Sum_is=1728655159 $ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY X! NEWS-news.tpu - a program to let people read news in comfort (scrolling X! backwards, automatic pause, etc) X! X!`009news.tpu Copyright 1988 (c) Christopher Seline X!`009ALL RIGHTS RESERVED X! X!`009TO USE THIS PRODUCT YOU MUST OBTAIN A LICENSE X! X!`009USE OF THIS PRODUCT MORE THAN FIVE (5) TIMES X!`009WITHOUT A LICENSE IS A CRIME. TO OBTAIN A LICENSE X!`009SEND THE LICENSING FEE TO: X!`009`009Christopher Seline X!`009`009127 Green Bay Rd. X!`009`009Winnetka, IL 60093 X! X!`009LICENSING FEE: X!`009`009Cluster license $250`009(per cluster) X!`009`009Machine license $100`009(per machine) X!`009`009Personal license$020`009(per user) X! X! X X`012 V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ X! installing this program V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ X! X! If you have lost the detailed instructions: X! rename this file to SYS$LOGIN:NEWS.TPU X! issue the DCL command EDIT/TPU/NOSEC/COM=SYS$LOGIN:NEWS.TPU X!`009Now, the following command will invoke news X!`009`009$ edit/tpu/sec=sys$login:news X!`009Don't forget to define NEWS_FARSITE to some decnet node. X!`009`009use MAP.PAS or MAP.BAS to figureout what to name it. X! X X`012 V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ X! INITIALIZATION PROCEDURES V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ X X XPROCEDURE tpu$init_procedure; X! TPU calls this procedure automatically when it starts up. X! After it exits, TPU will wait for bound keys and do their routines. X init_define_constants; X init_first; X init_determine_mode; X init_PopUp_intro_text; X init_subscribe; X init_moveto_first_group_with_news; XENDPROCEDURE; X X!---------- XPROCEDURE init_define_constants; X V message_window_length := 3; `009`009`009`009! size of the message window, Xin lines V status_text := "(X03.50) ^Z to exit ? for help ";`009! text to be dis Xplayed on the window's status line X spool_dir := "news_spool:";`009`009`009`009! spool area if enabled X page_scroll_amount := 19; X V $remote := 1; $sync := 2; $local := 3; $unknown := -1; $mode := $unknown;` X009`009`009! GLOBAL MODE V!`009$mode indicates what mode NEWS operates in. That is, where it looks for f Xiles X!`009`009$remote`009`009-- All files are on NEWS_FARSITE V!`009`009$sync`009`009-- active. is on NEWS_FARSITE, but some news articles ar Xe kept in NEWS_SPOOL, X!`009`009`009`009 so check there first X!`009`009$local`009`009-- All files are in NEWS_SPOOL (including active). V!`009`009`009`009 In $local mode, NEWS does not use DECNET at all. (unless Xyou've defined X!`009`009`009`009 NEWS_SPOOL to be on a DECNET NODE. X V no := 0; yes := 1; help_visited := no; keypad_help_visited := no;`009`009! XGLOBAL HELP BUFFER STATUS V X ! change these to $ form XENDPROCEDURE; X X!--------- XPROCEDURE init_first XLOCAL main_window_length; Xon_error`009! kill error messages Xendon_error; X V main_window_length := GET_INFO(SCREEN, "visible_length") - message_window_l Xength; X SET(PROMPT_AREA, main_window_length+1, 1, NONE); X V text_buffer := CREATE_BUFFER("Text");`009`009! create a buffer to hold the Xtext X SET(EOB_TEXT, text_buffer, "[END OF NEWS ITEM]"); X SET(NO_WRITE, text_buffer); X V text_window := CREATE_WINDOW(1, main_window_length, ON);`009! create the ma Xin text window X MAP(text_window, text_buffer); X V message_buffer := CREATE_BUFFER("Message Buffer");`009! Create a message bu Xffer for TPU messages, V SET(NO_WRITE, message_buffer); `009`009`009! for debugging, and map it into X a window X SET(SYSTEM, message_buffer); X SET(EOB_TEXT, message_buffer, ""); V message_window := CREATE_WINDOW(25-message_window_length, message_window_le Xngth, OFF); X MAP(message_window, message_buffer); X X XSET(FACILITY_NAME, "NEWS");`009`009`009`009! some initializtion XSET(MESSAGE_FLAGS, 15);`009`009`009`009`009! all message info XSET(SUCCESS, OFF); XSET(INFORMATIONAL, OFF); X Vjournal_open('nl:');`009`009`009`009`009! hack to prevent W-TPU$NOJOURNAL messa Xge X Xenable_bell; X XENDPROCEDURE; X X X!---------- XPROCEDURE init_determine_mode Xlocal junk, junk1; Xon_error Vjunk1 := 1;`009`009`009`009`009! indicate error, we expect an error when checki Xng for local spooling Xendon_error; X Xunmap(message_window);`009`009`009`009! stiffle RMS error messages X X! this procedure also creates active Xactive := CREATE_BUFFER ('active');`009`009! buffer holds /usr/lib/news/active XPOSITION (active); XSET (NO_WRITE, active); XSET (SYSTEM, active); XSET (TIMER, ON, "Loading active"); X Vmessage("");message("");message("");message("");! why can we intercept them w/ Xon ERR!!!! X XREAD_FILE(spool_dir + 'active.'); XIF beginning_of(active) = end_of(active) THEN X READ_FILE('news_farsite::"/usr/lib/news/active"'); X $mode := $remote X ELSE X $mode := $local; XENDIF; X XSET (TIMER, OFF); X XIF end_of(active) = beginning_of(active) THEN X message("I could not load active."); X message("USE q TO ABORT"); X message("USE q TO ABORT"); X message("USE q TO ABORT"); X five_map; X abort; XENDIF; X X XIF $mode = $remote THEN X! determine if spooling exists..... Xjunk := create_buffer("junk"); Xposition(junk); Xjunk1 := 0; XREAD_FILE (spool_dir + 'news-spooling-exists.'); VIF junk1 <> 1 then $mode := $sync; ENDIF;`009! if the file was sucessfully open Xed then we have local spooling of remote files X XENDIF; X XIF $mode = $remote THEN`009MESSAGE("NEWS(DECNET/VMS) V00.90 (remote)") ELSE XIF $mode = $local THEN`009MESSAGE("NEWS(DECNET/VMS) V00.90 (local)") ELSE XIF $mode = $sync THEN`009MESSAGE("NEWS(DECNET/VMS) V00.90 (sync)") ELSE X`009`009`009MESSAGE("NEWS(DECNET/VMS) V00.90 (BUG)"); XENDIF;ENDIF;ENDIF;`009! why can't the CASE statement deal with variables! X Xmap(message_window,message_buffer);`009`009! UNstiffle messages X XENDPROCEDURE; X X!---------- XPROCEDURE init_PopUp_intro_text; XPOSITION (BEGINNING_OF(text_buffer)); X X! THIS IS WHERE INTRODUCTORY TEXT GOES X V copy_text(" news.tpu Copyright (c) 1988 Christopher Seline"); s Xplit_line; X copy_text(" ALL RIGHTS RESERVED "); split_line; X copy_text(" "); split_line; V!copy_text(" USE OF THIS PRODUCT MORE THAN FIVE (5) TIMES WITHOUT A LICENSE XIS A"); split_line; V!copy_text(" CRIME. TO OBTAIN A LICENSE SEND THE LICENSING FEE TO: "); spli Xt_line; X!copy_text(" `009Christopher Seline "); split_line; X!copy_text("`009127 Green Bay Rd."); split_line; X!copy_text("`009Winnetka, IL 60093 "); split_line; X!copy_text(" "); split_line; X!copy_text(" LICENSING FEE:"); split_line; X!copy_text(" Cluster license $250`009(per cluster)"); split_line; X!copy_text(" Machine license $100`009(per machine)"); split_line; X!copy_text(" Personal license$020`009(per user)"); split_line; X copy_text(" "); split_line; X copy_text(" "); split_line; X V copy_text(" Press the SPACE BAR for next USENET message"); sp Xlit_line; X! XENDPROCEDURE; X X X!---------- XPROCEDURE init_subscribe X Xsubscribe := CREATE_BUFFER ('subscribe','sys$login:News_Subscribe.dat'); XSET (NO_WRITE, subscribe); XSET (SYSTEM, subscribe); XPOSITION (subscribe); XIF (BEGINNING_OF (subscribe) = END_OF (subscribe)) ! null or file not found X THEN X message ("Can't find your news subscription -- subscribing for you."); X message ("This takes several minutes -- so sit back and relax..."); X subscribe_create; XENDIF; Xupdate_banner; XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE subscribe_create XLOCAL a,b; XPOSITION (subscribe); VCOPY_TEXT (active);`009`009`009`009`009! copy active buffer into subscribe buff Xer X XIF (BEGINNING_OF (subscribe) = END_OF (subscribe)) ! null or file not found X THEN X message ("!!BUG -- reached subscribe_create with NULL active buffer"); X abort; XENDIF; X X X! now we need to massage the data VMAP (text_window, subscribe);`009`009`009`009! let them watch us massage the da Xta VPOSITION (BEGINNING_OF (subscribe));`009`009`009! leave only column one and two X, delete column three and four Xloop X exitif mark(none) = END_OF(subscribe);`009`009! exit loop at end of buffer X X a := select_column_two;`009`009`009`009! set last message read column V b := INT(a) - 20;`009`009 `009`009`009! 20 is a magic number for how many X messages to mark as unread X IF b < 1 THEN b := 1; ENDIF; X replace_column_two (b); X X position (search(' ',FORWARD));`009`009`009! delete last two columns X move_horizontal (+1); X position (search(' ',FORWARD)); X split_line; X erase_line; Xupdate(current_window); Xendloop; X V!move_group_to_top ("comp.os.vms"); ! these groups will be X read first X!move_group_to_top ("rec.arts.comics"); X!move_group_to_top ("rec.humor"); X!move_group_to_top ("rec.arts.drwho"); X!move_group_to_top ("rec.arts.startrek"); Xmove_group_to_top ("news.announce.newusers"); X VPOSITION (BEGINNING_OF (subscribe)); `009`009`009`009! unsubscribe control grou Xp Xposition(SEARCH (LINE_BEGIN & 'control', FORWARD, NO_EXACT)); Xreplace_column_two (99999);`009! 99999 magic number for unsubscribed X X XPOSITION (BEGINNING_OF (subscribe)); Xmap(text_window,text_buffer); XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE move_group_to_top (group_name) XLOCAL group_name, j1, j2; X! move a group to the top of subscribe buffer V! note, unlike most routines, this one does not restore original position in bu Xffers X XPOSITION (BEGINNING_OF (subscribe)); Xj1 := SEARCH (LINE_BEGIN & group_name & ' ', FORWARD, NO_EXACT); XIF j1 = 0 THEN return; ENDIF;`009`009`009! return if it doesn't exist Xposition(j1); X Xj2 := current_line; Xerase_line; XPOSITION (BEGINNING_OF (subscribe)); Xcopy_text(j2); Xsplit_line; XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- VPROCEDURE init_moveto_first_group_with_news;`009`009! move to first group w Xith something in it to read X Xmove_to_group_with_pending_news; X XENDPROCEDURE; X X`012 V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ V! PROCEDURES -- MANY BOUND TO KEYS -- MANY H XELPER FUNCTIONS V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X++++++++++++++++++++++++++++++++++++++++++++++++++++ X X X V!------------------------------------------------------------------------------ X- XPROCEDURE page_down; X! scroll down almost one screensworth X SCROLL(text_window, page_scroll_amount); XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE page_up; X! scroll up almost one screensworth X SCROLL(text_window, -page_scroll_amount); XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE line_down Xlocal a; X! scroll down one line X a:=mark(none); X SCROLL(text_window, 1); X If a = mark(none) THEN`009`009`009`009! we haven't moved X move_vertical(+1); X ENDIF; XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE line_up Xlocal a; X! scroll up one line X a:=mark(none); X SCROLL(text_window, -1); X If (a = mark(none)) THEN`009`009`009`009! we haven't moved X move_vertical(-1); X ENDIF; XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE go_to_group; Xmessage("Go to exact group is no longer supported"); XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE go_to_group_NOexact XLOCAL group_name, j1,j2,j3; X! go to a new group....no need to find exact name X Xon_error`009! kill error messages X! if error = tpu$_strnotfound then X!`009message ("couldn't find it"); X! endif; Xendon_error; X X Xj1 := CURRENT_BUFFER; XPOSITION (subscribe); Xj3 := MARK (none);`009! where we were if search fails X Xgroup_name := READ_LINE ('GO TO WHICH GROUP (NOexact name): '); X Xmove_vertical(+1);`009`009`009! so we don't find current line Xj2 := SEARCH ( group_name , FORWARD, NO_EXACT); X XIF j2 = 0 THEN `009`009`009`009! try from beginning of buffer X`009POSITION (BEGINNING_OF (subscribe)); X`009j2 := SEARCH ( group_name , FORWARD, NO_EXACT); XENDIF; X XIF j2 = 0 THEN`009`009`009`009`009! couldn't find it anywhere X MESSAGE ("Can't find the group you refered to: "+ group_name); X POSITION (j3);`009! move to old place in subscribe X POSITION (j1);`009! move to old buffer X RETURN(0); XENDIF; X XPOSITION (j2); Xposition (search (LINE_BEGIN, REVERSE, EXACT)); X Vif mark(none) = j3 then message ("This is the only group that matches: "+ group X_name); X endif; X Xposition(text_buffer); Xzero_text_buffer; Xupdate_banner;`009`009`009`009`009! indicate new group and position X `009 XENDPROCEDURE; X V!------------------------------------------------------------------------------ X- XPROCEDURE update_banner`009`009! update status_line to current grp & position VLOCAL s1,s2, subs_current, a2, active_top, active_bot, diff,arg; X X Vposition (subscribe); `009`009`009`009! get subscribed group & next mesg. num Xber Xs1 := select_column_one; Xs2 := select_column_two; Xsubs_current := INT(s2); X Vposition (BEGINNING_OF(active));`009`009`009!move to same group in active as in X subscribe Xarg := SEARCH (LINE_BEGIN & s1 & ' ', FORWARD, NO_EXACT); Vif arg = 0 THEN `009`009`009`009`009! subscribe has groups that no longer exi Xst in active; X sync_subscribe; X return(0); XENDIF; Xposition(arg); Xa2 := select_column_two; Xactive_top := int (a2); Xactive_bot := int (select_column_three); XIF active_bot > subs_current THEN subs_current := active_bot; ENDIF; Xdiff := active_top - subs_current; XIF diff < 0 THEN diff := 0; ENDIF; X XIF subs_current = 99999 then VSET(STATUS_LINE, text_window, REVERSE, status_text + ' ' + s1 + ': Unsubscri Xbed'); X`009ELSE VSET(STATUS_LINE, text_window, REVERSE, status_text + ' ' + s1 + ':' + STR(su Xbs_current)+' '+str(diff)+' left'); X `009ENDIF; Xupdate(current_window); XENDPROCEDURE; X X V`012 X V!------------------------------------------------------------------------------ X- Xprocedure sync_subscribe`009`009`009`009! called if subscribe is out of whack V;!!!!!LOCAL ac_tmp, sub_tmp, a, b;`009 `009`009! this happens if a new gr Xoup is added or deleted from active X Xdisable_bell; Xmessage("Since I last checked groups have been added or deleted from active"); Xmessage("So, I'm going to sync subscribe to active."); Xmessage ("This takes several minutes -- so sit back and relax..."); X X! first makes copies of subscribe and active X X Xac_tmp := CREATE_BUFFER("ac_tmp"); Xset(No_write, ac_tmp); Xposition(ac_tmp); copy_text(active); X Xsub_tmp := CREATE_BUFFER("sub_tmp"); set(No_write, sub_tmp); Xposition(sub_tmp); copy_text(subscribe); X Xmap(text_window,sub_tmp); Xposition(beginning_of(sub_tmp)); Vloop`009`009`009! check each group in subscribe, if it isn't in active then del Xete it from subscribe X exitif mark(none) = END_OF(sub_tmp); X a1:= mark(none); X a := select_column_one; X position(beginning_of(ac_tmp)); X b := search(LINE_BEGIN & a & ' ', FORWARD, NO_EXACT); X if b = 0 then X position(a1); X erase_line; X message ("Deleted "+a); X ELSE X position(b); X erase_line;`009! erase each line -- any left will be not in subscribe X position(a1); X move_vertical (+1); X ENDIF; X update(text_window); Xendloop; X Xif beginning_of(ac_tmp) <> end_of(ac_tmp) THEN X map(text_Window,ac_tmp); V POSITION (BEGINNING_OF (ac_tmp));`009`009`009! leave only column one and two X, delete column three and four X loop X exitif mark(none) = END_OF(ac_tmp);`009`009! exit loop at end of buffer X message('Added ' + select_column_one); X a := select_column_two;`009`009`009`009! set last message read column V b := INT(a) - 20;`009`009 `009`009! 20 is a magic number for how many Xmessages to mark as unread X IF b < 1 THEN b := 1; ENDIF; X replace_column_two (b); X X position (search(' ',FORWARD));`009`009`009! delete last two columns X move_horizontal (+1); X position (search(' ',FORWARD)); X split_line; X erase_line; X update(text_window); X endloop; X position(sub_tmp); X copy_text(ac_tmp); X update(text_window); XENDIF; X Xerase(subscribe); Xposition(subscribe); Xcopy_text(sub_tmp); X Xposition(beginning_of(subscribe)); Xposition(beginning_of(active)); Xposition(beginning_of(text_buffer)); Xmap(text_window,text_buffer); Xenable_bell; XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE catch_up`009`009! mark current group as read XLOCAL s1, a2, active_top,x; Xx := mark(none); Xposition (subscribe); `009! get subscribed group & next mesg. # Xs1 := select_column_one; X Xposition (BEGINNING_OF(active));! move to same group in active Xposition(SEARCH (LINE_BEGIN & s1 & ' ', FORWARD, NO_EXACT)); Xa2 := select_column_two; Xactive_top := int (a2); X Xposition(subscribe); Xreplace_column_two (active_top);`009! update subscribe mesg# X Xupdate_banner; Xzero_text_buffer; Xposition(x); XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE UN_catch_up`009`009! mark this group as UNread XLOCAL s1, a3, active_bottom, old_pos; X Xold_pos := mark(none); Xposition (subscribe); `009! get subscribed group & next mesg. # Xs1 := select_column_one; X Xposition (BEGINNING_OF(active));! move to same group in active Xposition(SEARCH (LINE_BEGIN & s1 & ' ', FORWARD, NO_EXACT)); Xa3 := select_column_three; Xactive_bottom := int (a3); X Xposition(subscribe); Xreplace_column_two (active_bottom);`009! update subscribe mesg# X Xposition(old_pos); Xzero_text_buffer; Xupdate_banner; XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE Unsubscribe XLOCAL x; Xx := mark(none); Xposition(subscribe); Xreplace_column_two (99999);`009! 99999 magic number for unsubscribed Xposition(x); `009 `009`009! This will be a bug when a group his 99999 Xzero_text_buffer; Xupdate_banner; XENDPROCEDURE X X V!------------------------------------------------------------------------------ X- VPROCEDURE Subscribe_proc`009`009`009`009! resubscribe to unsubscribed news grou Xp XLOCAL x; Xx := mark(none); Xposition(subscribe); XUn_catch_up; Xposition(x); Xupdate_banner; XENDPROCEDURE X X X X X`012 V!------------------------------------------------------------------------------ X- XPROCEDURE next_news_message VLOCAL i3,j1,j2,j3,s1,s2,s1a, s4,spool,news_file,subs_current,i,a1,a2,a3,active_ Xbottom,active_top,spool_file; X! read in next message X X Xupdate_banner;`009`009`009! Indicate which group and message this is Xdisable_bell;`009`009`009! no beeping X Xposition (subscribe); `009! get subscribed group & next mesg. # Xs1 := select_column_one; Xs1a:= s1; Xs2 := select_column_two; Xsubs_current := INT(s2); X XIF subs_current = 99999 THEN `009! if unsubscribed then recurse till OK X`009next_group; X `009next_news_message; X`009return(0); XENDIF; X X!move to same group in active as in subscribe Xposition (BEGINNING_OF(active)); Xi := SEARCH (LINE_BEGIN & s1 & ' ', FORWARD, NO_EXACT); Xposition(i); X Xa1 := select_column_one; Xa2 := select_column_two; Xa3 := select_column_three; Xactive_bottom := int (a3); Xactive_top := int (a2); X X! create file name XIF subs_current < active_bottom THEN subs_current := active_bottom; ENDIF; XIF subs_current > active_top THEN`009! Nothing Left to READ? V`009message('Nothing left to read in group ' + s1 + ' -- Moving to next Group') X; X`009next_group; RETURN; ENDIF; X Xspool := s1; XTRANSLATE(spool,'_', '.');`009`009! convert to VMS Name XTRANSLATE(s1, '/', '.'); `009! convert to Unix Name X Vnews_file := 'news_farsite::"/usr/spool/news/' + s1 + '/' + STR(subs_current) + X '"' ; X Xspool_file := spool_dir + spool + '_' + STR(subs_current)+ '.'; X Xsubs_current := subs_current + 1; Xposition(subscribe); Xreplace_column_two (subs_current);`009! update subscribe mesg# X X!read in file XPOSITION (text_buffer); XERASE (text_buffer); XSET (TIMER, ON, 'Retrieving.'); X XIf ($mode = $local) or ($mode = $sync) THEN READ_FILE ( spool_file ); ENDIF; X XIf ($mode = $remote) `009`009`009THEN READ_FILE ( news_file ); ENDIF; X XIf ($mode = $sync) and (BEGINNING_OF (text_buffer)= END_OF (text_buffer)) X THEN READ_FILE ( news_file ); ENDIF; X XPOSITION (BEGINNING_OF (text_buffer)); VIF (BEGINNING_OF (text_buffer)= END_OF (text_buffer))`009! null or file not fou Xnd X THEN X message ("Null News Body -- Hope that's OK"); X message(""); X ELSE V underline_subject_line; `009`009`009! underline subject if got ne Xws XENDIF; X X XSET (TIMER, OFF); Xenable_bell; X XENDPROCEDURE; X X X`012 V!------------------------------------------------------------------------------ X- VPROCEDURE next_group;`009`009`009 ! still needs to skip comletely read gro Xups X Xposition(subscribe); Xif mark(none) = end_of(current_buffer)then X`009message ('ARGH -- End of News Groups (no more to read)'); X`009move_vertical(-1); X`009return(0); XENDIF; Xmove_vertical(+1);`009`009`009`009! move to next group Xmove_to_group_with_pending_news; X Xupdate_banner; X XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE move_to_group_with_pending_news X! checks current group -- if current group has news it does not move forward X XLOCAL s1,s2,subs_current,a2,active_top,active_bot,diff; X Xposition(subscribe); X! check for end of news groups Xif mark(none) = end_of(current_buffer)then X`009message ('argh -- End of News Groups (no more to read)'); X`009move_vertical(-1); X`009return(0); XENDIF; X X! if its an unsubscribed group, skip it Xs1 := select_column_one; Xs2 := select_column_two; Xsubs_current := INT(s2); X XIF subs_current = 99999 THEN `009! if unsubscribed then recurse till OK X`009next_group; X`009return(0); XENDIF; X Vposition (BEGINNING_OF(active));`009`009`009!move to same group in active as in X subscribe Xposition(SEARCH (LINE_BEGIN & s1 & ' ', FORWARD, NO_EXACT)); Xa2 := select_column_two; Xactive_top := int (a2); Xactive_bot := int (select_column_three); XIF active_bot > subs_current THEN subs_current := active_bot; ENDIF; Xdiff := active_top - subs_current; XIF diff < 0 THEN diff := 0; ENDIF; X XIF diff = 0 THEN`009`009`009! recurse till locate group with items to read X next_group; X return(0); XENDIF; X XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE zero_text_buffer;`009`009`009`009! erase text buffer VIF end_of(text_buffer) <> beginning_of(text_buffer) THEN! but don't bother unle Xss there is text in it X erase(text_buffer); XENDIF; XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE space_bar XLOCAL here; Xhere := MARK(none); Xpage_down; XIF here = mark(none) THEN`009`009`009`009! we didn't move X next_news_message;`009`009`009`009`009! so at end of mesg XENDIF; XENDPROCEDURE; X X X V!------------------------------------------------------------------------------ X- XPROCEDURE exit_news; X XWRITE_FILE (subscribe, 'sys$login:NEWS_SUBSCRIBE.dat'); Xdisable_bell; Xmessage ('Thank You For Using NEWS(DECNET/VMS)`009 `009:-)'); Xquit; XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE keypad_help; X XIf keypad_help_visited = no THEN X keypad_help_init; X keypad_help_visited := yes; X return; XENDIF; X XMAP(text_window, keypad_help_buffer); X XENDPROCEDURE X X X XPROCEDURE keypad_help_init; Xkeypad_help_buffer := create_buffer('keypad_help_buffer'); XSET(NO_WRITE, keypad_help_buffer); XSET(SYSTEM, keypad_help_buffer); XSET(EOB_TEXT, keypad_help_buffer, ""); X XMAP(text_window, keypad_help_buffer); Xposition(keypad_help_buffer); X X!`012 Xcopy_text ('NEWS keypad for VT100 series terminals'); split_line; Xcopy_text (''); split_line; Vcopy_text (' _________________________________ _______________________ X__________'); split_line; Vcopy_text (' | ^ | | | | | | | | X | |'); split_line; Vcopy_text (' | | | V | | | | Find | Help | Pause X | |'); split_line; Vcopy_text (' |_______|_______|_______|_______| |_______|_______|______ X_|_______|'); split_line; Vcopy_text (' | | | X | |'); split_line; Vcopy_text (' | | | X | |'); split_line; Vcopy_text (' |_______|_______|______ X_|_______|'); split_line; Vcopy_text (' | | | X | Next |'); split_line; Vcopy_text (' | | | X | Group |'); split_line; Vcopy_text (' |_______|_______|______ X_|_______|'); split_line; Vcopy_text (' | | | X | |'); split_line; Vcopy_text (' | | | X | |'); split_line; Vcopy_text (' CTRL/R - Refresh |_______|_______|______ X_| Next |'); split_line; Vcopy_text (' CTRL/Z - Exit | Next |Prev X |Message|'); split_line; Vcopy_text (' | Screen |Screen X | |'); split_line; Vcopy_text (' |_______________|______ X_|_______|'); split_line; Xcopy_text (''); split_line; Xposition(beginning_of(keypad_help_buffer)); X X! XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE news_help; X! give them help X XIf help_visited = no THEN X news_help_init; X help_visited := yes; X return; XENDIF; X XMAP(text_window, help_buffer); X XENDPROCEDURE X X X XPROCEDURE news_help_init; Xhelp_buffer := create_buffer('help_buffer'); XSET(NO_WRITE, help_buffer); XSET(SYSTEM, help_buffer); XSET(EOB_TEXT, help_buffer, ""); X XMAP(text_window, help_buffer); Xposition(help_buffer); X Vcopy_text(' NEWS keyboard help: X '); split_line; Vcopy_text(' n - get next message X '); split_line; Vcopy_text(' N - moves to next group X '); split_line; Vcopy_text(' X '); split_line; Vcopy_text(' s - Saves current message to a file X '); split_line; Vcopy_text(' g - go to a group by name X '); split_line; Vcopy_text(' X '); split_line; Vcopy_text(' c - Catch-up (marks all messages in current gr Xoup as read)'); split_line; Vcopy_text(" u - Unsubscribe (you'll never see this Xgroup again)"); split_line; Vcopy_text(' # - read article by number (skips interveni Xng articles)'); split_line; Vcopy_text(' X '); split_line; Vcopy_text(' CTRL/W - refresh screen X '); split_line; Vcopy_text(' CTRL/Z - exit X '); split_line; Vcopy_text(' X '); split_line; Vcopy_text(' - Displays next screen full of text X '); split_line; Vcopy_text(' - If there is no more text, it gets next messag Xe '); split_line; Vcopy_text(' X '); split_line; Vcopy_text(' X '); split_line; Xcopy_text(" Press <1> to Exit Help"); XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE disable_bell; VSET (BELL, ALL ,OFF); X XSET (BELL, BROADCAST, ON); XENDPROCEDURE; X XPROCEDURE enable_bell; XSET (BELL, ALL ,ON ); XENDPROCEDURE; X X V!------------------------------------------------------------------------------ X- XPROCEDURE my_undefined_key; Xmessage ('');`009`009`009! this rings bell as long as broadcast is set = all XENDPROCEDURE; X XPROCEDURE one_map;`009`009! map text_buffer with USENET news to screen XMAP(text_window, text_buffer); Xupdate_banner; XENDPROCEDURE; X XPROCEDURE two_map;`009`009! map subscribe to screen X`009`009`009`009! allow arrows keys to select group XMAP (text_window, subscribe); XENDPROCEDURE; X XPROCEDURE three_map; XMAP (text_window, active); XENDPROCEDURE; X XPROCEDURE five_map; XMAP (text_window, message_buffer); XENDPROCEDURE; X XPROCEDURE six_map; XMAP (text_window, ac_tmp); XENDPROCEDURE; X XPROCEDURE seven_map; XMAP (text_window, sub_tmp); XENDPROCEDURE; X X X XPROCEDURE end_of_line Xposition (search (LINE_END, FORWARD, EXACT)); XENDPROCEDURE; X X XPROCEDURE begin_of_line; Xposition (search (LINE_BEGIN, REVERSE, EXACT)); XENDPROCEDURE; X X XPROCEDURE save_mesg`009`009`009! write current message to disk XLOCAL save_name; Xsave_name := READ_LINE ('Save current message to file: '); Xif length(save_name) = 0 then return(0); endif; XWRITE_FILE (text_buffer, save_name); Xmessage('file written');`009! add: check if written sucessfully XENDPROCEDURE; X X XPROCEDURE select_column_one XLOCAL j1; `009`009`009`009! returns column one as a string Xposition (search (LINE_BEGIN, REVERSE, EXACT)); Xj1 := search (LINE_BEGIN & SCAN(' '),FORWARD); XRETURN (SUBSTR(j1,1,999)); XENDPROCEDURE; X X XPROCEDURE select_column_two XLOCAL a, b, c, d; ! returns column two as a string X Xposition (search (LINE_BEGIN, REVERSE, EXACT)); X Xa := current_line + ' '; Xb := INDEX (a, ' '); Xa := SUBSTR (a, b+1, 999); X Xc := INDEX (a, ' '); Xd := SUBSTR (a, 1, c - 1); X XRETURN(SUBSTR(d,1,999)); XENDPROCEDURE; X X XPROCEDURE select_column_three XLOCAL a, b, c, d, e; `009`009`009`009`009! returns column three as a string X Xposition (search (LINE_BEGIN, REVERSE, EXACT));`009`009! LINE ->> STRING Xa := current_line + ' '; X Xb := INDEX (a, ' '); Xa := SUBSTR (a, b+1, 999); X Xc := INDEX (a, ' '); Xa := SUBSTR (a, c+1, 999); X Xd := INDEX (a, ' ');`009`009`009! extract column three Xe := SUBSTR (a, 1, d-1); X XRETURN (SUBSTR(e,1,999)); XENDPROCEDURE; X X XPROCEDURE replace_column_two (thing) XLOCAL a, aa, aaa, line, x3, b, c, d, thing1; X Xthing1 := STR(thing);`009`009`009! precede w/ 0's XIF LENGTH(thing1) < 5 THEN thing1 := "0"+thing1; ENDIF; XIF LENGTH(thing1) < 5 THEN thing1 := "0"+thing1; ENDIF; XIF LENGTH(thing1) < 5 THEN thing1 := "0"+thing1; ENDIF; XIF LENGTH(thing1) < 5 THEN thing1 := "0"+thing1; ENDIF; XIF LENGTH(thing1) < 5 THEN thing1 := "0"+thing1; ENDIF; X Xposition (search (LINE_BEGIN, REVERSE, EXACT)); `009! LINE ->> STRING Xa := current_line + ' '; X Xb := INDEX (a, ' '); Xaa := SUBSTR (a, b+1, 999); X Xc := INDEX (aa, ' '); Xaaa:= SUBSTR (aa, c, 999); X Xline := SUBSTR(a,1,b) + thing1 + aaa; Xedit (line, TRIM_TRAILING); Xposition (search (LINE_BEGIN, REVERSE, EXACT)); Xcopy_text(line); Xsplit_line; Xerase_line; Xmove_vertical (-1); XENDPROCEDURE; X X XPROCEDURE go_to_article XLOCAL a1, numb , x; X Xa1 := READ_LINE ('Go to which article number: '); Xif a1 = "" THEN return(0); ENDIF; Xnumb := INT(a1); Xif numb = 0 then return; endif; X Xx := mark(none); Xposition(subscribe); Xreplace_column_two (numb); Xposition(x); Xnext_news_message; X XENDPROCEDURE; X X XPROCEDURE top_of_buf; Xposition(beginning_of(current_buffer)); XENDPROCEDURE; X X XPROCEDURE bot_of_buf; Xposition(end_of(current_buffer)); XENDPROCEDURE; X X Xprocedure author; Xmessage("Written By Christopher Seline (11/Apr/88)"); Xmessage("SCS7317@oberlin.bitnet"); XENDPROCEDURE; X XPROCEDURE try; Xmessage('try1'); X XENDPROCEDURE; X XPROCEDURE underline_line XLOCAL r1,r2; X! bug -- only underlines in one buffer at a time Xposition (search (LINE_BEGIN, REVERSE, EXACT)); Xr1 := MARK (none); Xposition (search (LINE_END, FORWARD, EXACT)); Xr2 := MARK (none); X Xunderline_x2 := CREATE_RANGE (r1,r2,UNDERLINE); Xr1 := 0; Xr2 := 0; XENDPROCEDURE; X XPROCEDURE underline_subject_line XLOCAL X r1,r2,j3 ; X Xj3 := mark (none); Xr1 := search ('subject',FORWARD,NO_EXACT); XIF r1 = 0 THEN return(0); ENDIF; !No Subject Xposition (r1); X Xposition (search (LINE_BEGIN, REVERSE, EXACT)); Xr1 := MARK (none); Xposition (search (LINE_END, FORWARD, EXACT)); Xr2 := MARK (none); X Xunderline_i1 := CREATE_RANGE (r1,r2,UNDERLINE); Xr1 := 0; Xr2 := 0; X Xposition (j3); XENDPROCEDURE; X X X X VPROCEDURE scroll_line_to(dest_line)`009`009`009`009! scrolls the screen so that X the current line is at the line # specified by dest_line VLOCAL old_position;`009`009`009`009`009`009! preserves the cursor position thro Xugh the scroll X old_position := MARK(NONE); X SCROLL(CURRENT_WINDOW, X GET_INFO(CURRENT_WINDOW, "current_row")-dest_line); X POSITION(old_position); XENDPROCEDURE; X X X`012 V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X+++++++++++++++++++++++++++++++++++++++++++++++++ X! K E Y B I N D I N G S V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X+++++++++++++++++++++++++++++++++++++++++++++++++ X VSET(SELF_INSERT, "TPU$KEY_MAP_LIST", OFF);`009! make it so typing keys won't se Xlf-insert VSET(UNDEFINED_KEY, "TPU$KEY_MAP_LIST", "my_undefined_key");`009! and specify wh Xat to do when an undefined key is pressed XDEFINE_KEY("exit_news", CTRL_Z_KEY);`009`009! exit XDEFINE_KEY("quit",KEY_NAME('q')); XDEFINE_KEY("author", KEY_NAME("A")); XDEFINE_KEY("page_down", KP0);`009`009`009! page down XDEFINE_KEY("page_up", PERIOD);`009`009`009! page up XDEFINE_KEY("line_down", DOWN);`009`009`009! scroll down XDEFINE_KEY("line_up", UP);`009`009`009! scroll up XDEFINE_KEY("go_to_article", KEY_NAME("#"));`009! goto article # XDEFINE_KEY("go_to_group", KEY_NAME("G"));`009! Goto Group EXACT XDEFINE_KEY("go_to_group_NOexact", KEY_NAME("g"));! Goto Group NOEXACT XDEFINE_KEY("go_to_group_NOexact", PF1);`009`009! Goto Group NOEXACT XDEFINE_KEY("next_group", KEY_NAME('N'));`009! next group XDEFINE_KEY("next_group", COMMA );`009! next group XDEFINE_KEY("space_bar", KEY_NAME(" "));`009 `009! NEXT THING XDEFINE_KEY("next_news_message", ENTER); XDEFINE_KEY("next_news_message", KEY_NAME('n')); XDEFINE_KEY("attach", KEY_NAME('P'));`009`009! PAUSE news XDEFINE_KEY("attach", PF3 ); XDEFINE_KEY("catch_up",KEY_NAME('c')); `009`009! mark group as read XDEFINE_KEY("UN_catch_up",KEY_NAME('C'));`009`009! mark group as UNread XDEFINE_KEY("keypad_help", PF2); XDEFINE_KEY("news_help", KEY_NAME('?')); XDEFINE_KEY("news_help", KEY_NAME('h')); XDEFINE_KEY ("one_map", KEY_NAME("1")); XDEFINE_KEY ("two_map", KEY_NAME("2")); XDEFINE_KEY ("three_map", KEY_NAME("3")); XDEFINE_KEY ("five_map", KEY_NAME("5")); XDEFINE_KEY ("six_map", KEY_NAME("6")); XDEFINE_KEY ("seven_map", KEY_NAME("7")); X XDEFINE_KEY ("top_of_buf",KEY_NAME("<")); XDEFINE_KEY ("bot_of_buf",KEY_NAME(">")); XDEFINE_KEY ("save_mesg", KEY_NAME('s'));`009`009! save to disk XDEFINE_KEY ("subscribe_proc", KEY_NAME('U'));`009`009! UNunsubscribe XDEFINE_KEY ("unsubscribe", KEY_NAME('u')); XDEFINE_KEY ("refresh", CTRL_L_KEY); XDEFINE_KEY ("refresh", CTRL_R_KEY); XDEFINE_KEY ("refresh", CTRL_W_KEY); X X! for debugging X XDEFINE_KEY ("try" , KEY_NAME("~")); X X X V!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ X+++++++++++++++++++++++++++++++++++++++++++++++++ X X!SAVE("SYS$LOGIN:news"); XSAVE("students:[scs7317.trans]news_inprog"); XQUIT; X $ GoSub Convert_File $ Exit From ncr-sd!hp-sdd!hplabs!decwrl!ucbvax!LBL.GOV!SCS7317%OCVAXB%VB.CC.CMU.EDU%KL.SRI.COM%lbl%sfsu1.hepnet Mon May 30 12:53:46 PDT 1988 Received: from KL.SRI.COM by LBL.Gov with INTERNET ; Thu, 26 May 88 16:14:11 PDT Received: from VB.CC.CMU.EDU by KL.SRI.COM with TCP; Tue 24 May 88 16:04:03-PDT Date: Tue, 24 May 88 19:04 EDT >From: Christopher Seline Subject: NEWS(DECNET/VMS) USENET on VMS manual for NEWS To: info-vax@KL.SRI.COM X-VMS-To: CMCCVB::IN%"info-vax@kl.sri.com" .lm 3 .rm 72 .sp1 .ap .p 0,1,3 .enable bar .c74;----------------------------------- .c74;| NEWS | .c74;| USENET News reading utility | .c74;| User's manual | .c74;----------------------------------- .c74;version 3.00 .c74;(c) 1988 Christopher Seline .sk 4 ^&Conventions used in this document:\& .begin bar Sections that describe advanced concepts are denoted by vertical bars in the left margin. This information is intended for the more experienced user, and can be skipped at the first reading. .end bar .sk 4 .c74;*** ^&Introduction\& *** ^&About USENET News\& "News" is a utility that enables users on a network site not directly on USENET (e.g., bitnet users) to read the news that is circulated around the world on USENET, commonly known as netnews. Netnews is a huge bulletin board of sorts: a forum of open discussion and/or announcements on many topics in which all of the thousands of readers are welcome to participate. Netnews is divided into well over 200 newsgroups, each of which is devoted to a particular topic. The subject names are split first into general areas, then into more specific topics. The root classifications are: .lit news - about netnews sci - science comp - computers soc - social rec - recreation misc - miscellaneous talk - discussions .el There are other initial names of groups that are specific to the network site. For example, 'att' denotes newsgroups specific to AT_&T, and can only be read by users using an AT_&T node. Beyond these classifications, the newsgroup names get progressively more specific. Examples: comp.sys.ibm.pc, rec.arts.startrek, soc.college, and rec.auto. Each newsgroup name should be sufficiently descriptive of the topic discussed. When you read netnews for the first time, the first newsgroup you go into will be "news.announce.newusers". READ EVERY ARTICLE IN IT. It contains information and guidelines about netnews that every reader is expected to know. ^&Getting started with NEWS\& Before running news, it is necessary to define the variable 'news__farsite', like so: .sk1 .c74;define news__farsite [local-value] This is a code that tells NEWS how to contact the nearest USENET site. Since this will be a different value on each system, your system manager will tell you what your local value is. It is easiest to put this definition in your login.com file, so you don't have to remember it each time you read the news. News is a VAX TPU (Text Processing Utility) program. This means that to run the program, you invoke the TPU editor with a special command file. This file should be stored in a public directory. Here is how the program is run at Oberlin: .sk1 .c74;edit/tpu/sec=softlib:[share]news Your system manager will be able to tell you where the program is on your system. Replace 'softlib:[share]news' above with the appropriate directory and file name. To make this procedure easier, you can define the above command as something else in your login.com file, like so: .sk1 .c74;$define news edit/tpu/sec=softlib:[share]news Again, replace this filename with the one specific to your system. After this is done, simply type 'news' to run the program. .sk3 .c74;*** ^&Your First NEWS Session\& *** ^&Establishing the link to netnews\& When you run NEWS for the first time it takes a minute to create a necessary information file in your directory. NEWS will tell you that it is creating a new subscription for you. Every time you invoke NEWS it will take several moments to access netnews at your USENET site. It should blink 'Loading active' near the bottom right corner of the screen until it establishes the link. If there is an outright error in accessing the USENET node, you will know right away, and will be prompted to hit 'q' to quit. If this happens, either the link is temporarily down or you are trying to access the USENET node incorrectly (due to an incorrect news__farsite value). If you are sure you have the correct news__farsite value defined, try again later. If it blinks 'Loading active' for more than a few minutes, either the network load is too high or the USENET node is having problems of its own. Try again later. ^&Screen layout\& The screen is split into two sections, separated by a bar of inverse text. The top (largest) part of the screen is the main display area; this is where the news articles are displayed. The area below the bar is where NEWS program messages and error messages are displayed. The inverse-video bar acts as a status line, and also reminds you of two important commands: -Z to exit, and '?' for help. The status information includes the newsgroup you are currently reading, the current article number, and the number of remaining articles in that newsgroup. The article number is probably already quite high. This is because the numbers have not been reset since the newsgroup began. You cannot read the articles before the one that NEWS starts you at; they have been discarded due to old age. ^&On-line help\& On-line command information is displayed with '?' or 'h'. Hit '1' to return to reading the news. On VT-100 type terminals, keypad information is also available with the PF2 key. '1' exits this help screen as well. ^&Newsgroup subscriptions\& When you run NEWS for the first time, you are automatically 'subscribed' to all the newsgroups, meaning you have the opportunity to read articles in every group. Since you will probably not be interested in all the topics, you will want to un-subscribe to most groups. After you un-subscribe to a newsgroup, you will not see any of its articles again unless you re-subscribe to it. See the section titled 'Selecting newsgroups' for a discussion of how to choose your subscriptions. Remember to read everything in 'news.announce.newusers' before moving on to the rest of netnews. .page .c74;*** ^&Reading Articles\& *** The up and down arrows scroll the screen in both directions. However, there are easier ways to page through the articles. The space bar scrolls down to next screen. If you are at the end of an article, this will also move to the next article. If you are at the end of the last article in a newsgroup, it will move to the next available newsgroup and wait for further instructions before reading any articles. Note that when you advance to the next article there is a delay as the program blinks 'Retrieving' in the message window. This is because it takes time to grab the file from the USENET node. Other commands: .lm 9 .p -6,1,3 >#####Go to the end of the current article. <#####Go to the top of the current article. n#####Advances to next article, even if you have not seen all of the current article. _######Go to a particular article number, which NEWS prompts you for. If you skip forward, NEWS will count the skipped articles as read when you exit. This means that when you re-enter NEWS, your current position in that newsgroup will be beyond those missed articles. s#####Save the current article to a file. NEWS will prompt you for a filename and inform you when the process is complete. c#####Catch up in the newsgroup. This marks all the active articles as read, so you can start fresh with all future articles. This is a good way to rationalize not sifting through all the remaining articles. C#####Un-catch up. This returns your current article number to the first active (and unread) article in the newsgroup. .sk1 The following commands utilize the keypad on VT-100 type terminals: .lm 9 .p -6,1,3 <0>###Page down. This differs from the space bar in that it will not advance any further when it reaches the end of the current article. <_.>###Page up. As with '0', this will not move beyond the current article. .lm 14 .p -11,1,3 ###Advance to the next message. Identical to the 'n' command. .page .c74;*** ^&Selecting Newsgroups\& *** .lm 3 .p 0,1,3 ^&Moving between newsgroups\& The following commands allow you to choose your current newsgroup: .lm 9 .p -6,1,3 N#####Go to the next subscribed newsgroup. Note the difference between 'N' and 'n'. g#####Go to the next non-specific newsgroup. NEWS will prompt you for a newsgroup name, and will advance to the next newsgroup that contains the requested string. For example, enter 'ibm' and it will move to the next newsgroup that has 'ibm' in its name. If it does not find the specified keyword in any newsgroups, it will remain in the current group. G#####Go to the next specific newsgroup. This time, when NEWS prompts you for a newsgroup name, you must enter the full name of the newsgroup, such as 'comp.sys.ibm.pc'. If it does not find the specified newsgroup, it will remain in the current group. Also, on the VT-100 keypad: <,>###Go to the next subscribed newsgroup. Identical to the 'N' command. PF1###Go to the next non-specific newsgroup. Identical to the 'g' command. .lm 3 .p 0,1,3 With all commands that change the current newsgroup, NEWS will wait for you to decide if you want to read articles in that newsgroup. Hit the space bar or 'n' to read the first article. .sk1 ^&Subscribing to specific newsgroups\& The following commands allow you to choose which newsgroups to read and which ones to skip next time you read netnews. .lm 9 .p -6,1,3 u#####Unsubscribe to the current newsgroup. If you are reading an article, NEWS will advance to the next available newsgroup and wait for instructions. U#####Un-unsubscribe to the current newsgroup. Returns the current article number to the first unread article. 2#####(on the regular keyboard) Display the list of newsgroups. This will replace the article area on the screen with a list of all newsgroups available, as well as your current article number in that newsgroup. You can scroll around with the same commands as you use to read messages - the arrow keys, the space bar, '<', '>', and the keypad. '1' returns you to the current article. .lm 3 .p 0,1,3 The 'u' and 'U' commands are made considerably easier through the '2' command. With the newsgroup list on the screen, 'u' and 'U' affect the newsgroup marked by the cursor at the top of the screen. Note that when you unsubscribe to an article, the current article number changes to 99999, and un-unsubscribing changes it back to the first unread article. .begin bar What the '2' command is actually doing is making the newsgroup list buffer the active buffer in TPU. The '3' command will name the newsgroup file as the active buffer. The '1' command returns the article buffer to be the active buffer (note that this is why '1' exits help screens and returns to netnews). The newsgroup file contains the list of newsgroups in your home directory. One can edit this file outside of NEWS, putting the important newsgroups at the top of the list. Deleting newsgroups from this list, even if you think you will never ever want to read them, is not recommended. The extra information the file contains is the number of the latest posted article in the newsgroup, and the subscription status of that newsgroup. .end bar .sk3 .c74;*** ^&Miscellaneous commands\& *** To exit news, type Control-Z. This causes NEWS to remember which articles you read, so that the next time you read news you are at the same point in all your subscribed newsgroups. 'q' also exits the program, but does not remember which messages you read. To refresh the screen, type Control-W or Control-R. .begin bar The 'P' command pauses NEWS, returning to the operating system temporarily. This allows you to read mail, etc. and still remain in the NEWS program. On VT-100 terminals, the PF3 key also executes this command. To use this feature, NEWS must be invoked with SPAWN#NEWS in DCL. To re-enter NEWS, use the ATTACH#[process-name] command, where [process-name] was the name given by SPAWN to your command level process when you invoked NEWS. '5' assigns the message buffer (normally seen at the bottom of the screen) to be the current buffer. See 'Selecting Newsgroups: Subscribing to specific newsgroups' for a discussion of swapping buffers. .end bar .page .c74;*** ^&Command Summary\& *** .lit ?,h help page down, even through articles n next article N next newsgroup # go to article number c catch-up to latest article C un-catch-up (return to last unread article) g go to non-specific newsgroup G go to specific newsgroup s save article to file u unsubscribe to current newsgroup U un-unsubscribe to newsgroup < top of article > bottom of article ^Z exit (remember read articles) q quit (don't remember read articles) ^R,^W redraw screen 1 make text buffer active 2 make newsgroup buffer active | 3 make complete newsgroup file active | 5 make message buffer active | p pause .el .c74;VT-100 Keypad commands: .lit PF2 keypad help 0 page down . page up next article , next newsgroup PF1 go to non-specific newsgroup | PF3 pause .el .page .c74;*** Program Messages *** "Can't find the group you referred to: [group-name]" You asked to go to a newsgroup (with either g or G) and NEWS could not find a group by that name. You are returned to the newsgroup and article you are currently reading. "Nothing left to read in group [group-name] -- Moving to next Group" This is what happens when you finish the last article in a newsgroup and hit the space bar or 'n'. Note that although it moves to the next group, it does not start reading the articles; hit 'n' or the space bar again to continue. "Null News Body -- Hope that's OK" NEWS tried to read an article that turned out to be empty. This is most likely due to a numbering error in netnews, so you're not missing anything.