home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / transparnt.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  24.1 KB  |  714 lines

  1. ;From ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!ucbvax!spider.co.uk!briant Tue Mar 27 09:05:56 1990
  2. ;Article 1612 of comp.emacs:
  3. ;Path: ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!ucbvax!spider.co.uk!briant
  4. ;From briant@spider.co.uk (Brian Tompsett)
  5. ;Newsgroups: comp.emacs
  6. ;Subject: transparent.el, a transparent process window.
  7. ;Message-ID: <9003211610.AA05397@orbweb.spider.co.uk>
  8. ;Date: 21 Mar 90 16:10:37 GMT
  9. ;Sender: daemon@ucbvax.BERKELEY.EDU
  10. ;Lines: 611
  11. ;
  12. ;
  13. ;  In reponse to several requests for terminal emulators and such, and ways
  14. ;of running programs under emacs that use terminal control, I have created
  15. ;the following  piece of elisp by cloning what is already in GNU Emacs 18.55.
  16. ;
  17. ; You can use this code to rlogin/telnet to a remote site, or run vi or
  18. ;what ever strange purpose you have in mind!
  19. ;
  20. ; It was quicker to do it this way that write a complete vt100 interpreter
  21. ;in elisp. I'll do that another day. :-)
  22. ;
  23. ; I may also produce a complete vi interface CLONE (as a .vip file!) someday
  24. ;soon - stayed tuned.
  25. ;    Brian.
  26. ;--
  27. ;Brian Tompsett. Spider System Ltd. Tel: 031 554 9424 E-mail:briant@uk.co.spider
  28. ;Spider Park, Stanwell Street, Edinburgh, EH6 5NG. Fax: 031 554 0649
  29. ;(Secretary, BCS Edinburgh Branch, 53 Bonaly Crescent, Edinburgh. 031 441 2210)
  30. ;-------------------------------------------------------------------------------
  31. ;; Transparent window to a process for GNU Emacs
  32. ;;  Brian Tompsett, March 1990
  33. ;;      British Computer Society, Edinburgh.
  34. ;;        briant@spider.co.uk     bct@tardis.cs.ed.ac.uk
  35. ;;
  36. ;; Acknowledgement:
  37. ;;       This code is freely plaugarised from the terminal.el and vip.el
  38. ;;       packages of Emacs 18.55.
  39. ;;       terminal.el was written by Richard Mlynarik, November 1986.
  40. ;;       vip.el was written by Masahiko Sato (ms@sail.stanford.edu)
  41.  
  42. ;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
  43. ;; Parts of this file are obtained from GNU Emacs code and therefore the
  44. ;; GNU License applies.
  45.  
  46. ;; GNU Emacs is distributed in the hope that it will be useful,
  47. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  48. ;; accepts responsibility to anyone for the consequences of using it
  49. ;; or for whether it serves any particular purpose or works at all,
  50. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  51. ;; License for full details.
  52.  
  53. ;; Everyone is granted permission to copy, modify and redistribute
  54. ;; GNU Emacs, but only under the conditions described in the
  55. ;; GNU Emacs General Public License.   A copy of this license is
  56. ;; supposed to have been given to you along with GNU Emacs so you
  57. ;; can know your rights and responsibilities.  It should be in a
  58. ;; file named COPYING.  Among other things, the copyright notice
  59. ;; and this notice must be preserved on all copies.
  60. ;;----------------------------------------------------------------------
  61. ;; Documentation:
  62. ;;
  63. ;;  This implements an apparently transparent emacs, almost as if we had
  64. ;;   done a fork/exec to the program we wished to run and the child process
  65. ;;   controls /dev/tty while emacs sleeps. This is not really what happens!
  66. ;;
  67. ;; It can be used to invoke programs that themselves wish to drive the
  68. ;; terminal directly by using terminal control codes (obtained from termcap
  69. ;; for example). 
  70. ;; All input and output is transparent and is not intercepted by emacs.
  71. ;; An emacs escape character has been provided so that
  72. ;; emacs commands can be invoked from within transparent windows.
  73. ;; The escape character defaults to C-^ unless changed by setting 
  74. ;; the variable terminal-escape-char.
  75. ;; Functions have been provided for logging output and stuffing input.
  76. ;;
  77. ;;  The main function is transparent-window. This can be invoked in two modes,
  78. ;;  either with the emacs display being scrolled up the screen with the cursor
  79. ;;  starting on the bottom left in the echo area, or with the emacs display 
  80. ;;  being cleared and the cursor starting in the home position.
  81. ;; The emacs screen is restored when the child process dies. There is an option
  82. ;; to wait for user input before restoring the emacs screen.
  83. ;;
  84. ;; transparent-window can be invoked interactively and it will prompt for 
  85. ;; arguments. It can also be called from lisp. An example, is given below:
  86. ;;
  87. ;; (defun ex-shell ()
  88. ;;   "ex shell"
  89. ;;  (require 'transparent)
  90. ;;   (setq buffer (current-buffer))
  91. ;;  (transparent-window (get-buffer-create "*transparent*")
  92. ;;             ;; Default shell is same thing M-x shell uses.
  93. ;;             (or explicit-shell-file-name
  94. ;;             (getenv "ESHELL")
  95. ;;             (getenv "SHELL")
  96. ;;             "/bin/sh") nil t "[Hit return to continue] ")
  97. ;;  (set-buffer buffer) )
  98. ;;
  99. ;; problems:  Cannot set the correct values of <erase> <kill> and <intr>
  100. ;;            to what they were before emacs was invoked.
  101. ;;            I would need to be able to call reset_sys_modes and set_sys_modes
  102. ;;            from elisp. They are only C callable.
  103. ;;
  104. ;;            Assumes we are unix, and BSD to boot! Other systems will have
  105. ;;            problems with the assumtions about /bin/sh and stty!
  106. ;;            I'm sure someone can have a VMS version for us.
  107. ;;
  108. ;;            When in scrolling mode, and a clock running on a mode line,
  109. ;;            the clock does not know the mode line has scrolled up, and the
  110. ;;            display gets a little splattered.
  111. ;;
  112. ;;       
  113.  
  114. (provide 'transparent)
  115.  
  116. (defvar tr-scroll-off-emacs nil
  117.   "If non-nil the emacs window is scrolled up the screen, otherwise
  118. the screen is cleared" )
  119.  
  120. (defvar tr-wait-message nil
  121.  "Message to be displayed when the widow process dies")
  122.  
  123. (defvar tr-saved-inverse-video nil
  124.   "Where the old value of inverse video is stored")
  125.  
  126. (defvar tr-saved-mode-line nil
  127.  "Where the old value of the mode line is held")
  128.  
  129. (defvar tr-process nil
  130.  "Where is id of the process is held")
  131.  
  132. ;; This code is from vip.el
  133.   
  134. (defmacro tr-loop (count body)
  135.   "(COUNT BODY) Execute BODY COUNT times."
  136.   (list 'let (list (list 'count count))
  137.     (list 'while (list '> 'count 0)
  138.           body
  139.           (list 'setq 'count (list '1- 'count)))))
  140.  
  141. (defvar transparent-map nil)
  142. (if transparent-map
  143.     nil
  144.   (let ((map (make-keymap)))
  145.     (fillarray map 'tr-pass-through)
  146.     (setq transparent-map map)))
  147.  
  148. (defvar tr-exit-map nil)
  149. (if tr-exit-map
  150.     nil
  151.   (let ((map (make-keymap)))
  152.     (fillarray map 'exit-minibuffer)
  153.     (setq tr-exit-map map)))
  154.  
  155. ;; escape to emacs mode temporarily
  156.  
  157. (defvar tr-emacs-local-map nil
  158.   "Local map used in emacs mode. \(buffer specific\)")
  159.  
  160. (make-variable-buffer-local 'tr-emacs-local-map)
  161.  
  162. (defun tr-get-editor-command (l-map g-map &optional str)
  163.   "Read characters from keyboard until an editor command is formed, using
  164. local keymap L-MAP and global keymap G-MAP.  If the command is a
  165. self-insert-command, the character just read is returned instead.  Optional
  166. string STR is used as initial input string."
  167.   (let (char l-bind g-bind)
  168.     (setq char
  169.       (if (or (null str) (string= str ""))
  170.           (read-char)
  171.         (string-to-char str)))
  172.     (setq last-command-char char)
  173.     (setq l-bind (tr-binding-of char l-map))
  174.     (if (null l-bind)
  175.     ;; since local binding is empty, we concentrate on global one.
  176.     (progn
  177.       (setq g-bind (tr-binding-of char g-map))
  178.       (if (null g-bind)
  179.           nil ;; return nil, since both bindings are void.
  180.         (if (keymapp g-bind)
  181.         (tr-get-editor-command nil g-bind (tr-string-tail str))
  182.           (if (eq g-bind 'self-insert-command) char g-bind))))
  183.       ;; local binding is nonvoid
  184.       (if (keymapp l-bind)
  185.       ;; since l-bind is a keymap, we consider g-bind as well.
  186.       (progn
  187.         (setq g-bind (tr-binding-of char g-map))
  188.         (if (null g-bind)
  189.         (tr-get-editor-command l-bind nil (tr-string-tail str))
  190.           (if (keymapp g-bind)
  191.           ;; both bindings are keymap
  192.           (tr-get-editor-command l-bind g-bind (tr-string-tail str))
  193.         ;; l-bind is a keymap, so we neglect g-bind
  194.         (tr-get-editor-command l-bind nil (tr-string-tail str)))))
  195.     ;; l-bind is a command
  196.     (if (eq l-bind 'self-insert-command) char l-bind)))))
  197.  
  198. (defun tr-binding-of (char map)
  199.   "Return key-binding of CHAR under keymap MAP.  It is nil if the binding
  200. is void, or a command, or a keymap"
  201.   (let ((val (if (listp map)
  202.          (cdr (assq char map))
  203.            (aref map char))))
  204.     (cond ((null val) nil)
  205.       ((keymapp val)
  206.        (if (symbolp val) (symbol-function val) val))
  207.       (t
  208.        ;; otherwise, it is a function which is either a real function or
  209.        ;; a keymap fset to val.
  210.        (let ((fun (symbol-function val)))
  211.          (if (or (null fun) (keymapp fun)) fun val))))))
  212.  
  213. (defun tr-escape (arg &optional char)
  214.   "Escape to emacs mode and execute one emacs command and then return.
  215.   ARG is used as the prefix value for the executed command.  If
  216. CHAR is given it becomes the first character of the command."
  217.   (interactive "P")
  218.   (let (com (buff (current-buffer)) (first t))
  219.     (if char (setq unread-command-char char))
  220.     (setq prefix-arg arg)
  221.     (while (or first (>= unread-command-char 0))
  222.       ;; this while loop is executed until unread command char will be
  223.       ;; exhausted.
  224.       (setq first nil)
  225.       (setq com (tr-get-editor-command tr-emacs-local-map global-map))
  226.       (if (numberp com)
  227.       (tr-loop (tr-p-val prefix-arg)
  228.             (insert (char-to-string com)))
  229.     (command-execute com prefix-arg)))
  230.     (setq prefix-arg nil)  ;; reset prefix arg
  231.     ))
  232.  
  233.  
  234. (defun tr-p-val (arg)
  235.   "Get value part of prefix-argument ARG."
  236.   (cond ((null arg) 1)
  237.     ((consp arg) (if (null (car arg)) 1 (car arg)))
  238.     (t arg)))
  239.  
  240. (defun tr-string-tail (str)
  241.   (if (or (null str) (string= str "")) nil
  242.     (substring str 1)))
  243.  
  244. ;; This code is from terminal.el
  245.  
  246. (defun tr-stuff-string (string)
  247.   "Read a string to send to through the transparent window
  248. as though that string had been typed on the keyboard.
  249.  
  250. Very poor man's file transfer protocol."
  251.   (interactive "sStuff string: ")
  252.   (process-send-string tr-process string))
  253.  
  254. (defun tr-set-output-log (name)
  255.   "Record output from the transparent window in a buffer."
  256.   (interactive (list (if tr-log-buffer
  257.              nil
  258.                (read-buffer "Record output in buffer: "
  259.                     (format "%s output-log"
  260.                         (buffer-name (current-buffer)))
  261.                     nil))))
  262.   (if (or (null name) (equal name ""))
  263.       (progn (setq tr-log-buffer nil)
  264.          (message "Output logging off."))
  265.     (if (get-buffer name)
  266.     nil
  267.       (save-excursion
  268.     (set-buffer (get-buffer-create name))
  269.     (fundamental-mode)
  270.     (buffer-flush-undo (current-buffer))
  271.     (erase-buffer)))
  272.     (setq tr-log-buffer (get-buffer name))
  273.     (message "Recording transparent window output into buffer \"%s\""
  274.          (buffer-name tr-log-buffer))))
  275.  
  276. (defun tr-tofu ()
  277.   "Discontinue output log."
  278.   (interactive)
  279.   (tr-set-output-log nil))
  280.   
  281.  
  282. (defun tr-toggle (sym arg)
  283.   (set sym (cond ((not (numberp arg)) arg)
  284.          ((= arg 1) (not (symbol-value sym)))
  285.          ((< arg 0) nil)
  286.          (t t))))
  287.  
  288.  
  289. (defun tr-pass-through ()
  290.   "Send the last character typed through the transparent window
  291. without any interpretation"
  292.   (interactive)
  293.   (if (eql last-input-char terminal-escape-char)
  294.       (call-interactively 'tr-escape)
  295.     (process-send-string tr-process (char-to-string last-input-char))
  296.     (tr-process-output t)))
  297.  
  298. (defun tr-filter (process string)
  299.   (let* ((obuf (current-buffer))
  300.      (m meta-flag))
  301.     ;; can't use save-excursion, as that preserves point, which we don't want
  302.     (unwind-protect
  303.     (progn
  304.       (set-buffer (process-buffer process))
  305.       (goto-char tr-saved-point)
  306.       (and (bufferp tr-log-buffer)
  307.            (if (null (buffer-name tr-log-buffer))
  308.            ;; killed
  309.            (setq tr-log-buffer nil)
  310.          (set-buffer tr-log-buffer)
  311.          (goto-char (point-max))
  312.          (insert string)
  313.          (set-buffer (process-buffer process))))
  314.       (setq tr-pending-output (nconc tr-pending-output (list string)))
  315.       ;; this binding is needed because emacs looks at meta-flag when
  316.       ;;  the keystroke is read from the keyboard, not when it is about
  317.       ;;  to be fed into a keymap (or returned by read-char)
  318.       ;; There still could be some screws, though.
  319.       (let ((meta-flag m))
  320.         (tr-process-output (eq (current-buffer)
  321.                    (window-buffer (selected-window)))))
  322.       (set-buffer (process-buffer process))
  323.       (setq tr-saved-point (point)))
  324.       (set-buffer obuf))))
  325.  
  326. (defun tr-process-output (preemptable)
  327.   ;;>> There seems no good reason to ever disallow preemption
  328.   (setq preemptable t)
  329.   (catch 'tr-process-output
  330.     (let ((buffer-read-only nil)
  331.       (string nil) ostring start char (matchpos nil))
  332.       (while (cdr tr-pending-output)
  333.     (setq ostring string
  334.           start (car tr-pending-output)
  335.           string (car (cdr tr-pending-output))
  336.           char (aref string start))
  337.     (if (eql (setq start (1+ start)) (length string))
  338.         (progn (setq tr-pending-output
  339.                (cons 0 (cdr (cdr tr-pending-output)))
  340.              start 0
  341.              string (car (cdr tr-pending-output)))
  342.         (setcar tr-pending-output start)))
  343.     (if (null string) (send-string-to-terminal (char-to-string char))
  344.       (send-string-to-terminal string))
  345.     (setq tr-pending-output (cons 0 (cdr (cdr tr-pending-output))))
  346.     (and preemptable
  347.          (input-pending-p)
  348.          ;; preemptable output!  Oh my!!
  349.          (throw 'tr-process-output t)))))
  350.   ;; We must update window-point in every window displaying our buffer
  351.   (let* ((s (selected-window))
  352.      (w s))
  353.     (while (not (eq s (setq w (next-window w))))
  354.       (if (eq (window-buffer w) (current-buffer))
  355.       (set-window-point w (point))))))
  356.  
  357. (defun tr-get-char ()
  358.   (if (cdr tr-pending-output)
  359.       (let ((start (car tr-pending-output))
  360.         (string (car (cdr tr-pending-output))))
  361.     (prog1 (aref string start)
  362.       (if (eql (setq start (1+ start)) (length string))
  363.           (setq tr-pending-output (cons 0 (cdr (cdr tr-pending-output))))
  364.           (setcar tr-pending-output start))))
  365.     (catch 'char
  366.       (let ((filter (process-filter tr-process)))
  367.     (unwind-protect
  368.         (progn
  369.           (set-process-filter tr-process
  370.                   (function (lambda (p s)
  371.                                     (or (eql (length s) 1)
  372.                                         (setq tr-pending-output (list 1 s)))
  373.                                     (throw 'char (aref s 0)))))
  374.           (accept-process-output tr-process))
  375.       (set-process-filter tr-process filter))))))
  376.  
  377. (defun tr-sentinel (process message)
  378.   (cond ((eq (process-status process) 'run))
  379.     ((null (buffer-name (process-buffer process)))) ;deleted
  380.     (t (let ((b (current-buffer)))
  381.            (set-buffer (process-buffer process))
  382.            (setq buffer-read-only nil)
  383.            (fundamental-mode)
  384.            (setq mode-line-inverse-video tr-saved-inverse-video)
  385.            (setq mode-line-format tr-saved-mode-line)
  386.            (if tr-wait-message 
  387.            (send-string-to-terminal tr-wait-message))
  388.                ;; If we are scrolling then we are stuck in a minibuffer
  389.                ;; read. Put it out of its misery. No return.
  390.            (if tr-scroll-off-emacs
  391.            (progn
  392.              (if tr-wait-message
  393.               (condition-case nil 
  394.                  (read-from-minibuffer "" nil tr-exit-map)))
  395.              (exit-minibuffer)))
  396.            (if tr-wait-message
  397.            (progn
  398.              (setq tr-saved-mini-map 
  399.                   (copy-keymap minibuffer-local-map))
  400.              (condition-case nil 
  401.              (read-from-minibuffer "" nil tr-exit-map))
  402.              (setq minibuffer-local-map tr-saved-mini-map) ))
  403.            ;; Must kill buffer to delete process
  404.            (kill-buffer (current-buffer))
  405.            (redraw-display)))))
  406.  
  407. (defun tr-clear-screen ()
  408.   ;; regenerate buffer to compensate for (nonexistent!!) bugs.
  409.   (erase-buffer)
  410.   (goto-char (point-min)))
  411.  
  412.  
  413. (defvar tr-stty-string "stty -nl new dec echo"
  414.   "*Command string (to be interpreted by \"sh\") which sets the modes
  415. of the virtual terminal to be appropriate for interactive use.")
  416.  
  417. (defvar explicit-shell-file-name nil
  418.   "*If non-nil, is file name to use for explicitly requested inferior shell.")
  419.  
  420. (defun transparent-window (buffer program args &optional scroll wait-message)
  421.  "Create a transparent window in BUFFER, run PROGRAM on arguments ARGS.
  422. ARGS is a list of argument-strings. SCROLL which if
  423. non-nil scrolls the emacs display up the screen from the echo area, and if nil
  424. clear the screen and homes the cursor. WAIT-MESSAGE if non-nil is a string
  425. to be displayed, while awaiting any key-depression before exiting.
  426. Any input typed when BUFFER is the current Emacs buffer is sent to that
  427. program an keyboard input.
  428.  
  429. Interactively, BUFFER defaults to \"*transparent*\" and PROGRAM and ARGS
  430. are parsed from an input-string using your usual shell.
  431.  
  432. To give commands to emacs (as opposed to the program running under it),
  433. type Control-^.  This may be followed by an emacs command.
  434.  
  435. This escape character may be changed using the variable `terminal-escape-char'.
  436.  
  437. `Meta' characters may not currently be sent through the terminal emulator.
  438.  
  439. This function calls the value of terminal-mode-hook if that exists
  440. and is non-nil after the terminal buffer has been set up and the
  441. subprocess started.
  442.  
  443. The buffer (and the transparent window) are deleted when the command exits."
  444.  
  445.   (interactive
  446.     (cons (save-excursion
  447.         (set-buffer (get-buffer-create "*transparent*"))
  448.         (buffer-name (if (or (not (boundp 'tr-process))
  449.                  (null tr-process)
  450.                  (not (eq (process-status tr-process)
  451.                       'run)))
  452.                  (current-buffer)
  453.                (generate-new-buffer "*transparent*"))))
  454.       (append
  455.         (let* ((default-s
  456.              ;; Default shell is same thing M-x shell uses.
  457.              (or explicit-shell-file-name
  458.              (getenv "ESHELL")
  459.              (getenv "SHELL")
  460.              "/bin/sh"))
  461.            (s (read-string
  462.                (format "Program to run: (default %s) "
  463.                    default-s))))
  464.           (if (equal s "")
  465.           (list default-s '())
  466.         (tr-parse-program-and-args s))))))
  467.   (set-buffer buffer)
  468.   (setq tr-scroll-off-emacs scroll)
  469.   (setq tr-wait-message wait-message)
  470.   (transparent-mode)
  471.   (setq buffer-read-only nil)
  472.   (let (process)
  473.     (while (setq process (get-buffer-process (current-buffer)))
  474.       (if (y-or-n-p (format "Kill process %s? " (process-name process)))
  475.       (delete-process process)
  476.     (error "Process %s not killed" (process-name process)))))
  477.   (condition-case err
  478.       (progn
  479.     (if (fboundp 'start-subprocess)
  480.         ;; this winning function would do everything, except that
  481.         ;;  rms doesn't want it.
  482.         (setq tr-process (start-subprocess "transparent"
  483.                    program args
  484.                    'channel-type 'terminal
  485.                    'filter 'tr-filter
  486.                    'buffer (current-buffer)
  487.                    'sentinel 'tr-sentinel
  488.                    'modify-environment
  489.                      (list (cons "TERM" (getenv "TERM")))))
  490.       ;; so instead we resort to this...
  491.       (setq tr-process (start-process "transparent-window" (current-buffer)
  492.                  "/bin/sh" "-c"
  493.                  ;; Yuck!!! Start a shell to set some terminal
  494.                  ;; control characteristics.  Then start the
  495.                  ;; "env" program to setup the terminal type
  496.                  ;; Then finally start the program we wanted.
  497.                  (format "%s; exec %s TERM=%s %s"
  498.                                      tr-stty-string
  499.                      (tr-quote-arg-for-sh
  500.                        (concat exec-directory "env"))
  501.                      (getenv "TERM")
  502.                      (mapconcat 'tr-quote-arg-for-sh
  503.                         (cons program args) " ")))))
  504.       (set-process-filter tr-process 'tr-filter)
  505.       (set-process-sentinel tr-process 'tr-sentinel))
  506.     (error (fundamental-mode)
  507.        (signal (car err) (cdr err))))
  508.   (setq inhibit-quit t)            ;sport death
  509.   (if tr-scroll-off-emacs 
  510.       (save-excursion (set-buffer buffer)
  511.               (run-hooks 'terminal-mode-hook)
  512.               (setq tr-saved-recurse enable-recursive-minibuffers)
  513.               (setq enable-recursive-minibuffers t)
  514.               (setq tr-saved-mini-map 
  515.                   (copy-keymap minibuffer-local-map))
  516.               ;; We hang in this read until process death.
  517.               (condition-case nil
  518.                (read-from-minibuffer "" nil transparent-map))
  519.               (setq minibuffer-local-map tr-saved-mini-map)
  520.               (setq enable-recursive-minibuffers tr-saved-recurse)
  521.               ;;(run-hooks 'tr-window-death-hook)
  522.               (kill-buffer buffer)
  523.               (redraw-display)
  524.               )
  525.     ;; These are done for non-scrolling mode
  526.     (switch-to-buffer buffer)
  527.     (delete-other-windows)
  528.     (tr-clear-screen)
  529.     (setq tr-emacs-local-map (current-local-map))
  530.     (use-local-map transparent-map)
  531.     (run-hooks 'terminal-mode-hook)))
  532.  
  533. (defun tr-parse-program-and-args (s)
  534.   (cond ((string-match "\\`\\([a-zA-Z0-9-+=_.@/:]+[ \t]*\\)+\\'" s)
  535.      (let ((l ()) (p 0))
  536.        (while p
  537.          (setq l (cons (if (string-match
  538.                 "\\([a-zA-Z0-9-+=_.@/:]+\\)\\([ \t]+\\)*"
  539.                 s p)
  540.                    (prog1 (substring s p (match-end 1))
  541.                  (setq p (match-end 0))
  542.                  (if (eql p (length s)) (setq p nil)))
  543.                    (prog1 (substring s p)
  544.                  (setq p nil)))
  545.                l)))
  546.        (setq l (nreverse l))
  547.        (list (car l) (cdr l))))
  548.     ((and (string-match "[ \t]" s) (not (file-exists-p s)))
  549.      (list shell-file-name (list "-c" (concat "exec " s))))
  550.     (t (list s ()))))
  551.  
  552. (put 'transparent-mode 'mode-class 'special)
  553. ;; This is only separated out from function transparent-window
  554. ;; to keep the latter a little more managable.
  555. (defun transparent-mode ()
  556.   "Set up variables for use of the transparent-window
  557. One should not call this -- it is an internal function
  558. of the transparent-window"
  559.   (kill-all-local-variables)
  560.   (buffer-flush-undo (current-buffer))
  561.   (setq major-mode 'transparent-mode)
  562.   (setq mode-name "transparent")
  563.   (make-variable-buffer-local 'mode-line-format)
  564.   (setq tr-saved-mode-line mode-line-format)
  565.   (setq mode-line-format "")
  566.   (make-variable-buffer-local 'mode-line-inverse-video)
  567.   (setq tr-saved-inverse-video mode-line-inverse-video)
  568.   (setq mode-line-inverse-video nil)
  569.   (setq buffer-read-only t)
  570.   (setq truncate-lines t)
  571.   (make-local-variable 'terminal-escape-char)
  572.   (setq terminal-escape-char (default-value 'terminal-escape-char))
  573.   ;; If we are scrolling emacs off the top of the screen by reading
  574.   ;; in the minibuffer, then we cannot make this a local variable!
  575.   (if (not tr-scroll-off-emacs) (make-local-variable 'tr-process))
  576.   (make-local-variable 'tr-pending-output)
  577.   (setq tr-pending-output (list 0))
  578.   (make-local-variable 'tr-saved-point)
  579.   (setq tr-saved-point (point-min))
  580.   (make-local-variable 'inhibit-quit)
  581.   ;(setq inhibit-quit t)
  582.   (make-local-variable 'tr-log-buffer)
  583.   (setq tr-log-buffer nil)
  584.   ;;>> Nothing can be done about this without decruftifying
  585.   ;;>>  emacs keymaps.
  586.   (make-local-variable 'meta-flag) ;sigh
  587.   (setq meta-flag nil)
  588.   ;(use-local-map transparent-mode-map)
  589.   ;; terminal-mode-hook is called above in function terminal-emulator
  590.   )
  591.  
  592.  
  593.  
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.  
  603.  
  604.  
  605.  
  606.  
  607.  
  608.  
  609.  
  610.  
  611.  
  612.  
  613.  
  614.  
  615.  
  616.  
  617.  
  618.  
  619.  
  620.  
  621.  
  622.  
  623.  
  624.  
  625.  
  626.  
  627.  
  628.  
  629.  
  630.  
  631.  
  632.  
  633.  
  634.  
  635.  
  636.  
  637.  
  638.  
  639.  
  640.  
  641.  
  642.  
  643.  
  644.  
  645.  
  646.  
  647.  
  648.  
  649.  
  650.  
  651. ;;;; what a complete loss
  652.  
  653. (defun tr-quote-arg-for-sh (fuckme)
  654.   (cond ((string-match "\\`[a-zA-Z0-9-+=_.@/:]+\\'"
  655.                fuckme)
  656.      fuckme)
  657.     ((not (string-match "[$]" fuckme))
  658.      ;; "[\"\\]" are special to sh and the lisp reader in the same way
  659.      (prin1-to-string fuckme))
  660.     (t
  661.      (let ((harder "")
  662.            (cretin 0)
  663.            (stupid 0))
  664.        (while (cond ((>= cretin (length fuckme))
  665.              nil)
  666.             ;; this is the set of chars magic with "..." in `sh'
  667.             ((setq stupid (string-match "[\"\\$]"
  668.                             fuckme cretin))
  669.              t)
  670.             (t (setq harder (concat harder
  671.                         (substring fuckme cretin)))
  672.                nil))
  673.          (setq harder (concat harder (substring fuckme cretin stupid)
  674.                                   ;; Can't use ?\\ since `concat'
  675.                                   ;; unfortunately does prin1-to-string
  676.                                   ;; on fixna.  Amazing.
  677.                   "\\"
  678.                   (substring fuckme
  679.                          stupid
  680.                          (1+ stupid)))
  681.            cretin (1+ stupid)))
  682.        (concat "\"" harder "\"")))))
  683.  
  684.  
  685. ;From ark1!nems!mimsy!haven!purdue!tut.cis.ohio-state.edu!spider.co.uk!briant Wed Mar 28 13:11:22 1990
  686. ;Article 1381 of gnu.emacs:
  687. ;Path: ark1!nems!mimsy!haven!purdue!tut.cis.ohio-state.edu!spider.co.uk!briant
  688. ;From briant@spider.co.uk (Brian Tompsett)
  689. ;Newsgroups: gnu.emacs
  690. ;Subject: Re: transparent.el, a transparent process window.
  691. ;Message-ID: <9003261352.AA04628@orbweb.spider.co.uk>
  692. ;Date: 26 Mar 90 13:52:14 GMT
  693. ;Sender: daemon@tut.cis.ohio-state.edu
  694. ;Distribution: gnu
  695. ;Organization: GNUs Not Usenet
  696. ;Lines: 16
  697. ;
  698. ;
  699. ; It has been pointed out to me that I inadvertantly left out a copyright notice
  700. ;from the file transparent.el. The code in terminal.el, which I used is 
  701. ;copyrighted, and the copyright should have been propogated into transparent.el
  702. ;which contained sections of code from terminal.el.
  703. ;
  704. ;Please add the following line to all copies of the file transparent.el.
  705. ;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
  706.  
  707. ;   Thank you,
  708. ;     Brian.
  709. ;--
  710. ;Brian Tompsett. Spider System Ltd. Tel: 031 554 9424 E-mail:briant@uk.co.spider
  711. ;Spider Park, Stanwell Street, Edinburgh, EH6 5NG. Fax: 031 554 0649
  712. ;(Secretary, BCS Edinburgh Branch, 53 Bonaly Crescent, Edinburgh. 031 441 2210)
  713. ;(BCS = British Computer Society. NOT Boston Computer Society !!   :-)        )
  714.