/[emacs]/emacs/lisp/vmsproc.el
ViewVC logotype

Diff of /emacs/lisp/vmsproc.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by lute, Mon Jul 4 23:09:00 2005 UTC revision 1.12 by monnier, Fri Jul 29 20:14:37 2005 UTC
# Line 1  Line 1 
1  ;;; vmsproc.el --- run asynchronous VMS subprocesses under Emacs  ;;; vmsproc.el --- run asynchronous VMS subprocesses under Emacs
2    
3  ;; Copyright (C) 1986 Free Software Foundation, Inc.  ;; Copyright (C) 1986, 2005 Free Software Foundation, Inc.
4    
5  ;; Author: Mukesh Prasad  ;; Author: Mukesh Prasad
6  ;; Maintainer: FSF  ;; Maintainer: FSF
# Line 34  Line 34 
34    "String to insert to distinguish commands entered by user.")    "String to insert to distinguish commands entered by user.")
35    
36  (defvar subprocess-running nil)  (defvar subprocess-running nil)
37  (defvar command-mode-map nil)  (defvar command-mode-map
38      (let ((map (make-sparse-keymap)))
39  (if command-mode-map      (define-key map "\C-m" 'command-send-input)
40      nil      (define-key map "\C-u" 'command-kill-line)
41    (setq command-mode-map (make-sparse-keymap))      map))
   (define-key command-mode-map "\C-m" 'command-send-input)  
   (define-key command-mode-map "\C-u" 'command-kill-line))  
42    
43  (defun subprocess-input (name str)  (defun subprocess-input (name str)
44    "Handles input from a subprocess.  Called by Emacs."    "Handles input from a subprocess.  Called by Emacs."
# Line 65  the end." Line 63  the end."
63    (if subprocess-running    (if subprocess-running
64        (return t))        (return t))
65    (setq subprocess-buf (get-buffer-create "*COMMAND*"))    (setq subprocess-buf (get-buffer-create "*COMMAND*"))
66    (save-excursion    (with-current-buffer subprocess-buf
     (set-buffer subprocess-buf)  
67      (use-local-map command-mode-map))      (use-local-map command-mode-map))
68    (setq subprocess-running (spawn-subprocess 1 'subprocess-input    (setq subprocess-running (spawn-subprocess 1 'subprocess-input
69                                               'subprocess-exit))                                               'subprocess-exit))
# Line 81  the end." Line 78  the end."
78      (setq cmd (substring command 0 (string-match " " command)))      (setq cmd (substring command 0 (string-match " " command)))
79      (setq args (substring command (string-match " " command)))      (setq args (substring command (string-match " " command)))
80      (call-process cmd nil buffer nil "*dcl*" args)))      (call-process cmd nil buffer nil "*dcl*" args)))
81  ;BUGS: only the output up to the end of the first image activation is trapped.    ;; BUGS: only the output up to the end of the first image activation is trapped.
82  ;  (if (not subprocess-running)    ;; (if (not subprocess-running)
83  ;      (start-subprocess))    ;;     (start-subprocess))
84  ;  (save-excursion    ;; (with-current-buffer buffer
85  ;    (set-buffer buffer)    ;;   (let ((output-filename (concat "SYS$SCRATCH:OUTPUT-FOR-"
86  ;    (let ((output-filename (concat "SYS$SCRATCH:OUTPUT-FOR-"    ;;                               (getenv "USER") ".LISTING")))
87  ;                                  (getenv "USER") ".LISTING")))    ;;     (while (file-exists-p output-filename)
88  ;      (while (file-exists-p output-filename)    ;;       (delete-file output-filename))
89  ;       (delete-file output-filename))    ;;     (define-logical-name "SYS$OUTPUT" (concat output-filename "-NEW"))
90  ;      (define-logical-name "SYS$OUTPUT" (concat output-filename "-NEW"))    ;;     (send-command-to-subprocess 1 command)
91  ;      (send-command-to-subprocess 1 command)    ;;     (send-command-to-subprocess 1 (concat
92  ;      (send-command-to-subprocess 1 (concat    ;;                                 "RENAME " output-filename
93  ;                                    "RENAME " output-filename    ;;                                 "-NEW " output-filename))
94  ;                                    "-NEW " output-filename))    ;;     (while (not (file-exists-p output-filename))
95  ;      (while (not (file-exists-p output-filename))    ;;       (sleep-for 1))
96  ;       (sleep-for 1))    ;;     (define-logical-name "SYS$OUTPUT" nil)
97  ;      (define-logical-name "SYS$OUTPUT" nil)    ;;     (insert-file output-filename)
98  ;      (insert-file output-filename)    ;;     (delete-file output-filename))))
 ;      (delete-file output-filename))))  
99    
100  (defun subprocess-command ()  (defun subprocess-command ()
101    "Starts asynchronous subprocess if not running and switches to its window."    "Starts asynchronous subprocess if not running and switches to its window."
# Line 115  the spawned subprocess.  Otherwise bring Line 111  the spawned subprocess.  Otherwise bring
111  line to the last line for resubmission."  line to the last line for resubmission."
112    (interactive)    (interactive)
113    (beginning-of-line)    (beginning-of-line)
114    (let ((current-line (buffer-substring (point)    (let ((current-line (buffer-substring (point) (line-end-position))))
                                         (progn (end-of-line) (point)))))  
115      (if (eobp)      (if (eobp)
116          (progn          (progn
117            (if (not subprocess-running)            (if (not subprocess-running)
# Line 129  line to the last line for resubmission." Line 124  line to the last line for resubmission."
124                      (progn (beginning-of-line) (insert command-prefix-string)))                      (progn (beginning-of-line) (insert command-prefix-string)))
125                  (next-line 1))))                  (next-line 1))))
126        ;; else -- if not at last line in buffer        ;; else -- if not at last line in buffer
127        (end-of-buffer)        (goto-char (point-max))
128        (backward-char)        (backward-char)
129        (next-line 1)        (next-line 1)
130        (if (string-equal command-prefix-string        (insert
131                          (substring current-line 0 (length command-prefix-string)))         (if (compare-strings command-prefix-string nil nil
132            (insert (substring current-line (length command-prefix-string)))                              current-line 0 (length command-prefix-string))
133          (insert current-line)))))             (substring current-line (length command-prefix-string))
134             current-line)))))
135    
136  (defun command-kill-line()  (defun command-kill-line ()
137    "Kills the current line.  Used in command mode."    "Kills the current line.  Used in command mode."
138    (interactive)    (interactive)
139    (beginning-of-line)    (beginning-of-line)
# Line 145  line to the last line for resubmission." Line 141  line to the last line for resubmission."
141    
142  (define-key esc-map "$" 'subprocess-command)  (define-key esc-map "$" 'subprocess-command)
143    
144  ;;; arch-tag: 600b2512-f903-4887-bcd2-e76b306f5b66  ;; arch-tag: 600b2512-f903-4887-bcd2-e76b306f5b66
145  ;;; vmsproc.el ends here  ;;; vmsproc.el ends here

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26