#!MUNGERPATH

; Mush Copyright (c) 2013 James Bailie.
; All rights reserved.
;
; Redistribution and use in source form, with or without modification, are
; permitted provided that the following conditions are met:
;
;     * Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following disclaimer.
;     * The name of James Bailie may not be used to endorse or promote
; products derived from this software without specific prior written permission.
;
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS"
; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
; POSSIBILITY OF SUCH DAMAGE.

; SYNOPSIS
;
; mush [-c <command> | <filename> ]


; DESCRIPTION
;
; Mush is a job-control shell, written in Munger(1).  The shell's command set
; may be extended with lisp functions.  The shell provides features for
; interactive use, only.  Programming is accomplished in the underlying lisp
; dialect.


; START-UP

; The shell attempts to read lisp from the file ~/.mushrc at startup.  After
; ~/.mushrc has been read, the shell attempts to read commands from standard
; input, unless it has been given command line arguments.

; The shell recognizes one option only, the -c option.  If present, it must
; be followed by a command-line to be run.  The shell runs the command and
; then exits.  Note this argument is an actual literal command-line, not a
; filename of commands to be run.

; Any other command-line arguments are assumed to be filenames to read
; shell commands from.  After all the files have been processed, the shell
; will then exit.


; COMMAND-LINE STRUCTURE, COMMAND AND FILENAME COMPLETION

; The shell gets its input via Munger's 'getline' intrinsic.  If stdin is a
; terminal, command-line editing, command and filename completion, as well as
; a command history are all available.  See the entry for 'getline' in the
; Munger manual page for full details on how these mechanisms work.

; More than one command may also be entered in one line of input, but only if
; each command is separated from its neighbors with a space-delimited
; semi-colon.

; ls ; cd ..

; Output from the shell which is wrapped in square brackets has actually
; been sent to stderr.  Prompts are printed to stdout.

; : cd
; [ /home/jbailie ]

; The shell recognizes the backslash as a line-continuation character, but
; only if it is separated from the preceding command-line elements by
; whitespace.  To cancel a command in progress, input a blank line.

; : ls \\
; : *cgi
; blog.cgi
; client.cgi
; login.cgi


; GLOBBING

; Shell glob patterns in unquoted command arguments will be recognized and
; substituted apropriately.  The command position never undergoes
; glob-expansion.


; QUOTING

; There is only one quoting mechanism, the double-quote:  "quoted element".

; Single command-line tokens which contain whitespace must be quoted to be
; recognized by the shell as single tokens.

; Quoting suppresses glob and alias expansion.

; Quoting the tokens '\\', '&', '|', ';', '>', '>>', '2>', and '2>>' causes
; the shell to treat them as literal values, and not shell instructions.

; Munger's command and filename completion mechanism will work with commands
; and filenames containing whitespace, but will not quote these
; items.  The user must quote these items manually.

; To embed literal quotes in the command line, whether or not they are part
; of quoted elements, each individual " must be escaped with a backslash.

; : echo \\"foobar\\"
; "foobar"
; : echo "embedded whitespace and quotes: \\"foobar\\""
; embedded whitespace and quotes: "foobar"


; JOB CONTROL

; A process may be started in the background by passing a last command
; line element consisting of the ampersand character '&'.  It must be
; separated from the command arguments by whitespace in order for it to be
; recognized by the shell.

; A user may stop a foreground process group by pressing Control-Z.  The
; stopped process group may be restarted in the foreground by invoking 'fg'.
; The process group may be restarted in the background by invoking 'bg'.

; An invocation of 'fg' or 'bg' without an argument will restart the most
; recently stopped process.

; If that process exits, then another invocation of 'fg' or 'bg' without
; argument will start the next most recently stopped process.

; If there are no stopped processes, but there are background processes, then
; 'fg' without argument will foreground the most recently-backgrounded
; process.

; 'fg' may be invoked with a single argument, which must be the process group
; id of a stopped or backgrounded process group to be started in the
; foreground.

; 'bg' may be invoked with a single argument, which must be the process group
; id of a stopped process group to be started in the background.

; The pgids of stopped and background processes may be ascertained with
; the 'jobs' command.  If the output from 'jobs' is longer than the height
; of the screen, stderr may be redirected to file.

; If the user attempts to exit the shell with Control-D when there are
; stopped jobs, the shell will complain.  Invoking 'exit' will cause
; the shell to exit unconditionally.


; REDIRECTIONS

; The last command line arguments (before the '&' if it is present on the
; command-line), may be redirection instructions.  Redirection instructions
; consist of a redirection symbol followed by a filename.  The filename must
; be separated from the symbol by whitespace.  Redirection symbols are one of
; '>', '>>', '2>', '2>>', or '<'.

; > filename

; instructs the shell to redirect the standard output of the associated
; command to the specified file.

; >> filename

; works similarly, but indicates the file should be opened in append mode.

; 2> filename

; instructs the shell to redirect the standard error of the associated
; command to the specfied file.

; 2>> filename

; works similarly, but indicates the file should be opened in append mode.

; < filename

; Instructs the shell to redirect the standard input of the associated
; command to the specified file.

; Glob patterns are not recognized in redirection instruction filenames
; whether or not they are quoted, but they are subject to quote processing
; and environment variable interpolation.  In other words an unquoted
; filename argument behaves as if it were quoted.  There are four special
; cases where the filename is interpreted as a file descriptor:

; > 2

; means stdout is to be redirected onto stderr.

; >> 2

; equivalent to the above.

; 2> 1

; means stderr is to be redirected onto stdout.

; 2>> 1

; equivalent to the above.

; If one wishes to redirect to a file named '1' or '2' then one must
; qualify the filename.  Note that redirection instructions must be
; contiguous tokens of non-whitespace characters.  These two commands are not
; equivalent:

; : program 2> filename
; : program 2 > filename

; The first command runs 'program' with no arguments and stderr redirected
; to 'filename', while the second command runs 'program' with one argument
; named 2, and with stdout redirected to 'filename'.

; The shell redirects stdout before redirecting stderr, regardless of the
; order in which the redirections occurred on the command line.  So, if you
; wish to redirect stdout and stderr onto the same file, both of the
; following commands will do it:

; cat > filename 2> 1
; cat 2> 1 > filename

; This command will not do it:

; cat 2> filename > 2

; The shell would redirect stdout onto stderr first, and then redirect stderr
; onto the file.  This means stdout would remain redirected to the original
; stderr stream.  It also means the only real use of > 2 is to send stdout to
; the original stderr stream.


; PIPELINES

; To create a pipeline each command in the pipeline must be separated from
; its neighbor with a '|', itself separated from its neighbors by whitespace.

; Note that redirections for each process in the pipeline may be specified
; before the |, but that only stderr redirections will be attempted, except
; for the first process in the pipeline, where stdin redirection will be
; attempted as well, and the last process, where only stdout and stderr
; redirections will be attempted.

; : jot 100 | fmt | grep 100
; 92 93 94 95 96 97 98 99 100

; If the commands in a pipeline are long, one can break up the pipeline and
; input each command on a separate line.  To do this, all the commands,
; excepting the last, must have the '|' character as their last element.  The
; shell will continue to prompt for more commands until one is entered which
; does not end with '|'.

; : jot 100 |
; : fmt |
; : grep 100
; 92 93 94 95 96 97 98 99 100

; To cancel a pipeline line in progress, enter a blank line.

; A pipeline can be started in the background, in the same manner as an
; ordinary command:

; : jot 100 | fmt | grep 100 &

; This particular pipeline would receive SIGTTOU, stopping it, as soon as
; grep attempted to print to the terminal.


; ALIASES

; Abbreviations may be defined which will be recognized and expanded where
; the abbreviation text is unquoted and delimited by whitespace.  The 'alias'
; and 'unalias' define and undefine, respectively, aliases.  The alias
; command accepts two or more arguments, the first of which is the
; abbreviation, while the rest form the expansion.

; alias ll ls -l
; [ ll => ls -l ]
; alias lf ls -F
; [ lf => ls -F ]

; The aliases command lists the currently defined aliases.

; aliases
; [ ll => ls -l ]
; [ lf => ls -F ]

; To define aliases in the user's ~/.mushrc, abbreviations are mapped to
; lists of tokens in the aliases table.

; (hash aliases "ll" '("ls" "-l"))
; (hash aliases "lf" '("ls" "-F"))
; (hash aliases "ff" '("firefox" ">" "/dev/null" "2>" "1" "&"))
; (hash aliases "sl" '("sylpheed" ">" "/dev/null" "2>" "1" "&"))

; One feature I did not implement is subshell command interpolation where a
; backtick-delimited command is run in a subshell, and its output
; is interpolated into the command line.  You can use a stdin redirection
; or a pipe to xargs -I or -J to accomplish similar tasks.

; xargs -J % kill -TERM % < /var/run/httpd.pid
; cat /var/run/syslog.pid /var/run/sendmail.pid | xargs -J % kill -HUP %


; CHANGING DIRECTORIES

; The shell has an internal 'cd' command to change the current working
; directory.  Invoked without arguments, it will make the user's home
; directory the current working directory.  Invoked with '-' as argument, it
; will attempt to change to the directory which was the previous current
; working directory before the last invocation of 'cd' .  If the argument to
; 'cd' is unquoted it undergoes glob-expansion.  If the glob-expansion
; produces more than one result, the first is used.


; MODIFYING THE PROMPT

; The user may change the string used as the command prompt with the
; 'prompt' shell command.  Environment variable interpolation,
; quote-processing, and glob-expansion are performed on the argument.  If the
; user provides more than one argument, or glob-expansion results in more
; than one argument, the first is used.

; : prompt "$ "
; $

; The user may change the prompt in their ~/.mushrc by assigning a string to
; the 'prompt' global.


; MODIFYING PATH

; If the user changes the PATH environment variable or adds executables to
; the directories specified by the variable, then he or she must invoke the
; shell's 'rescan' command in order to get the Munger interpreter to update
; its internal list of executables.


; EXEC-ING NEW PROCESS IMAGES

; The shell has an 'exec' command to replace itself with a new process image.
; Any command preceded by 'exec' on the command line replaces the shell, so
; that when the command exits, one will be dumped back to where one was
; before the shell started, which may be the login prompt.


; PROGRAMMING

; Entering a lone '.' in the command position will cause the shell to drop
; down to a Munger interpreter prompt where lisp may be evaluated.  Control-D
; or '_' exits back to the shell.


; INITIALIZING THE ENVIRONMENT

; Lisp may be inserted into ~.mushrc to be executed at start-up to define
; environment variables and user-functions.

; (setenv "CLICOLOR"  "1")
; (setenv "EDITOR"    "dkns")
; (setenv "PAGER"     "more")
; (setenv "BLOCKSIZE" "K")
; (setenv "PATH"      "/usr/local/bin:/usr/bin:/bin/:/sbin:/usr/sbin")
; (setenv "HOME"      "/home/jbailie/")


; USER-DEFINED FUNCTIONS

; When the shell is processing commands, any item in command position, which
; is not recognized as an executable or shell command, is looked-up in the
; 'functions' table.  This table maps command name strings to closures.  A
; lisp function inserted into the functions table must be defined to accept a
; variable length argument list.  If a lisp function encounters an error the
; shell will exit, perhaps terminating your login, so user functions should
; be well-tested.  User functions may be defined at the lisp prompt or
; specified in ~/.mushrc

; The 'cd', 'expand_items', and 'fork_it' helper functions are exposed for
; use by user code.  The 'functions' and 'aliases' tables, the 'pipecmds'
; list, the 'last_status' variable, and the 'prompt' string are also
; available.

; Note that the only items given to the lisp function are the command's
; arguments, after variable and subshell interpolation and alias expansion
; have been performed.  Redirection instructions, and '&' and '|' will all
; have been stripped away.  Glob expansion and quote processing WILL NOT have
; been performed on the arguments.

; In the following example, the 'fork_it' function performs glob-expansion
; and escape removal for us.  This allows user functions to create argument
; lists for 'fork_it' using glob patterns, and also to quote literal items
; resembling glob patterns to prevent expansion.  'fork_it' will also perform
; any redirections which were specified on the command line.

; (hash functions
;  "up"
;  (let ((cmd (command_lookup "scp")))
;     (lambda ((args))
;        (fork_it 0
;           cmd
;           (append args (list "root@mammothcheese.ca:/usr/local/www/html/"))))))

; The first argument to 'fork_it' is a boolean indicating whether or not the
; process should be run in the background.  Here, 0 indicates it will be run
; in the foreground.  The second argument is the fully-qualified path to the
; command to be run.  We use the 'command_lookup' intrinsic to find the
; location of 'scp' for us.  The third argument is a list of the arguments to
; be passed to the command.  We simply append another argument to the ones
; the user has supplied to complete the 'scp' command.

; After this definition has been evaluated, this shell command:

; : up *.html

; will be equivalent to this shell command:

; : scp *.html root@mammothcheese.ca:/usr/local/www/html/

; The 'fork_it' function returns the exit status of the command if it exited,
; or it returns the signal number that either killed or stopped the process.

; The function has another use, triggered by the presence of an optional
; fourth argument.  If present, the fourth argument, regardless of its value,
; indicates that 'fork_it' should impose a pipe between itself and the
; command, and gather up the command's output and return it as a single
; string, instead of returning the exit status/signal number.  Note that when
; the fourth argument is present, 'fork_it' will ignore the first argument,
; and always run the command in the background so that job control signals
; cannot stop the command while 'fork_it' is gathering up the command's
; output.

; (fork_it 0 (command_lookup "ls") '("*munger") 1)
; "cal.munger
; cat.munger
; cgi.munger
; dkns.munger
; ed.munger
; err.munger
; fcgi.munger
; filter.munger
; fmt.munger
; google.munger
; grep.munger
; incorporation.munger
; library.munger
; mbox2munger.munger
; mime2munger.munger
; msh.munger
; options.munger
; rss.munger
; tags.munger
; tk.munger
; transform.munger
; view.munger
; xml2alist.munger
; xml2sqlite.munger
; xmlquery.munger
; xmlsqlite.munger
; "

; The 'last_status' global contains the exit status of the last command run
; in the foreground, or the signal number of the signal which killed/ stopped
; it.  Here is a user-function which makes use of it:

; (hash functions
;  "and"
;  (let ((cmd ""))

;     (lambda ((args))
;        (when args

;           (unless last_status
;              (setq cmd (substring (car args) 0 1))

;              (if (or (eq "." cmd) (eq "/" cmd))
;                 (setq cmd (car args))
;                 (setq cmd (command_lookup (car args))))

;              (fork_it 0 cmd (cdr args)))))))

; One could use this function when compiling:

; : make ; and make install

; This function will expose the value of last_status to the user:

; (hash functions
;    "status"
;    (lambda ((ignored))
;       (warn "[ " last_status " ]")))

; The 'cd' utility function accepts a string specifying the directory to
; change to or a false boolean ("", (), or 0), which means to change to the
; user's home directory.  If the string is '-' the function works just like
; invoking 'cd -' at the command prompt, as described earlier in this
; comment.

; The 'expand_items' utility function accepts the argument list passed to the
; lisp function and returns a new list with each of the items processed
; appropriately for quotes and glob-expansion.  Note that 'fork_it' calls
; this function itself.  It is provided for use in situations where the
; user-function does not call 'fork_it'.

; Here is a custom "detab" function to expand tabs in a set of files to a
; maximum of 3 spaces:

; (hash functions
;  "detab"

;  (let ((tmp "") (line ""))

;     (lambda ((args))
;        (setq args (expand_items args))

;        (while args
;           (with_output_file (setq tmp (concat (car args) ".tmp"))
;              (with_input_file (car args)
;                 (while (setq line (getline))
;                    (print (expand 3 line)))))

;           (rename tmp (car args))
;           (setq args (cdr args))))))

; This user-function rips an audio cd into .mp3 files.  The input device is
; specified as argument.

; (hash functions
;    "ripit"

;    (let ((conv (command_lookup "dagrab"))
;          (lame (command_lookup "lame")))

;        (lambda ((args))
;           (if (not args)
;              (warn "[ DEVICE NAME REQUIRED ]")

;              (fork_it 0 conv (cons "-a" (cons "-d" args)))
;              (foreach
;                 (lambda (x)
;                    (fork_it 0 lame (list x (concat (rootname x) ".mp3"))))
;                 (glob "*.wav"))))))

; It would be invoked like this:

; : ripit /dev/acd0

; Here is a user-function which provides functionality similar to a "here"
; document in other shells.  It accepts an end token preceding a command
; line, as arguments.  It then reads lines of text from the terminal until it
; encounters a line consisting of just the end token, which it discards.  The
; collected lines are written to a temporary file, and then the specified
; command line is run with its standard input redirected onto the temporary
; file.  After the command terminates, the temporary file is deleted.

; (hash functions
;    "collect"
;    (lambda ((args))

;       (let ((tmp "")
;             (file "")
;             (tst "")
;             (here (stack)))

;          (if (< (length args) 2)
;             (warn "[ USAGE: collect <end> <cmd> <arg>* ]")

;             (until (eq (car args) (if (setq tmp (getline "collect: " 8))
;                                       (setq tmp (chomp tmp))
;                                       ""))
;                (push here tmp))

;             (setq file
;                (with_temporary_output_file
;                   (foreach println (flatten here))))

;             (setq args (cdr args))
;             (setq cmd (substring (car args) 0 1))

;             (if (or (eq "." cmd) (eq "/" cmd))
;                 (setq cmd (car args))
;                 (setq cmd (command_lookup (car args))))

;             (protect
;                (with_input_file file
;                   (fork_it 0 cmd (cdr args)))

;                (unlink file))

;             (clear here (length here))))))

; User functions do not participate in pipelines described on the
; command-line, but user functions may create pipelines.  The programmer
; places lists of items describing each command onto the 'pipecmds' list in
; reverse order, for all but the last command in the pipeline.  The
; programmer then invokes \'fork_it' on the last command.  Each sublist in
; the 'pipecmds' list consists of four elements.

; First, a boolean false ("", (), or 0), or a two-element list consisting of
; a filename onto which to redirect standard error, and a boolean indicating
; whether or not to open the file in append mode.

; Second, the fully-qualified path to the command.

; Third, a list of the command's arguments as they would appear before
; quote-processing and glob expansion.  Environment variable and subshell
; interpolation, and alias expansion will not be performed on these items.

; Fourth, a false boolean, or a filename to redirect stdin onto.

; Any command in the pipeline may specify a stderr redirection, but only the
; first command in the pipeline (but last on the list) should specify a stdin
; redirection.  If you include a stdin redirection for other processes in the
; pipeline, you will break the pipeline.  Output redirections for the last
; process in the pipeline can be specified on the command line when the user
; function is invoked.  The example below is the equivalent of
; ls | fmt -l 35 | grep -n foobar.

; (hash functions
;    "myfunc"

;    (let ((ls (command_lookup "ls"))
;          (fmt (command_lookup "fmt"))
;          (grep (command_lookup "grep")))

;       (lambda ((args))
;          (setq pipecmds (qquote '((0 ,fmt ("-l" "35") 0)
;                                   (0 ,ls  ()          0))))

;          (fork_it 0 grep '("-n" "foobar")))))

; If the pipeline did not print to the terminal, we could have given a first
; argument of 1 to 'fork_it' to cause the pipeline to be run in the
; background.

; -----------------------------------------------------------------------

; Program text.

(fatal)

; Blocks SIGHUP, SIGINT, SIGQUIT, SIGTTOU, SIGTTIN, and SIGTSTP.
; It is particularly necessary for us to block SIGTTOU or the shell will
; not be allowed to invoke "tcsetpgrp" when it is a background process,
; preventing job control from working.

(block)

; This stops the interpreter from reaping zombies, so the shell can know
; when processes change state.

(zombies)

; This table maps strings to closures.  Each string names a user-function
; and is mapped to the closure implementing the user-function.

(setq functions (table))

; This table maps strings to lists defining aliases.

(setq aliases (table))

; The initial string used for the prompt.

(setq prompt (concat (car (geteuid)) ": "))

; A list to contain the items in a pipeline.

(setq pipecmds ())

; Holds the exit status of the last command run in the foreground,
; or the signal number which killed/stopped it.

(setq last_status 0)

; Get the saved command line history, if any.

(load_history (join "/" (getenv "HOME") ".mush_history"))

; The whole program is wrapped in a closure to create a namespace
; unavailable to the user when he or she is working at the lisp prompt
; via "interact".

; This prevents the user from inadventently changing the shell program
; itself.

(let ((stopped         ()) (background      ()) (names     (table))
      (remove_quotes    0) (do_alias         0) (do_unalias       0)
      (do_exec          0) (do_prompt        0) (do_jobs          0)
      (expand_alias     0) (main             0) (do_aliases       0)
      (wait_for_bg      0) (wait_for_it      0) (fg               0)
      (bg               0) (get_redirections 0) (get_redir0       0)
      (get_redir1       0) (get_redir2       0) (do_redirections  0)
      (escape           0) (remove_slash     0) (spawn_pipeline   0)
      (check_cmd        0) (process_command  0) (try_it           0)
      (quote_rx (regcomp "\"")))


; This function blocks in "wait" until the specified process stops or
; exits.  We call it after starting a foreground process to reap its
; zombie or report it to the user as stopped.

(defun wait_for_it (pid)
   (setq pid (wait pid))
   (tcsetpgrp (getpgrp))

   (when (eq 'STOPPED (cadr pid))
      (setq stopped (cons (car pid) stopped))
      (warn "")
      (warn "[ PROCESS GROUP " (car pid) " " (cadr pid) "; SIGNAL " (caddr pid) " ]"))

   (when (eq 'KILLED (cadr pid))
      (unhash names (car pid)))

   (caddr pid))

; This function is called once for each iteration of the command-processing
; loop to reap the zombies of any exited background processes, and to
; report the status of any stopped background processes.  The items on the
; background list are all process group ids.

(defun wait_for_bg ((pid))
   (setq background
      (remove 0
         (mapcar
            (lambda (x)
               (cond ((eq -1 (car (setq pid (wait x 1)))) 0)

                     ((not (car pid)) x)

                     (1 (when (eq 'STOPPED (cadr pid))
                           (setq stopped (cons (car pid) stopped)))
                        (warn "[ BACKGROUND PROCESS GROUP " (car pid) " "
                           (cadr pid) "; STATUS/SIGNAL " (caddr pid) " ]")
                        (unhash names (car pid))
                        0)))

            background)))

   ; Pick up any zombies from pipeline processes other than the process
   ; group leader.

   (while (> (car (wait -1 1)) 0)
      (unhash names (car pid))))

; Function to foreground the most recent stopped or backgrounded process.

(defun fg ((pid))

   (if (not pid)
      (if (not stopped)
         (if (not background)
            (warn "[ NO STOPPED OR BACKGROUND PROCESS GROUPS ]")

            (setq pid (car background))
            (setq background (cdr background)))

         (setq pid (car stopped))
         (setq stopped (cdr stopped))
         (setq background (remove pid background)))

      (setq pid (digitize (car pid)))
      (if (not (or (member pid stopped)
                   (member pid background)))
         (progn
            (warn "[ NO STOPPED OR BACKGROUNDED PROCESS GROUP WITH PGID " pid " ]")
            (setq pid 0))

         (setq stopped (remove pid stopped))
         (setq background (remove pid background))))

   (when pid
      (tcsetpgrp pid)
      (killpg pid 19)
      (wait_for_it pid)))

; Function to background the most recently-stopped process.

(defun bg ((pid))
   (if (not stopped)
      (warn "[ NO STOPPED PROCESS GROUPS ]")

      (if pid
         (if (not (member (setq pid (digitize (car pid))) stopped))
            (warn "[ NO STOPPED PROCESS GROUP WITH PGID " pid " ]")

            (setq stopped (remove pid stopped)))

         (setq pid (car stopped))
         (setq stopped (cdr stopped)))

      (setq background (cons pid background))
      (killpg pid 19)))

; Function to ensure that the command specified on the command line
; exists, before we attempt to "fork_it".

(defun check_cmd (item (tmp))
   (if (or (eq "." (setq tmp (substring item 0 1)))
           (eq "/" tmp))

      (when (and (eq (exists item) 1)
                 (access item 0)
                 (access item 2))
         item)

      (command_lookup item)))

; Group of functions to parse redirection instructions from the command
; line and store them, and to perform the redirections at a later time.

(let ((redir_rx (regcomp "^(2?)(>>?)$"))
      (m ()) (redir0 0) (redir1 0) (redir2 0)
      (tmp 0) (redir "") (file "") (app 0))

   (defun get_redirections (items)
      (setq redir0 (setq redir1 (setq redir2 0)))

      (catch
         (while (>= (length items) 3)
            (setq file (car items))
            (setq redir (cadr items))

            (cond ((setq m (matches redir_rx redir))
                   (setq app (if (eq (caddr m) ">") 0 1))
                   (if (not (cadr m))
                      (setq redir1 (list (escape file) app))
                      (setq redir2 (list (escape file) app))))

                  ((eq redir "<") (setq redir0 (escape file)))

                  (1 (throw items)))

            (setq items (cddr items)))

         items))

   (defun get_redir0 () redir0)
   (defun get_redir1 () redir1)
   (defun get_redir2 () redir2)

   (defun try_it (desc file app)
      (setq tmp (exists file))

      (cond ((and (not desc) (not tmp))
             (beep)
             (warn "[ " file " DOES NOT EXIST ]"))

            ((and (or (not desc) (and desc app tmp))
                  (or (eq tmp 2) (eq tmp 3) (eq tmp 4) (eq tmp 8)))
             (beep)
             (warn "[ " file " IS NOT A FILE, FIFO, SYMLINK, OR SOCKET ]"))

            ((stringp (setq tmp (if desc (redirect desc file app) (redirect 0 file))))
             (beep)
             (warn "[ " file ": " tmp " ]"))

            ((< tmp 0)
             (beep)
             (warn "[ " file ": " (case tmp (-1 "DOES NOT EXIST")
                                            (-2 "PERMISSION DENIED")
                                            (-3 "LOCKED")) " ]"))))

   (defun do_redirections ()
      (catch
         (when redir0
            (when (try_it 0 redir0 0)
               (throw 0)))

         (when redir1
            (if (eq "2" (car redir1))
               (stdout2stderr)
               (when (try_it 1 (car redir1) (cadr redir1))
                  (throw 0))))

         (when redir2
            (if (eq "1" (car redir2))
               (stderr2stdout)
               (when (try_it 2 (car redir2) (cadr redir2))
                  (throw 0))))

         1)))

; Closure provides some regexps and temporary variables to
; a group of functions.

(let ((delim_rx (regcomp "^\"(.*)\"$"))
      (quote_rx (regcomp "\\\\\""))
      (glob_rx (regcomp "[]~[{}*?]"))
      (slash_rx (regcomp "/$"))
      (old_dir "")
      (tmp "")
      (tmp2 "")
      (tmp3 ""))

   ; Strips delimiter quotes from quoted items, and unescapes escaped
   ; quotes in both quoted and unquoted items.

   (defun escape (str)
      (substitute quote_rx "\""
         (substitute delim_rx "\1" str) 0))

   ; Implements the "cd" shell command.

   (defun cd (dir)
      (when dir
         (if (match delim_rx (setq tmp dir))
            (setq tmp3 (escape tmp))
            (setq tmp3 (substitute quote_rx "\"" tmp 0))

            (when (setq tmp (glob tmp3))
               (setq tmp3 (car tmp)))))

      (cond ((not dir)
             (setq tmp3 (pwd))
             (if (stringp (setq tmp (chdir (setq tmp2 (getenv "HOME")))))
                (warn "[ " (upcase tmp 1) " ]")
                (setq old_dir tmp3)
                (warn "[ " tmp2 " ]")))

            ((eq "-" tmp3)
             (if (not old_dir)
                (warn "[ NO PREVIOUS DIRECTORY ]")

                (setq tmp2 (pwd))
                (if (stringp (setq tmp (chdir old_dir)))
                   (warn "[ " (upcase tmp 1) " ]")

                   (warn "[ " old_dir " ]")
                   (setq old_dir tmp2))))

            ((and (setq tmp2 (pwd)) (stringp (setq tmp (chdir tmp3))))
             (warn "[ " (upcase tmp 1) " ]"))

            (1 (setq old_dir tmp2)
               (warn "[ " (pwd) " ]"))))

   ; Removes trailing slash from glob-expanded items which are
   ; directories, so command like this work as expected:

   ; : ls | grep *munger

   (defun remove_slash (item)
      (substitute slash_rx "" item))

   ; Remove delimiting quotes from argument.

   (defun remove_quotes (item)
      (substitute delim_rx "\1" item 1))

   ; Performs quote-processing and glob-expansion over an
   ; entire argument list.

   (defun expand_items (items)
      (setq tmp items)
      (setq items ())

      (while tmp
         (if (match delim_rx (car tmp))
            (setq items (cons (escape (car tmp)) items))

            (setq tmp3 (substitute quote_rx "\"" (car tmp) 0))

            (if (and (match glob_rx tmp3) (setq tmp2 (glob tmp3)))
               (setq items (append (mapcar remove_slash tmp2) items))
               (setq items (cons tmp3 items))))

         (setq tmp (cdr tmp)))

      (reverse items))

   ; Function to spawn a pipeline off of the stdin of a child process
   ; created by "fork_it".  Does any pending redirections for each process
   ; along the way.  The "fork_it" child is the process group leader, and
   ; the last element in the pipeline.

   (defun spawn_pipeline (cmd items (pid))
      (setq pipecmds (reverse pipecmds))

      (while pipecmds
         (setq tmp3 (expand_items (caddr (car pipecmds))))
         (setq tmp (car pipecmds))

         (case (setq pid (forkpipe 0))
            (-1 (warn "[ COULD NOT FORK ]"))

            (0  (when (setq tmp2 (cadddr tmp))
                   (try_it 0 tmp2 0))

                (when (setq tmp2 (car tmp))
                   (if (eq "1" (car tmp2))
                      (stderr2stdout)
                      (try_it 2 (car tmp2) (cadr tmp2))))

                (when (stringp (cadr tmp))
                   (apply exec (cons (cadr tmp) tmp3)))
                (exit 1)))

         (setq pipecmds (cdr pipecmds)))

      (when (setq tmp (get_redir1))
         (if (eq "2" (car tmp))
            (stdout2stderr)
            (try_it 1 (car tmp) (cadr tmp))))

      (when (setq tmp (get_redir2))
         (if (eq "1" (car tmp))
            (stderr2stdout)
            (try_it 2 (car tmp) (cadr tmp))))

      (apply exec (cons cmd items))
      (exit 1)))

; Function to fork a new process, and establish new process group.
; Causes redirections to be performed, and pipelines to be spawned.

(let ((pid 0) (str "") (line ""))

   (defun fork_it (start_bg cmd items (flag))
      (setq items (expand_items items))

      ; Turn-off garbage collection during process creation, to
      ; make it happen faster.

      (case (setq pid (if flag (forkpipe 0) (fork)))
         (-1 (warn "[ COULD NOT FORK ]"))

         (0  (setpgid 0 0)
             (unless (or start_bg flag)
                (tcsetpgrp (getpgrp)))
             (unblock)

             (if pipecmds
                (spawn_pipeline cmd items)
                (when (do_redirections)
                   (apply exec (cons cmd items)))
                (exit 1)))

         (?  (setpgid pid pid)
             (hash names pid cmd)

             (if start_bg
                (setq background (cons pid background))

                (if (not flag)
                   (progn
                      (tcsetpgrp pid)
                      (setq last_status (wait_for_it pid)))

                   (setq str "")
                   (while (setq line (getline))
                     (setq str (concat str line)))
                   (resume 0)
                   (canon)
                   (setq last_status (wait_for_it pid))
                   str))))))

; Function to implement the "exec" shell command.

(let ((c ""))

   (defun do_exec (items)
      (when items
         (setq c (substring (car items) 0 1))
         (apply exec (cons (if (or (eq c "/") (eq c "."))
                              (car items)
                              (command_lookup (car items)))
                           (expand_items (cdr items)))))))

; Function to change the command prompt.

(defun do_prompt (items)
   (if (not items)
      (warn "[ PROMPT STRING MUST BE PROVIDED ]")
      (setq prompt (car (expand_items items)))))

; Function to display jobs running in the background.

(defun do_jobs ()
   (do_redirections)

   (warn "[ BACKGROUND JOBS: " (length background) " ]")
   (foreach
      (lambda (pid) (warn "[ " pid ": " (lookup names pid) " ]"))
      background)

   (warn "[ STOPPED JOBS: " (length stopped) " ]")
   (foreach
      (lambda (pid) (warn "[ " pid ": " (lookup names pid) " ]"))
      stopped))

; Functions to manage aliases.

(let ((k ()))
   (defun do_aliases ()
      (if (not (setq k (keys aliases)))
         (warn "[ NO ALIASES DEFINED ]")

         (foreach
            (lambda (k)
               (warn "[ " k " => " (join " " (lookup aliases k)) " ]"))
            k))))

(defun do_alias (args)
   (if (< (length args) 2)
      (warn "[ USAGE: alias <alias> <token>+ ]")

      (if (match quote_rx (car args))
         (warn "[ ALIASES CANNOT CONTAIN QUOTE CHARACTERS ]")

         (hash aliases (car args) (cdr args))
         (warn "[ " (car args) " => " (join " " (cdr args)) " ]"))))

(defun do_unalias (args)
   (if (not (eq (length args) 1))
      (warn "[ USAGE: unalias <alias> ]")

      (unhash aliases (car args))
      (warn "[ ALIAS " (car args) " REMOVED ]")))

; This function accepts a single command plucked out of the command line
; by "main" and rendered into a reversed list of discrete strings, and
; determines what to do with them.  Each item in a multiple-command command
; line or pipeline will be passed as a separate list to this function.

; The function first determines whether the command should be run in the
; foreground or the background.  If it is part of a pipeline, when that
; information will be included with the last command in the pipeline.

; Then it determines if the command is a user-function, a shell command
; or an external command.  If it is an external command, the function
; verifies the command exists and is executable.

; If the process is a command, a shell function, or a user-function, it is
; immediately invoked.  If the process is part of a pipeline, the command
; particulars are stored on a list for later invocation when we receive the
; command list for the last process in the pipeline.

(let ((start_bg 0) (cmd 0) (pipeline 0) (func ""))

   (defun process_command (items)
      (setq start_bg 0)
      (setq pipeline 0)

      (when items
         (cond ((eq (car items) "&")
                (setq start_bg 1)
                (setq items (cdr items)))

               ((eq (car items) "|")
                (setq pipeline 1)
                (setq items (cdr items)))))

      (when (setq items (reverse (get_redirections items)))
         (setq cmd   (car items))
         (setq items (cdr items))

         (cond ((eq cmd "fg")       (if items (fg (car items)) (fg)))
               ((eq cmd "bg")       (if items (bg (car items)) (bg)))
               ((eq cmd "exit")     (while (> (car (wait -1 1)) 0)) (quit))

               ((eq cmd "alias")    (do_alias items))
               ((eq cmd "unalias")  (do_unalias items))
               ((eq cmd "aliases")  (do_aliases))

               ((eq cmd "jobs")     (do_jobs))
               ((eq cmd "cd")       (cd (and items (car items))))
               ((eq cmd "exec")     (do_exec items))

               ((eq cmd "prompt")   (do_prompt items))
               ((eq cmd "rescan")   (rescan_path))
               ((eq cmd ".")        (interact)   (newline))

               ((and (not (setq func (check_cmd (setq cmd (remove_quotes cmd)))))
                     (not (setq func (lookup functions cmd))))
                (warn "[ COMMAND " cmd " DOES NOT EXIST OR PERMISSION DENIED ]")
                (setq pipecmds ()))

               (1 (cond ((and pipeline (stringp func))
                         (setq pipecmds
                           (cons (list (get_redir2) func items
                                       (if pipecmds 0 (get_redir0)))
                                 pipecmds)))

                        ((closurep func)
                         (apply func items)
                         (setq pipecmds ()))

                        (1 (fork_it start_bg func items)
                           (setq pipecmds ()))))))))

; The final parenthesis of this closure, closes the giant wrapper closure.

; This is the main function.  It reads a line of input, and uses a regular
; expression to break it up into tokens.  It then assembles the tokens into
; separate lists for each command found in the command line, feeding them
; to "process_command" one command at a time.

(let ((items ()) (m ()) (line "") (multi "")
      (multi_rx (regcomp "[\b\t]\\\\[\b\t]*$"))
      (cmd_rx (regcomp (concat "^[" (char 10) (char 13) "\b\t]*(([^\b\t\"]|\\\\\")+|\"([^\"]|\\\\\")*\")(.*)"))))

   (defun expand_alias (item)
      (or (reverse (lookup aliases item)) (list item)))

   ; We map the closure to the string "main" in the user functions table.
   ; This mapping will be used to invoke the function from outside of the
   ; wrapper closure, and will be removed before any user code is run.

   (hash functions "main"
      (defun main ((first))

         (catch
            (for (((setq line (or (and first (car first)) (getline prompt -3))))
                  (line)
                  ((setq line (getline prompt -3))))

               (unless (setq line (chomp line))
                  (setq pipecmds ())
                  (setq multi "")
                  (wait_for_bg)
                  (continue))

               (when (match multi_rx line)
                  (setq multi (concat multi (substitute multi_rx " " line)))
                  (continue))

               (when multi
                  (setq line (concat multi line))
                  (setq multi ""))

               (while (setq m (matches cmd_rx line))
                  (setq items (append (expand_alias (cadr m)) items))
                  (setq line (caddddr m)))

               (setq items (reverse items))

               (while items
                  (setq m (cons (car items) m))

                  (cond ((eq (car items) ";")
                         (process_command (cdr m))
                         (canon)
                         (setq m ()))

                        ((eq (car items) "|")
                         (process_command m)
                         (canon)
                         (setq m ())))

                  (setq items (cdr items)))

               (when m
                  (process_command m))
               (canon)

               (when first (throw 0))
               (wait_for_bg))

            (save_history (join "/" (getenv "HOME") ".mush_history"))

            (when stopped
               (warn "[ THERE ARE STOPPED JOBS ]")
               (beep)
               (tailcall 0))))))) ; Final parenthesis closes giant wrapper closure.

(let ((rc (join "/" (getenv "HOME") ".mushrc")))
   (when (eq 1 (exists rc))
      (if (access rc 0)
         (load rc)
         (warn "[ ~/.mushrc: PERMISSION DENIED ]"))))

; Trickery to make "main" visible outside of the giant wrapper closure
; without using globals.

(let ((f (lookup functions "main")))
   (unhash functions "main")

   (next)

   (if (next)
      (if (eq (current) "-c")
         (f (next))

         (do
            (with_input_file (current)
               (f))
            (next)))

      (when (isatty 1)
         (goto (lines) 0))
      (f)))

(while (> (car (wait -1 1)) 0))
(quit)
