home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / S-mode / S-tek.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  8.2 KB  |  217 lines

  1. ;;;; -*- Mode: Emacs-Lisp -*- 
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;; 
  4. ;;;; File            : S-tek.el
  5. ;;;; Authors         : David Smith
  6. ;;;; Created On      : June 25, 1992
  7. ;;;; Last Modified By: David Smith
  8. ;;;; Last Modified On: Mon Jun 29 14:51:26 CST 1992
  9. ;;;; Version         : 1.1
  10. ;;;; 
  11. ;;;; PURPOSE
  12. ;;;;    Tek graphics support of S-mode.
  13. ;;;;     Component of the S-mode distribution -- see file S.el for info
  14. ;;;; 
  15. ;;;; Copyright 1992  David Smith   dsmith@stats.adelaide.edu.au
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17.  
  18. ;;; Tek support for S-mode   25-Jun-92
  19. ;;; Copyright 1992 David Smith  (dsmith@stats.adelaide.edu.au)
  20. ;;;
  21. ;;; This file forms part of the S-mode package defined in the file S.el
  22. ;;; and is autoloaded as required.
  23.  
  24. ;;; GENERAL DISCLAIMER
  25. ;;; 
  26. ;;; This program is free software; you can redistribute it
  27. ;;; and/or modify it under the terms of the GNU General Public
  28. ;;; License as published by the Free Software Foundation; either
  29. ;;; version 1, or (at your option) any later version.
  30. ;;; 
  31. ;;; This program is distributed in the hope that it will be
  32. ;;; useful, but WITHOUT ANY WARRANTY; without even the implied
  33. ;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  34. ;;; PURPOSE.  See the GNU General Public License for more
  35. ;;; details.
  36. ;;; 
  37. ;;; You should have received a copy of the GNU General Public
  38. ;;; License along with this program; if not, write to the Free
  39. ;;; Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  40. ;;; 02139, USA.
  41. ;;; 
  42. ;;; In short: you may use this code any way you like, as long as you
  43. ;;; don't charge money for it, remove this notice, or hold anyone liable
  44. ;;; for its results.
  45.  
  46. ;;;
  47. ;;; OVERVIEW
  48. ;;;
  49.  
  50. ;;; If S-tek-mode is non-nil, then whenever output from an S
  51. ;;; command looks like Tek graphics (i.e. starts with S-tek-graphics-re,
  52. ;;; such as sent by the tek4014() driver) it is sent straight to the
  53. ;;; terminal. This mode may be toggled with \\[S-tek-mode-toggle].
  54. ;;; 
  55. ;;; This mode depends on being able to work out where the graphics finish
  56. ;;; and normal (text) output starts. In the easiest case, it finishes with
  57. ;;; your prompt and S-mode has no trouble detecting that. Sometimes
  58. ;;; plotting functions also display some text afterwards, and provided the
  59. ;;; function finishes and your prompt is displayed *at the start* of a
  60. ;;; line this is no problem either, but make sure any such function you
  61. ;;; write finishes any text with a newline. Functions like
  62. ;;; 
  63. ;;;     badfun <- function() { plot(1:10) cat(\"Hello\") invisible() }
  64. ;;; 
  65. ;;; will break the graphics detector. Other functions, such as 
  66. ;;; `gam(obj,ask=T)' present a menu after the plot and wait for input (and
  67. ;;; so your prompt isn't displayed). The variable S-tek-possible-graph-prompts 
  68. ;;; is a regular expression used to detect any alternative prompt used in
  69. ;;; this case.
  70. ;;; 
  71. ;;; When the graphics display has completed, press any key to return to
  72. ;;; your Emacs display. This mode also works with the \"ask=T\" option to
  73. ;;; tek4014(), however any single key is now the appropriate response to
  74. ;;; the \"GO?\" prompt.
  75. ;;; 
  76. ;;; Unexpected redisplays of the Emacs screen (such as caused by
  77. ;;; display-time or garbage collection) can possibly send garbage to your
  78. ;;; graphics display, but unfortunately there seems to way to prevent this.
  79. ;;; 
  80. ;;; If you have a very simple prompt, it may by chance appear in the
  81. ;;; graphics output which could possibly cause problems; if this occurs
  82. ;;; you will be given a warning. It is advisable to choose a prompt with
  83. ;;; at least two characters. Tek mode relies on your prompt not changing
  84. ;;; while it is active. If your prompt changes while S-tek-mode is t be
  85. ;;; sure to tell the Tek graphics detector with
  86. ;;; \\[S-tek-get-simple-prompt], or toggle S-tek-mode twice with
  87. ;;; \\[S-tek-mode-toggle].
  88. ;;; 
  89. ;;; When this mode is enabled, S-mode will make your Emacs process
  90. ;;; unusable while waiting for the first output from a function (so it can
  91. ;;; determine whether or not it's graphics). You may be stuck for a long
  92. ;;; time when executing a time-consuming function that produces no output.
  93.  
  94. ;;;
  95. ;;; Internal variables to S tek mode.
  96. ;;;
  97.  
  98. (defvar S-tek-graphics-re "\035\\|\033"
  99.   "Regexp signalling start of Tek graphics.")
  100.  
  101. (defvar S-tek-go-string "\ v @\GO? "
  102.   "String which, if found in TEK graphics, signals that S is waiting
  103. for another plot.")
  104.  
  105. (defvar S-tek-graphics-end-string "\C-_\033:"
  106.   "Regexp which, along with S-tek-simple-prompt, signals end of graphics.")
  107.  
  108. (defvar S-tek-prompt-warning-given t
  109.   "Flag, t if warning given about prompt found in graphics.")
  110.  
  111. (defvar S-tek-enter-tek-mode-code "\e[?38h"
  112.   "Control codes to enter Tek mode.")
  113.  
  114. (defvar S-tek-leave-tek-mode-code 
  115.   (if (string= (getenv "TERM") "xterm")
  116.       "\e\C-c" "\C-x") 
  117.   "Control codes to leave Tek mode.")
  118.  
  119. ;;;
  120. ;;; The Tek driver itself
  121. ;;;
  122.  
  123. (defun S-tek-looking-at-string (str)
  124.   "Like looking-at, but does a simple string search"
  125.   (string= str (buffer-substring (point) (+ (point) (length str)))))
  126.  
  127. (defun S-tek-looking-after-string (str)
  128.   "Like S-tek-looking-at-string, but considers text before point"
  129.   (string= str (buffer-substring (point) (- (point) (length str)))))
  130.  
  131. (defun S-tek-wait-for-eog ()
  132. ;;; Waits until the Tek graphics output is completed, and puts point just
  133. ;;; before the prompt
  134.   (let* ((cbuffer (current-buffer))
  135.          (sprocess (get-process "S"))
  136.          (sbuffer (process-buffer sprocess))
  137.          (limit comint-last-input-end)
  138.      result)
  139.     (set-buffer sbuffer)
  140.     (if (not S-tek-simple-prompt)
  141.     (S-tek-get-simple-prompt))
  142.     (while (progn
  143.          (accept-process-output sprocess)
  144.          (goto-char (point-max))
  145.          (not (if (or (search-backward S-tek-simple-prompt limit t)
  146.               (re-search-backward S-tek-possible-graph-prompts limit t))
  147.               (cond
  148.                ((S-tek-looking-after-string S-tek-graphics-end-string) 
  149.             (setq result 'done))
  150.                ((S-tek-looking-after-string "\n")
  151.             ;; Found prompt at bol. This means that graphics finished
  152.             ;; some time ago; go back and get it
  153.             (search-backward S-tek-graphics-end-string nil t) 
  154.             (search-forward S-tek-graphics-end-string nil t)
  155.                     ; put point at eog
  156.             (setq result 'done))
  157.                (t
  158.             ;; Other alternatives mean prompt found in middle of graphics
  159.             (if S-tek-prompt-warning-given nil
  160.               (message "Prompt found in Tek graphics. Maybe you should change it.")
  161.               (sleep-for 5)
  162.               (setq S-tek-prompt-warning-given t))
  163.               nil))
  164.             ;; Prompt not found, maybe a GO? is waiting?
  165.             (if (not (search-backward S-tek-go-string limit t)) nil
  166.               ;; GO? found
  167.               (search-forward S-tek-go-string) ; Put point at end of GO
  168.               (setq result 'go))))))
  169.     (set-buffer cbuffer)
  170.     result))
  171.  
  172. ;;; (fset 'real-sit-for (symbol-function 'sit-for))
  173. ;;; (fset 'real-set-buffer-modofied-p (symbol-function 'set-buffer-modified-p))
  174.  
  175. (defun S-tek-snarf-graphics nil
  176.   ;; We're in the S process buffer, and the output
  177.   ;; from an S command is about to appear. If it's Tek graphics,
  178.   ;; pull it out and plot it, else leave it alone.
  179.   (accept-process-output (get-process "S"))
  180.   (let* ((pmark (process-mark (get-buffer-process (current-buffer))))
  181.      (output (buffer-substring comint-last-input-end pmark))
  182.      graphics
  183.      graph-type)
  184.     (if (string-match S-tek-graphics-re output)
  185.     (progn
  186.       (garbage-collect)
  187.       ;; Hopefully sentinels will not cause another collection, causing
  188.       ;; a message which looks ugly in the graphics.
  189.       (message 
  190.        (concat "Grabbing graphics ... wait  "
  191.            (if S-tek-pause-for-graphics 
  192.                "[Press any key to clear graphics]")))
  193.       (setq graph-type (S-tek-wait-for-eog))
  194.       (save-excursion
  195.         (setq graphics
  196.           (buffer-substring comint-last-input-end 
  197.                     (point)))
  198.         (delete-region comint-last-input-end (point))
  199.         (send-string-to-terminal S-tek-enter-tek-mode-code)
  200.         (send-string-to-terminal graphics)
  201.         (send-string-to-terminal S-tek-leave-tek-mode-code)
  202.         (if (eq graph-type 'go)
  203.         (progn
  204.           (if S-tek-pause-for-graphics nil
  205.             (message "Press a key for next plot."))
  206.           (read-char)
  207.           (inferior-S-send-input)
  208.           (forward-line -1)
  209.           (delete-blank-lines))
  210.           (if S-tek-pause-for-graphics
  211.           (read-char))
  212.         (redraw-display)))
  213.         (goto-char (point-max))))))
  214.  
  215. ;;; Provide package
  216.  
  217. (provide 'S-tek)