Commit 3a2a8cc1 authored by David Byers's avatar David Byers
Browse files

Bugfixar, stöd för nya medlemskapsyper, diverse

parent 0843a29d
1998-06-10 David Byers <davby@ida.liu.se>
* utilities.el (lyskom-current-time): Ny funktion.
* startup.el (lyskom): Anvnd den
1998-06-08 David Byers <davby@ida.liu.se>
* services.el (initiate-set-membership-type): Ny funktion. Whee!
* parse.el: Lade till parsning av created-at i
lyskom-parse-membership och lyskom-parse-member
* komtypes.el: Lade till created-at i membership och member.
Tue Jun 2 11:49:27 1998 David Byers <davby@ida.liu.se>
* Lade in -*-coding: raw-text;-*- i alla filer.
......
......@@ -46,7 +46,7 @@ LANGUAGES = swedish english
SHELL = /bin/sh
RM = /bin/rm -f
EMACS=emacs
EMACS=xemacs
EMACS-BATCH = $(EMACS) -batch
GENERIC-CLEAN = *~ *.o core
GENERIC-DIST-CLEAN = TAGS
......
......@@ -18,11 +18,6 @@ Att g
** OSORTERADE
LysKOM fungerar inte i XEmacs i tty-mode. No such face:
kom-active-face. Antingen är det fixat eller så är det inte fel i
20.2. Jag har noterat liknande problem i 19.30 i Sun-consolen.
FIX BY: 0.46
Om förbindelsen bryts så får man args out of range ibland.
FIX BY: 0.46
......@@ -404,10 +399,6 @@ Att g
med den här flaggan som inte borde ha den eller nåt sånt.
FIX BY: 0.46
Implementera aux-items på medlemskap. En iten skulle vara att
medlemskapet egentligen är en inbjudan.
FIX BY: 0.46/2.0
** MARKERINGAR
......@@ -444,7 +435,12 @@ Att g
att kom-friends används, så man får närvaromeddelanden enbart om
sina vänner. Uppdatera även inställningsbufferten.
Det finns rester av den gamla vilkabufferten kvar i koden i cache.el.
Det finns rester av den gamla vilkabufferten kvar i koden i
cache.el.
Skriv ihop hantera medlemskap (prioritize-new.el.) Den skall
utnyttja den nya medlemskapsstrukturen.
Local variables:
......
......@@ -368,9 +368,33 @@
(defun lyskom-print-xface (item &optional obj)
(lyskom-xemacs-or-gnu
nil ;;; +++ FIXME: Do the right thing
(lyskom-maybe-add-face-to-string item
(make-string 0 ?X))
nil))
(defun lyskom-maybe-add-face-to-string (item string)
(lyskom-xemacs-or-gnu
(if (null item)
string
(unless (find-face 'kom-xface)
(make-face 'kom-xface))
(let* ((data (make-string 0 ?X))
(h (concat "X-Face: " (aux-item->data item)))
(g (intern h lyskom-xface-cache))
(e (make-extent 0 0 data)))
(if (boundp g)
(setq g (symbol-value g))
(set g (make-glyph
(list 'global (cons '(tty) [nothing]))
(list 'global (cons '(win)
(vector 'xface ':data h)))))
(setq g (symbol-value g))
(set-glyph-face g 'kom-xface))
(set-extent-begin-glyph e g)
data))
string))
(defun lyskom-print-alternate-name (item &optional obj)
(concat "Alternate: " (aux-item->data item) " "
(lyskom-aux-item-terminating-button item obj)))
......
......@@ -330,7 +330,7 @@ Ask for the name of the person, the conference to add him/her to."
(whereto (lyskom-read-conf-stat (lyskom-get-string 'where-to-add)
'(all) nil nil t))
(pers-stat (blocking-do 'get-pers-stat (conf-stat->conf-no who))))
(lyskom-add-member-answer (lyskom-try-add-member whereto who pers-stat)
(lyskom-add-member-answer (lyskom-try-add-member whereto who pers-stat nil)
whereto who)))
......@@ -346,7 +346,7 @@ Ask for the name of the person, the conference to add him/her to."
'(all) nil "" t)))
(who (blocking-do 'get-conf-stat lyskom-pers-no))
(pers-stat (blocking-do 'get-pers-stat lyskom-pers-no)))
(lyskom-add-member-answer (lyskom-try-add-member whereto who pers-stat)
(lyskom-add-member-answer (lyskom-try-add-member whereto who pers-stat nil)
whereto who)))
......@@ -361,14 +361,15 @@ for person PERS-NO and send them into lyskom-try-add-member."
(blocking-do-multiple ((whereto (get-conf-stat conf-no))
(who (get-conf-stat pers-no))
(pers-stat (get-pers-stat pers-no)))
(let ((result (lyskom-try-add-member whereto who pers-stat)))
(let ((result (lyskom-try-add-member whereto who pers-stat nil)))
(lyskom-add-member-answer result whereto who)
(if thendo
(apply thendo data))
result)))
(defun lyskom-try-add-member (conf-conf-stat pers-conf-stat pers-stat)
(defun lyskom-try-add-member (conf-conf-stat pers-conf-stat
pers-stat membership-type)
"Add a member to a conference.
Args: CONF-CONF-STAT PERS-CONF-STAT PERS-STAT
CONF-CONF-STAT: the conf-stat of the conference the person is being added to
......@@ -405,6 +406,11 @@ Returns t if it was possible, otherwise nil."
(lyskom-format 'where-on-list-q
(length lyskom-membership))))))))
(when (null membership-type)
(setq membership-type
(lyskom-create-membership-type nil nil nil nil
nil nil nil nil)))
(if (= (conf-stat->conf-no pers-conf-stat)
lyskom-pers-no)
(lyskom-format-insert 'member-in-conf
......@@ -415,7 +421,8 @@ Returns t if it was possible, otherwise nil."
(blocking-do 'add-member
(conf-stat->conf-no conf-conf-stat)
(conf-stat->conf-no pers-conf-stat)
priority where))))
priority where
membership-type))))
(defun lyskom-add-member-answer (answer conf-conf-stat pers-conf-stat)
......@@ -2282,7 +2289,7 @@ Uses Protocol A version 9 calls"
(defun lyskom-who-is-on-check-membership-8 (who-info-list conf-stat)
"Returns a list of those in WHO-INFO-LIST which is member in CONF-STAT."
(let ((members (blocking-do 'get-members (conf-stat->conf-no conf-stat)
0 (conf-stat->no-of-members conf-stat)))
0 (conf-stat->no-of-members conf-stat)))
(len (length who-info-list))
(i 0)
(res nil))
......
......@@ -250,8 +250,8 @@ otherwise: the conference is read with lyskom-completing-read."
(if (lyskom-j-or-n-p
(lyskom-get-string 'show-members-list-also-q))
(let ((member-list (blocking-do 'get-members
(conf-stat->conf-no conf-stat)
0 lyskom-max-int)))
(conf-stat->conf-no conf-stat)
0 lyskom-max-int)))
(lyskom-format-insert 'conf-has-these-members
conf-stat)
......@@ -260,10 +260,10 @@ otherwise: the conference is read with lyskom-completing-read."
(progn
(lyskom-insert-string 'member-list-header)
(lyskom-traverse
member (conf-no-list->conf-nos member-list)
member (member-list->members member-list)
(let ((membership (blocking-do
'query-read-texts
member
(member->conf-no member)
(conf-stat->conf-no conf-stat))))
;; Print a row describing the membership of MEMBER
;; (described by MEMBERSHIP) in CONF-STAT.
......@@ -284,13 +284,25 @@ otherwise: the conference is read with lyskom-completing-read."
(if (zerop unread)
" "
(format "%7d " unread))
member))))))
(member->conf-no member)
(lyskom-return-membership-type (member->membership-type member))
)
(when (and (member->created-by member)
(not (zerop (member->created-by member)))
(not (eq (member->conf-no member)
(member->created-by member))))
(lyskom-format-insert 'conf-membership-line-2
(lyskom-return-date-and-time
(member->created-at member))
(member->created-by member)))
)))))
;; Don't show membership info
(lyskom-insert "\n")
(lyskom-traverse
member (conf-no-list->conf-nos member-list)
(lyskom-format-insert " %#1P\n" member))))))))
member (member-list->members member-list)
(lyskom-format-insert " %#1P\n"
(member->conf-no member)))))))))
;;; ================================================================
......@@ -437,7 +449,18 @@ otherwise: the conference is read with lyskom-completing-read."
(conf-stat->supervisor member-conf-stat))
(lyskom-get-string 'is-supervisor-mark)
" ")
member-conf-stat)
member-conf-stat
(lyskom-return-membership-type (membership->type membership))
)
(when (and (membership->created-by membership)
(not (zerop (membership->created-by membership)))
(not (eq (conf-stat->conf-no conf-stat)
(membership->created-by membership))))
(lyskom-format-insert 'pers-membership-line-2
(lyskom-return-date-and-time
(membership->created-at membership))
(membership->created-by membership)))
(setq lyskom-count-var (+ lyskom-count-var unread)))))))
;; "Print the total number of unread texts for the person CONF-STAT."
......@@ -1917,3 +1940,46 @@ membership info."
nil nil secret nil nil nil nil nil)
0 label)))
(cache-del-conf-stat objno)))))
(defun lyskom-read-text-no-prefix-arg (prompt command)
"Call in interactive list to read text-no"
(cond
((null current-prefix-arg) lyskom-current-text)
((integerp current-prefix-arg) current-prefix-arg)
((listp current-prefix-arg)
(lyskom-read-number (lyskom-get-string prompt)))
(t (signal 'lyskom-internal-error (list command)))))
(def-kom-command kom-fast-reply (&optional text-no)
"Add a fast reply to a text."
(interactive (list (lyskom-read-text-no-prefix-arg 'what-fast-reply-no
'kom-fast-reply)))
(lyskom-fast-reply text-no
(lyskom-read-string
(lyskom-get-string 'fast-reply-prompt)
nil
'lyskom-fast-reply-history)))
(def-kom-command kom-agree (&optional text-no)
"Convenience function to add agreement."
(interactive (list (lyskom-read-text-no-prefix-arg 'what-agree-no
'kom-agree)))
(lyskom-fast-reply text-no (lyskom-read-string (lyskom-get-string 'agree-prompt)
(lyskom-get-string 'default-agree-string)
'lyskom-fast-reply-history)))
(defun lyskom-fast-reply (text-no message)
"To text TEXT-NO add MESSAGE as a fast reply."
(lyskom-report-command-answer
(blocking-do 'modify-text-info
text-no
nil
(list (lyskom-create-aux-item 0 2 0 0
(lyskom-create-aux-item-flags
nil nil nil nil nil nil nil nil)
0 message)))))
......@@ -438,7 +438,7 @@ is sent with each packet. If STRING is longer it is splitted."
process
(progn
(if lyskom-debug-communications-to-buffer
(lyskom-debug-insert process ">>>>>> " string))
(lyskom-debug-insert process "-> " string))
string)))
(t
(let ((i 0))
......@@ -457,7 +457,8 @@ is sent with each packet. If STRING is longer it is splitted."
(goto-char (point-max))
(insert "\n"
(format "%s" process)
(concat ">>>>>> " string)))
"-> "
string))
(set-buffer (process-buffer process))))
string))
(setq i (+ i lyskom-max-packet-size)))))))
......
......@@ -1225,15 +1225,26 @@ FOOTN-TO or FOOTN-IN."
;;; Constructor:
(def-komtype member-list members)
(def-komtype member conf-no created-by created-at membership-type)
(def-komtype membership-type invitation passive secret rsv1
rsv2 rsv3 rsv4 rsv5)
(defsubst lyskom-create-membership (last-time-read
conf-no
priority
last-text-read
read-texts)
read-texts
created-by
created-at
type)
"Create a membership from all parameters."
(cons
'MEMBERSHIP
(vector last-time-read conf-no priority last-text-read read-texts
created-by created-at type
)))
......@@ -1259,6 +1270,19 @@ FOOTN-TO or FOOTN-IN."
"Get read-texts from membership."
(elt (cdr membership) 4))
(defsubst membership->created-by (membership)
"Get created-by from membership"
(elt (cdr membership) 5))
(defsubst membership->created-at (membership)
"Get created-by from membership"
(elt (cdr membership) 6))
(defsubst membership->type (membership)
"Get type from membership"
(elt (cdr membership) 7))
;;; Modifiers:
......@@ -1282,6 +1306,18 @@ FOOTN-TO or FOOTN-IN."
"Set read-texts in membership to NEWVAL."
(aset (cdr membership) 4 newval))
(defsubst set-membership->created-by (membership newval)
"Set created-by in membership to NEWVAL."
(aset (cdr membership) 5 newval))
(defsubst set-membership->created-at (membership newval)
"Set type in membership to NEWVAL."
(aset (cdr membership) 6 newval))
(defsubst set-membership->type (membership newval)
"Set type in membership to NEWVAL."
(aset (cdr membership) 7 newval))
;;; Predicate:
......
......@@ -171,8 +171,9 @@ If there is no active area, then do something else."
(defun kom-mouse-null (event)
"Do nothing."
(interactive "@e")
;; This is here to pervent unwanted events when clicking mouse-3
(interactive "e"))
)
(defun lyskom-make-button-menu (title entries buf arg text)
"Create a menu keymap from a list of button actions."
......
......@@ -505,6 +505,33 @@ reading list then the conf is inserted last in the to do list."
Prints the name and amount of unread in the conference we just went to
according to the value of kom-print-number-of-unread-on-entrance.
Args: CONF-STAT READ-INFO"
;;
;; Deal with special membership types
;;
(let ((mship (lyskom-get-membership (conf-stat->conf-no conf-stat))))
(when mship
;; Check for invitation
(when (membership-type->invitation (membership->type mship))
(lyskom-format-insert 'your-invited
conf-stat
(membership->created-by mship))
(when (lyskom-j-or-n-p (lyskom-get-string 'accept-invitation))
(set-membership-type->invitation (membership->type mship)
nil)
(initiate-set-membership-type
'main
nil
lyskom-pers-no
(conf-stat->conf-no conf-stat)
(membership->type mship))))
;; Check for going to passive membership
(when (membership-type->passive (membership->type mship))
(lyskom-format-insert 'enter-passive conf-stat))))
(lyskom-run-hook-with-args 'lyskom-change-conf-hook
lyskom-current-conf
(conf-stat->conf-no conf-stat))
......@@ -641,7 +668,7 @@ This function does not use blocking-do."
CONF-NO.
If the membership list is not fully prefetched and the membership can't be
found inlyskom-membership, a blocking call to the server is made."
found in lyskom-membership, a blocking call to the server is made."
(or (lyskom-try-get-membership conf-no)
(and (not (lyskom-membership-is-read))
(let ((membership
......@@ -709,25 +736,26 @@ The position lyskom-last-viewed will always remain visible."
;;;
(defsubst lyskom-do-insert (string)
(defun lyskom-do-insert (string)
(let ((start (point)))
(insert string)
(let ((bounds (next-text-property-bounds 1 (max 1 (1- start))
'special-insert))
(next (make-marker))
(fn nil))
(while bounds
(set-marker next (cdr bounds))
(setq fn (get-text-property (car bounds) 'special-insert))
(remove-text-properties (car bounds) (cdr bounds)
'(special-insert))
(condition-case val
(funcall fn (car bounds) (cdr bounds))
(error (apply 'message (cdr val))))
(setq start next)
(setq bounds (next-text-property-bounds 1 start
'special-insert)))))
)
(insert string)
(let ((bounds (next-text-property-bounds 1 (max 1 (1- start))
'special-insert))
(next (make-marker))
(fn nil))
(while bounds
(set-marker next (cdr bounds))
(setq fn (get-text-property (car bounds) 'special-insert))
(remove-text-properties (car bounds) (cdr bounds)
'(special-insert))
(condition-case val
(funcall fn (car bounds) (cdr bounds))
(error (apply 'message (cdr val))))
(setq start next)
(setq bounds (next-text-property-bounds 1 start
'special-insert))))
))
(defun lyskom-insert (string)
......@@ -1207,10 +1235,15 @@ Note that it is not allowed to use deferred insertions in the text."
(setq arg tmp)
(let ((aux (conf-stat-find-aux arg
10
lyskom-pers-no)))
(if aux
(concat (aux-item->data (car aux)) " *")
(conf-stat->name arg))))))
lyskom-pers-no))
(face (conf-stat-find-aux arg
9)))
(lyskom-maybe-add-face-to-string
face
(if aux
(concat (aux-item->data (car aux)) " *")
(conf-stat->name arg))))
)))
;; Find the name and return it
((integerp arg)
......@@ -2241,7 +2274,7 @@ Set lyskom-current-prompt accordingly. Tell server what I am doing."
'next-text)
((not (read-list-isempty lyskom-to-do-list))
'next-conf)
;; This is not really true. The pretech may still be fetching the
;; This is not really true. The prefetch may still be fetching the
;; membership. One possible way is to test for a non-numeric,
;; non-nil value. Or even better, introduce a test function to
;; isolate the test.
......@@ -2696,8 +2729,8 @@ If MEMBERSHIPs prioriy is 0, it always returns nil."
(if (not lyskom-debug-what-i-am-doing)
(if (not (and (eq ?: (elt output 0))
(eq ?5 (elt output 1))))
(lyskom-debug-insert proc "-----> " output))
(lyskom-debug-insert proc "-----> " output)))
(lyskom-debug-insert proc "<- " output))
(lyskom-debug-insert proc "<- " output)))
(set-buffer (process-buffer proc))
(princ output lyskom-unparsed-marker)
......@@ -2821,6 +2854,8 @@ Other objects are converted correctly."
(lyskom-format-conf-type object))
((eq (car object) 'PRIVS)
(lyskom-format-privs object))
((eq (car object) 'MEMBERSHIP-TYPE)
(lyskom-format-membership-type object))
((eq (car object) 'LIST)
(lyskom-format-simple-list (cdr object)))
(t
......@@ -2835,6 +2870,18 @@ Other objects are converted correctly."
object))))))
(defun lyskom-format-membership-type (membership-type)
"Format a MEMBERSHIP-TYPE for output to the server."
(concat
(lyskom-format-bool (membership-type->invitation membership-type))
(lyskom-format-bool (membership-type->passive membership-type))
(lyskom-format-bool (membership-type->secret membership-type))
(lyskom-format-bool (membership-type->rsv1 membership-type))
(lyskom-format-bool (membership-type->rsv2 membership-type))
(lyskom-format-bool (membership-type->rsv3 membership-type))
(lyskom-format-bool (membership-type->rsv4 membership-type))
(lyskom-format-bool (membership-type->rsv5 membership-type))))
(defun lyskom-format-conf-type (conf-type)
"Format a CONF-TYPE for output to the server."
(concat
......
......@@ -91,10 +91,9 @@ lyskom-unparsed-buffer is exhausted."
Return nil, or signal lyskom-protocol-error if the
first non-white character was not equal to CHAR."
(if (/= char (lyskom-parse-nonwhite-char))
(signal 'lyskom-protocol-error
(list (concat
"Expecting " (char-to-string char) " but got "
(char-to-string (char-after (1- lyskom-parse-pos))))))
(lyskom-protocol-error 'lyskom-expect-char
"Expecting %S but got %S"
char (char-after (1- lyskom-parse-pos)))
nil))
......@@ -124,9 +123,11 @@ Signal lyskom-protocol-error if the next token is not a number."
((looking-at "[ \n]*\\'")
(goto-char (point-max))
(signal 'lyskom-parse-incomplete nil))
(t (signal 'lyskom-protocol-error
(list (concat "Expected number, got "
(lyskom-string-to-parse)))))))
(t (lyskom-protocol-error 'lyskom-parse-num
"Expected number, got %S"
(lyskom-string-to-parse))))
)
(defun lyskom-parse-string ()
......@@ -142,7 +143,9 @@ Signal lyskom-protocol-error if the next token is not a string."
((string-match "\\`[0-9]*\\(\\|H\\)\\'" to-parse)
(signal 'lyskom-parse-incomplete nil))
((null (string-match "\\`[0-9]+H" to-parse))
(signal 'lyskom-protocol-error (list to-parse))) ;Not a legal string.
(lyskom-protocol-error 'lyskom-parse-string
"Expected hollerith, got %S"
to-parse)) ;Not a legal string.
(t
(let ((end (match-end 0))
(len (string-to-int to-parse)))
......@@ -167,10 +170,8 @@ Signal lyskom-parse-incomplete if there is no nonwhite char to parse."
(cond
((= char ?0) nil)
((= char ?1) t)
(t (signal 'lyskom-protocol-error
(list 'lyskom-parse-1-or-0 char
lyskom-parse-pos
(buffer-string)))))))
(t (lyskom-protocol-error 'lyskom-parse-1-or-0
"Expected boolean, got %S" char)))))
(defun lyskom-parse-bitstring (default)
......@@ -192,10 +193,9 @@ Signal lyskom-parse-incomplete if there is no nonwhite char to parse."
;; expected.
(setq continue nil))
(t (signal 'lyskom-protocol-error
(list 'lyskom-parse-bitstring char
lyskom-parse-pos
(buffer-string))))))
(t (lyskom-protocol-error 'lyskom-parse-bitstring
"Expected bool or space, got %S"
char))))
(if (not (or (eq char ?\ )
(eq char ?\n)))
;; This occurs when the received string is longer than
......@@ -245,7 +245,8 @@ Signal lyskom-parse-incomplete if there is no nonwhite char to parse."
(lyskom-parse-num))
((string-match "\\`[0-9]\\'" to-parse) ;Incomplete number?
(signal 'lyskom-parse-incomplete nil))
(t (signal 'lyskom-protocol-error (list to-parse))))))
(t (lyskom-protocol-error 'lyskom-skip-one-token
"Unrecognized token")))))
(defun lyskom-skip-array ()
......@@ -318,10 +319,8 @@ result is assigned to the element."
(prog1
(lyskom-parse-misc-info-list-sub n)
(lyskom-expect-char ?})))
(t ;Error.
(signal 'lyskom-protocol-error (list 'lyskom-parse-misc-info-list
"Expected * or {, got "
(char-to-string char)))))))
(t (lyskom-protocol-error 'lyskom-parse-misc-info-list
"Expected * or {, got %S" char)))))
(defun lyskom-parse-misc-info-list-sub (n)
......@@ -346,10 +345,8 @@ result is assigned to the element."
(setq res (lyskom-parse-misc-footn-in last n)))
((eq next-key 15) ;bcc-recpt
(setq res (lyskom-parse-misc-recipient 'BCC-RECPT last n)))
(t ;error!
(signal 'lyskom-protocol-error
(list 'lyskom-parse-misc-info-list-sub
"Unknown misc-type " next-key))))
(t (lyskom-protocol-error 'lyskom-parse-misc-info-list-sub
"Unknown misc-info type %S" next-key)))
(setq n (car res))