Commit d8a8cb58 authored by David Byers's avatar David Byers
Browse files

Major performance improvements. Minor bug fixes.

Detailed changes:
> 2004-07-11  David Byers  <byers@lysator.liu.se>
>
> 	Performance improvements:
> 	* prefetch.el: Completely new implementation.
>
> 	New implementation of lyskom-membership using AVL trees:
> 	* commands2.el (kom-list-news): Use lyskom-traverse-membership
> 	instead of mapping over lyskom-membership.
> 	(lyskom-update-membership-buffer): Use lyskom-traverse-membership
> 	instead of traversing lyskom-membership
>
> 	* stack-m.el: New file. Copied from elib with modifications.
>
> 	* elib-node.el: New file. Copied from elib with modifications.
>
> 	* avltree.el: New file. Copied from elib with modifications.
>
> 	* prefetch.el (lyskom-prefetch-membership-handler): Use
> 	lyskom-add-memberships-to-membership since this function now
> 	maintains a sorted membership list.
>
> 	* reading.el (lyskom-membership-<): Moved here from lyskom-rest.el.
> 	(lyskom-membership-length): New function.
> 	(lyskom-init-membership): New function.
> 	(lyskom-membership-position): New implementation.
> 	(lyskom-remove-membership): New implementation.
> 	(lyskom-replace-membership): New implementation.
> 	(lyskom-insert-membership): New implementation.
> 	(lyskom-add-memberships-to-membership): New implementation.
> 	(lyskom-update-membership-positions): New implementation.
> 	(lyskom-mship-cache-del): New function.
> 	(lyskom-mship-cache-put): New function.
> 	(lyskom-mship-cache-get): New function.
> 	(lyskom-mship-cache-create): New function.
> 	(lyskom-mship-cache-data): New function.
> 	(lyskom-mship-cache-index): New function.
> 	(lyskom-mship-cache): New variable.
> 	(lyskom-get-membership): Moved here from lyskom-rest.el. New
> 	implementation.
> 	(lyskom-try-get-membership): Ditto.
>
> 	* commands1.el (lyskom-add-member): Reimplement position
> 	calculation using lyskom-traverse-membership and possibly fixing a
> 	bug along the way.
>
> 	* macros.el (lyskom-traverse): New implementation using catch and
> 	no hard-coded variable names.
> 	(lyskom-traverse-break): New implementation using throw.
> 	(lyskom-traverse-aux): New implementation using catch and
> 	new-style backqoutes.
> 	(lyskom-traverse-membership): New macro.
>
> 	* commands1.el (kom-delete-conf): Don't manipulate
> 	lyskom-membership directly.
> 	(lyskom-add-member): Ditto.
>
> 	* startup.el (lyskom-set-membership): Removed. Not used.
> 	(lyskom-clear-vars): Don't save lyskom-membership or
> 	lyskom-membership-is read. They're overwritten anyway.
>
> 	* macros.el (lyskom-with-lyskom-buffer): New macro.
>
> 2004-06-28  David Byers  <byers@lysator.liu.se>
>
> 	Fix a bug where texts were not marked as read when they got a new
> 	recipient and also weren't placed in the read-list:
> 	* view-text.el (lyskom-mark-as-read): Use lyskom-recpt-types-list
> 	instead of hard-coding the list.
>
> 	* async.el (lyskom-async-new-recipient): When processing a new
> 	recipient, call mark-as-read with the text's local number, not
> 	it's global number.
>
parent 824bbcd3
2004-07-11 David Byers <byers@lysator.liu.se>
Performance improvements:
* prefetch.el: Completely new implementation.
New implementation of lyskom-membership using AVL trees:
* commands2.el (kom-list-news): Use lyskom-traverse-membership
instead of mapping over lyskom-membership.
(lyskom-update-membership-buffer): Use lyskom-traverse-membership
instead of traversing lyskom-membership
* stack-m.el: New file. Copied from elib with modifications.
* elib-node.el: New file. Copied from elib with modifications.
* avltree.el: New file. Copied from elib with modifications.
* prefetch.el (lyskom-prefetch-membership-handler): Use
lyskom-add-memberships-to-membership since this function now
maintains a sorted membership list.
* reading.el (lyskom-membership-<): Moved here from lyskom-rest.el.
(lyskom-membership-length): New function.
(lyskom-init-membership): New function.
(lyskom-membership-position): New implementation.
(lyskom-remove-membership): New implementation.
(lyskom-replace-membership): New implementation.
(lyskom-insert-membership): New implementation.
(lyskom-add-memberships-to-membership): New implementation.
(lyskom-update-membership-positions): New implementation.
(lyskom-mship-cache-del): New function.
(lyskom-mship-cache-put): New function.
(lyskom-mship-cache-get): New function.
(lyskom-mship-cache-create): New function.
(lyskom-mship-cache-data): New function.
(lyskom-mship-cache-index): New function.
(lyskom-mship-cache): New variable.
(lyskom-get-membership): Moved here from lyskom-rest.el. New
implementation.
(lyskom-try-get-membership): Ditto.
* commands1.el (lyskom-add-member): Reimplement position
calculation using lyskom-traverse-membership and possibly fixing a
bug along the way.
* macros.el (lyskom-traverse): New implementation using catch and
no hard-coded variable names.
(lyskom-traverse-break): New implementation using throw.
(lyskom-traverse-aux): New implementation using catch and
new-style backqoutes.
(lyskom-traverse-membership): New macro.
* commands1.el (kom-delete-conf): Don't manipulate
lyskom-membership directly.
(lyskom-add-member): Ditto.
* startup.el (lyskom-set-membership): Removed. Not used.
(lyskom-clear-vars): Don't save lyskom-membership or
lyskom-membership-is read. They're overwritten anyway.
* macros.el (lyskom-with-lyskom-buffer): New macro.
2004-06-28 David Byers <byers@lysator.liu.se>
Fix a bug where texts were not marked as read when they got a new
recipient and also weren't placed in the read-list:
* view-text.el (lyskom-mark-as-read): Use lyskom-recpt-types-list
instead of hard-coding the list.
* async.el (lyskom-async-new-recipient): When processing a new
recipient, call mark-as-read with the text's local number, not
it's global number.
2004-07-03 Ulrik Haugen <qha@lysator.liu.se>
* Makefile (DPKG_BUILDPACKAGE_OPTIONS): Buggfix, don't set
......
......@@ -70,6 +70,9 @@ LANGUAGE-EL := $(LANGUAGES:=-strings.el) $(LANGUAGES:=-help.el)
# Finally, other source files.
SOURCES = komtypes.el \
clienttypes.el \
elib-node.el \
stack-m.el \
avltree.el \
faces.el \
deferred-insert.el \
utilities.el \
......
......@@ -654,10 +654,13 @@ converted, before insertion."
(if (and kom-mark-read-texts-as-read-in-new-recipient
(lyskom-text-read-at-least-once-p text-stat t)
(not (eq conf-no lyskom-pers-no)))
(initiate-mark-as-read 'follow
nil
conf-no
(list text-no))
(lyskom-traverse misc-info (text-stat->misc-info-list text-stat)
(when (and (memq (misc-info->type misc-info) lyskom-recpt-types-list)
(eq conf-no (misc-info->recipient-no misc-info)))
(initiate-mark-as-read 'follow
nil
conf-no
(list (misc-info->local-no misc-info)))))
;; Text is previously unread or in the mailbox
(let ((local-no nil))
......
......@@ -95,8 +95,8 @@ eventually be permanently deleted."
lyskom-pers-no)
(lyskom-insert (lyskom-get-string
'you-have-deleted-yourself))
(lyskom-init-membership)
(setq lyskom-pers-no nil
lyskom-membership nil
lyskom-to-do-list (lyskom-create-read-list)
lyskom-reading-list (lyskom-create-read-list)
lyskom-pending-commands (cons
......@@ -667,11 +667,11 @@ be called from a callback."
(>= kom-membership-default-placement 0))
kom-membership-default-placement)
((eq kom-membership-default-placement 'first) 0)
((eq kom-membership-default-placement 'last) (length lyskom-membership))
((eq kom-membership-default-placement 'last) (lyskom-membership-length))
(t (lyskom-read-num-range
0 (pers-stat->no-of-confs pers-stat)
(lyskom-format 'where-on-list-q
(length lyskom-membership)))))))
(lyskom-membership-length)))))))
(message-flag (if mship-type
(membership-type->message-flag mship-type)
(lyskom-j-or-n-p (lyskom-format 'set-message-flag-q whereto))))
......@@ -699,24 +699,20 @@ be called from a callback."
;; the membership lsit sorted.
(when (eq lyskom-pers-no (conf-stat->conf-no who))
(let ((mship-list lyskom-membership)
(mship nil)
(index 0)
(found nil))
(while mship-list
(setq mship (car mship-list)
mship-list (cdr mship-list))
(cond ((> (membership->priority mship) priority))
((< (membership->priority mship) priority)
(setq position index mship-list nil found t))
((and (= (membership->priority mship) priority)
(= index position))
(setq mship-list nil found t))
((and (= (membership->priority mship) priority)
(> index position))
(setq position index mship-list nil found t)))
(setq index (1+ index))
(unless found (setq position (1+ index))))))
(setq position
(let ((index 0))
(lyskom-traverse-membership mship
(cond ((> (membership->priority mship) priority))
((< (membership->priority mship) priority)
(lyskom-traverse-break index))
((and (= (membership->priority mship) priority)
(= index position))
(lyskom-traverse-break position))
((and (= (membership->priority mship) priority)
(> index position))
(lyskom-traverse-break index)))
(setq index (1+ index))))))
;; Print the prompt
......
......@@ -79,7 +79,7 @@ See `kom-list-membership-in-window'."
(let ((inhibit-read-only t))
(save-excursion (set-buffer buf)
(erase-buffer))
(lyskom-traverse x lyskom-membership
(lyskom-traverse-membership x
(initiate-get-conf-stat 'membership 'lyskom-memb-received-1
(membership->conf-no x)
x buf))))))
......@@ -924,14 +924,14 @@ See `kom-allow-incompleteness'."
(when num-arg
(cond
((= num-arg 0)
(lyskom-traverse-membership el
(when (not (membership-type->passive (membership->type el)))
(setq lyskom-iter-list-news-mship-confs
(cons (membership->conf-no el)
lyskom-iter-list-news-mship-confs))))
(setq at-least nil
lyskom-iter-list-news-mship-confs
(delq nil
(mapcar (lambda (el)
(when (not (membership-type->passive
(membership->type el)))
(membership->conf-no el)))
lyskom-membership))))
lyskom-iter-list-news-mship-confs (nreverse lyskom-iter-list-news-mship-confs)))
((> num-arg 0)
(lyskom-format-insert 'list-unread-with-n-unread
(setq at-least num-arg)))
......
......@@ -942,7 +942,7 @@ CONF can be a a conf-stat or a string."
name
(make-string 27 ? ))
0 27)))
(if (zerop total-unread)
(lyskom-remove-unread-buffer lyskom-buffer)
(lyskom-add-unread-buffer lyskom-buffer))
......@@ -952,74 +952,6 @@ CONF can be a a conf-stat or a string."
(force-mode-line-update)))
;;; ================================================================
;;; +++Where should this be moved???
(def-kom-var lyskom-membership-table nil
"Association list mapping conferences to memberships."
local)
(defun lyskom-membership-table-add (membership)
(let ((tmp (assq (membership->conf-no membership) lyskom-membership-table)))
(if tmp
(setcdr tmp membership)
(setq lyskom-membership-table
(cons (cons (membership->conf-no membership) membership)
lyskom-membership-table)))))
(defun lyskom-membership-table-del (conf-no)
(setq lyskom-membership-table
(delq (assq conf-no lyskom-membership-table)
lyskom-membership-table)))
(defun lyskom-try-get-membership (conf-no &optional want-passive)
"Returns non-nil if conference CONF-NO is present on lyskom-membership.
The value is actually the membership for the conference.
For foreground functions, lyskom-get-membership should probably be used
instead.
This function does not use blocking-do.
Optional argument mship-list is the membership list to look in."
(save-excursion
(set-buffer lyskom-buffer)
(let ((list lyskom-membership)
(found (cdr (assq conf-no lyskom-membership-table))))
(while (and (not found) (not (null list)))
(if (= conf-no (membership->conf-no (car list)))
(setq found (car list)))
(setq list (cdr list)))
(if (and found
(or want-passive
(not (membership-type->passive (membership->type found)))))
found
nil))))
(defun lyskom-get-membership (conf-no &optional want-passive)
"Get the membership for CONF-NO, or nil if the user is not a member of
CONF-NO.
If the membership list is not fully prefetched and the membership can't be
found in lyskom-membership, a blocking call to the server is made."
(save-excursion
(set-buffer lyskom-buffer)
(or (lyskom-try-get-membership conf-no want-passive)
(and (not (lyskom-membership-is-read))
(let ((membership
(blocking-do 'query-read-texts lyskom-pers-no conf-no t 0)))
(if (and membership (lyskom-visible-membership membership))
(lyskom-add-membership membership conf-no))
(if (and membership
(or want-passive
(not (membership-type->passive
(membership->type membership)))))
membership
nil))))))
;;;; ================================================================
......@@ -3849,19 +3781,6 @@ Returns the selected alternative (a symbol)"
(elt (assq input-char alts) 2))))
(defun lyskom-membership-< (a b)
"Retuns t if A has a higher priority than B. A and B are memberships."
(cond ((> (membership->priority a)
(membership->priority b)) t)
((and (= (membership->priority a)
(membership->priority b))
(numberp (membership->position a))
(numberp (membership->position b)))
(< (membership->position a)
(membership->position b)))
(t nil)))
(defun impl ()
(error "Not implemented"))
......
......@@ -51,52 +51,59 @@
(defmacro lyskom-traverse (atom sequence &rest body)
"Bind ATOM to each element in SEQUENCE and execute BODY.
Value returned is always nil."
`(let* ((__i__ 0)
(__sequence__ ,sequence)
(__len__ (or (listp __sequence__ )
(length __sequence__)))
(,atom nil)
(__result__ nil))
(setq __result__ __result__) ; Get rid of compiler warnings
(if (listp __sequence__)
(while __sequence__
(setq ,atom (car __sequence__))
,@body
(setq __sequence__ (cdr __sequence__)))
(while (< __i__ __len__)
(setq ,atom (aref __sequence__ __i__))
,@body
(setq __i__ (1+ __i__))))
__result__))
(defmacro lyskom-traverse-break (&optional result)
"Break a current lyskom-traverse"
`(progn (setq __len__ 0)
(setq __sequence__ nil)
(setq __result__ (or ,result __result__))))
(let ((seq-sym (make-symbol "sequence"))
(len-sym (make-symbol "len"))
(idx-sym (make-symbol "index")))
`(catch 'lyskom-traverse
(let* ((,seq-sym ,sequence)
(,idx-sym 0)
(,len-sym (or (listp ,seq-sym)
(length ,seq-sym)))
(,atom nil))
(if (listp ,seq-sym)
(while ,seq-sym
(setq ,atom (car ,seq-sym))
,@body
(setq ,seq-sym (cdr ,seq-sym)))
(while (< ,idx-sym ,len-sym)
(setq ,atom (aref ,seq-sym ,idx-sym))
,@body
(setq ,idx-sym (1+ ,idx-sym))))))))
(defmacro lyskom-traverse-membership (var &rest forms)
"Traverse the membership list.
Variable VAR is bound to each membership, in turn, and FORMS are evaluated."
`(catch 'lyskom-traverse
(lyskom-avltree-traverse
(lambda (,var) ,@forms) (lyskom-mship-cache-data))))
(defmacro lyskom-traverse-aux (atom sequence &rest body)
"Bind ATOM to each element in SEQUENCE and execute BODY.
Value returned is always nil."
(let ((seq (make-symbol "aux-items")))
(` (let (((, seq) (, sequence))
((, atom) nil))
(while (, seq)
(setq (, atom) (car (, seq)))
(let ((seq-sym (make-symbol "aux-items")))
`(catch 'lyskom-traverse
(let ((,seq-sym ,sequence)
(,atom nil))
(while ,seq-sym
(setq ,atom (car ,seq-sym))
(if (not (aux-item-flags->deleted
(aux-item->flags (, atom))))
(progn (,@ body)))
(setq (, seq) (cdr (, seq))))))))
(aux-item->flags ,atom)))
(progn ,@body))
(setq ,seq-sym (cdr ,seq-sym)))))))
(put 'lyskom-traverse-aux 'edebug-form-spec
'(sexp form body))
(defmacro lyskom-traverse-break (&optional result)
"Break a current lyskom-traverse"
`(throw 'lyskom-traverse ,result))
(put 'lyskom-traverse-aux 'lisp-indent-hook 2)
(put 'lyskom-traverse 'edebug-form-spec
'(sexp form body))
(put 'lyskom-traverse-aux 'edebug-form-spec '(sexp form body))
(put 'lyskom-traverse-aux 'lisp-indent-hook 2)
(put 'lyskom-traverse-membership 'edebug-form-spec '(sexp body))
(put 'lyskom-traverse-membership 'lisp-indent-hook 1)
(put 'lyskom-traverse 'lisp-indent-hook 2)
(put 'lyskom-traverse 'edebug-form-spec '(sexp form body))
;;; ======================================================================
......@@ -114,6 +121,16 @@ Value returned is always nil."
(put 'lyskom-save-excursion 'edebug-form-spec t)
(put 'lyskom-save-excursion 'lisp-indent-hook 0)
(defmacro lyskom-with-lyskom-buffer (&rest forms)
"Evaluate FORMS in the current LysKOM buffer."
`(save-excursion
(set-buffer lyskom-buffer)
,@forms))
(put 'lyskom-with-lyskom-buffer 'edebug-form-spec t)
(put 'lyskom-with-lyskom-buffer 'lisp-indent-hook 0)
;;; ======================================================================
;;; Some useful macros to make the code more readable.
;;;
......
This diff is collapsed.
......@@ -56,135 +56,6 @@ also means modifying the lyskom-reading-list. The zero text-nos are skipped."
lyskom-to-do-list))))
(defun lyskom-sort-membership ()
"Sort the internal membership list."
(setq lyskom-membership (sort lyskom-membership 'lyskom-membership-<))
(lyskom-update-membership-positions))
(defun lyskom-update-membership-positions ()
"Update all the position fields in the memberships in the membership list."
(let ((mship lyskom-membership)
(num 0))
(while mship
(set-membership->position (car mship) num)
(setq num (1+ num) mship (cdr mship)))
;; FIXME: If something changed, tell the server.
(lyskom-sort-to-do-list)))
(defun lyskom-add-memberships-to-membership (memberships)
"Adds a newly fetched MEMBERSHIP-PART to the list in lyskom-membership.
If an item of the membership is already read and entered in the
lyskom-membership list then this item is not entered."
(save-excursion
(set-buffer lyskom-buffer)
(let ((list (listify-vector memberships)))
(while list
;; If membership is already added or passive, don't add it
(if (memq (membership->conf-no (car list))
(mapcar (function membership->conf-no) lyskom-membership))
nil
(setq lyskom-membership (append lyskom-membership (list (car list)))))
(lyskom-membership-table-add (car list))
(setq list (cdr list))))))
(defun lyskom-insert-memberships-in-membership (memberships)
(save-excursion
(set-buffer lyskom-buffer)
(let ((list (listify-vector memberships)))
(while list
;; If membership is already added or passive, don't add it
(if (memq (membership->conf-no (car list))
(mapcar (function membership->conf-no) lyskom-membership))
nil
(lyskom-membership-table-add (car list))
(setq lyskom-membership (cons (car list) lyskom-membership)))
(setq list (cdr list))))
(lyskom-sort-membership)))
(defun lyskom-do-insert-membership (membership)
(if (membership->position membership)
(setq lyskom-membership
(cond ((elt lyskom-membership (membership->position membership))
(lyskom-insert-in-list
membership
lyskom-membership
(elt lyskom-membership
(membership->position membership))))
((>= (membership->position membership) 0)
(nconc lyskom-membership (list membership)))
(t (cons membership lyskom-membership))))
(let ((mship-list lyskom-membership)
(found nil))
(while mship-list
(when (<= (membership->priority (car mship-list))
(membership->priority membership))
(setq lyskom-membership
(lyskom-insert-in-list membership
lyskom-membership
(car mship-list))
mship-list nil
found t))
(setq mship-list (cdr mship-list)))
(unless found (setq lyskom-membership
(nconc lyskom-membership (list membership))))))
(lyskom-membership-table-add membership))
(defun lyskom-insert-membership (membership)
"Add MEMBERSHIP into lyskom-membership, sorted by priority."
(save-excursion
(set-buffer lyskom-buffer)
(lyskom-do-insert-membership membership)
(lyskom-update-membership-positions)
(lp--update-buffer (membership->conf-no membership))))
(defun lyskom-replace-membership (membership)
"Find the membership for the same conference as MEMBERSHIP, and
replace it with MEMBERSHIP into lyskom-membership."
(save-excursion
(set-buffer lyskom-buffer)
(when (lyskom-try-get-membership (membership->conf-no membership) t)
(lyskom-do-remove-membership (membership->conf-no membership))
(lyskom-do-insert-membership membership)
(lp--update-buffer (membership->conf-no membership))
(lyskom-run-hook-with-args 'lyskom-replace-membership-hook
membership
lyskom-membership))))
(defun lyskom-do-remove-membership (conf-no)
"Remove the membership for CONF-NO from lyskom-membership."
(let ((list lyskom-membership))
(while list
(if (= conf-no (membership->conf-no (car list)))
(progn
(setcar list nil)
(setq list nil))
(setq list (cdr list)))))
(setq lyskom-membership (delq nil lyskom-membership))
(lyskom-membership-table-del conf-no))
(defun lyskom-remove-membership (conf-no)
"Remove the membership for CONF-NO from lyskom-membership."
(save-excursion
(set-buffer lyskom-buffer)
(lyskom-do-remove-membership conf-no)
(lp--update-buffer conf-no)
(lyskom-run-hook-with-args 'lyskom-remove-membership-hook
conf-no lyskom-membership)))
(defun lyskom-membership-position (conf-no)
"Return the position of the membership for CONF-NO."
(save-excursion
(set-buffer lyskom-buffer)
(let ((mship (lyskom-get-membership conf-no t)))
(or (membership->position mship)
(- (length (memq mship lyskom-membership))
(length lyskom-membership))))))
(defun lyskom-sort-to-do-list ()
"Sort lyskom-to-do-list in order of membership priorities.
The priorities for CONF elements are updated to match the membership
......@@ -231,3 +102,136 @@ reasonable guess."
;; Both are not CONF, so A is not less than B
(t t)))
;;; ================================================================
;;; Fundamental membership cache functions
;;; (require 'lyskom-avltree)
(def-kom-var lyskom-mship-cache nil
"Membership cache. Do not alter directly."
local)
(defsubst lyskom-mship-cache-index () (aref lyskom-mship-cache 0))
(defsubst lyskom-mship-cache-data () (aref lyskom-mship-cache 1))
(defun lyskom-mship-cache-create ()
"Initialize the membership cache to empty."
(vector (make-hash-table :size 300 :test 'eq)
(lyskom-avltree-create 'lyskom-membership-<)))
(defun lyskom-mship-cache-get (conf-no)
"Get the membership for CONF-NO from the membership cache."
(gethash conf-no (lyskom-mship-cache-index)))
(defun lyskom-mship-cache-put (mship)
"Add MSHIP to the membership cache."
(lyskom-avltree-enter (lyskom-mship-cache-data) mship)
(puthash (membership->conf-no mship) mship (lyskom-mship-cache-index)))
(defun lyskom-mship-cache-del (conf-no)
"Delete CONF-NO from the membership cache."
(let ((mship (lyskom-mship-cache-get conf-no)))
(when mship
(lyskom-avltree-delete (lyskom-mship-cache-data) mship)
(remhash conf-no (lyskom-mship-cache-index)))))
(defun lyskom-update-membership-positions ()
"Update the position field of all memberships."
(let ((num 0))
(lyskom-avltree-traverse (lambda (mship)
(set-membership->position mship num)
(setq num (1+ num)))
(lyskom-mship-cache-data))))
(defun lyskom-add-memberships-to-membership (memberships)
"Adds a newly fetched MEMBERSHIP-PART to the list in lyskom-membership.
If an item of the membership is already read and entered in the
lyskom-membership list then this item is not entered."
(lyskom-with-lyskom-buffer
(lyskom-traverse mship memberships
(unless (lyskom-mship-cache-get (membership->conf-no mship))
(lyskom-mship-cache-put mship)))))
(defun lyskom-insert-membership (mship)
"Add MSHIP into lyskom-membership, sorted by priority."
(lyskom-with-lyskom-buffer
(lyskom-mship-cache-put mship)
(lyskom-update-membership-positions)
(lp--update-buffer (membership->conf-no mship))))