blocking-do constructs included and used.

src/commands1.el

@@ -233,49 +233,33 @@ as TYPE. If no such misc-info, return NIL"
 ;;;                         Brev - Send letter
 
 ;;; Author: Inge Wallin
-
+;;; Rewritten using read-conf-no by Linus Tolke (4=>1)
 
 (defun kom-send-letter ()
-  "Send a personal letter to a person."
+  "Send a personal letter to a person or a conference."
   (interactive)
   (lyskom-start-of-command 'kom-send-letter)
   (lyskom-tell-internat 'kom-tell-write-letter)
-  (lyskom-completing-read-conf-stat 'main 'lyskom-send-letter-2
-				    (lyskom-get-string 'who-letter-to)
-				    nil nil ""))
-
-			  
-(defun lyskom-send-letter-2 (conf-stat)
-  "Send a letter to the person or conference with conf-stat CONF-STAT.
-If the conference has a set motd, show it and confirm that the user
-still wants to send the letter."
-  (if (zerop (conf-stat->msg-of-day conf-stat))
-      (lyskom-do-send-letter (conf-stat->conf-no conf-stat))
-    (progn
-      (recenter 0)
-      (lyskom-format-insert 'has-motd (conf-stat->name conf-stat))
-      (lyskom-view-text 'main (conf-stat->msg-of-day conf-stat))
-      (lyskom-run 'main 'lyskom-send-letter-3
-		  (conf-stat->conf-no conf-stat)))))
-
-
-(defun lyskom-send-letter-3 (conf-no)
-  "Ask for confirmation if the recipient of the letter has a motd."
-  (if (j-or-n-p (lyskom-get-string 'motd-persist-q))
-      (lyskom-do-send-letter conf-no)
-    (lyskom-end-of-command)))
-
-
-(defun lyskom-do-send-letter (conf-no)
-  "Asks for subject for the letter to be written and starts the editing."
-  (if (= conf-no lyskom-pers-no)
-      (lyskom-edit-text lyskom-proc
-			(lyskom-create-misc-list 'recpt conf-no)
-			"" "")
-    (lyskom-edit-text lyskom-proc
-		      (lyskom-create-misc-list 'recpt conf-no
-					       'recpt lyskom-pers-no)
-		      "" "")))
+  (let* ((tono (lyskom-read-conf-no (lyskom-get-string 'who-letter-to) 'all))
+	 (conf-stat (blocking-do 'get-conf-stat tono)))
+    (if (if (zerop (conf-stat->msg-of-day conf-stat))
+	    t
+	  (progn
+	    (recenter 0)
+	    (lyskom-format-insert 'has-motd (conf-stat->name conf-stat))
+	    (lyskom-view-text 'main (conf-stat->msg-of-day conf-stat))
+	    (if (j-or-n-p (lyskom-get-string 'motd-persist-q))
+		t
+	      (lyskom-end-of-command)
+	      nil)))
+	(if (= tono lyskom-pers-no)
+	    (lyskom-edit-text lyskom-proc
+			      (lyskom-create-misc-list 'recpt tono)
+			      "" "")
+	  (lyskom-edit-text lyskom-proc
+			    (lyskom-create-misc-list 'recpt tono
+						     'recpt lyskom-pers-no)
+			    "" "")))))
 
 
 ;;; ================================================================
@@ -666,11 +650,11 @@ If optional arg TEXT-NO is present write a comment to that text instead."
 				(format " (%d)" text-no)
 			      "")))
   (if text-no
-      (progn
-	(lyskom-collect 'main)
-	(initiate-get-text-stat 'main nil text-no)
-	(initiate-get-text 'main nil text-no)
-	(lyskom-use 'main 'lyskom-write-comment-soon text-no 'comment))
+      (lyskom-write-comment-soon
+       (blocking-do 'get-text-stat text-no)
+       (blocking-do 'get-text text-no)
+       text-no
+       'comment)
     (lyskom-insert-string 'confusion-what-to-comment)
     (lyskom-end-of-command)))
 
@@ -690,11 +674,10 @@ If optional arg TEXT-NO is present write a footnote to that text instead."
 		  (signal 'lyskom-internal-error '(kom-write-comment))))))
   (lyskom-start-of-command 'kom-write-footnote)
   (if text-no
-      (progn
-	(lyskom-collect 'main)
-	(initiate-get-text-stat 'main nil text-no)
-	(initiate-get-text 'main nil text-no)
-	(lyskom-use 'main 'lyskom-write-comment-soon text-no 'footnote))
+      (lyskom-write-comment-soon
+       (blocking-do 'get-text-stat text-no)
+       (blocking-do 'get-text text-no)
+       text-no 'footnote)
     (lyskom-insert-string 'confusion-what-to-footnote)
     (lyskom-end-of-command)))
 
@@ -704,12 +687,10 @@ If optional arg TEXT-NO is present write a footnote to that text instead."
   (interactive)
   (lyskom-start-of-command 'kom-comment-previous)
   (if lyskom-previous-text
-      (progn
-	(lyskom-collect 'main)
-	(initiate-get-text-stat 'main nil lyskom-previous-text)
-	(initiate-get-text 'main nil lyskom-previous-text)
-	(lyskom-use 'main 'lyskom-write-comment-soon 
-		    lyskom-previous-text 'comment))
+      (lyskom-write-comment-soon 
+       (blocking-do 'get-text-stat lyskom-previous-text)
+       (blocking-do 'get-text lyskom-previous-text)
+       lyskom-previous-text 'comment)
     (lyskom-insert-string 'confusion-what-to-comment)
     (lyskom-end-of-command)))
 
@@ -745,19 +726,26 @@ The default subject is SUBJECT. TYPE is either 'comment or 'footnote."
 				'kom-tell-write-comment
 			      'kom-tell-write-footnote))
       (lyskom-collect 'edit)
-      (lyskom-traverse
-       misc-info (text-stat->misc-info-list text-stat)
-       (cond
-	((eq 'RECPT (misc-info->type misc-info))
-	 (initiate-get-conf-stat 'edit nil (misc-info->recipient-no 
-					    misc-info)))
-	((and (eq type 'footnote)
-	      (eq 'CC-RECPT (misc-info->type misc-info)))
-	 (setq ccrep (cons (misc-info->recipient-no misc-info) ccrep))
-	 (initiate-get-conf-stat 'edit nil (misc-info->recipient-no
-					    misc-info)))))
-      (lyskom-list-use 'edit 'lyskom-comment-recipients lyskom-proc text-stat
-		       subject type ccrep))))
+      (let (data)
+	(mapcar 
+	 (function
+	  (lambda (misc-info)
+	    (cond
+	     ((eq 'RECPT (misc-info->type misc-info))
+	      (setq data 
+		    (cons (blocking-do 'get-conf-stat 
+				       (misc-info->recipient-no misc-info))
+			  data)))
+	     ((and (eq type 'footnote)
+		   (eq 'CC-RECPT (misc-info->type misc-info)))
+	      (setq ccrep (cons (misc-info->recipient-no misc-info) 
+				ccrep))
+	      (setq data (cons (bloking-do 'get-conf-stat
+					   (misc-info->recipient-no misc-info))
+			       data))))))
+	 (text-stat->misc-info-list text-stat))
+	(lyskom-comment-recipients data lyskom-proc text-stat
+				   subject type ccrep)))))
 
 
 (defun lyskom-comment-recipients (data lyskom-proc text-stat

src/commands2.el

@@ -479,15 +479,22 @@ Args: MEMBERSHIP-LIST CONF-STAT."
 ;;;              Skicka meddelande - Send message
 
 ;;; Author: Inge Wallin
+;;; Rewritten to use lyskom-read-conf-no by Linus Tolke
 
 
 (defun kom-send-message ()
-  "Send a message to one or all users in KOM right now."
+  "Send a message to one of the users in KOM right now."
   (interactive)
   (lyskom-start-of-command 'kom-send-message)
-  (lyskom-completing-read 'main 'lyskom-send-message
-			  (lyskom-get-string 'who-to-send-message-to)
-			  'person 'empty ""))
+  (lyskom-send-message 
+   (lyskom-read-conf-no (lyskom-get-string 'who-to-send-message-to)
+			'logins t)))
+
+(defun kom-send-alarm ()
+  "Send a message to all of the users in KOM right now."
+  (interactive)
+  (lyskom-start-of-command 'kom-send-alarm)
+  (lyskom-send-message 0))
 
 
 (defun lyskom-send-message (pers-no)

src/completing-read.el

@@ -39,6 +39,193 @@
 ;;; Author: Linus Tolke
 
 
+;;; Completing-function
+
+(defvar lyskom-name-hist nil)
+
+(defvar lyskom-minibuffer-local-completion-map
+  (let ((map (copy-keymap minibuffer-local-completion-map)))
+    (define-key map " " nil)
+    map)
+  "Keymap used for reading LysKOM names.")
+
+(defvar lyskom-minibuffer-local-must-match-map
+  (let ((map (copy-keymap minibuffer-local-must-match-map)))
+    (define-key map " " nil)
+    map)
+  "Keymap used for reading LysKOM names.")
+
+(defun lyskom-read-conf-no (prompt type &optional empty initial)
+  "Returns the conf-no of a conf or person read by lyskom-read-conf-name.
+The question is prompted with PROMPT.
+Only the conferences of TYPE are allowed.
+If EMPTY is non-nil then the empty string is allowed (returns 0).
+INITIAL is the initial contents of the input field."
+  (let (read)
+    (while (and (string= (setq read
+				(lyskom-read-conf-name prompt type t initial))
+			 "")
+		(not empty)))
+    (if (string= read "")
+	0
+      (lyskom-read-conf-name-internal read type 'conf-no))))
+
+(defun lyskom-read-conf-name (prompt type 
+				     &optional mustmatch 
+				     initial)
+  "Read a LysKOM name, prompting with PROMPT.
+The TYPE allows for subsets of the entire Lyskom-name space:
+* all
+* confs only conferences
+* pers only persons
+* logins only persons that are logged in right now.
+The third argument MUSTMATCH makes the function always return the conf-no and 
+never the read string.
+The fourth argument INITIAL is the initial contents of the input-buffer.
+
+Returns the name."
+  (let* ((completion-ignore-case t)
+	 (current-lyskom-process lyskom-proc) ;What an ugly hack.
+	 (minibuffer-local-completion-map 
+	  lyskom-minibuffer-local-completion-map)
+	 (minibuffer-local-must-match-map 
+	  lyskom-minibuffer-local-must-match-map))
+    (completing-read prompt 
+		     'lyskom-read-conf-name-internal
+		     type
+		     mustmatch
+		     initial
+		     'lyskom-name-hist)))
+
+
+(defun lyskom-read-conf-name-internal (string predicate all)
+  "The \"try-completion\" for the lyskom-read name.
+STRING is the string to be matched.
+PREDICATE is one of:
+* all
+* confs only conferences
+* pers only persons
+* logins only persons that are logged in right now.
+If third argument ALL is t then we are called from all-completions.
+If third argument ALL is nil then we are called from try-completion.
+If third argument ALL is 'conf-no then we are called from lyskom name
+to conf-no translator."
+  (let* ((alllogins (and (string= string "")
+			 (eq predicate 'logins)))
+	 (list (if (not alllogins)
+		   (blocking-do 'lookup-name string)))
+	 (nos (append (conf-list->conf-nos list) nil))
+	 (parlist (if (memq predicate '(pers confs))
+		      (let ((nos nos)
+			    (typs (append (conf-list->conf-types list) nil))
+			    res)
+			(while nos
+			  (setq res (cons (cons (car nos) (car typs)) res))
+			  (setq nos (cdr nos)
+				typs (cdr typs)))
+			res)))
+	 (logins (and (eq predicate 'logins)
+		      (mapcar
+		       (function (lambda (ele)
+				   (who-info->pers-no ele)))
+		       (append (blocking-do 'who-is-on) nil))))
+	 (mappedlist (cond
+		      (alllogins
+		       logins)
+		      ((eq predicate 'all)
+		       nos)
+		      ((eq predicate 'confs)
+		       (apply 'append 
+			(mapcar (function 
+				 (lambda (par)
+				   (and (not (conf-type->letterbox (cdr par)))
+					(list (car par)))))
+				parlist)))
+		      ((eq predicate 'pers)
+		       (apply 'append
+			(mapcar (function
+				 (lambda (par)
+				   (and (conf-type->letterbox (cdr par))
+					(list (car par)))))
+				parlist)))
+		      ((eq predicate 'logins)
+		       (let ((nos (sort nos '<))
+			     (lis (sort logins '<))
+			     res)
+			 (while (and nos
+				     lis)
+			   (if (= (car nos) (car lis))
+			       (setq res (cons (car nos) res)))
+			   (if (> (car nos)
+				  (car lis))
+			       (setq lis (cdr lis))
+			     (setq nos (cdr nos))))
+			 res)))))
+    (cond
+     ((eq all 'conf-no)
+      (car mappedlist))
+     ((eq all 'lambda)
+      (= (length mappedlist) 1))
+     (all
+      (mapcar (function (lambda (no)
+			  (conf-stat->name 
+			   (blocking-do 'get-conf-stat no))))
+	      mappedlist))
+     ((and (= (length mappedlist) 1)
+	   (string= string (conf-stat->name
+			    (blocking-do 'get-conf-stat (car mappedlist)))))
+      t)
+     ((= (length mappedlist) 0)
+      nil)
+     (t					; No exact match
+      (lyskom-try-complete-partials 
+       string
+       (mapcar (function (lambda (no)
+			   (list (conf-stat->name 
+				  (blocking-do 'get-conf-stat no)))))
+	       mappedlist))))))
+
+
+(defun lyskom-try-complete-partials (string alist)
+  "Returns the longest string matching STRING.
+Where every word matches the corresponding word in the car part of ALIST.
+parst matching ([^)]) in string and alist are disgarded."
+  (let* ((a-whitespace "\\([ \t]\\|([^)]*)\\)+")
+	 (endfirstword (string-match a-whitespace string))
+	 (firstword (substring string 0 endfirstword))
+	 (reststring (and endfirstword
+			  (substring string (match-end 0))))
+	 (words (let ((res (try-completion firstword alist)))
+		  (cond
+		   ((eq res t) string)
+		   (res)
+		   (t string))))	;+++ Buggfix. Inget error om []\->{}|
+	 (endfirstwords (string-match a-whitespace words))
+	 (firstwords (substring words 0 endfirstwords))
+	 (restlist (mapcar
+		    (function
+		     (lambda (part)
+		       (cond
+			((string-match a-whitespace
+				       (car part))
+			 (list (substring (car part) (match-end 0))))
+			((list "")))))
+		    alist)))
+    (if	(= (length reststring) 0)
+	words
+      (concat (if (> (length firstwords) (length firstword))
+		  firstwords
+		firstword)
+	      " " (lyskom-try-complete-partials reststring
+						restlist)))))	 
+
+					  
+;;; Old stuff:
+;;
+;; The functions below are slowly being replaced by the functions above.
+;; i.e. when they are no longer used in the client.
+
+
 ;;; ================================================================
 ;;;      Some entry points into the functions in this file
 
@@ -352,36 +539,7 @@ The variable that the name is tested against is the locally bound initial."
   "Returns a list of the name (a string) in CONF-STAT."
   (list (conf-stat->name stat)))
 
-(defun lyskom-try-complete-partials (string alist)
-  "Returns the longest string matching STRING.
-Where every word matches the corresponding word in the car part of ALIST.
-parst matching ([^)]) in string and alist are disgarded."
-  (let* ((a-whitespace "\\([ \t]\\|([^)]*)\\)+")
-	 (endfirstword (string-match a-whitespace string))
-	 (firstword (substring string 0 endfirstword))
-	 (reststring (and endfirstword
-			  (substring string (match-end 0))))
-	 (words (or (try-completion firstword alist)
-		    string))		;+++ Buggfix. Inget error om []\->{}|
-	 (endfirstwords (string-match a-whitespace words))
-	 (firstwords (substring words 0 endfirstwords))
-	 (restlist (mapcar
-		    (function
-		     (lambda (part)
-		       (cond
-			((string-match a-whitespace
-				       (car part))
-			 (list (substring (car part) (match-end 0))))
-			((list "")))))
-		    alist)))
-    (if	(= (length reststring) 0)
-	words
-      (concat (if (> (length firstwords) (length firstword))
-		  firstwords
-		firstword)
-	      " " (lyskom-try-complete-partials reststring
-						restlist)))))
-	
+;; lyskom-try-complete-partials used in the new version also.
 
 (defun lyskom-complete-verify-type (conf-stat
 				    kom-queue handler prompt type new empty

src/edit-text.el

@@ -108,39 +108,34 @@ footn-to	-> Fotnot till text %d."
 	    (data (cdr (car misc-list))))
 	(cond
 	 ((eq key 'recpt)
-	  (initiate-get-conf-stat 'edit 'lyskom-edit-insert-misc-conf
-				  data
-				  (lyskom-get-string 'recipient)
-				  where-put-misc data))
+	  (lyskom-edit-insert-misc-conf (blocking-do 'get-conf-stat data)
+					(lyskom-get-string 'recipient)
+					where-put-misc data))
 	 ((eq key 'cc-recpt)
-	  (initiate-get-conf-stat 'edit 'lyskom-edit-insert-misc-conf
-				  data
-				  (lyskom-get-string 'carbon-copy)
-				  where-put-misc data))
+	  (lyskom-edit-insert-misc-conf (blocking-do 'get-conf-stat data)
+					(lyskom-get-string 'carbon-copy)
+					where-put-misc data))
 	 ((eq key 'comm-to)
-	  (initiate-get-text-stat 'edit 'lyskom-edit-get-commented-author
-				 data
-				 (lyskom-get-string 'comment)
-				 where-put-misc data))
+	  (lyskom-edit-get-commented-author (blocking-do 'get-text-stat data)
+					    (lyskom-get-string 'comment)
+					    where-put-misc data))
 	 ((eq key 'footn-to)
-	  (initiate-get-text-stat 'edit 'lyskom-edit-get-commented-author
-				 data
-				 (lyskom-get-string 'footnote)
-				 where-put-misc data)))
-      (setq misc-list (cdr misc-list))))
-    (lyskom-run 'edit 'princ
-		(lyskom-format 'text-mass
-			       subject 
-			       (if kom-emacs-knows-iso-8859-1
-				   lyskom-header-separator
-				 lyskom-swascii-header-separator)
-			       body 
-			       (if kom-emacs-knows-iso-8859-1
-				   lyskom-header-subject
-				 lyskom-swascii-header-subject))
-		where-put-misc)
-    (lyskom-run 'edit 'lyskom-edit-goto-char where-put-misc)
-    (set-buffer edit-buffer)))
+	  (lyskom-edit-get-commented-author (blocking-do 'get-text-stat data)
+					    (lyskom-get-string 'footnote)
+					    where-put-misc data)))
+	(setq misc-list (cdr misc-list))))
+    (princ (lyskom-format 'text-mass subject 
+			  (if kom-emacs-knows-iso-8859-1
+			      lyskom-header-separator
+			    lyskom-swascii-header-separator)
+			  body 
+			  (if kom-emacs-knows-iso-8859-1
+			      lyskom-header-subject
+			    lyskom-swascii-header-subject))
+	   where-put-misc)
+    (set-buffer edit-buffer)
+    (goto-char where-put-misc)
+    ))
 
 
 (defun lyskom-edit-goto-char (marker)
@@ -178,11 +173,10 @@ NUMBER is the number of the person. Used if the conf-stat is nil."
 
 
 (defun lyskom-edit-get-commented-author (text-stat string stream number)
-  (lyskom-halt 'edit)
   (if text-stat
-    (initiate-get-conf-stat 'edit-2 'lyskom-edit-insert-commented-author
-			    (text-stat->author text-stat)
-			    string stream number)
+      (lyskom-edit-insert-commented-author 
+       (blocking-do 'get-conf-stat (text-stat->author text-stat))
+       string stream number)
     (lyskom-edit-insert-commented-author nil string stream number)))
 
 
@@ -193,7 +187,7 @@ NUMBER is the number of the person. Used if the conf-stat is nil."
 			    (lyskom-format 'by (conf-stat->name conf-stat))
 			  ""))
 	 stream)
-  (lyskom-resume 'edit))
+  )
 			  
 
 
@@ -444,8 +438,8 @@ text in BUFFER. If the conference has a set motd, then show it."
   (let ((text-no (conf-stat->msg-of-day conf-stat)))
     (if (zerop text-no)
 	(lyskom-edit-insert-misc-conf conf-stat string stream nil)
-      (initiate-get-text 'edit 'lyskom-edit-add-recipient/copy-3
-			 text-no conf-stat string stream buffer))))
+      (lyskom-edit-add-recipient/copy-3 (blocking-do 'get-text text-no)
+					conf-stat string stream buffer))))
 
 
 (defun lyskom-edit-add-recipient/copy-3 (text conf-stat string stream buffer)

src/services.el

@@ -608,3 +608,40 @@ Args: KOM-QUEUE HANDLER &rest DATA."
 
 
 ;;; ================================================================
+
+
+;; Blocking reading from server:
+
+(defun blocking-return (retval)
+  "Sets blocking variable."
+  (setq lyskom-blocking-return retval))
+
+(defun blocking-do (command &rest data)
+  "Does the COMMAND agains the lyskom-server and returns the result.
+COMMAND is one lyskom-command (like the initiate-* but the initiate- is 
+stripped.
+The cache is consulted when command is get-conf-stat, get-pers-stat
+or get-text-stat."
+  (save-excursion
+    (set-buffer (process-buffer (or lyskom-proc
+				    current-lyskom-process)))
+    (cond
+     ((and (eq command 'get-conf-stat)
+	   (cache-get-conf-stat (car data))))	 
+     ((and (eq command 'get-pers-stat)
+	   (cache-get-pers-stat (car data))))
+     ((and (eq command 'get-text-stat)
+	   (cache-get-text-stat (car data))))
+     ((and (eq command 'get-text)
+	   (cache-get-text (car data))))
+     (t
+      (let ((lyskom-blocking-return 'not-yet-gotten))
+	(apply (intern-soft (concat "initiate-"
+				    (symbol-name command)))
+	       'blocking 'blocking-return
+	       data)
+	(while (eq lyskom-blocking-return 'not-yet-gotten)
+	  (accept-process-output lyskom-proc))
+	lyskom-blocking-return)))))
+
+

src/startup.el

@@ -376,14 +376,7 @@ WANT-PERSONS is t for persons, nil for confs."
    (t
     (initiate-login 'main 'lyskom-start-anew-login-2
 		    pers-no password pers-no lyskom-pers-no)
-    (lyskom-run 'main 'lyskom-edit-text lyskom-proc
-		       (lyskom-create-misc-list
-		       'recpt
-		       (server-info->pers-pres-conf lyskom-server-info))
-		      (lyskom-format 'presentation-subject name)
-		      (lyskom-format 'presentation-form name)
-		      'lyskom-set-presentation pers-no)
-    (lyskom-run 'main 'lyskom-tell-internat 'kom-tell-1st-pres))))
+    )))
 
 
 ;;; ================================================================