Commit cc219b26 authored by Linus Tolke Y's avatar Linus Tolke Y
Browse files

blocking-do constructs included and used.

parent 2e96f43d
No preview for this file type
...@@ -233,49 +233,33 @@ as TYPE. If no such misc-info, return NIL" ...@@ -233,49 +233,33 @@ as TYPE. If no such misc-info, return NIL"
;;; Brev - Send letter ;;; Brev - Send letter
;;; Author: Inge Wallin ;;; Author: Inge Wallin
;;; Rewritten using read-conf-no by Linus Tolke (4=>1)
(defun kom-send-letter () (defun kom-send-letter ()
"Send a personal letter to a person." "Send a personal letter to a person or a conference."
(interactive) (interactive)
(lyskom-start-of-command 'kom-send-letter) (lyskom-start-of-command 'kom-send-letter)
(lyskom-tell-internat 'kom-tell-write-letter) (lyskom-tell-internat 'kom-tell-write-letter)
(lyskom-completing-read-conf-stat 'main 'lyskom-send-letter-2 (let* ((tono (lyskom-read-conf-no (lyskom-get-string 'who-letter-to) 'all))
(lyskom-get-string 'who-letter-to) (conf-stat (blocking-do 'get-conf-stat tono)))
nil nil "")) (if (if (zerop (conf-stat->msg-of-day conf-stat))
t
(progn
(defun lyskom-send-letter-2 (conf-stat) (recenter 0)
"Send a letter to the person or conference with conf-stat CONF-STAT. (lyskom-format-insert 'has-motd (conf-stat->name conf-stat))
If the conference has a set motd, show it and confirm that the user (lyskom-view-text 'main (conf-stat->msg-of-day conf-stat))
still wants to send the letter." (if (j-or-n-p (lyskom-get-string 'motd-persist-q))
(if (zerop (conf-stat->msg-of-day conf-stat)) t
(lyskom-do-send-letter (conf-stat->conf-no conf-stat)) (lyskom-end-of-command)
(progn nil)))
(recenter 0) (if (= tono lyskom-pers-no)
(lyskom-format-insert 'has-motd (conf-stat->name conf-stat)) (lyskom-edit-text lyskom-proc
(lyskom-view-text 'main (conf-stat->msg-of-day conf-stat)) (lyskom-create-misc-list 'recpt tono)
(lyskom-run 'main 'lyskom-send-letter-3 "" "")
(conf-stat->conf-no conf-stat))))) (lyskom-edit-text lyskom-proc
(lyskom-create-misc-list 'recpt tono
'recpt lyskom-pers-no)
(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)
"" "")))
;;; ================================================================ ;;; ================================================================
...@@ -666,11 +650,11 @@ If optional arg TEXT-NO is present write a comment to that text instead." ...@@ -666,11 +650,11 @@ If optional arg TEXT-NO is present write a comment to that text instead."
(format " (%d)" text-no) (format " (%d)" text-no)
""))) "")))
(if text-no (if text-no
(progn (lyskom-write-comment-soon
(lyskom-collect 'main) (blocking-do 'get-text-stat text-no)
(initiate-get-text-stat 'main nil text-no) (blocking-do 'get-text text-no)
(initiate-get-text 'main nil text-no) text-no
(lyskom-use 'main 'lyskom-write-comment-soon text-no 'comment)) 'comment)
(lyskom-insert-string 'confusion-what-to-comment) (lyskom-insert-string 'confusion-what-to-comment)
(lyskom-end-of-command))) (lyskom-end-of-command)))
...@@ -690,11 +674,10 @@ If optional arg TEXT-NO is present write a footnote to that text instead." ...@@ -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)))))) (signal 'lyskom-internal-error '(kom-write-comment))))))
(lyskom-start-of-command 'kom-write-footnote) (lyskom-start-of-command 'kom-write-footnote)
(if text-no (if text-no
(progn (lyskom-write-comment-soon
(lyskom-collect 'main) (blocking-do 'get-text-stat text-no)
(initiate-get-text-stat 'main nil text-no) (blocking-do 'get-text text-no)
(initiate-get-text 'main nil text-no) text-no 'footnote)
(lyskom-use 'main 'lyskom-write-comment-soon text-no 'footnote))
(lyskom-insert-string 'confusion-what-to-footnote) (lyskom-insert-string 'confusion-what-to-footnote)
(lyskom-end-of-command))) (lyskom-end-of-command)))
...@@ -704,12 +687,10 @@ If optional arg TEXT-NO is present write a footnote to that text instead." ...@@ -704,12 +687,10 @@ If optional arg TEXT-NO is present write a footnote to that text instead."
(interactive) (interactive)
(lyskom-start-of-command 'kom-comment-previous) (lyskom-start-of-command 'kom-comment-previous)
(if lyskom-previous-text (if lyskom-previous-text
(progn (lyskom-write-comment-soon
(lyskom-collect 'main) (blocking-do 'get-text-stat lyskom-previous-text)
(initiate-get-text-stat 'main nil lyskom-previous-text) (blocking-do 'get-text lyskom-previous-text)
(initiate-get-text 'main nil lyskom-previous-text) lyskom-previous-text 'comment)
(lyskom-use 'main 'lyskom-write-comment-soon
lyskom-previous-text 'comment))
(lyskom-insert-string 'confusion-what-to-comment) (lyskom-insert-string 'confusion-what-to-comment)
(lyskom-end-of-command))) (lyskom-end-of-command)))
...@@ -745,19 +726,26 @@ The default subject is SUBJECT. TYPE is either 'comment or 'footnote." ...@@ -745,19 +726,26 @@ The default subject is SUBJECT. TYPE is either 'comment or 'footnote."
'kom-tell-write-comment 'kom-tell-write-comment
'kom-tell-write-footnote)) 'kom-tell-write-footnote))
(lyskom-collect 'edit) (lyskom-collect 'edit)
(lyskom-traverse (let (data)
misc-info (text-stat->misc-info-list text-stat) (mapcar
(cond (function
((eq 'RECPT (misc-info->type misc-info)) (lambda (misc-info)
(initiate-get-conf-stat 'edit nil (misc-info->recipient-no (cond
misc-info))) ((eq 'RECPT (misc-info->type misc-info))
((and (eq type 'footnote) (setq data
(eq 'CC-RECPT (misc-info->type misc-info))) (cons (blocking-do 'get-conf-stat
(setq ccrep (cons (misc-info->recipient-no misc-info) ccrep)) (misc-info->recipient-no misc-info))
(initiate-get-conf-stat 'edit nil (misc-info->recipient-no data)))
misc-info))))) ((and (eq type 'footnote)
(lyskom-list-use 'edit 'lyskom-comment-recipients lyskom-proc text-stat (eq 'CC-RECPT (misc-info->type misc-info)))
subject type ccrep)))) (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 (defun lyskom-comment-recipients (data lyskom-proc text-stat
......
...@@ -479,15 +479,22 @@ Args: MEMBERSHIP-LIST CONF-STAT." ...@@ -479,15 +479,22 @@ Args: MEMBERSHIP-LIST CONF-STAT."
;;; Skicka meddelande - Send message ;;; Skicka meddelande - Send message
;;; Author: Inge Wallin ;;; Author: Inge Wallin
;;; Rewritten to use lyskom-read-conf-no by Linus Tolke
(defun kom-send-message () (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) (interactive)
(lyskom-start-of-command 'kom-send-message) (lyskom-start-of-command 'kom-send-message)
(lyskom-completing-read 'main 'lyskom-send-message (lyskom-send-message
(lyskom-get-string 'who-to-send-message-to) (lyskom-read-conf-no (lyskom-get-string 'who-to-send-message-to)
'person 'empty "")) '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) (defun lyskom-send-message (pers-no)
......
...@@ -39,6 +39,193 @@ ...@@ -39,6 +39,193 @@
;;; Author: Linus Tolke ;;; 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 ;;; 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." ...@@ -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." "Returns a list of the name (a string) in CONF-STAT."
(list (conf-stat->name stat))) (list (conf-stat->name stat)))
(defun lyskom-try-complete-partials (string alist) ;; lyskom-try-complete-partials used in the new version also.
"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)))))
(defun lyskom-complete-verify-type (conf-stat (defun lyskom-complete-verify-type (conf-stat
kom-queue handler prompt type new empty kom-queue handler prompt type new empty
......
...@@ -108,39 +108,34 @@ footn-to -> Fotnot till text %d." ...@@ -108,39 +108,34 @@ footn-to -> Fotnot till text %d."
(data (cdr (car misc-list)))) (data (cdr (car misc-list))))
(cond (cond
((eq key 'recpt) ((eq key 'recpt)
(initiate-get-conf-stat 'edit 'lyskom-edit-insert-misc-conf (lyskom-edit-insert-misc-conf (blocking-do 'get-conf-stat data)
data (lyskom-get-string 'recipient)
(lyskom-get-string 'recipient) where-put-misc data))
where-put-misc data))
((eq key 'cc-recpt) ((eq key 'cc-recpt)
(initiate-get-conf-stat 'edit 'lyskom-edit-insert-misc-conf (lyskom-edit-insert-misc-conf (blocking-do 'get-conf-stat data)
data (lyskom-get-string 'carbon-copy)
(lyskom-get-string 'carbon-copy) where-put-misc data))
where-put-misc data))
((eq key 'comm-to) ((eq key 'comm-to)
(initiate-get-text-stat 'edit 'lyskom-edit-get-commented-author (lyskom-edit-get-commented-author (blocking-do 'get-text-stat data)
data (lyskom-get-string 'comment)
(lyskom-get-string 'comment) where-put-misc data))
where-put-misc data))
((eq key 'footn-to) ((eq key 'footn-to)
(initiate-get-text-stat 'edit 'lyskom-edit-get-commented-author (lyskom-edit-get-commented-author (blocking-do 'get-text-stat data)
data (lyskom-get-string 'footnote)
(lyskom-get-string 'footnote) where-put-misc data)))
where-put-misc data))) (setq misc-list (cdr misc-list))))
(setq misc-list (cdr misc-list)))) (princ (lyskom-format 'text-mass subject
(lyskom-run 'edit 'princ (if kom-emacs-knows-iso-8859-1
(lyskom-format 'text-mass lyskom-header-separator
subject lyskom-swascii-header-separator)
(if kom-emacs-knows-iso-8859-1 body
lyskom-header-separator (if kom-emacs-knows-iso-8859-1
lyskom-swascii-header-separator) lyskom-header-subject
body lyskom-swascii-header-subject))
(if kom-emacs-knows-iso-8859-1 where-put-misc)
lyskom-header-subject (set-buffer edit-buffer)
lyskom-swascii-header-subject)) (goto-char where-put-misc)
where-put-misc) ))
(lyskom-run 'edit 'lyskom-edit-goto-char where-put-misc)
(set-buffer edit-buffer)))
(defun lyskom-edit-goto-char (marker) (defun lyskom-edit-goto-char (marker)
...@@ -178,11 +173,10 @@ NUMBER is the number of the person. Used if the conf-stat is nil." ...@@ -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) (defun lyskom-edit-get-commented-author (text-stat string stream number)
(lyskom-halt 'edit)
(if text-stat (if text-stat
(initiate-get-conf-stat 'edit-2 'lyskom-edit-insert-commented-author (lyskom-edit-insert-commented-author
(text-stat->author text-stat) (blocking-do 'get-conf-stat (text-stat->author text-stat))
string stream number) string stream number)
(lyskom-edit-insert-commented-author nil 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." ...@@ -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)) (lyskom-format 'by (conf-stat->name conf-stat))
"")) ""))
stream) stream)
(lyskom-resume 'edit)) )
...@@ -444,8 +438,8 @@ text in BUFFER. If the conference has a set motd, then show it." ...@@ -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))) (let ((text-no (conf-stat->msg-of-day conf-stat)))
(if (zerop text-no) (if (zerop text-no)
(lyskom-edit-insert-misc-conf conf-stat string stream nil) (lyskom-edit-insert-misc-conf conf-stat string stream nil)
(initiate-get-text 'edit 'lyskom-edit-add-recipient/copy-3 (lyskom-edit-add-recipient/copy-3 (blocking-do 'get-text text-no)
text-no conf-stat string stream buffer)))) conf-stat string stream buffer))))
(defun lyskom-edit-add-recipient/copy-3 (text conf-stat string stream buffer) (defun lyskom-edit-add-recipient/copy-3 (text conf-stat string stream buffer)
......
...@@ -608,3 +608,40 @@ Args: KOM-QUEUE HANDLER &rest DATA." ...@@ -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)))))
...@@ -376,14 +376,7 @@ WANT-PERSONS is t for persons, nil for confs." ...@@ -376,14 +376,7 @@ WANT-PERSONS is t for persons, nil for confs."
(t (t
(initiate-login 'main 'lyskom-start-anew-login-2 (initiate-login 'main 'lyskom-start-anew-login-2