#!/usr/bin/perl die "need perl5" unless $] >= 5; ############################################################### # plum - perlian screen based mh mail/news/msgs reader # tom christiansen # # original: 25-june-91 ############################################################### #### purely for plinting pliancy... ##### # # either run this once as root or make it something you can write # $PLUMLIB = $ENV{'PLUMLIB'} || "/usr/local/lib/plum"; $ADDR_CACHE = $ENV{'plum_addrcache'} || "$PLUMLIB/plumaddrs"; $VERSION = '$Revision: 1.31 $'; $AUTH = '$Author: tchrist $'; $DATE = '$Date: 91/12/18 19:14:43 $'; $BUGS_TO = 'tchrist@convex.com'; require 'termcap.pl'; use POSIX qw(:termios_h); # BEGIN REQUIRED MODULES # MODULE CONT.pl v1.3 sub CONT { &cbreak; print $TC{'ti'}; &refresh; } # MODULE HANDLER.pl v1.2 sub HANDLER { &panic("Unexpectedly hit by a SIG$_[0]"); } # MODULE INTERRUPT.pl v1.2 sub INTERRUPT { &warn("Interrupted"); &cbreak; &throw("int"); } # MODULE KEY_PRESS.pl v1.2 1; sub KEY_PRESS { &assert('&called_by("main\'reap_some_folders")'); &assert('$$ == $Start_Pid', $$, $Start_Pid); # &throw('key_press'); } # MODULE PLUMBER.pl v1.2 sub PLUMBER { &panic('unexpected sigpipe'); } # MODULE POSTMAN.pl v1.2 sub POSTMAN { alarm(0); if (&got_mail != $Mail_Waiting) { &draw_scroll_bar; # slumbers not nor sleeps, or hang forever &gotoyx($Current_Line); } $SIG{'ALRM'} = 'POSTMAN'; alarm($U{"mailcheck"}); } # MODULE QUIT.pl v1.2 sub QUIT { &msg("See ya!"); &gotoyx($rows); &_quit; } # MODULE RESIZE.pl v1.3 sub RESIZE { &get_winsize; &redraw; &msg("new winsize $rows x $cols") if $U{"debug"}; $Last_Typed = ''; &throw("winch"); } # MODULE STOP.pl v1.2 sub STOP { &cooked; &bottom_line; print $TC{'te'}; kill('STOP',$$); } # MODULE Tcompile.pl v1.2 sub Tcompile { local($ms,$decr,$string); &assert('defined @Tputs'); for $cap (@_) { next unless defined($string = $TC{$cap}); if ($string =~ /(^[\d.]+)(\*?)(.*)$/) { $ms = $1; #$ms *= $affcnt if $2; $string = $3; $decr = $Tputs[$ospeed]; if ($decr > .1) { $ms += $decr / 2; $string .= $TC{'pc'} x ($ms / $decr); } } $TC{$cap} = $string; } } # MODULE _cleanup.pl v1.2 sub _cleanup { &cooked; exit 1 if &thrown eq 'oops'; } # MODULE activate_folder.pl v1.6 sub activate_folder { local($folder) = @_; &assert('$folder',$folder); $Last_Seq = $Current_Seq; if (! defined $Active_Folders{$folder}) { $Active_Folders{$folder} = &gensym; push(@Active_Folders, $folder); } local($package) = $Active_Folders{$folder}; # warning: it is important that any of these aggregate vars get cleared # instead of undeffed. otherwise you may get a coredump. local($code)=<<"EOF"; { package $package; *'Current_Folder = *Current_Folder; *'Current_Seq = *Current_Seq; *'Current_Line = *Current_Line; *'Top_Line = *Top_Line; *'Scan_Lines = *Scan_Lines; *'Scan_IDs = *Scan_IDs; *'Incomplete_Read = *Incomplete_Read; *'Folder_ID = *Folder_ID; *'Last_Typed = *Last_Typed; *'Deleted = *Deleted; } EOF eval $code; $Current_Seq = $folder; &panic("bad eval: $@\n$code\n") if $@; } # MODULE assert.pl v1.2 sub assert { &panic("ASSERTION BOTCHED: $_[0]",$@) unless eval $_[0]; } # MODULE autotype.pl v1.4 sub autotype { return unless $U{"autotype"}; if ($Current_Message eq $Last_Typed || ($Deleted{$Current_Message} && $Current_Cmd eq 'autotype')) { local($line); if (defined ($line = &get_next_line)) { local($clear_plus_) = 1; local($U{'autotype'}); &goto_line($line); } else { return; } } local($func) = $U{'spacecommand'} || 'type'; if ($func ne 'type') { return if &key_ready; if (&bogus_msg) { &clear_bottom; $Last_Typed = ''; } else { &catch("&$func()") && &rethrow; $Last_Typed = $Current_Message; } } else { &type(); } } # MODULE bogus_msg.pl v1.2 sub bogus_msg { $Deleted{$Current_Message} || $Current_Message =~ /\[Refiled\]/; } # MODULE bottom_line.pl v1.2 sub bottom_line { &gotoyx($rows - 1); &clear_eol; } # MODULE canonicalize.pl v1.2 sub canonicalize { local($_) = @_; s/^\s+//; s/\s+$//; if ($_ eq '^') { $_ = $Current_Folder; s![^/]*$!!; } # make absolute s!\@$!$Current_Folder!; s!\@(\S)!$Current_Folder/$1!; # add a plus if they didn't give me one s/^(\w+)([^:]|$)/+$1$2/i unless /\+/; # must be a sequence, assume current folder s/$/ $Current_Folder/ unless /\+/; $_; } # MODULE cleanup.pl v1.4 sub cleanup { &_cleanup; &commit_deletions if %Deleted;; #&gotoyx($rows); #print "\n"; #&gotoyx($rows - 2); #&clear_eol; &bottom_line; #print "We're outta here!\n"; print $TC{'te'}; exit 0; } # MODULE clear_bottom.pl v1.2 sub clear_bottom { &gotoyx($Bar_Line+1); &clear_eos; } # MODULE clear_eol.pl v1.2 sub clear_eol { print $TC{'ce'}; } # MODULE clear_eos.pl v1.2 sub clear_eos { print $TC{'cd'}; } # MODULE compute_bar_line.pl v1.2 sub compute_bar_line { if ($Top_Line + int($rows/2) - 1 > @Scan_Lines) { $Bar_Line = @Scan_Lines - $Top_Line; } else { $Bar_Line = int($rows/2) - 1; $Bar_Line = @Scan_Lines if $Bar_Line > @Scan_Lines; } $Bar_Line = $U{'window'} if $U{'window'} > 0 && $Bar_Line > $U{'window'}; } # MODULE control.pl v1.2 sub control { sprintf("%c", ord("\u$_[0]") - 0x40); } # MODULE current_msgid.pl v1.3 sub current_msgid { &verify_folder_id; ($Current_Message =~ /^\s*(\d+)/)[0]; } # MODULE curse.pl v1.4 sub curse { local(@args) = @_; #defined(@args); TRY_AGAIN: { eval '&command_loop(@args);'; if ($@ && !&thrown) { &warn($@,''); if (&qprompt("Attempt to recover? ") !~ /n/i) { &bottom_line; print "restarting..."; redo TRY_AGAIN; } } } } # MODULE debugging.pl # $Id$ sub debugging { $U{"debug"} || $Debug_List =~ /$_[0]/i; } # MODULE dispatch_folder_demon.pl v1.5 sub dispatch_folder_demon { #local($root) = $_[0] || $MHPATH; undef @Folder_List; undef @Folder_Names; local($folder_file) = &tempname; open(FOLDER_DEMON, "+>$folder_file") || die "can't creat $folder_file: $!"; unlink($folder_file); $Demon_Running = 1; if (!defined($Demon_Pid = fork)) { $Demon_Running = 0; &warn("cannot fork folder demon: $!"); return 0; } $Demon_Start_Time = time; return if $Demon_Pid; $SIG {'PIPE'} = 'DEFAULT'; $SIG {'INT'} = 'IGNORE'; $SIG {'QUIT'} = '_quit'; $SIG {'WINCH'} = 'IGNORE'; $SIG {'USR1'} = 'IGNORE'; #close(TTY); #close(STDIN); close('STDOUT'); open (::STDOUT, ">&FOLDER_DEMON") || &panic("folder demon cannot dup STDOUT: $!"); $| = 1; #local($MHPATH) = $root; &scan_folders($MHPATH); print "EOF\n"; close('FOLDER_DEMON'); exit; } # MODULE display_filehandle.pl v1.6 sub display_filehandle { local($handle,$file) = @_; local($curline, $topline); local($looked); local($got_line); local($filepos); local($name,$size); local($sinkhole); local($|) = $U{'flushline'}; local($CE) = $TC{'ce'}; local($DO) = "\r" . $TC{'do'}; if ($file && -e $file) { $size = -s _; $name = $file; if ((index($file, $MHPATH)) >= 0) { $name = substr($file, length($MHPATH)+1); } $name =~ s/\\//g; $name =~ s/^/+/; } if (!$size) { $sinkhole = "/tmp/plum.pipe.$$"; &assert(open('SINK', ">$sinkhole")); unless ($pid = fork) { &assert('defined $pid', $pid, $!); select('SINK'); $| = 1; print while <$handle>; exit; } # reopen to avoid problems with bidirectional # stdio buffers &assert(open(::SINK, "<$sinkhole")); $handle = 'SINK'; $size = -s main::SINK; $name = "(pipe)"; unlink $sinkhole; } $curline = $topline = ($Bar_Line || -1) + 1; { local($|) = 1; &gotoyx($topline,0); &clear_eos; } &gotoyx($curline - 1); vec($filepos, 0, 32) = tell($handle); GET_LINE: { while (<$handle>) { $got_line++; vec($filepos, $got_line, 32) = tell($handle); chop; 1 while s/\t+/' 'x (length($&) * 8 - length($`) % 8)/e; s/^\376\375\374// || ($_ = &uncontrol($_)) if tr/\0-\37\200-\377//; SHOW_LINE: { if (++$curline == $rows) { &pager'bottom; } elsif (&key_ready) { #} elsif (!($looked++ % 10) && &key_ready) { $key = &getkey; #&pager'bottom; $Next_Key = $key unless $key =~ /[Qq \033]/; last GET_LINE; } s/ +$//; if ($cols <= length) { print $DO, substr($_, 0, $cols - 1), $CE; substr($_, 0, $cols - 1) = ''; redo SHOW_LINE if length; redo GET_LINE; } print $DO, $_, $CE; } } if ($sinkhole && !$got_line && (kill(0,$pid) || $size != -s $handle)) { sleep 1; seek(::SINK,0,0); redo GET_LINE; } &pager'bottom if $U{'stopateof'} && $got_line; } if (!$got_line) { local($blank) = ""; &gotoyx($Bar_Line + ($rows-$Bar_Line)/2 - 1, ($cols - length($blank))/2); print $blank; } &clear_eos unless $curline == 1+$topline; &bottom_line; } sub pager'bottom { local($where); print $TC{'cd'} unless $curline == $topline; #print $DO; &bottom_line; $size = -s ::SINK if $sinkhole; if (tell($handle) == $size) { $where = "END"; } else { $where = int (100 * tell($handle)/$size) . '%'; } print $CE, $TC{'so'},$name, ' (',$where, ')', $TC{'se'}; $key = &getkey; if ($key =~ /^[\002b]/) { if ($where eq 'END') { $got_line -= $rows + $curline - 2 * $topline - 1; } else { $got_line -= ($curline - $topline - 1) * 2 + 1; } if ($got_line < 0) { # back up into header seek($handle, 0, 0); } else { seek($handle, vec($filepos, $got_line, 32), 0); } &gotoyx($Bar_Line); $curline = $topline; redo GET_LINE; } # we'll do CR later... maybe if ($key eq ' ' && $where eq 'END') { $Next_Key = ' '; &bottom_line; last GET_LINE; } if ($key =~ /^[\006f \r\n]/) { &bottom_line, last GET_LINE if $where eq 'END'; &gotoyx($Bar_Line); $curline = $topline+1; } else { $Next_Key = $key unless $key =~ /^q/i; last GET_LINE; } } # MODULE display_line.pl v1.3 sub display_line { local($line) = @_; if (defined($Deleted{$line})) { substr($line,0,1) = 'D'; &standout; printf "%-${cols}.${cols}s".$TC{'ce'}, $line; &standin; #&clear_eol; } else { print substr($line, 0, $cols - 1), $TC{'ce'}; #&clear_eol; #&autotype; } } # MODULE down_line.pl v1.3 sub down_line { local($count) = $Count; undef $Count; local($ok); if ($Top_Line + $Current_Line + 1 == @Scan_Lines) { &warn("At end of listing") unless $quiet_edges_; } else { local($clear_plus_) = 1; #&clear_plus; &goto_line($Top_Line + $Current_Line + ($count ? $count : 1)); $ok++; } $ok; } sub down_line_sticky { $Movement_Direction = 'down_line'; &down_line; } # MODULE draw_scroll_bar.pl v1.2 sub draw_scroll_bar { local($bar) = '-' x $cols; local($start, $width, $end); &compute_bar_line; # die "bad barline" unless $Bar_Line; &gotoyx($Bar_Line); if (@Scan_Lines) { $width = $Bar_Line/@Scan_Lines * $cols; $start = $Top_Line/@Scan_Lines * $cols; $start = int($start +.5); $width = int($width +.5); $end = $start + $width; $end = $cols if $end >= $cols; $end--; if ($end == $cols || $Top_Line + $Bar_Line > @Scan_Lines) { $end = $cols - 1; } substr($bar, $start, 1) = '('; substr($bar, $end, 1) = ')'; substr($bar, $start, 1) = '|' if $start == $end; } substr($bar, 0, 1) = '['; substr($bar, length($bar) - 1, 1) = ']'; substr($bar, length($bar) - 2, 1) = '(' if $start == length($bar)-1; if ($Mail_Waiting = &got_mail) { print $TC{'so'}, $bar, $TC{'se'}; } else { print $bar; } } # MODULE exceptions.pl v1.1 sub catch { local($__code__, @__exceptions__) = @_; local($__exception__); eval "$__code__"; if (($__exception__ = &thrown) && @__exception__) { for (@__exceptions__) { return $__exception__ if /$__exception__/; } &throw($__exception__); } $__exception__; } sub throw { local($exception) = @_; #use Carp; #confess("EXCEPTION: $exception\n"); die("EXCEPTION: $exception\n"); } sub thrown { $@ =~ /^(EXCEPTION: )+(.*)/ && $2; } # MODULE folder2path.pl v1.2 sub folder2path { local($_) = @_; local($expr); s/\b@/+$Current_Folder/; s/^\+//; ($expr = $MHPATH) =~ s/(\W)/\\$1/g; s!^([^/])!$expr/$1!; s/\\//g; $_; } # MODULE func_body.pl v1.3 sub func_body { local($_) = @_; if (/^gensym_\w+$/) { $_ = $Function_Bodies{$_}; if (!/^{ *\n/) { # simple function s/^{ &//; s/'\); }//; s/\('/ /; } else { # local($*) = 1; s/\n/ /g; } s/^\s*\{\s*//; s/\s*\}\s*$//; s/\s+/ /g; s/;$//; s/\s*$//; } $_; } # MODULE gensym.pl v1.3 $gensym = 'a'; sub gensym { 'gensym_' . $gensym++; } # MODULE get_winsize.pl v1.2 sub get_winsize { local($winsize) = ''; if (defined &TIOCGWINSZ) { ioctl(TTY, &TIOCGWINSZ, $winsize) || die "can't ioctl TIOCGWINSZ: $!"; ($rows, $cols, $xpixel, $ypixel) = unpack('S4', $winsize); } else { $rows = $ENV{'LINES'} || $TC{'li'} || 24; $cols = $ENV{'COLUMNS'} || $TC{'co'} || 80; } } # MODULE getcmd.pl v1.2 sub getcmd { local($_); $Lo_Range = $Hi_Range = $Count = ''; while (defined($_ = &getkey)) { if (/\d/) { $Count .= $_; &msg($Lo_Range ? "$Lo_Range-$Count" : $Count); } elsif (/-/) { $Lo_Range = $Count; $Count = ''; &msg("$Lo_Range-"); } elsif (/\033/) { return "\033" unless $Lo_Range || $Count; $Lo_Range = $Hi_Range = $Count = ''; &msg(''); } else { if ($Lo_Range) { if ($Count) { $Hi_Range = $Count; $Count = $Lo_Range; } else { $Count = $Lo_Range; $Lo_Range = ''; } } last; } } $Count = 0 + $Count; $_; } # MODULE getkey.pl v1.4 $_bad_reads = 0; sub getkey { local($key, $!); { local($|) = 1; print ''; } { if (defined $Next_Key) { $key = $Next_Key; # &bottom_line; undef $Next_Key; } elsif (!sysread(TTY,$key,1)) { $key = undef; redo if $! =~ /inter/i; &warn ("read from tty failed: $!") if $!; exit if $_bad_reads++ > 5; } else { $_bad_reads = 0; } redo unless ord($key); } $key; } # MODULE got_mail.pl v1.2 sub got_mail { -s $U{"mailbox"}; } # MODULE goto_line.pl v1.5 %plus_chars = ( 'up_line', '^', 'down_line', 'v', 'nothing', '+', ); sub goto_line { local($delta) = &screen_size; local($|) = 0; local($newpage,$oldpage); local($line) = @_; $line = $#Scan_Lines if $line > $#Scan_Lines; $line = 0 if $line < 0; # return if $line eq $Current_Line + $Top_Line; $oldpage = int($Top_Line / $delta); $newpage = int($line / $delta); local($oldmsg) = $Current_Message; $Top_Line = int($line / $delta) * $delta; $Current_Line = int($line % $delta); $Current_Message = $Scan_Lines[$Top_Line + $Current_Line]; $Last_Typed = ''; if ($Top_Line + $Current_Line + 1 == @Scan_Lines) { &throw('empty_folder') if $hit_bottom_++ > 2; $Movement_Direction = 'up_line' if $U{'changemove'}; } elsif ($Top_Line == 0 && $Current_Line == 0) { &throw('empty_folder') if $hit_top_++ > 2; $Movement_Direction = 'down_line' if $U{'changemove'}; } if ($newpage == $oldpage) { if ($clear_plus_) { local($Current_Message) = $oldmsg; # dumb and ugly $clear_plus_ = 0; &clear_plus; } &gotoyx($Current_Line); &set_plus; &autotype; } else { $| = 1; print ''; &redraw; } } sub set_plus { print $TC{"so"} if $Deleted{$Current_Message}; print $plus_chars{$Movement_Direction} || '?', "\r"; print $TC{"se"} if $Deleted{$Current_Message}; local($|) = 1; print ''; } sub clear_plus { if ($Deleted{$Current_Message}) { print $TC{"so"}, "D\r", $TC{"se"}; } else { print " \r"; } } # MODULE gotoyx.pl v1.2 sub gotoyx { local($row, $col) = @_; $row = 0 if !defined $row; $col = 0 if !defined $col; &Tputs(&Tgoto($TC{'cm'}, $col, $row), 0, 'STDOUT'); } # MODULE help_alpha.pl v1.4 sub help_alpha { "\U$a" cmp "\U$b"; } # MODULE help_by_value.pl v1.4 sub help_by_value { "\U$Cmds{$a}" cmp "\U$Cmds{$b}"; } # MODULE init.pl v1.5 $HOME = $ENV{'HOME'} || (getpwuid($<))[7]; $USER = $USER || $ENV{USER} || $ENV{LOGNAME} || getlogin() || (getpwuid($<))[0]; srand($$|time); $Start_Pid = $$; $Movement_Direction = 'down_line'; $Last_Command = 'shell_command'; sub init { #%%# #%%# Initialize everything. Read system config files, maybe .ph files, #%%# load up initial bindings, initialize filecache and tty stuff, #%%# read system and user rc files, and dispatch the folder demon. #%%# &load_commands; ET_RESURREXIT: { print STDERR "$0 restarted!\n" if $restarted; &parse_args; if ($Dump_Me) { $restarted++; undef $Dump_Me; print "dumping...\n"; dump ET_RESURREXIT; } } &tty_stuff; &init_filecache; $SIG{'WINCH'} = 'RESIZE'; unless ($No_RC_Files) { &ssource("$PLUMLIB/plumrc"); # want function definitions &ssource("$HOME/.plumrc"); &ssource(".plumrc"); } # &dispatch_folder_demon; } # MODULE init_filecache.pl v1.4 sub init_filecache { package filecache; if (defined &'NOFILE) { $maxopen = &'NOFILE - 12; return; } $seq = 0; $numopen = 0; if (open(PARAM,'/usr/include/sys/param.h')) { local($.); while () { $maxopen = $1 - 12 if /^\s*#\s*define\s+NOFILE\s+(\d+)/; $'NOFILE = $1; } close PARAM; } $maxopen = 6 unless $maxopen; } sub filecache'open { # open in their package open($_[0], $_[1]); } # but they only get to see this one sub main'cachein { package filecache; ($file) = @_; ($package) = caller; if (!$isopen{$file}) { if (++$numopen > $maxopen) { sub byseq {$isopen{$a} <=> $isopen{$b};} local(@lru) = sort byseq keys(%isopen); splice(@lru, $maxopen / 3); $numopen -= @lru; for (@lru) { close $_; delete $isopen{$_}; } } &open($file, "< " . $file) || return undef; } elsif ($'U{'debug'}) { } seek($file,0,0); $isopen{$file} = ++$seq; } sub main'uncache { package filecache; local($file); for $file (@_) { if ($isopen{$file}) { close $file; delete $isopen{$file}; $numopen--; } } } sub main'clear_filecache { # (DIRECTORY) #%%# #%%# Close anything cached open in this directory. #%%# package filecache; local($dir) = @_; for $file (keys %isopen) { if (index($file,$dir) == 0 && substr($file, length($dir), 1) eq '/') { close $file; delete $isopen{$file}; $numopen--; } } } # MODULE isdef.pl v1.2 sub needdef { # (FUNC_NAME, ...) returns BOOLEAN #%%# #%%# Takes a list of function names and verifies that they #%%# are all defined. Returns true if all are ok, false #%%# otherwise. #%%# local($function); local(@missing); for $function (@_) { push(@missing,$function) unless eval "defined &$function"; } @missing; } # MODULE key_ready.pl v1.2 sub key_ready { local($rin); defined($Next_Key) || do { vec($rin, fileno(TTY), 1) = 1; select($rin,undef,undef,0); }; } # MODULE load_commands.pl v1.5 %Cmds = ( &control('b'), 'page_backward', &control('f'), 'page_forward', &control('g'), 'current_folder', &control('l'), 'refresh', &control('p'), 'up_line', &control('j'), 'down_line_sticky', &control('n'), 'down_line', &control('r'), 'reread', &control('h'), 'reverse_help', &control('t'), 'pop_folder', &control('['), 'debugger_escape', &control(']'), 'push_folder', &control('^'), 'alternate_folder', ' ', 'autotype', '+', 'folder', '!', 'shell_command', '|', 'paged_shell_command', '`', 'pick_subsequence', '$', 'bottom', '[', 'prev_folder', ']', 'next_folder', '{', 'first_folder', '}', 'last_folder', '%', 'goto_percent', '.', 'dot', ',', 'next_line', '/', 'search_forward', '<', 'page_backward', '*', 'show_marks', '=', 'list_folders', '_', 'list_active_folders', '~', 'toggle_print', ':', 'colon', '>', 'page_forward', '?', 'search_backward', '@', 'list_sub_folders', 'a', 'reply', 'A', 'reply_cc_all', 'b', 'page_backward', 'B', 'bug_report', 'c', 'comp', 'C', 'comp_use', 'd', 'delete', 'D', 'distribute', 'e', 'edit_current', 'f', 'forward', 'F', 'fast_forward', 'G', 'goto_message', 'g', 'goto_message', 'h', 'help', 'H', 'home_screen', 'i', 'incorporate', 'j', 'down_line', 'J', 'down_line_sticky', 'k', 'up_line', 'K', 'up_line_sticky', 'L', 'bottom_screen', 'l', 'tail_syslog', 'm', 'comp', 'M', 'middle_screen', 'N', 'search_next_backward', 'n', 'search_next_forward', 'P', 'pager_show', 'p', 'show', 'q', 'quit_confirm', 'x', 'quit', 'X', 'quit_nodelete', 'Q', 'quit_nodelete', 'R', 'auto_refile', 'r', 'reply', 's', 'refile', 'S', 'sortm', 't', 'type', 'T', 'headers', 'u', 'undelete', 'U', 'undelete_all', 'v', 'print_plum_version', 'V', 'print_perl_version', 'z', 'pack_folder', 'Z', 'zedzed', '^', 'top', ); @Original_Commands = ( 'page_backward', 'page_forward', 'current_folder', 'refresh', 'up_line', 'down_line', 'folder', 'reread', 'pop_folder', 'debugger_escape', 'push_folder', 'alternate_folder', 'autotype', 'shell_command', 'pick_subsequence', 'bottom', 'goto_percent', 'dot', 'next_line', 'search_forward', 'page_backward', 'show_marks', 'list_folders', 'toggle_print', 'colon', 'page_forward', 'reverse_search', 'list_sub_folders', 'reply', 'reply_cc_all', 'page_backward', 'bug_report', 'comp', 'comp_use', 'delete', 'distribute', 'forward', 'page_forward', 'goto_message', 'goto_message', 'help', 'home_screen', 'incorporate', 'down_line', 'up_line', 'bottom_screen', 'tail_syslog', 'comp', 'middle_screen', 'next_reverse', 'next_search', 'pager_show', 'show', 'quit', 'quit', 'quit_nodelete', 'quit_nodelete', 'auto_refile', 'reply', 'refile', 'sortm', 'type', 'headers', 'undelete', 'print_version', 'edit_current', 'pack_folder', # these are not usually bound 'eval', 'RESIZE', 'nothing', 'bind', 'unbind', 'source', 'code', 'memo', 'show_variable', 'show_status', 'paged_shell_command', 'commit_deletions', 'rmm', 'plum_names', 'set', 'chdir', 'pwd', 'list_active_folders', 'next_folder', 'prev_folder', 'first_folder', 'last_folder', 'describe_function', 'undelete_all', 'new_folders', ); sub load_commands { local($cmd, $fun); while (($cmd, $fun) = each %Cmds) { if (eval "!defined &$fun") { &warn("key `$cmd' bound to undefined function `$fun'\n"); } } &sort_cmd_list; } # MODULE make_speeds.pl v1.2 sub make_speeds { local($speed) = 0; for (B0, B50, B75, B110, B134, B150, B200, B300, B600, B1200, B1800, B2400, B4800, B9600, B19200, B38400) { eval "sub $_ { $speed; }"; &panic($@) if $@; $speed++; } } # MODULE msg.pl v1.5 sub msg { local(@msgs) = @_; local($_); local($|) = 1; # return unless $Initted || $warning_msg_; for (@msgs) { s/\s+$//; } if (@msgs > 1 || ($cols && length($msgs[0]) > $cols)) { if (&fork_pager) { &continue; &gotoyx($Current_Line) if defined $Current_Line; return; } if ($warning_msg_) { $m = "<<< **** WARNING **** >>>"; print "\n\n\376\375\374", # trick the pager ' ' x (($cols - length($m) - 1) / 2), $TC{'so'}, $m, $TC{'se'}, "\n\n"; } for (@msgs) { print; print "\n"; } exit; } &bottom_line if $Initted; &standout if $warning_msg_; print $msgs[0]; &standin if $warning_msg_; print "\r\n" unless $Initted; sleep 1 if $smsg_pause_; &gotoyx($Current_Line) if defined $Current_Line; } # MODULE panic.pl v1.3 sub panic { select(STDERR); &bottom_line; print "\npanic: "; print "(start_pid is $Start_Pid, my pid is $$)\n" if $Start_Pid != $$; print "@_\n"; #exit 1 unless $U{"debug"}; exit 1 if $] <= 4.003; # caller broken # stack traceback stolen from perl debugger local($i,$_); local($p,$f,$l,$s,$h,$a,@a,@sub); for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) { @a = @DB'args; for (@a) { if (/^StB\000/ && length($_) == length($_main{'_main'})) { $_ = sprintf("%s",$_); } else { s/'/\\'/g; s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/; s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; } } $w = $w ? '@ = ' : '$ = '; $a = $h ? '(' . join(', ', @a) . ')' : ''; push(@sub, "$w&$s$a from file $f line $l\n"); last if $signal; } for ($i=0; $i <= $#sub; $i++) { last if $signal; print $sub[$i]; } kill 'TERM', -$Start_Pid; exit 1; } # MODULE parse_args.pl v1.5 sub parse_args { #%%# #%%# Parse plum's command line from \@ARGV, setting variables #%%# as appropriate. #%%# local($_); $ttyname = '/dev/tty'; while ($ARGV[0] =~ /^-(.+)/ && (shift @ARGV, ($_ = $1), 1)) { next if /^$/; # ran out of args s/d// && (++$U{"debug"}, warn("did d $_"), redo); s/u// && (++$Dump_Me, redo); s/x// && (++$No_RC_Files, redo); s/f// && do { &source($_ || shift @ARGV); next; }; s/t// && do { $ttyname = $_ || shift @ARGV; $ttyname = "/dev/$ttyname" unless $ttyname =~ m!^/dev/!; redo; }; s/D// && do { $Debug_List .= $_ || shift @ARGV; redo;; }; &usage; } } # MODULE plum_names.pl v1.7 CONFIG: { package plum_names; @NNVN_w1 = (Perl, Practical, Precocious); @NNVN_w2 = ( Language, Lark, League, Legacy, Legend, Lever, Liaison, Liberation, Lifeboat, Lifestyle, Lister, Lubricant, Luminary, Lunacy, Luxury, ); @NNVN_w3 = ( Unclutters, Unfetters, Unifies, Unites, Unseats, Upgrades, Upstages, Uses, Usurps, ); @NNVN_w4 = (Mh, Mail); @NNVN = ( *NNVN_w1, *NNVN_w2, *NNVN_w3, *NNVN_w4 ); @NVNN_w1 = (Perl); @NVNN_w2 = ( Lampoons, Launders, Leapfrogs, Leaps, Learns, Legitimizes, Levels, Levitates, Liberates, Lightens, Likes, Liquidates, Loathes, Loosens, Loves, Lubricates, ); @NVNN_w3 = ( Ubiquitous, Ugly, Ulcerated, Ultimate, Ultra, Uncouth, Unending, Underling, Underlying, Unkempt, Unmanageable, Unmangled, Unruly, Unseemly, Unwieldy, Upbeat, Unquelled, Unquenchable, Unread, Untenable, Unusable, Urbane, Usable, Useful, Utmost, Utopian, ); @NVNN_w4 = (Mh, Mail); @NVNN = ( *NVNN_w1, *NVNN_w2, *NVNN_w3, *NVNN_w4 ); @rule_sets = ( *NVNN, *NNVN ); } sub plum_names { package plum_names; &'fork_pager && return; local(@lines); for $set (@rule_sets) { *words = $set; (*w1, *w2, *w3, *w4) = @words; for $w1 (@w1) { for $w2 (@w2) { for $w3 (@w3) { for $w4 (@w4) { push(@lines, "$w1 $w2 $w3 $w4\n"); } } } } } &'assert('!$@', $@); print &'scramble(@lines); exit; } sub pick_a_plum { package plum_names; *rules = $rule_sets[rand @rule_sets]; (*w1, *w2, *w3, *w4) = @rules; join ( ' ', $w1[rand @w1], $w2[rand @w2], $w3[rand @w3], $w4[rand @w4]); } # MODULE postcompile.pl v1.3 sub postcompile { # local($fun) = &whowasi; # don't do that; sigh local($__fun__) = $__whowasi__ || &panic("dunno who i was!"); local($__addr__); die("No address for $__fun__") unless $__addr__ = $Func_Addrs{$__fun__}; die("$__fun__ should already be loaded") if $__addr__ < $Data_Start; die("can't load $__fun__ from $__fun__ on : $!") unless seek(DATA,$__fun__,0); # &msg MUST PRELOAD &smsg(sprintf("(autoloading %s from byte %07o)\n", $__fun__, $__addr__)) if $Start_Pid == $$ && &debugging('autoload'); seek(DATA,$__addr__,0); local($__code__,$_); while () { $__code__ .= $_; last if /^\}/; } die "No /^sub\\s$__fun__/in code at $__addr__:\n$__code__\n" unless $__code__ =~ /^sub\s+$__fun__/; local($tmp) = substr($_stub{$__fun__}, 7*4, 4); substr($_stub{$__fun__}, 7*4, 4) = substr($_main{$__fun__}, 7*4, 4); substr($_main{$__fun__}, 7*4, 4) = $tmp; eval $__code__; $@ && &panic(sprintf( "code for %s (addr %07o) didn't eval: %s\n CODE:\n%s", $__fun__, $Func_Addrs{$__fun__}, $@, $__code__ ) ); &$__fun__; } sub fetch_function_addrs { local($count); local($_); local($hischecksum, $mychecksum); local($update); $Data_Start = tell(DATA); print STDERR "gathering functions: " if defined $ENV{'debug_plum'}; seek(DATA,0,0); { local($/); $mychecksum = unpack("%16C*", ); } if ((stat(DATA))[9] > (stat($ADDR_CACHE))[9]) { print STDERR "addrcache out of date " if defined $ENV{'debug_plum'}; $update++; } elsif (!open(ADDRS, $ADDR_CACHE)) { print STDERR "can't open addrcache $ADDR_CACHE: $! " if defined $ENV{'debug_plum'}; $update++; } else { ($hischecksum) = =~ /^CHECKSUM (\d+)/; if ($mychecksum != $hischecksum) { print STDERR "checksum mismatch " if defined $ENV{'debug_plum'}; $update++; } } unless ($update) { print STDERR "yippee, snagged addrcache " if defined $ENV{'debug_plum'}; split, $Func_Addrs{$_[0]} = $_[1] while ; $count = $. - 1; close ADDRS; } else { seek(DATA,0,0); for (local($told); ; $told = tell) { next unless /^\s*sub\s+((\w+')?(\w+))/; warn "duplicate func $1 @ $told" if defined $Func_Addrs{$1}; $Func_Addrs{$1} = $told; $count++; } unless (open(ADDRS, ">$ADDR_CACHE")) { print STDERR "couldn't update addrcache: $! " if defined $ENV{'debug_plum'}; } else { print STDERR "updating addrcache " if defined $ENV{'debug_plum'}; local($x,$y); print ADDRS 'CHECKSUM ', $mychecksum, "\n"; print ADDRS $x, ' ', $y, "\n" while ($x, $y) = each %Func_Addrs; close ADDRS; } } print STDERR "found $count functions\n" if defined $ENV{'debug_plum'}; seek(DATA,$Data_Start,0); } # this guy makes me coredump if used to autoload sub whowasi { (caller(2))[3]; } # MODULE pvar.pl v1.2 sub pvar { # should this guy be postcompiled, bad things happen. local($var) = shift; local($val) = $U{$var}; &assert('$var =~ /^\w+$/', $var, $val); if ($val) { $UBool{$var} ? $var : "$var=$U{$var}"; } else { $UBool{$var} ? "no$var" : ($U{$var} eq '' ? "$var=" : "$var=$U{$var}"); } } # MODULE quiet_commit.pl v1.3 sub quiet_commit { if (%Deleted) { &verify_folder_id; &commit_deletions; } } # MODULE quit.pl v1.2 sub quit { &throw("return"); } # MODULE read_folder.pl v1.5 sub read_folder { local($startseq) = @_; local($line, $name, $msgs,$mid); local($newtop,$count); local($errs); ($Current_Folder) = $Current_Seq =~ /([@+][^\s`]+)/; $Current_Line = undef; $line = `folder $Current_Folder < /dev/null 2>&1`; if ($?) { &warn($line); &throw('bogus_folder'); } if (!$startseq) { ($name, $msgs) = $line =~ /^\s*(\S*)\+ has\s+(\d+) message/; if (!$msgs) { &warn("Folder $Current_Seq is empty!"); &throw('empty_folder'); } if (!$Current_Folder) { $Current_Folder = "+$name"; $Current_Seq .= ' ' . $Current_Folder; } &msg("reading $msgs messages out of $Current_Seq..."); @Scan_Lines = (); %Scan_IDs = (); %Deleted = (); $Last_Typed = undef; $Current_Line = undef; &clear_filecache(&folder2path($Current_Folder)); open(FOLDER, "scan -width 200 $Current_Seq 2>&1 |") || &die("can't open folder $Current_Seq: $!"); } else { open(FOLDER, "scan -width 200 $startseq 2>&1 |") || &die("can't open folder $startseq: $!"); } sub LAST_FOLDER { $Incomplete_Read = 1; print("<>"); local($count) = @Scan_Lines; last FOLDER_READ; # you didn't see me do this } $Incomplete_Read = 0; FOLDER_READ: { local($SIG{'INT'}) = 'LAST_FOLDER'; while () { if (/^scan: /) { if (/unable to open message (\d+): (.*), continuing/) { $_ = sprintf("%5d? --%s--", $1, $2); } } if (!/^\s*([\d?]+)/) { print STDERR; $errs .= $_; next; } $mid = $1; chop; s/^(^\s*[\d?]+)\+/$1 / && ($newtop = $#Scan_Lines + 1); push(Scan_Lines, ' ' x 3 . $_); $Scan_IDs{$mid} = $#Scan_Lines; if (!(@Scan_Lines % 10)) { $count = @Scan_Lines; print $count, "\b" x length("$count"); } } } close(FOLDER); &warn("strange problem reading $Current_Folder") if $? && !$Incomplete_Read++; unless (@Scan_Lines) { &warn("$Current_Seq has no messages"); &throw('empty_folder'); } &set_folder_id; $newtop = @Scan_Lines unless defined $newtop; &compute_bar_line; $Top_Line = int($newtop / &screen_size) * &screen_size; $Current_Line = int($newtop % &screen_size); $Current_Message = $Scan_Lines[$Top_Line + $Current_Line]; } # MODULE redraw.pl v1.5 sub redraw { local($i); local($|) = $U{'flushline'}; &clear_screen; #&throw('empty_folder') if $Deleted == @Scan_Lines; &draw_scroll_bar; for ($i = 0; $i < $Bar_Line; $i++) { &gotoyx($i); &display_line($Scan_Lines[$Top_Line + $i]); } &goto_line($Top_Line+$Current_Line); } # MODULE rmm.pl v1.3 sub numerically { $a <=> $b; } sub rmm { if ($U{"wastebasket"}) { # XXX this doesn't happen here &system("refile -src $Current_Folder @_ +".$U{"wastebasket"}); } else { &system("rmm $Current_Folder @_") if @_; } &set_folder_id; } # MODULE scan_folders.pl v1.4 sub scan_folders { local($path) = @_; local($_); local($count); local(@dirents); local($name); local($folder); local(*DIR); if (!opendir(DIR, $path)) { &warn("cannot opendir $path: $!"); return; } while (defined($_ = readdir(DIR))) { next if /^\./; if (/^\d+$/) { $count++; } else { push(@dirents, $_); } } closedir(DIR); $name = substr($path, 1+length($MHPATH)); printf "%5d ", $count; print $name || '+'; print '/' if @dirents; print "\n"; if ($U{"symfolders"}) { @dirents = sort grep(-d "$path/$_", @dirents); } else { @dirents = sort grep(!-l "$path/$_" && -d _, @dirents); } for $folder (@dirents) { &scan_folders("$path/$folder"); } } # MODULE screen_size.pl v1.2 sub screen_size { local($screen) = int($rows/2) - 1; if ($U{'window'} > 0 && $screen > $U{'window'}) { $screen = $U{'window'}; } $screen; } # MODULE set_cbreak.pl v1.3 { my $ison; my $savebits; my $savevtime; my $savevmin; sub set_cbreak { my($on) = shift; my($termios, $bitmask); $termios = POSIX::Termios->new; $termios->getattr(fileno(TTY)); $bitmask = ICANON | IEXTEN | ECHO; if ($on && $ison == 0) { $ison = 1; $savebits = $termios->getlflag; $termios->setlflag($savebits & ~$bitmask); $savebits &= $bitmask; $save_vtime = $termios->getcc(VTIME); $termios->setcc(VTIME, 0); $save_vmin = $termios->getcc(VMIN); $termios->setcc(VMIN, 1); } elsif ( !$on && $ison == 1 ) { $ison = 0; $termios->setlflag($termios->getlflag | $savebits); $termios->setcc(VTIME, $save_vtime); $termios->setcc(VMIN, $save_vmin); } else { return 1; } $termios->setattr(fileno(TTY), TCSANOW ); } } sub cbreak { &set_cbreak(1); } sub cooked { &set_cbreak(0); } # MODULE smsg.pl v1.2 sub smsg { local($smsg_pause_) = 1; &msg; } # MODULE sort_cmd_list.pl v1.2 sub sort_cmd_list { local(%seen); undef (%Cmd_Names); for (@Original_Commands, values %Cmds) { $Cmd_Names{$_} = 1; $_ .= ' '; $seen{$_} = 1; } @Cmd_Names = sort keys %seen; } # MODULE source.pl v1.5 sub source { local($source_file) = @_; local($start); local($_); local(*FILE_); local($sourcing_) = 1; $source_file = &'prompt("Source what file? ") unless $source_file; if ($source'opened{&fileid($source_file)}) { printf STDERR "file %s already opened on dev,ino (%s)!\n", $source_file, &fileid($source_file); return 0; } &die("Cannot open $source_file: $!") unless open(FILE_, $source_file); # warn "BEGIN Sourcing $source_file\n"; local($cmd, $args); while () { chop; next if /^\s*#/; next unless /\S/; ($cmd, $args) = split(' ',$_,2); if (defined $Cmd_Abbrev{$cmd} && $U{"abbreviations"}) { $cmd = $Cmd_Abbrev{$cmd}; } $start = $.; # use to munge line number if (!eval "defined &$cmd") { &warn("$source_file: No such function at line $start: $cmd"); } elsif (&catch("&$cmd(\$args)")) { &warn("Error at line $start of $source_file: $_", "\n", " $cmd: ". &thrown); } } $@ = ''; # clear error undef $source'opened{$source_file}; close(FILE_); # warn "END Sourcing $source_file\n"; 1; } # MODULE ssource.pl v1.3 sub ssource { local($rc) = @_; -e $rc && &source($rc); } # MODULE standin.pl v1.2 sub standin { print $TC{'se'}; } # MODULE standout.pl v1.2 sub standout { print $TC{'so'}; } # MODULE switch_folder.pl v1.7 sub switch_folder { local($folder) = @_; if (!$folder) { $Last_Seq ? &alternate_folder() : &folder(); return; } if (defined($Current_Seq) && $folder eq $Current_Seq) { &die("Same folder"); } &quiet_commit if $Current_Seq; &update_cur if @Scan_Lines && $Current_Folder; &activate_folder($folder); if (@Scan_Lines) { local($U{"autotype"}) = 0; &redraw; &msg("returning to $Current_Seq"); &update_cur; } else { if (&catch('&read_folder()', '(bogus|empty)_folder')) { &deactivate_folder($Current_Seq); if ($Last_Seq) { &activate_folder($Last_Seq); } else { &catch('&folder()') until @Scan_Lines; } return; } else { &redraw; } } } # MODULE system.pl v1.3 sub system { # (STRING) returns BOOLEAN #%%# Run a command with no interpolation. Will return #%%# true if the command worked, false otherwise. Inspect #%%# for further details. Side effect of clearing pager #%%# screen and printing the command executed. Cursor will #%%# NOT be returned where it was, as we don't know that. local($args) = "@_"; local($return); local($then); if ($paged_) { exec "$args"; &warn("exec failed on \"$args\""); exit; } &clear_bottom; print("!$args\r\n"); &cooked; { alarm(0); local( $SIG{'INT'} ) = 'DEFAULT'; local( $SIG{'CONT'} ) = 'DEFAULT'; local( $SIG{'TSTP'} ) = 'DEFAULT'; local( $SIG{'WINCH'} ) = 'DEFAULT'; $then = time; $return = system $args; } &POSTMAN if $then - $U{"mailcheck"} > time; &smsg("$args returned $return") if $U{"debug"} && $return; $Last_Typed = '' if $return; &cbreak; !$return; } # MODULE tempname.pl v1.2 sub tempname { $Tmpfile_Seqno = '00000' unless defined $Tmpfile_Seqno; local($base) = "/tmp/plum.$$-"; local($file); 0 while -e ($file = $base . $Tmpfile_Seqno++); $file; } # MODULE top_main.pl v1.7 sub command_loop { local( $SIG {'INT'} ) = 'INTERRUPT'; local( $SIG {'QUIT'} ) = 'QUIT'; local( $SIG {'PIPE'} ) = 'PLUMBER'; #local( $SIG {ALRM} ) = 'POSTMAN'; local( $SIG {'TSTP'} ) = 'STOP'; local( $SIG {'CONT'} ) = 'CONT'; local( $SIG {'IO'} ) = IGNORE; local($start_folder); if (grep(/[+@]/, @ARGV) > 1) { warn "Only one folder at a time"; &usage; } $start_folder = "@_" || "+inbox"; $start_folder =~ s/\s*//; if ($start_folder eq '+inbox' && &got_mail) { &incorporate; } else { eval '&switch_folder($start_folder)'; eval '&folder()' until @Scan_Lines; } local($cmd, $Current_Cmd); local($eof_count) = 0; local($lastcheck) = time; local($hit_top_, $hit_bottom_); local($soon) = $U{"mailcheck"}; COMMAND: for (;;) { local($SIG{'INT'}) = IGNORE; local($SIG {ALRM}) = 'POSTMAN'; ($hit_top_, $hit_bottom_) = (0,0); if ($lastcheck + $U{"mailcheck"} > time) { $lastcheck = time; &POSTMAN; } &gotoyx($Current_Line); if ($soon <= 0) { &POSTMAN; $soon = $U{"mailcheck"}; } alarm($soon); $cmd = eval '&getcmd()'; $soon -= alarm(0); if (!defined($cmd)) { if (&thrown) { $Last_Typed = ''; } elsif ($@) { &warn("Unexpected error: $@"); } else { # EOF? exit 1 if $eof_count++ > 5; } next COMMAND; } $eof_count = 0; if (defined $Cmds{$cmd}) { $Current_Cmd = $Cmds{$cmd}; if (eval "defined &$Current_Cmd") { RUNCMD: { local($SIG{'INT'}) = 'INTERRUPT'; eval("&$Current_Cmd()"); die("FATAL ERROR in $Current_Cmd: $@") if $@ && !&thrown; last COMMAND if &thrown eq 'return'; if (!@Scan_Lines) { $Current_Cmd = 'switch_folder'; redo RUNCMD; } } } else { &warn("can't call undefined subroutine $Current_Cmd"); } } else { &warn("unknown command: `" . &uncontrol($cmd) . "'"); } } &update_cur; &commit_deletions; # END MAIN } # MODULE tty_stuff.pl v1.3 sub tty_stuff { my($termios); open (STDIN, "< $ttyname") || die "can't open $ttyname: $!"; open (STDOUT, "> $ttyname") || die "can't open $ttyname: $!"; open (TTY, "+< $ttyname") || die "can't open $ttyname: $!"; $| = 1; $termios = POSIX::Termios->new; $termios->getattr(fileno(TTY)); $my_erase = $termios->getcc(VERASE); $my_kill = $termios->getcc(VKILL); $ispeed = $termios->getispeed; $ospeed = $termios->getospeed; if ($ispeed > &B1200) { $U{"autotype"} = 1; } else { $Cmds{' '} = 'type' if $Cmds{' '} eq 'autotype'; } &get_winsize; &cbreak; unless ($TERM = $ENV{'TERM'}) { warn 'no $TERM: assuming vt100', "\n"; $TERM = 'vt100'; } &Tgetent($TERM); if (!defined($TC{'ti'})) { warn "don't know $TERM, trying vt100\n"; $TERM = 'vt100'; &Tgetent($TERM); } $Initted++; &Tcompile( 'cd', 'ce', 'cl', 'cm', 'dl', 'se', 'so', 'ti', 'te'); print $TC{'ti'}; } # MODULE type.pl v1.4 sub type { &goto_message if $Count; return if &key_ready; if (&bogus_msg) { &warn("There's no message here to type!") if $Current_Cmd eq 'type'; &clear_bottom; $Last_Typed = ''; return; } local($file) = &folder2path($Current_Folder) . '/' . ¤t_msgid; local($_); if (!&cachein($file)) { &warn ("cannot type $file: $!"); return; } # &mark_seen; while (<$file>) { last if /^-*$/; } local($pos) = tell($file); while (<$file>) { if (/\S/) { last; } $pos = tell($file); } seek($file, $pos, 0) if $pos; &display_filehandle($file,$file); $Last_Typed = $Current_Message; &gotoyx($Current_Line); } # MODULE uncontrol.pl v1.2 sub uncontrol { local($_) = @_; #s/([\200-\377])/sprintf("\\%03o",ord($1))/eg; s/([\200-\377])/'M-'.pack('c',ord($1)&0177)/eg; s/([\000-\037\177])/'^'.pack('c',ord($1)^64)/eg; $_; } # MODULE up_line.pl v1.3 sub up_line { local($count) = $Count; undef $Count; local($ok); if ($Current_Line == 0 && $Top_Line == 0) { &warn("At start of listing") unless $quiet_edges_; } else { local($clear_plus_) = 1; #&clear_plus; &goto_line($Top_Line + $Current_Line + ($count ? -$count : -1)); $ok++; } $ok; } sub up_line_sticky { $Movement_Direction = 'up_line'; &up_line; } # MODULE version.pl v1.3 sub plum_version { &strip_version("plum v" . ($VERSION =~ /([\d.]+)/)[0]. ": $AUTH $DATE"); } sub strip_version { local($_) = @_; s/\$(\w+)/\L$1/g; s/\$+/ /g; s/\s+/ /g; $_; } sub perl_version { local($_) = sprintf("perl v%5.3f: %s", $], $]); substr($_, index($_, "\n")-2) = ''; &strip_version($_); } # MODULE warn.pl v1.2 sub warn { local($warning_msg_) = 1; &smsg; } # PREAMBLE CODE FOR MODULE set.pl v1.9 %U = ( "abbreviations", 0, "autotype", 0, "autolist", 1, "beep", 1, "ignorecase", 1, "debug", 0, "cleanfolders", 1, "mailbox", "/usr/spool/mail/$USER", "mailcheck", 10, "spacecommand", 'type', "flushline", 0, "changemove", 1, "symfolders", 0, "stopateof", 0, "wastebasket", '', "window", 0, ); @U_list = keys %U; %UBool = (); for ( "abbreviations", "autolist", "autotype", "beep", "changemove", "cleanfolders", "debug", "flushline", "stopateof", "symfolders", "ignorecase" ) { &assert('/^\w+$/', $_); $UBool{$_}++; # $UBool{"no$_"}++; push(@U_list, "no$_"); } # PREAMBLE CODE FOR MODULE verify_folder_id.pl v1.3 # number of seconds we give anno to dirty our folder # $_folder_fudge_factor = 15; # MAIN PROGRAM STARTS HERE sub debugger_escape { 0; } sub main { print("plum v" . (&plum_version =~ /([\d.]+)/)[0] . ': ' . &pick_a_plum . "\n" ); chop($MHPATH = `mhpath +`); die "can't get mhpath" if $?; &fetch_function_addrs; &init; &curse(@ARGV); &cleanup; die "NOT REACHED"; } sub _quit { print "\n"; exit; } sub EXIT { exit $_[0]; } # MODULE alternate_folder.pl v1.3 sub alternate_folder { &die("No alternate folder") unless defined $Last_Seq; &switch_folder($Last_Seq); } # MODULE auto_refile.pl v1.2 sub auto_refile { local($repeat_refile_) = 1; if (!defined $Last_Refile) { &warn("No previous refile"); return; } &refile; } # MODULE autolist.pl v1.2 sub autolist { package Complete; &'fork_pretty_pager && (&'bottom_line, redo loop); foreach $cmp (@_cmp_lst) { print "$cmp\r\n" if $cmp =~ /^$return/; } exit; } sub autoload { local($fun, $file, $i); use Carp; warn "autoloading @_"; for ($i = 0; $i < @_; $i += 2) { ($fun, $file) = @_[$i..$i+1]; next unless $fun; $file = "$fun.pl" unless $file; require $file; # die "autoload failure creating stub for $fun: $@" if $@; # msg "wee -- off to $fun\n"; # goto &$fun; } } # MODULE beep.pl v1.3 sub beep { &warn("vb is $TC{'vb'}") if $U{'debug'}; #print $TC{'vb'} ? $TC{'vb'} : "\007"; print "\007" if $U{'beep'}; } # MODULE bind.pl v1.3 sub bind { local($bind_string) = @_; local ($key, $string) = split(' ',$bind_string,2); local($cmd, $args, $func); if ($key eq '') { $key = &qprompt("Bind what key? "); return if $key eq ''; print &uncontrol($key); } if ($key =~ /^[-\d]+$/) { &warn("can't bind sequence numbers"); return; } ($cmd, $args) = split(' ',$string, 2); if ($cmd eq '') { local($bind) = 'Bind'; if ($Cmds{$key}) { &warn("`".&uncontrol($key). "' was previously bound to `". &func_body($Cmds{$key}). "'") unless $sourcing_; $bind = 'Rebind'; } ($cmd, $args) = &get_run_command($bind . " ". &uncontrol($key). " to what function? "); last if $cmd eq ''; } if ($cmd !~ /^\w+$/) { # bind random code local($code); $func = &gensym; $code = $cmd; $code .= ' ' . $args if $args ne ''; $code .= ';' if $code !~ /;\s*$/; &load_new_func($key, $func, <) { last if $_ eq "__END__\n"; $runcode .= $_; } local(%omain) = %_main; eval $runcode; if ($@ && !&thrown) { $@ =~ s/file \(eval\)/$fh/; $@ =~ s/line (\d+)/$1+$start/e; &warn($@); $@ = ''; &throw("code_error"); } # time to look deeply inside ourselves for $sym (keys %_main) { if (!defined $omain{$sym} && eval "defined &$sym") { push(@newcmds, $sym); } } if (@newcmds) { push(@Original_Commands, @newcmds); &sort_cmd_list; } $@ = ''; } # MODULE colon.pl v1.2 sub colon { $Count = 0; local($cmd, $args) = &get_run_command(':'); return if $cmd eq ''; if (defined $Cmd_Abbrev{$cmd} && $U{"abbreviations"}) { $cmd = $Cmd_Abbrev{$cmd}; &bottom_line; print "$cmd $args\n"; } if ($cmd =~ /(\S+)\s(.*)/) { $cmd = $1; $args = $2; } $cmd =~ s/^://; $cmd =~ y/A-Z/a-z/ if $U{'ignorecase'}; $cmd = 'quit_nodelete' if ($cmd eq 'q!'); if (!eval "defined &$cmd") { &warn("No such function: $cmd"); } else { $Current_Cmd = $cmd; eval "&$cmd(\$args)"; if ($@) { &warn("$cmd: $@") unless &thrown; &rethrow if &thrown eq 'return'; } } $@ = ''; # clear error } # MODULE commit_deletions.pl v1.4 sub commit_deletions { local(@rmm); local($new); local(@msg); local($path); local($dmid); local($target); if (! %Deleted) { return 0; } if (defined $Deleted{$Current_Message}) { $Current_Line = &get_next_line; } for (sort numerically keys(%Deleted)) { ($mid) = /^\s*(\d+)/; $path = &folder2path($Current_Folder) . '/' . $mid; if ($Deleted{$_} ne &fileid($path)) { @msg = ("Message $mid is not the same file you deleted!!"); if ($filecache'isopen{$path}) { push(@msg, "But boy are you in luck! I still have a handle to it!", "I'm going to save it off to a lost+found folder"); &warn(@msg,''); &system("folder +lost+found") || next; chop($new = `mhpath new`); &assert('! -e $new', $new); open(NEW, ">$new") || &die("can't creat $new: $!"); seek($path,0,0) || &die("can't seek on $path: $!"); print NEW while <$path>; close NEW || &die("couldn't close $new: $!"); &msg("Safely siphoned $path into $new",''); } else { &warn(@msg, 'You\'d better rescan the folder!'); next; } } else { push(@rmm, $mid); } &uncache($path); $dmid = $mid; $target = $Scan_IDs{$mid}; splice(@Scan_Lines, $target, 1); delete $Scan_IDs{$mid}; #for $mid (sort numerically keys %Scan_IDs) { for $mid (keys %Scan_IDs) { next if $mid < $dmid; $Scan_IDs{$mid}--; } } %Deleted = (); $Deleted = 0; return unless @rmm; &rmm(@rmm); &redraw if $Current_Cmd eq 'commit_deletions'; 1; } # MODULE comp.pl v1.2 sub comp { &goto_message if $Count; &system("comp"); &redraw; } # MODULE comp_use.pl v1.2 sub comp_use { &goto_message if $Count; &system("comp -use -draftmessage", ¤t_msgid, '-draftfolder',$Current_Folder); &redraw; } # MODULE complete.pl v1.3 sub complete { package Complete; local($prompt, *_cmp_lst, $suppress_prompt) = @_; local($return); local ($c, $cmp, $l, $r, $ret, $return, $test); local($did_show); loop: { unless ($suppress_prompt) { print "\r"; &'clear_eol; print $prompt, $return; } $suppress_prompt = 0; while (($c = &'getkey) !~ /[\n\r ]/) { if ($c eq "\033") { return (undef, undef); } elsif ($c eq "\t") { @_match = (); foreach $cmp (@_cmp_lst) { if ($cmp =~ /^$return/) { push (@_match, $cmp); } } $test = $_match[0]; $l = length ($test); unless ($#_match == 0) { shift (@_match); foreach $cmp (@_match) { until (substr ($cmp, 0, $l) eq substr ($test, 0, $l)) { $l--; } } $'U{'autolist'} ? &'autolist : &'beep; } print $test = substr ($test, $r, $l - $r); $r = length ($return .= $test); last if @match == 1; if (!@_match && $c eq ' ') { print ' '; last; } } elsif ($c eq "\004") { # (^D) completion list $did_show = 1; &'autolist; } elsif ($c eq $'my_kill && $r) { # (^U) kill $return = ''; $r = 0; if ($did_show) { &'clear_bottom; $did_show = 0; } &'bottom_line; # some day i may be sorry for this redo loop; } elsif ($c eq "\010" || $c eq "\177" || $c eq $'my_erase) { if ($r) { print "\b \b"; chop ($return); $r--; } else { return (undef, undef); } } elsif ($c gt ' ' && $c lt "\177") { $return .= $c; $r++; print $c; } } } if ($did_show) { &'clear_bottom; &'bottom_line; print $prompt, $return; } wantarray ? ($return, $c =~ /[\n\r]/ ) : $return; } # MODULE cond_redraw.pl v1.2 sub cond_redraw { if (&continue eq "\033") { &bottom_line; } else { &redraw; } } # MODULE continue.pl v1.2 sub continue { &bottom_line; print("Type any character to continue..."); &getkey; } # MODULE current_folder.pl v1.4 sub current_folder { local(@line); local($idx); sub mk_status_line { local($sub, $num, $short) = @_; sprintf("%s has %s%d message%s", $sub, $short ? "?" : "", $num, $num == 1 ? "" : "s" ); } $line[0] = &mk_status_line($Current_Seq, scalar(@Scan_Lines), $Incomplete_Read); if (defined $Last_Seq) { local($last_lines, $last_inc); local($package) = $Active_Folders{$Last_Seq}; eval < 2) { $line[$idx] .= " [" . (@Active_Folders-2) . " others active]"; } #$line[$idx] .= "dead"; if (length("@line") < $cols-6) { &msg("@line"); } else { &msg(@line); } } # MODULE current_msg.pl v1.2 sub current_msg { $Current_Message; } # MODULE current_msg_path.pl v1.2 sub current_msg_path { local(@ids) = split(' ', ¤t_msgid); for (@ids) { $_ = &folder2path($Current_Folder) . '/' . $_; } "@ids"; } # MODULE deactivate_folder.pl v1.3 sub deactivate_folder { local($folder) = @_; local($i); delete $Active_Folders{$folder}; for ($i = 0; $i < @Active_Folders; $i++) { if ($Active_Folders[$i] eq $folder) { splice(@Active_Folders, $i, 1); last; } } } # MODULE delete.pl v1.3 sub delete { &goto_message if $Count; $Deleted{$Current_Message} = &fileid(¤t_msg_path) || &die("This message has mysteriously vaporized!"); $Deleted++; $Last_Command = 'delete'; { local($U{"autotype"}) = 0; &display_line($Current_Message); } &next_line; } # MODULE describe_function.pl v1.2 sub describe_function { local($funclist) = "@_"; local(@funclist); local($xxx, $desc); local(@args); local($_); $funclist = &prompt("Describe what function? ") unless $funclist; for $func (split(' ',$funclist)) { $desc = ''; $func =~ s/^&//; if (eval "!defined &$func") { &warn("No such function: &$func"); next; } if (!defined($Func_Addrs{$func})) { &warn("Unknown function: &$func"); next; } seek(DATA, $Func_Addrs{$func}, 0); $_ = ; ($name) = /sub\s+(\w+)\s*\173\s*/; ($args, $xxx, $returns) = m/#\s*(.+)(returns?\s+(.+))?/; while () { last unless s/^#%%#\s*//; $desc .= $_; } next if $desc eq ''; $desc =~ s/\s+/ /g; push(@args, $name, $args, $returns, $desc); } return unless @args; &fork_pager && return; $format = "format STDOUT =\n" . &format_line('Function: @') . '$name' . "\n" . &format_line('Arguments: @') . '$args' . "\n" . &format_line('Returns: @') . '$returns' . "\n" . &format_line(' ~~ ^') . '$desc' . "\n.\n" ; eval $format; &assert('!$@', $@); while (($name, $args, $returns, $desc) = splice(@args, 0, 4)) { $args = 'NONE' unless $args; $returns = 'NOTHING' unless $returns; write; print "\n" if @args; } exit; } sub format_line { local($str) = @_; $str . '<' x ($cols - length($str) - 1) . "\n"; } # MODULE die.pl v1.2 sub die { &warn(@_); &throw("@_"); } # MODULE distribute.pl v1.3 sub distribute { local($whom); local($form); local($mid); &goto_message if $Count; $Last_Command = 'distributet'; $mid = ¤t_msgid; $whom = &prompt("Resend message to whom: "); if (!$whom) { &clear_bottom; &warn("dist aborted"); return; } $form = &makeform(</dev/null"); &warn("dist failed!") if $?; unlink($form); &fudge_folder_id; # anno updates } # MODULE dmsg.pl v1.2 sub dmsg { &smsg("DEBUG: @_") if $U{"debug"}; } # MODULE dot.pl v1.2 sub dot { local($dot) = 1; &$Last_Command; } # MODULE edit_current.pl v1.2 sub edit_current { &goto_message if $Count; &system($ENV{'EDITOR'} || 'vi', ¤t_msg_path); &redraw; } # MODULE eval.pl v1.2 sub eval { local($string) = @_; if ($string eq '') { $string = &prompt ("eval what? "); print "\r"; &clear_eol; } eval "$string"; if ($@ && !&thrown) { $@ =~ s/ in file \(eval\)//; &warn($@); } undef $@; } # MODULE fileid.pl v1.3 sub fileid { local(@sb); (@sb = stat($_[0])) && join(',',@sb[0,1]); } # MODULE first_folder.pl v1.4 sub first_folder { &switch_folder($Active_Folders[0]); return; } # MODULE folder.pl v1.2 sub folder { local($folder) = @_; local($kind_) = "New"; $folder = &get_folder if $folder eq ''; return unless $folder; &switch_folder($folder); } # MODULE fork_pager.pl v1.2 sub fork_pager { local($pid); if (!defined($pid = open(PAGER, "-|"))) { &warn("cannot fork pager: $!"); return 1; } if ($pid) { &display_filehandle(PAGER); close(PAGER); return $pid; } $paged_ = 1; # weirdest scope of all; this only lives in children? alarm(0); $SIG{'PIPE'} = IGNORE; $SIG{'INT'} = DEFAULT; $SIG{'QUIT'} = '_quit'; #$SIG{'ALRM'} = IGNORE; $SIG{'WINCH'} = IGNORE; # $SIG{'CHLD'} = 'HANDLER'; $| = 1; 0; } # MODULE fork_pretty_pager.pl v1.3 sub fork_pretty_pager { local($pid); if (!defined($pid = open(PAGER, "-|"))) { &warn("cannot fork pretty pager: $!"); return 1; } if ($pid) { local($_); local($maxlen) = 1; local($mylen); local(@list) = (); while () { s/\s+$//; $maxlen = $mylen if (($mylen = length($_)) > $maxlen); push(@list, $_); } close(PAGER); if (!@list) { &clear_bottom; return $pid; } $maxlen++; if (!defined($pid = open(PAGER, "-|"))) { &warn("cannot fork pretty pager 2: $!"); return 1; } if ($pid) { undef @list; &display_filehandle(PAGER); close(PAGER); return $pid; } $| = 1; #$SIG { 'ALRM' } = IGNORE; $SIG { 'INT' } = DEFAULT; $SIG { 'PIPE' } = DEFAULT; $SIG { 'QUIT' } = '_quit'; $SIG { 'WINCH' } = IGNORE; local($file) = int($cols / $maxlen); exit if !$file; local($rank) = int(($#list+$file)/$file); local($elt); for ($elt = 0; $elt < $rank * $file; $elt++) { $target = ($elt%$file) * $rank + int(($elt/$file)); $piece = sprintf("%-${maxlen}s", $target < ($#list+1) ? $list[$target] : ""); $piece =~ s/\s+$// if ($elt+1) % $file == 0; print $piece; print "\n" if ($elt+1) % $file == 0; } print "\n" if ($elt+1) % $file == 0; exit; } #$SIG {ALRM} = 'IGNORE'; $SIG {'INT'} = 'DEFAULT'; $SIG {'PIPE'} = 'DEFAULT'; $SIG {'QUIT'} = '_quit'; $SIG {'WINCH'} = 'IGNORE'; $| = 1; 0; # kid } # MODULE forward.pl v1.3 sub forward { &goto_message if $Count; local($id); &system('forw',$id = ¤t_msgid,$Current_Folder); local($Last_Typed) = ''; &fudge_folder_id; # anno updates &redraw; } sub fast_forward { &goto_message if $Count; local($mid) = ¤t_msgid; $Last_Command = 'forward'; $whom = &prompt("Forward message to whom: "); if (!$whom) { &clear_bottom; &warn("forw aborted"); return; } local($subject) = &get_current_subject; local($form); $form = &makeform(</dev/null"); &warn("forw failed!") if $?; unlink($form); &fudge_folder_id; # anno updates } # MODULE get_current_subject.pl v1.2 sub get_current_subject { local($path) = ¤t_msg_path; unless (open(FILE, $path)) { &warn("cannot open $path to get subjecdt: $!"); &throw("restart"); } local($/) = ''; local($*) = 1; local($_); $_ = ; close FILE; s/\n\s+/ /g; local($subject) = /^subject:\s*(.*)/i; &smsg("subject $subject") if $U{"debug"}; $subject; } # MODULE get_folder.pl v1.2 sub get_folder { local($folder); local($path); $kind_ = "Which" unless $kind_; $Next_Key = '+' unless $Demon_Running && kill(0,$Demon_Pid); return '' unless $folder = &prompt("$kind_ folder: "); $folder = &canonicalize($folder); if (! -d ($path = &folder2path(($folder =~ /(\+[^\s`]+)/)[0]))) { &warn("No such folder: $folder"); return ''; } $folder; } # MODULE get_next_line.pl v1.1 sub get_next_line { local($msg); if ($Movement_Direction eq 'up_line') { defined ($msg = &gnlu) || ($msg = &gnld); } else { defined ($msg = &gnld) || ($msg = &gnlu); } $msg; } sub gnld { local($i); for ($i = $Top_Line+$Current_Line+1; $i < @Scan_Lines; $i++) { return $i if !$Deleted{$Scan_Lines[$i]}; } undef; } sub gnlu { local($i); for ($i = $Top_Line+$Current_Line-1; $i >= 0; $i--) { return $i if !$Deleted{$Scan_Lines[$i]}; } undef; } # MODULE get_run_command.pl v1.3 sub get_run_command { local($prompt) = @_; local($cmd_word, $cmd_args); { local($done); &bottom_line; ($cmd_word,$done) = &complete($prompt, *Cmd_Names, 0); last if !$cmd_word || $done; print ' '; ($cmd_args, $done) = &read_eol($cmd_word . ' ', 1, 1); return () if !defined $done; redo if !$done; } return if $cmd_word eq ''; $cmd_word =~ s/^\s+//; $cmd_word =~ s/\s+$//; $cmd_args =~ s/^\s+//; $cmd_args =~ s/\s+$//; ($cmd_word, $cmd_args); } # MODULE goto_message.pl v1.4 sub goto_message { local($newcur); if ($Count == 0) { $newcur = @Scan_Lines - 1; } else { $newcur = $Scan_IDs{$Count}; } if (!defined $newcur) { &warn("No message $Count"); &throw('missing_message'); } undef $Count; local($U{"autotype"}) unless $Current_Cmd eq 'goto_message'; local($clear_plus_) = 1; &goto_line($newcur); } # MODULE goto_percent.pl v1.2 sub goto_percent { if (!$Count) { &warn("% needs a count"); return; } $Count = 100 if $Count > 100; &goto_line(int(@Scan_Lines * ($Count/100))); } # MODULE headers.pl v1.2 sub headers { &goto_message if $Count; local($file) = ¤t_msg_path; local($_); if (!&cachein($file)) { &warn("cannot type header on $file: $!"); return; } &fork_pager && return; while (<$file>) { last if /^$/; print; } exit; } # MODULE help.pl v1.4 sub help { local($key, $body); local($mask) = "%-5s%s\n"; &fork_pretty_pager && return; local($|) = 1; if (!$help_reversed_) { @key_list = sort help_alpha keys %Cmds; for $key (@key_list) { $Cmds{$key} = &func_body($Cmds{$key}); } } else { undef %newcmds; for $key (keys %Cmds) { $newcmds{$key} = &func_body($Cmds{$key}); } *Cmds = *newcmds; # i don't care; this is a dead-end process @key_list = sort help_by_value keys %Cmds; } for $key (@key_list) { $body = $Cmds{$key}; if ($key eq ' ') { $key = 'SPC'; } else { $key = &uncontrol($key); } printf $mask, $key, $body; } exit; } # MODULE home_screen.pl v1.3 sub home_screen { $Movement_Direction = 'down_line' if $U{'changemove'}; $Last_Typed = ''; &clear_plus; &goto_line($Top_Line); } # MODULE incorporate.pl v1.4 sub incorporate { if (!&got_mail) { &warn("No mail to incorporate"); return; } &quiet_commit; &system("inc -silent") || return; $Movement_Direction = 'down_line'; if ($Current_Seq ne '+inbox') { if ($Active_Folders{'+inbox'}) { &update_cur if @Scan_Lines && $Current_Folder; &activate_folder('+inbox'); &read_folder("cur-last"); &redraw; } else { &switch_folder('+inbox'); } } else { &read_folder("cur-last"); &redraw; } } # MODULE last_folder.pl v1.4 sub last_folder { &switch_folder($Active_Folders[$#Active_Folders]); return; } # MODULE list_active_folders.pl v1.2 sub list_active_folders { &fork_pager && return; # all variables after this go away... for (@Active_Folders) { $maxlen = length if $maxlen < length; } $maxlen += 3; $mask = "%-${maxlen}s %5d\n"; #printf $mask, "active folders", 0+@active; #print "\n"; foreach $folder (@Active_Folders) { $package = $Active_Folders{$folder}; eval "{ package $package; ".<<'EOF'."}"; $'name = $Current_Seq; $'count = @Scan_Lines; EOF &assert('!$@', $@); $name =~ s/^\+/ / unless $name eq $Current_Seq; printf $mask, $name, $count; } exit; } # MODULE list_folders.pl v1.2 sub list_folders { &dispatch_folder_demon unless $Demon_Running || @Folder_List; &reap_some_folders if $Demon_Running; &fork_pretty_pager && return; print @Folder_List; exit; } # MODULE list_sub_folders.pl v1.2 sub list_sub_folders { &fork_pretty_pager && return; &scan_folders(&folder2path($Current_Folder)); exit; } # MODULE load_new_func.pl v1.2 sub load_new_func { local($key, $name, $code) = @_; eval $code; if ($@) { $@ =~ s/file \(eval\)/$file_/; # $@ =~ s/line (\d+)/$1+$start/e; &warn("$@: $code"); &continue; &throw('oops'); } ($Function_Bodies{$name} = $code) =~ s/^\s*sub \w+ //; $Cmds{$key} = $name; 1; } # MODULE makeform.pl v1.2 sub makeform { local($body) = @_; local($name) = &tempname; open(FORM, ">$name") || die "can't create $name: $!"; print FORM $body; close(FORM); $name; } # MODULE mark_seen.pl v1.2 sub mark_seen { fork && return; close(STDOUT); close(STDERR); close(STDIN); exec('mark', '-delete', '-sequence', 'unseen', ¤t_msgid); exit; } # MODULE memo.pl v1.2 sub memo { local($memo) = $@; local($whom,$text) = split(' ',$memo, 2); if ($whom eq '') { last unless $whom = &prompt("Send a memo to whom? "); if ($text eq '') { last unless $text = &prompt("What single line of text? "); } } local($form); $form = &makeform(<= @Scan_Lines) { &warn("No remaining windows"); } else { $delta *= $Count if $Count; $newline = $Top_Line + $Current_Line + $delta; $newline = int($newline/$screen); $newline *= $screen; $Last_Typed = ''; $Movement_Direction = 'down_line' if $U{'changemove'}; &goto_line($newline); } } # MODULE paged_shell_command.pl v1.3 sub paged_shell_command { local($cmd) = @_; return unless $cmd = $cmd || ($dot && $Last_Shell) || &prompt('|'); $Last_Command = 'paged_shell_command'; $Last_Shell = $cmd; &fork_pager && return; &assert('$$ != $Start_Pid'); &shell_command($cmd); exit; } # MODULE pager_show.pl v1.2 sub pager_show { local($arg) = @_; &goto_message if $Count = $arg || $Count; &system($ENV{'PAGER'} || 'more', ¤t_msg_path); &cond_redraw; } # MODULE pick_subsequence.pl v1.2 sub pick_subsequence { local($_); $_ = &prompt("pick what? "); last if $_ eq ''; s/^(su(b(j(e(c(t)?)?)?)?)?)\s+/-$1 /i; s/^(f(r(o(m)?)?)?)\s+/-$1 /i; s/^(se(a(r(c(h)?)?)?)?)\s+/-$1 /i; s/^(t(o)?)\s+/-$1 /i; s/^(c(c)?)\s+/-$1 /i; s/$/ $Current_Seq/ unless /[+@]/; &switch_folder("`pick $_`"); } # MODULE pop_folder.pl v1.3 sub pop_folder { if (!@Folder_Stack) { &warn("No folders to pop"); return; } pop @Folder_Stack; &switch_folder($Folder_Stack[$#Folder_Stack]); } # MODULE prev_folder.pl v1.4 sub prev_folder { local($i); if ($Active_Folders[0] eq $Current_Seq) { &die("No previous active folders"); } for ($i = 1; $i <= $#Active_Folders; $i++) { if ($Active_Folders[$i] eq $Current_Seq) { &switch_folder($Active_Folders[$i-1]); return; } } &assert(0, $Current_Seq, @Active_Folders); } # MODULE print_version.pl v1.2 sub print_plum_version { &msg(&plum_version); } sub print_perl_version { &msg(&perl_version); } # MODULE prompt.pl v1.2 sub prompt { local($prompt) = @_; local($_); local($ok); &bottom_line; print $prompt; ($_, $ok) = &read_eol($prompt,1,0,1); if (!defined $ok) { &bottom_line; &throw('restart'); } s/^\s+//; s/\s+$//; $_; } # MODULE push_folder.pl v1.3 sub push_folder { local($folder) = @_; local($kind_) = "Push"; $folder = &get_folder unless $folder; return if $folder eq ''; push(@Folder_Stack, $folder) unless &catch('&switch_folder($folder)'); } # MODULE pwd.pl v1.2 sub pwd { local($cwd); chop($cwd = `pwd`); &msg($cwd); } sub chdir { local($dir) = shift || $HOME; chdir($dir) || &die("can't chdir to $dir: $!"); } # MODULE qprompt.pl v1.2 sub qprompt { &bottom_line; local($prompt) = @_; print $prompt; &getkey; } # MODULE quit_confirm.pl v1.2 sub quit_confirm { &quit if &qprompt("Really quit? ") =~ /y/i; &bottom_line; } # MODULE quit_nodelete.pl v1.3 sub quit_nodelete { &warn("skipping deletions") if %Deleted; &quit; } # MODULE read_eol.pl v1.2 sub read_eol { local($prompt, $with_folders, $quick_exit) = @_; local($return); local($c); while (($c = &getkey) !~ /[\n\r]/) { if ($c eq "\010" || $c eq "\177" || $c eq $my_erase) { if (length($return)) { print "\b \b"; chop($return); } else { return (undef, 0) if $quick_exit; next; } if (substr($return,-1) eq '+') { print "\b \b"; $c = chop($return); redo; } } elsif ($c eq $my_kill) { return (undef, 0) if $quick_exit; print "\r"; $return = ''; &clear_eol; print $prompt; next; } elsif ($c eq "\022") { $return = ''; print $prompt; next; } elsif ($c eq "\033") { return (undef,undef); } elsif ($c gt ' ' && $c lt "\177") { $return .= $c; print $c; if ($c eq '+' && $with_folders) { if ($'Demon_Running) { &'reap_some_folders; } local($folder, $done) = &complete($prompt . $return, *Folder_Names, 0); if (!defined($done)) { return (undef, undef); } else { $return .= $folder; last if $done; $return .= ' '; print ' '; } } } elsif ($c =~ /[ \t]/) { $return .= ' '; print $c; } } print "\r"; wantarray ? ($return, 1) : $return; } # MODULE reap_some_folders.pl v1.2 sub reap_some_folders { local($_); local($count); $Demon_Running || &dispatch_folder_demon; if (kill(0,$Demon_Pid)) { &bottom_line; print "[reaping folder listing from demon...] "; waitpid($Demon_Pid,0); } seek(FOLDER_DEMON, 0, 0) || &die("can't seek on folder demon's filehandle: $!"); local($name); while () { last if /^EOF$/; push(@Folder_List, $_); /^\s*(\d+)\s+(\S+)/ || next; $name = $2; $name .= ' ' unless $name =~ m!/$!; push(@Folder_Names, $name); } close(FOLDER_DEMON) || &die("folder daemon failed!"); $Demon_Running = 0; } # MODULE refile.pl v1.6 sub refile { local($dest) = @_; &goto_message if $Count; local($mid) = ¤t_msgid; if (defined $repeat_refile_) { $dest = $Last_Refile; } else { $Next_Key = '+' unless $dest || ($Demon_Running && kill(0,$Demon_Pid)); $dest = &prompt("Refile into where? ") if $dest eq ''; } if ($dest eq '') { &clear_bottom; &warn("Refile aborted"); return; } &die("Refiling into the same folder?") if $dest eq $Current_Folder; $dest = "+$dest" unless $dest =~ /^[-@+]/; $Last_Refile = $dest; $Last_Command = 'auto_refile'; &system("refile -src $Current_Folder $mid $dest"); &gotoyx($Current_Line); return 0 if $?; #local($go_up) = $Movement_Direction =~ /up/; #local($Movement_Direction) = 'nothing'; if ($dest !~ /-l(i(n(k)?)?)?/) { &set_folder_id; &uncache(¤t_msg_path); $Last_Typed = ''; local($dmid) = $mid; local($target) = $Top_Line + $Current_Line; splice(@Scan_Lines, $target, 1); delete $Scan_IDs{$mid}; for $mid (sort numerically keys %Scan_IDs) { next if $mid < $dmid; $Scan_IDs{$mid}--; } if (!@Scan_Lines) { &deactivate_folder($Current_Seq); &die("empty_folder"); } if ($Bar_Line == 1) { &up_line; return; } $Current_Line-- if $Current_Line == @Scan_Lines || $Movement_Direction eq 'up_line'; $Current_Message = $Scan_Lines[$Top_Line + $Current_Line]; $Last_Typed = ''; if (defined $TC{'dl'}) { print "\r", $TC{'dl'}; # just moved bar line. if (defined($Scan_Lines[$Top_Line+$Bar_Line])) { &gotoyx($Bar_Line-1); &display_line($Scan_Lines[$Top_Line+$Bar_Line]); } else { &gotoyx($Bar_Line-1); &display_line($Scan_Lines[$Top_Line+$Bar_Line-1]); } &draw_scroll_bar; &goto_line($Top_Line+$Current_Line); } else { &redraw; # you suffer w/o delete line } } #&autotype; #&next_line unless $?; 1; } # MODULE refresh.pl v1.2 sub refresh { $Last_Typed = ''; &redraw; } # MODULE reply.pl v1.3 sub reply { &goto_message if $Count; local($id); &system('repl',$id = ¤t_msgid,$Current_Folder); local($Last_Typed) = ''; &redraw; &fudge_folder_id; # anno updates } # MODULE reply_cc_all.pl v1.3 sub reply_cc_all { &goto_message if $Count; &system('repl -cc all -nocc me ',¤t_msgid, $Current_Folder); local($U{"autotype"}) = 0; &redraw; &fudge_folder_id; # anno updates } # MODULE reread.pl v1.4 sub reread { &commit_deletions; &update_cur; &read_folder(); &redraw; } # MODULE rethrow.pl v1.2 sub rethrow { die $@; } # MODULE reverse_help.pl v1.2 sub reverse_help { local($help_reversed_) = 1; &help(); } # MODULE reverse_search.pl v1.2 sub search_backward { local($targ) = @_; local($found); local($idx); $Search_Function = "search_backward"; if ($targ eq '') { $targ = &prompt("?"); &gotoyx($Current_Line) ; } if ($targ eq '') { if ($Last_Search eq '') { &warn("No previous search pattern"); return; } $targ = $Last_Search; } else { $Last_Search = $targ; } $idx = $Top_Line + $Current_Line - 1; eval <= 0; \$i--) { if (\$Scan_Lines[\$i] =~ /$targ/i) { \$found = \$i; last; } } EOS if ($@) { &warn($@); return; } if (defined $found) { local($clear_plus_) = 1; &goto_line($found); } else { &warn("?$targ? not found"); } } # MODULE scramble.pl v1.2 sub scramble { local(@new); srand($$ | time); push(@new, splice(@_, rand @_, 1)) while @_; @new; } # MODULE search_forward.pl v1.3 sub search_forward { local($targ) = @_; $Search_Function = "search_forward"; if ($targ eq '') { $targ = &prompt("/"); &gotoyx($Current_Line); } local($found); local($idx); if ($targ eq '') { # $Last_Search *NOT* main local if ($Last_Search eq '') { &warn("No previous search pattern"); return; } $targ = $Last_Search; } else { $Last_Search = $targ; } $idx = $Top_Line + $Current_Line + 1; eval <= $rows; #$val = int($rows/2) -1 if $val = 0; } $U{$var} = $val; &RESIZE if $var eq 'window'; &warn(&pvar($var)) unless $sourcing_; } sub setbool { local($var) = @_; &die("Bad variable name: $var") unless $var =~ /^\w+$/; if ($var =~ /no(\w+)/ && defined $U{$1}) { &die("$var is not a boolean") unless $UBool{$1}; $U{$1} = 0; &warn("$1 off") unless $sourcing_; return; } &die("No user variable $var") unless defined $U{$var}; if ($UBool{$var}) { $U{$var} = 1; &warn("$var on") unless $sourcing_; } else { &warn(&pvar($var)) unless $sourcing_; } } # MODULE shell_command.pl v1.2 sub shell_command { local($mid); local($cmd) = @_; &goto_message if $Count; $mid = ¤t_msgid; $Last_Command = 'shell_command'; return unless $cmd = $cmd || ($dot && $Last_Shell) || ($paged_ && exit) || &prompt("!") || $ENV{SHELL} || '/bin/sh'; $cmd = $Last_Shell if $cmd eq '!'; $Last_Shell = $cmd; local($cur_path) = &folder2path($Current_Folder); # replace % with mid, processing backslashes $cmd =~ s/\\(.)/"\376".ord($1)."\377"/eg; $cmd =~ s/#/$mid/g; $cmd =~ s!%!$cur_path/$mid!g; $foo =~ s/(\$\w+)/$1/eeg; $foo =~ s/(\@\w+)/$1/eeg; s/\376(\d+)\377/pack('C',$1)/eg; &system($cmd); &cond_redraw unless $paged_; } # MODULE show.pl v1.2 sub show { local($arg) = @_; $Count = $arg || $Count; &goto_message if $Count; &fork_pager && return; &system('show '.¤t_msgid, $Current_Folder); exit; } # MODULE show_marks.pl v1.2 sub show_marks { &system('mark'); } # MODULE show_status.pl v1.3 sub show_status { local($pack) = shift @_; require 'dumpvar.pl'; &fork_pager && return; if ($pack eq '') { local(@U_list); for (keys %_main) { next unless /^[A-Z]/; push(@U_list, $_) if eval "defined \$$_"; } &dumpvar('main',@U_list); } else { &dumpvar($pack, @_); } exit; } # MODULE show_variable.pl v1.5 sub show_variable { local($var) = @_; require 'dumpvar.pl'; local(@vars) = sort grep(eval "!defined &$_",grep(/^\w+/, keys %_main)); if ($var eq '') { last unless $var = &complete("Show which variable? ",*vars,0); } if ($var =~ /[^'\w\s]/) { eval "\@vars = grep(/\$var/, \@vars);"; if ($@) { $@ =~ s/at \(eval\) line \d+\.$//; &die("bad regexp: $@"); } } else { @vars = split(' ',$var); &die("No '$var' variables") unless grep(defined $_main{$_}, @vars); } &fork_pager && return; &dumpvar('main',@vars); exit; } # MODULE sortm.pl v1.3 sub sortm { &commit_deletions; &system("sortm",$Current_Folder); &read_folder(); &redraw; } # MODULE tail_syslog.pl v1.2 sub tail_syslog { &system("tail -f /usr/spool/mqueue/syslog"); &redraw unless &continue eq "\033"; } # MODULE toggle_print.pl v1.3 sub toggle_print { &set( ($U{"autotype"} ? "no" : "") . "autotype"); } # MODULE top.pl v1.3 sub top { &clear_plus; &goto_line(0); } # MODULE unbind.pl v1.2 sub unbind { local($key) = @_; if ($key eq '') { $key = &qprompt("Unbind what key? "); return if $key eq ''; print &uncontrol($key); } if (!defined $Cmds{$key}) { &warn("No current binding for ".&uncontrol($key)); return; } &msg("`" . &uncontrol($key) . "' no longer bound to `" . &func_body($Cmds{$key}) . "'"); delete $Cmds{$key}; } # MODULE undelete.pl v1.3 sub undelete { &goto_message if $Count; return unless defined $Deleted{$Current_Message}; delete $Deleted{$Current_Message}; # scary looking $Deleted--; #&clear_eol; $Last_Command = 'undelete'; &gotoyx($Current_Line); { local($U{"autotype"}) = 0; &display_line($Current_Message); } &next_line; } sub undelete_all { local($got_some); if ($got_some = %Deleted) { %Deleted = (); &redraw; } } # wish i could do this with mark, but cur is inviolate # # MODULE update_cur.pl v1.5 sub update_cur { return if $dont_update_cur_; local($curid) = ¤t_msgid; last unless $curid; local($oops) = `folder -fast $curid $Current_Folder 2>&1 1> /dev/null`; &warn("couldn't update cur to $curid in $Current_Folder: $oops") if $?; } sub mkseq { local($seqname, $seqnos, $folder) = @_; system('mark', '-seq', $seqname, split(' ',$seqnos), $folder || $Current_Folder); } sub addseq { local($seqname, $seqnos, $folder) = @_; system('mark', '-nozero', '-seq', $seqname, split(' ',$seqnos), $folder || $Current_Folder); } sub delseq { local($seqname, $seqnos, $folder) = @_; system('mark', '-del', '-seq', $seqname, split(' ',$seqnos), $folder || $Current_Folder); } sub rmseq { local($seqname, $folder) = @_; system('mark', '-del', 'all', '-seq', $seqname, $folder || $Current_Folder); } # MODULE usage.pl v1.4 sub usage { die < $id2[2]; } # MODULE yorn.pl v1.3 sub yorn { # (STRING) returns BOOLEAN #%%# #%%# Prompt the user with the given text string, and #%%# return whether he typed 'y' or 'n'. Make sure he #%%# types one or the other of these. #%%# local($|) = 1; local($key); { $key = &qprompt($_[0]); last if $key =~ /[yn]/i; &warn("Please answer yes or no [y or n]"); redo; } if ($key =~ /y/i) { print("Yes"); return 1; } else { print("No"); return 0; } } # MODULE zedzed.pl v1.2 sub zedzed { if (&getkey eq 'Z') { &quit; } else { &beep; } } &main(@ARGV);