Skip to content

GitLab

Commit 43ad7ec0 authored by Linus Tolke's avatar Linus Tolke
Browse files

En arbetsversion av 0.39 incheckad. Det är ganska mycket gjort men det 

finns mer att göra.
parent a8db3bcc
Expand all Hide whitespace changes
Inline Side-by-side
src/ChangeLog
View file @ 43ad7ec0
No preview for this file type
src/Makefile
View file @ 43ad7ec0
......@@ -24,7 +24,11 @@
#
# $Id$
# $Log$
# Revision 38.3 1994/01/14 02:40:01 linus
# Revision 38.4 1995/02/23 20:40:59 linus
# En arbetsversion av 0.39 incheckad. Det är ganska mycket gjort men det
# finns mer att göra.
#
# Revision 38.3 1994/01/14 02:40:01 linus
# Fixed local installation path.
#
# Revision 38.2 1994/01/14 00:28:00 linus
......@@ -134,7 +138,7 @@
# Lagt till lyskom-clientversion-long
#
CLIENTVERSION = 0.38.1
CLIENTVERSION = 0.39
GENERIC-CLEAN = *~ *.o core
GENERIC-DIST-CLEAN = TAGS
......@@ -175,9 +179,19 @@ PARTS-ELC = $(SRC-ELC)
all: lyskom.elc
# I dont want any warnings of the newer file...
vars.elc: vars.el macros.elc
$(EMACS-BATCH) -l `pwd`/macros -f batch-byte-compile $*.el
macros.elc: macros.el
$(EMACS-BATCH) -f batch-byte-compile $*.el
# influenced by autoconf? Yes.
vars.el: vars.el.in Makefile
rm -f vars.el
sed 's/@@CLIENTVERSION@@/$(CLIENTVERSION)/' < vars.el.in > vars.el
chmod 444 vars.el
lyskom.elc: $(HEADER-ELC) $(SWEDISH-ELC) $(PARTS-ELC)
cat $(HEADER-ELC) $(SWEDISH-ELC) $(PARTS-ELC) > lyskom.elc
......
src/async.el
View file @ 43ad7ec0
......@@ -63,18 +63,7 @@ this function shall be with current-buffer the BUFFER."
(lyskom-async-new-text text-stat)))) ;
((eq msg-no 1) ; Logout (obsolete)
; (let ((pno (lyskom-parse-num)))
; (lyskom-save-excursion
; (set-buffer buffer)
; (if (and (not (zerop lyskom-pers-no))
; (or kom-presence-messages
; kom-presence-messages-in-buffer))
; (initiate-get-conf-stat 'follow
; 'lyskom-show-logged-out-person
; pno))
;nej: (if (not (zerop lyskom-pers-no))
;nej: (initiate-who-is-on 'who-buffer 'cache-set-who-info-list))))
)
(lyskom-skip-tokens tokens))
((eq msg-no 2) ; Login, obsolete.
(lyskom-skip-tokens tokens))
......@@ -91,7 +80,7 @@ this function shall be with current-buffer the BUFFER."
(new-name (lyskom-parse-string)))
(lyskom-save-excursion
(set-buffer buffer)
(if (= conf-no lyskom-pers-no)
(if (and lyskom-pers-no (= conf-no lyskom-pers-no))
(lyskom-insert-before-prompt
(lyskom-format 'you-changed-name-to new-name)))
(cache-del-conf-stat conf-no) ;+++Borde {ndra i cachen i st{llet.
......@@ -109,20 +98,9 @@ this function shall be with current-buffer the BUFFER."
(let ((info (lyskom-parse-who-info)))
(lyskom-save-excursion
(set-buffer buffer)
(if (zerop lyskom-pers-no)
(if (or (not lyskom-pers-no)
(zerop lyskom-pers-no))
nil
; This fetches the conf-stats once to much.
; (if (and (/= (who-info->pers-no info) 0)
; (/= (who-info->pers-no info) lyskom-pers-no))
; ;Don't show myself.
; (initiate-get-conf-stat 'follow
; 'lyskom-show-changed-person
; (who-info->pers-no info)
; (who-info->working-conf info)
; (who-info->doing-what info)))
; (if (/= (who-info->working-conf info) 0)
; (initiate-get-conf-stat 'void nil
; (who-info->working-conf info)))
(cache-add-who-info info)))))
((eq msg-no 7) ; Database is syncing.
......@@ -145,13 +123,15 @@ this function shall be with current-buffer the BUFFER."
(session-no (lyskom-parse-num)))
(lyskom-save-excursion
(set-buffer buffer)
(if (and (not (zerop lyskom-pers-no))
(if (and lyskom-pers-no
(not (zerop lyskom-pers-no))
(/= pers-no lyskom-pers-no))
; Don't show myself.
(initiate-get-conf-stat 'follow
'lyskom-show-logged-in-person
pers-no))
(if (and (not (zerop lyskom-pers-no))
(if (and lyskom-pers-no
(not (zerop lyskom-pers-no))
lyskom-who-info-buffer-is-on)
(initiate-get-session-info 'who-buffer 'cache-add-session-info
session-no))
......@@ -186,7 +166,8 @@ this function shall be with current-buffer the BUFFER."
(session-no (lyskom-parse-num)))
(lyskom-save-excursion
(set-buffer buffer)
(if (and (not (zerop lyskom-pers-no))
(if (and lyskom-pers-no
(not (zerop lyskom-pers-no))
(/= lyskom-pers-no pers-no)
(or kom-presence-messages
kom-presence-messages-in-buffer))
......@@ -194,7 +175,7 @@ this function shall be with current-buffer the BUFFER."
'lyskom-show-logged-out-person
pers-no
session-no))
(if (not (zerop lyskom-pers-no))
(if (and lyskom-pers-no (not (zerop lyskom-pers-no)))
(lyskom-run 'who-buffer 'cache-del-who-info session-no)))))
(t
......
src/commands1.el
View file @ 43ad7ec0
This diff is collapsed.
src/commands2.el
View file @ 43ad7ec0
This diff is collapsed.
src/completing-read.el
View file @ 43ad7ec0
......@@ -31,6 +31,12 @@
;;;; or a person name with completion and other help.
;;;;
;; Overview of `exported' functions from this file:
;; lyskom-read-conf-no returns conf-no
;; lyskom-read-conf-stat returns conf-stat
;; lyskom-read-conf-name returns name
(setq lyskom-clientversion-long
(concat lyskom-clientversion-long
"$Id$\n"))
......@@ -59,6 +65,11 @@
"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.
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.
If EMPTY is non-nil then the empty string is allowed (returns 0).
INITIAL is the initial contents of the input field."
(let (read)
......@@ -70,6 +81,22 @@ INITIAL is the initial contents of the input field."
0
(lyskom-read-conf-name-internal read type 'conf-no))))
(defun lyskom-read-conf-stat (prompt type &optional empty initial)
"Exactly the same as lyskom-read-conf-no but returns the conf-stat if possible.
Arguments: PROMPT TYPE EMPTY INITIAL
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.
If EMPTY is non-nil then the empty string is allowed (returns nil)."
(let ((no (lyskom-read-conf-no prompt type empty initial)))
(if (zerop no)
nil
(blocking-do 'get-conf-stat no))))
(defun lyskom-read-conf-name (prompt type
&optional mustmatch
initial)
......@@ -249,9 +276,7 @@ to conf-no translator."
(cons string names)
names)))
((and (= (length mappedlist) 1)
(string= string (conf-stat->name
(blocking-do 'get-conf-stat (car mappedlist)))))
((= (length mappedlist) 1)
t)
((= (length mappedlist) 0)
(if (string-match (lyskom-get-string 'person-or-conf-no-regexp)
......@@ -311,446 +336,5 @@ parst matching ([^)]) in string and alist are disgarded."
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
(defun lyskom-completing-read-conf-stat (queue handler prompt
type new initial &rest data)
"Same as lyskom-completing-read, but give the handler a conf-stat
instead of a conf-no.
ARGS: QUEUE HANDLER PROMPT TYPE NEW INITIAL &rest DATA"
(apply 'lyskom-completing-read
queue 'lyskom-completing-read-conf-stat-handler
prompt type new initial queue handler data))
(defun lyskom-completing-read-conf-stat-handler (conf-no queue handler &rest data)
"Take CONF-NO (returned by lyskom-completing-read) and send it through QUEUE
to HANDLER using initiate-get-conf-stat. Also send DATA to it.
If we had the empty conf-no could be 0. Then we shall return 0."
(if (eq conf-no 0)
(apply handler 0 data)
(if data
(apply 'initiate-get-conf-stat queue handler conf-no data)
(initiate-get-conf-stat queue handler conf-no))))
(defvar lyskom-completing-map nil
"Keymap to read the conf names with completion.")
(defvar lyskom-initial-completing-map nil
"Keymap to hack certain lossage wrt scrolling other window in minibuffer.")
(defun lyskom-completing-read (kom-queue handler
prompt type new initial &rest data)
"Read the name of a person or conf using minibuffer.
Call server for name lookup using KOM-QUEUE. If KOM-QUEUE nil then using
the kom-queue miniread.
Then call the function HANDLER.
The arguments PROMPT, TYPE, NEW and INITIAL are used to do the read.
PROMPT and INITIAL are strings. TYPE is 'person if only allowed to return a
person, 'conf if only a conference is accepted, nil if you will accept both.
If NEW is nil then only persons and conferences already existing are accepted.
If NEW is t then a name not yet existing and not completing to an existing name
is accepted.
If NEW is 'empty then the empty string is accepted.
The function HANDLER is called with the arguments conf-no DATA.
If the parameter NEW is t and a name not existing is read then HANDLER is
called with the arguments name DATA.
If the parameter NEW is 'empty and the empty string is chosen then HANDLER is
called with the arguments 0 DATA."
(if kom-queue
nil
(setq kom-queue 'miniread))
(lyskom-completing-read-2 kom-queue handler
prompt type (eq new t) (eq new 'empty) initial
data (current-window-configuration)))
;;; ================================================================
(defun lyskom-completing-read-2 (kom-queue handler prompt type new empty
initial data curwin
&optional completion-buffer)
"Read the name of person or conf using minibuffer. Use lyskom-completing-read.
This function is called by lyskom-completing-read and calls itself recursively.
It reads a name (or part of it) using the minibuffer and does all the work that
is to be done before lookup-name is called.
When/If it is decided that lookup-name is requested then that is done and the
result is treated by lyskom-completing-read-3.
The args: KOM-QUEUE HANDLER PROMPT TYPE NEW EMPTY INITIAL DATA CURWIN
COMPLETION-BUFFER
The TYPE is one of: nil, person and conf. nil means choose both persons and
confs.
The NEW is non-nil then accept existing and non-existing names.
If EMPTY is non-nil then accept existing names or the empty string.
The CURWIN is the window configuration that we should return to when done.
COMPLETION-BUFFER, if given, tells which window the completions are shown in.
When C-G is pressed then lyskom-end-of-command is evaled."
(let* (window-conf
(window (selected-window))
(buffer (current-buffer))
(return
(read-from-minibuffer (if kom-emacs-knows-iso-8859-1
prompt
(iso-8859-1-to-swascii prompt))
initial
lyskom-initial-completing-map))
(result (substring return 1))
(control (string-to-char return))
no)
(if window-conf
(progn
(set-window-configuration window-conf)
(select-window window)))
(set-buffer buffer)
(cond
((and empty
(eq control ?X)
(string= result ""))
(lyskom-complete-return 0 handler data curwin))
((and (string= result "")
(eq control ?X))
(lyskom-message "%s" (concat prompt " " result " [Not sole completion]"))
(sit-for 2)
(lyskom-completing-read-2 kom-queue handler prompt type new empty result
data curwin))
((and (eq control ?X)
(string-match
(lyskom-get-string 'person-or-conf-no-regexp)
result))
(setq no (string-to-int (substring result
(match-beginning 1)
(match-end 1))))
(initiate-get-conf-stat kom-queue 'lyskom-complete-verify-type no
kom-queue handler prompt type new empty
result control data curwin))
((eq control ?G) ;QUIT
(set-window-configuration curwin)
(lyskom-end-of-command))
(t
(initiate-lookup-name kom-queue 'lyskom-completing-read-3 result
control kom-queue handler prompt type new empty
result data curwin)))))
(defun lyskom-completing-read-3 (conf-list what
kom-queue handler prompt type new empty
initial data curwin)
"Treats the result from the lookup-name. Use lyskom-completing-read.
This function is called by lyskom-completing-read-2 and calls
lyskom-completing-read-2 again if necessary.
The args: CONF-LIST WHAT KOM-QUEUE HANDLER PROMPT TYPE NEW EMPTY
INITIAL DATA CURWIN
CONF-LIST is the result from the lookup-name call.
If WHAT is nil then just reads from the minibuffer with PROMPT and INITIAL.
If WHAT is ?L then build a list of completions using lookup to the server.
If WHAT is ?X and CONF-LIST only contains 1 element of TYPE then calls HANDLER
with arguments conf-no DATA.
If WHAT is ?C then completes the buffer contents from the names of the
conferences in CONF-LIST.
The TYPE is one of: nil, person and conf. nil means choose both persons and
confs.
The NEW is non-nil then accept existing and non-existing names.
If EMPTY is non-nil then accept existing names or the empty string.
The CURWIN is the window configuration that we should return to when done.
When C-G is pressed then lyskom-end-of-command is evaled."
(cond
((eq what ?L) ;Build completions list
(lyskom-collect kom-queue)
(lyskom-traverse
conf-no (lyskom-get-from-conf-list (conf-list->conf-types conf-list)
(conf-list->conf-nos conf-list)
type)
(initiate-get-conf-stat kom-queue nil conf-no))
(lyskom-list-use kom-queue 'lyskom-show-completions
kom-queue handler prompt type new empty
initial data curwin))
((or (eq what ?X) ;Complete and exit
(eq what ?C)) ;Complete
(let ((choice (if type
(lyskom-get-from-conf-list
(conf-list->conf-types conf-list)
(conf-list->conf-nos conf-list)
type)
(conf-list->conf-nos conf-list))))
(cond
((and (= (length choice) 1)
(eq what ?X))
(lyskom-complete-return (elt choice 0) handler data curwin))
((and new
(= (length choice) 0)
(eq what ?X))
(lyskom-complete-return initial handler data curwin))
((or (eq what ?C)
(and (eq what ?X)
(> (length choice) 1)))
(lyskom-collect-ignore-err kom-queue)
(lyskom-traverse
conf-no choice
(initiate-get-conf-stat kom-queue nil conf-no))
(lyskom-list-use kom-queue 'lyskom-complete-and-edit
what kom-queue handler prompt type new empty initial
data curwin))
(t
(lyskom-message "%s" (concat prompt initial
(if (= (length choice)
0)
" [No match]"
" [Next char not unique]")))
(sit-for 2)
(lyskom-completing-read-2 kom-queue handler prompt type new empty
initial data curwin)))))
(t
(signal 'lyskom-internal-error
(list 'lyskom-completing-read
(char-to-string what))))))
(defun lyskom-show-completions (conf-stat-list
kom-queue handler prompt type new empty
initial data curwin)
"Show all completions collected."
(let (completion-buffer)
(with-output-to-temp-buffer " *Completions*"
(princ "Possible completions are:\n")
(mapcar '(lambda (conf-stat)
(princ (conf-stat->name conf-stat))
(terpri))
conf-stat-list)
(setq completion-buffer standard-output))
(lyskom-run kom-queue 'lyskom-completing-read-2
kom-queue handler prompt type new empty initial
data curwin completion-buffer)))
;;; The problem:
;;; When getting a list of possible completions, C-M-v scrolls
;;; the wrong window (the LysKOM buffer instead of the
;;; *Completions* buffer, as from M-x and other commands).
;;; Cause:
;;; Normally, when getting a completion list from other commands
;;; using 'completing-read', the minibuffer routines sets the
;;; variable 'minibuffer-scroll-window' to point to the *Completions*
;;; window. This is difficult to do from lyskom-completing-read,
;;; since the minibuffer is temporary exited when getting completions.
;;; Solution:
;;; Set minibuffer-scroll-window in the minibuffer. But this is
;;; tricky. What we do, is that we give a special keymap to
;;; read-minibuffer, where *all* keys (except C-g) are bound to
;;; lyskom-hack-minibuf. This function sets minibuffer-scroll-window
;;; to the correct value, switches keymap to lyskom-completing-map,
;;; which is the map doing the real job, and push back the given
;;; character to be read again (and thus interpreted in the new
;;; keymap context).
;;;
;;; The window to be scrolled is identified by the buffer in the
;;; parameter completion-buffer to lyskom-completing-read-2, which
;;; is set in lyskom-show-completions.
(defun lyskom-hack-minibuf ()
"Fix lossage due to minibuffer deletion when requesting alternatives."
(interactive)
(setq minibuffer-scroll-window
(and completion-buffer
(get-buffer-window completion-buffer)))
(use-local-map lyskom-completing-map)
(if (boundp 'unread-command-event) ;Special for lucid-emacs.
(setq unread-command-event last-command-event)
(setq unread-command-char last-command-char)))
(defun lyskom-complete-and-edit (conf-stats what
kom-queue handler prompt type new empty
initial data curwin)
"Used to catch the lookup return when typing \\[lyskom-complete].
Or when typing \\[lyskom-complete-and-exit] and there are several alternatives
then completing and trying to read again."
(let (nos
(completion-ignore-case t)) ;+++ should perhaps be
;lyskom-ignore-case-in-names flag
;instead
(cond
((null conf-stats) ;+++ Annan felhantering
(lyskom-completing-read-2 kom-queue handler prompt type new empty initial
data curwin))
((null (cdr conf-stats)) ;Sole completion.
(if (string= initial (conf-stat->name (car conf-stats)))
(progn
(lyskom-message "%s" (concat prompt initial " [Sole completion]"))
(sit-for 2)))
(lyskom-completing-read-2 kom-queue handler prompt type new empty
(conf-stat->name (car conf-stats))
data curwin))
((and (eq what ?X) ;Exact match is OK even if other
(setq nos (car (apply 'append;matches exist.
(mapcar
'lyskom-complete-test-exact-name
conf-stats)))))
(lyskom-complete-return nos handler data curwin))
(t ;Difficult one.
(let ((newname
(lyskom-try-complete-partials initial
(mapcar
'lyskom-complete-get-name-in-list
conf-stats))))
(if completion-auto-help ;Build list more often.
;Easier here, we have the conf-stats
(lyskom-show-completions conf-stats kom-queue handler prompt
type new empty
newname data curwin)
(lyskom-completing-read-2 kom-queue handler prompt type new empty
newname data curwin)))))))
(defun lyskom-complete-test-exact-name (stat)
"Returns a list containing the conf-no if CONF-STAT matches exactly.
The variable that the name is tested against is the locally bound initial."
(and (string= (upcase (conf-stat->name stat))
(upcase initial))
(list (conf-stat->conf-no stat))))
(defun lyskom-complete-get-name-in-list (stat)
"Returns a list of the name (a string) in CONF-STAT."
(list (conf-stat->name stat)))
;; lyskom-try-complete-partials used in the new version also.
(defun lyskom-complete-verify-type (conf-stat
kom-queue handler prompt type new empty
initial what data curwin)
"Used to allow people to write [mp] <number> also."
(if (and conf-stat ;+++ Annan felhantering
(or (null type)
(and (eq type 'person)
(conf-type->letterbox (conf-stat->conf-type conf-stat)))
(and (eq type 'conf)
(not (conf-type->letterbox
(conf-stat->conf-type conf-stat))))))
(lyskom-complete-return (conf-stat->conf-no conf-stat) handler
data curwin)
(lyskom-completing-read-2 kom-queue handler prompt type new empty initial
data curwin)))
(if lyskom-completing-map
nil
(setq lyskom-completing-map (make-sparse-keymap))
(define-key lyskom-completing-map "\n" 'lyskom-complete-and-exit)
(define-key lyskom-completing-map "\r" 'lyskom-complete-and-exit)
(define-key lyskom-completing-map "\t" 'lyskom-complete)
(define-key lyskom-completing-map "\C-g" 'lyskom-complete-quit)
; (define-key lyskom-completing-map "\C-\M-v" 'lyskom-scroll-other-minibuffer)
(define-key lyskom-completing-map "?" 'lyskom-complete-help))
(if lyskom-initial-completing-map
nil
(setq lyskom-initial-completing-map (make-keymap))
(cond
((fboundp 'map-keymap) ;lucid-emacs' way of doing things.
(map-keymap
(function (lambda (keydesc binding)
(define-key lyskom-initial-completing-map (vector keydesc)
'lyskom-hack-minibuf)))
global-map))
((string-match "^19" emacs-version)
(let ((i (length (car (cdr lyskom-initial-completing-map)))))
(while (>= (setq i (1- i)) 0)
(aset (car (cdr lyskom-initial-completing-map))
i 'lyskom-hack-minibuf)))
)
(t ; emacs-18.
(let ((i (length lyskom-initial-completing-map)))
(while (>= (setq i (1- i)) 0)
(aset lyskom-initial-completing-map i 'lyskom-hack-minibuf)))))
(define-key lyskom-initial-completing-map "\C-g" 'lyskom-complete-quit))
(defun lyskom-complete-and-exit ()
"Exit the minibuffer if the contents matches a single type."
(interactive)
(setq window-conf (current-window-configuration))
(goto-char (point-min))
(insert "X")
(exit-minibuffer))
(defun lyskom-complete-quit ()
"Exit the minibuffer if the contents matches a single type."
(interactive)
(setq window-conf (current-window-configuration))
(goto-char (point-min))
(insert "G")
(exit-minibuffer))
(defun lyskom-complete-help ()
"Build a list of completions and show it."
(interactive)
(setq window-conf (current-window-configuration))
(goto-char (point-min))
(insert "L")
(exit-minibuffer))
(defun lyskom-complete ()
"Insert the completing parts of the name."
(interactive)
(setq window-conf (current-window-configuration))
(goto-char (point-min))
(insert "C")
(exit-minibuffer))
(defun lyskom-scroll-other-minibuffer ()
"Scrolls the buffer with completions if there is one."
(interactive)
(setq minibuffer-scroll-window (get-buffer-window " *Completions*"))
(scroll-other-window))
(defun lyskom-get-from-conf-list (type-list conf-nos type)
"Returns a list of all conf-nos of a certain type.
The sequence TYPE-LIST and CONF-NOS have to be corresponding. The TYPE is the
one chosen. (nil person or conf see lyskom-completing-read)."
(let* ((list nil)
(r 0))
(while (< r (length type-list))
(let ((conf-type (elt type-list r))
(conf-no (elt conf-nos r)))
(if (or (null type)
(and (eq type 'person)
(conf-type->letterbox conf-type))
(and (eq type 'conf)
(not (conf-type->letterbox conf-type))))
(setq list (cons conf-no list))))
(setq r (1+ r)))
(nreverse list)))