Commit 178221e8 authored by David Byers's avatar David Byers
Browse files

Fixed questionable logic in lyskom-wait-queue that may have been the cause

of occasional hanging.
parent 954ca1f0
2002-08-09 David Byers <david.byers@swipnet.se>
Better font handling:
* utilities.el (lyskom-set-face-scheme): Set faces for overlays
only if they haven't been set by the user. Don't require expected
background in face schemes.
Attempt to fix irreprudicble hangs:
* services.el (lyskom-wait-queue): Rewrote without using
blocking-return. Use collector instead. The use of blocking-return
and dynamic binding was questionable and probably wrong.
2002-08-08 Per Cederqvist <ceder@ceder.dyndns.org> 2002-08-08 Per Cederqvist <ceder@ceder.dyndns.org>
The "sparar" marker could be left indefinitely in the mode line. The "sparar" marker could be left indefinitely in the mode line.
......
...@@ -1328,10 +1328,10 @@ or get-text-stat." ...@@ -1328,10 +1328,10 @@ or get-text-stat."
(save-excursion (save-excursion
(set-buffer (or lyskom-buffer (set-buffer (or lyskom-buffer
(process-buffer lyskom-proc))) (process-buffer lyskom-proc)))
(let ((lyskom-blocking-return 'not-yet-gotten)) (let ((collector (make-collector)))
(lyskom-run queue 'blocking-return (list t)) (lyskom-run queue (lambda (c) (set-collector->value c t)) collector)
(unwind-protect (unwind-protect
(while (and (eq lyskom-blocking-return 'not-yet-gotten) (while (and (null (collector->value collector))
(not lyskom-quit-flag)) (not lyskom-quit-flag))
(lyskom-accept-process-output)) (lyskom-accept-process-output))
(setq lyskom-ok-to-send-new-calls t) (setq lyskom-ok-to-send-new-calls t)
...@@ -1341,7 +1341,7 @@ or get-text-stat." ...@@ -1341,7 +1341,7 @@ or get-text-stat."
(lyskom-insert-before-prompt (lyskom-get-string 'interrupted)) (lyskom-insert-before-prompt (lyskom-get-string 'interrupted))
(signal 'quit nil))) (signal 'quit nil)))
(setq lyskom-quit-flag nil) (setq lyskom-quit-flag nil)
lyskom-blocking-return))) (collector->value collector))))
(defvar lyskom-multiple-blocking-return nil (defvar lyskom-multiple-blocking-return nil
......
...@@ -1079,40 +1079,49 @@ in lyskom-face-schemes." ...@@ -1079,40 +1079,49 @@ in lyskom-face-schemes."
;; the face scheme expects. If not, copy the computed highlight ;; the face scheme expects. If not, copy the computed highlight
;; faces to the real highlight faces. ;; faces to the real highlight faces.
(when (or (not (facep 'kom-dashed-lines-face)) (let ((expected-background
(not (facep 'kom-async-dashed-lines-face)) (or (null background)
(not (facep 'kom-text-body-face)) (null (assq 'expected-background properties))
(not (facep 'kom-async-text-body-face)) (equal (lyskom-color-values
(not (and background (cdr (assq 'expected-background properties)))
(assq 'expected-background properties) (lyskom-color-values background)))))
(equal (lyskom-color-values (unless (and (memq 'kom-dashed-lines-face set-faces)
(cdr (assq 'expected-background properties))) expected-background)
(lyskom-color-values background))))) (copy-face 'lyskom-strong-highlight-face 'kom-dashed-lines-face))
(setq set-faces (append set-faces
(list 'kom-dashed-lines-face (unless (and (memq 'kom-text-body-face set-faces)
'kom-text-body-face expected-background)
'kom-async-dashed-lines-face (copy-face 'lyskom-weak-highlight-face 'kom-text-body-face))
'kom-async-text-body-face)))
(copy-face 'lyskom-strong-highlight-face 'kom-dashed-lines-face) (unless (and (memq 'kom-async-dashed-lines-face set-faces)
(copy-face 'lyskom-weak-highlight-face 'kom-text-body-face) expected-background)
(copy-face 'lyskom-strong-highlight-face 'kom-async-dashed-lines-face) (copy-face 'lyskom-strong-highlight-face 'kom-async-dashed-lines-face))
(copy-face 'lyskom-weak-highlight-face 'kom-async-text-body-face))
(unless (and (memq 'kom-async-text-body-face set-faces)
;; Check that we've set all faces. If not, copy the default face and post a message expected-background)
(copy-face 'lyskom-weak-highlight-face 'kom-async-text-body-face))
(let ((unset-faces nil))
(lyskom-traverse face-name lyskom-faces (setq set-faces (append set-faces
(unless (memq face-name set-faces) (list 'kom-dashed-lines-face
(setq unset-faces (cons face-name unset-faces)) 'kom-text-body-face
(copy-face 'default face-name))) 'kom-async-dashed-lines-face
'kom-async-text-body-face))))
(when unset-faces
(lyskom-format-insert-before-prompt ;; Check that we've set all faces. If not, copy the default face and post a message
'missing-faces
(symbol-name scheme) (let ((unset-faces nil))
(mapconcat 'symbol-name (lyskom-traverse face-name lyskom-faces
unset-faces (unless (memq face-name set-faces)
"\n "))))))) (setq unset-faces (cons face-name unset-faces))
(copy-face 'default face-name)))
(when unset-faces
(lyskom-format-insert-before-prompt
'missing-faces
(symbol-name scheme)
(mapconcat 'symbol-name
unset-faces
"\n ")))))))
(defun lyskom-face-resource (face-name attr type) (defun lyskom-face-resource (face-name attr type)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment