aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader2006-08-27 10:42:40 +0000
committerMiles Bader2006-08-27 10:42:40 +0000
commit7a210b69c7f92650c524766d1b9d3f3eefdd67c7 (patch)
tree6d64433b8933041600d772b7ff68ad8bdcaa38af /lisp
parenteb411049435acd5469021b64ce3f59c4ac05f491 (diff)
downloademacs-7a210b69c7f92650c524766d1b9d3f3eefdd67c7.tar.gz
emacs-7a210b69c7f92650c524766d1b9d3f3eefdd67c7.zip
Miscellaneous tq-related fixes.
* lisp/emacs-lisp/tq.el: Small grammar fix in comments. (tq-enqueue): Check for existence of queue rather than the head queue item's question, which was a no-op. (tq-filter, tq-process-buffer): Make sure the process buffer exists before making it the current buffer. * lispref/processes.texi (Transaction Queues): Remove stray quote character. Revision: emacs@sv.gnu.org/emacs--devo--0--patch-411 Creator: Michael Olson <mwolson@gnu.org>
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog8
-rw-r--r--lisp/emacs-lisp/tq.el60
2 files changed, 40 insertions, 28 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2d203896066..187f2ff3fae 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
12006-08-27 Michael Olson <mwolson@gnu.org>
2
3 * emacs-lisp/tq.el: Small grammar fix in comments.
4 (tq-enqueue): Check for existence of queue rather than the
5 head queue item's question, which was a no-op.
6 (tq-filter, tq-process-buffer): Make sure the process buffer
7 exists before making it the current buffer.
8
12006-08-27 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> 92006-08-27 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
2 10
3 * term/mac-win.el (mac-apple-event-map): Rename hicommand to hi-command. 11 * term/mac-win.el (mac-apple-event-map): Rename hicommand to hi-command.
diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el
index 2126d7663fc..1e1e143f0f0 100644
--- a/lisp/emacs-lisp/tq.el
+++ b/lisp/emacs-lisp/tq.el
@@ -66,7 +66,7 @@
66;; regexp: regular expression that matches the end of a response from 66;; regexp: regular expression that matches the end of a response from
67;; the process 67;; the process
68(defun tq-queue-head-regexp (tq) (car (cdr (car (tq-queue tq))))) 68(defun tq-queue-head-regexp (tq) (car (cdr (car (tq-queue tq)))))
69;; closure: additional data to pass to function 69;; closure: additional data to pass to the function
70(defun tq-queue-head-closure (tq) (car (cdr (cdr (car (tq-queue tq)))))) 70(defun tq-queue-head-closure (tq) (car (cdr (cdr (car (tq-queue tq))))))
71;; fn: function to call upon receiving a complete response from the 71;; fn: function to call upon receiving a complete response from the
72;; process 72;; process
@@ -119,7 +119,7 @@ If DELAY-QUESTION is non-nil, delay sending this question until
119the process has finished replying to any previous questions. 119the process has finished replying to any previous questions.
120This produces more reliable results with some processes." 120This produces more reliable results with some processes."
121 (let ((sendp (or (not delay-question) 121 (let ((sendp (or (not delay-question)
122 (not (tq-queue-head-question tq))))) 122 (not (tq-queue tq)))))
123 (tq-queue-add tq (unless sendp question) regexp closure fn) 123 (tq-queue-add tq (unless sendp question) regexp closure fn)
124 (when sendp 124 (when sendp
125 (process-send-string (tq-process tq) question)))) 125 (process-send-string (tq-process tq) question))))
@@ -131,35 +131,39 @@ This produces more reliable results with some processes."
131 131
132(defun tq-filter (tq string) 132(defun tq-filter (tq string)
133 "Append STRING to the TQ's buffer; then process the new data." 133 "Append STRING to the TQ's buffer; then process the new data."
134 (with-current-buffer (tq-buffer tq) 134 (let ((buffer (tq-buffer tq)))
135 (goto-char (point-max)) 135 (when (buffer-live-p buffer)
136 (insert string) 136 (with-current-buffer buffer
137 (tq-process-buffer tq))) 137 (goto-char (point-max))
138 (insert string)
139 (tq-process-buffer tq)))))
138 140
139(defun tq-process-buffer (tq) 141(defun tq-process-buffer (tq)
140 "Check TQ's buffer for the regexp at the head of the queue." 142 "Check TQ's buffer for the regexp at the head of the queue."
141 (set-buffer (tq-buffer tq)) 143 (let ((buffer (tq-buffer tq)))
142 (if (= 0 (buffer-size)) () 144 (when (buffer-live-p buffer)
143 (if (tq-queue-empty tq) 145 (set-buffer buffer)
144 (let ((buf (generate-new-buffer "*spurious*"))) 146 (if (= 0 (buffer-size)) ()
145 (copy-to-buffer buf (point-min) (point-max)) 147 (if (tq-queue-empty tq)
146 (delete-region (point-min) (point)) 148 (let ((buf (generate-new-buffer "*spurious*")))
147 (pop-to-buffer buf nil) 149 (copy-to-buffer buf (point-min) (point-max))
148 (error "Spurious communication from process %s, see buffer %s" 150 (delete-region (point-min) (point))
149 (process-name (tq-process tq)) 151 (pop-to-buffer buf nil)
150 (buffer-name buf))) 152 (error "Spurious communication from process %s, see buffer %s"
151 (goto-char (point-min)) 153 (process-name (tq-process tq))
152 (if (re-search-forward (tq-queue-head-regexp tq) nil t) 154 (buffer-name buf)))
153 (let ((answer (buffer-substring (point-min) (point)))) 155 (goto-char (point-min))
154 (delete-region (point-min) (point)) 156 (if (re-search-forward (tq-queue-head-regexp tq) nil t)
155 (unwind-protect 157 (let ((answer (buffer-substring (point-min) (point))))
156 (condition-case nil 158 (delete-region (point-min) (point))
157 (funcall (tq-queue-head-fn tq) 159 (unwind-protect
158 (tq-queue-head-closure tq) 160 (condition-case nil
159 answer) 161 (funcall (tq-queue-head-fn tq)
160 (error nil)) 162 (tq-queue-head-closure tq)
161 (tq-queue-pop tq)) 163 answer)
162 (tq-process-buffer tq)))))) 164 (error nil))
165 (tq-queue-pop tq))
166 (tq-process-buffer tq))))))))
163 167
164(provide 'tq) 168(provide 'tq)
165 169