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"
;;; 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
......
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
......@@ -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."
(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))))
)))
;;; ================================================================
......
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