Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
lyskom-elisp-client
lyskom-elisp-client
Commits
cc219b26
Commit
cc219b26
authored
Jul 28, 1993
by
Linus Tolke
Browse files
blocking-do constructs included and used.
parent
2e96f43d
Changes
7
Hide whitespace changes
Inline
Side-by-side
src/ChangeLog
View file @
cc219b26
No preview for this file type
src/commands1.el
View file @
cc219b26
...
...
@@ -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
(
prog
n
(
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-soo
n
(
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
View file @
cc219b26
...
...
@@ -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 o
r all
users in KOM right now."
"Send a message to one o
f 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
View file @
cc219b26
...
...
@@ -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
View file @
cc219b26
...
...
@@ -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
View file @
cc219b26
...
...
@@ -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
View file @
cc219b26
...
...
@@ -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
))))
)))
;;; ================================================================
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment