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

Implemented lyskom-find-text-by-date

parent 35941a08
2002-01-03 David Byers <davby@ida.liu.se>
* commands2.el (kom-set-unread): Reindented.
* utilities.el (lyskom-find-text-by-date): New function.
* commands2.el (lyskom-time-greater): Reindented.
2002-01-02 David Byers <davby@ida.liu.se>
Work on bug 280
* parse.el (lyskom-parse-text-mapping): New implementation that
actually corresponds to the protocol specification.
Work on bug 280:
* commands1.el (kom-remove-presentation): New command.
* vars.el.in (lyskom-commands): Added kom-set-presentation and
......@@ -13,7 +24,7 @@
(kom-set-motd): New command
(lyskom-set-pres-or-motd-2): New function.
Various bugs
Various bugs:
* vars.el.in (lyskom-button-actions): Set pers actions for
kom-list-news and kom-membership to the values they have for conf
(bug 293).
......
......@@ -684,41 +684,41 @@
;;; Rehacked: David K}gedal
(def-kom-command kom-set-unread (&optional arg conf-no)
"Set number of unread articles in current conference."
(interactive "P")
(setq conf-no (or conf-no lyskom-current-conf))
(if (or (null conf-no) (zerop conf-no))
(progn
(lyskom-insert-string 'not-present-anywhere)
(lyskom-insert-string "\n"))
(let ((conf-stat (blocking-do 'get-conf-stat conf-no)))
(if (null conf-stat) ;+++ annan errorhantering
(lyskom-insert "Error!\n") ;+++ Hrrrmmmmffff????
(let* ((narg (prefix-numeric-value arg))
(n (if (and arg
(<= 0 narg)
(<= narg (conf-stat->no-of-texts conf-stat)))
narg
(lyskom-read-num-range
0 (conf-stat->no-of-texts conf-stat)
(lyskom-format 'only-last
(conf-stat->no-of-texts conf-stat)
(conf-stat->name conf-stat)))))
(result (blocking-do 'set-unread conf-no n))
(membership (blocking-do 'query-read-texts
lyskom-pers-no
conf-no)))
(lyskom-ignore result)
(lyskom-replace-membership membership)
(if (= conf-no lyskom-current-conf)
(set-read-list-empty lyskom-reading-list))
(read-list-delete-read-info conf-no lyskom-to-do-list)
(if (= conf-no lyskom-current-conf)
(progn (lyskom-fetch-start-of-map conf-stat membership)
(lyskom-go-to-conf lyskom-current-conf t))
(lyskom-prefetch-map conf-no membership))
)))))
(def-kom-command kom-set-unread (&optional arg conf-no)
"Set number of unread articles in current conference."
(interactive "P")
(setq conf-no (or conf-no lyskom-current-conf))
(if (or (null conf-no) (zerop conf-no))
(progn
(lyskom-insert-string 'not-present-anywhere)
(lyskom-insert-string "\n"))
(let ((conf-stat (blocking-do 'get-conf-stat conf-no)))
(if (null conf-stat) ;+++ annan errorhantering
(lyskom-insert "Error!\n") ;+++ Hrrrmmmmffff????
(let* ((narg (prefix-numeric-value arg))
(n (if (and arg
(<= 0 narg)
(<= narg (conf-stat->no-of-texts conf-stat)))
narg
(lyskom-read-num-range
0 (conf-stat->no-of-texts conf-stat)
(lyskom-format 'only-last
(conf-stat->no-of-texts conf-stat)
(conf-stat->name conf-stat)))))
(result (blocking-do 'set-unread conf-no n))
(membership (blocking-do 'query-read-texts
lyskom-pers-no
conf-no)))
(lyskom-ignore result)
(lyskom-replace-membership membership)
(if (= conf-no lyskom-current-conf)
(set-read-list-empty lyskom-reading-list))
(read-list-delete-read-info conf-no lyskom-to-do-list)
(if (= conf-no lyskom-current-conf)
(progn (lyskom-fetch-start-of-map conf-stat membership)
(lyskom-go-to-conf lyskom-current-conf t))
(lyskom-prefetch-map conf-no membership))
)))))
......@@ -914,16 +914,22 @@
(defun lyskom-time-greater (time1 time2)
"Returns t if TIME2 is before TIME1 chronologically."
(cond
((< (time->year time2) (time->year time1)))
((< (time->mon time2) (time->mon time1)))
((< (time->mday time2) (time->mday time1)))
((< (time->hour time2) (time->hour time1)))
((< (time->min time2) (time->min time1)))
((< (time->sec time2) (time->sec time1)))
(t nil)))
(defun lyskom-time-greater (time1 time2)
"Returns t if TIME2 is before TIME1 chronologically."
(cond
((< (time->year time2) (time->year time1)))
((> (time->year time2) (time->year time1)) nil)
((< (time->mon time2) (time->mon time1)))
((> (time->mon time2) (time->mon time1)) nil)
((< (time->mday time2) (time->mday time1)))
((> (time->mday time2) (time->mday time1)) nil)
((< (time->hour time2) (time->hour time1)))
((> (time->hour time2) (time->hour time1)) nil)
((< (time->min time2) (time->min time1)))
((> (time->min time2) (time->min time1)) nil)
((< (time->sec time2) (time->sec time1)))
((> (time->sec time2) (time->sec time1)) nil)
(t nil)))
;;; ================================================================
......
......@@ -1418,14 +1418,55 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed."
(lyskom-create-map first (apply 'vconcat maplist)))))
;;; ============================================================
;;; Local to global mapping
;;; - Sparse map
;;; - Text mapping
(def-komtype sparse-map mapping)
(def-komtype text-mapping have-more type mapping)
;;; ================================================================
;;; Text-Mapping support
(def-komtype text-mapping
range-begin
range-end
size
later-texts-exist
type
block)
(defsubst lyskom-create-text-pair (local global) (cons local global))
(defsubst text-pair->local-number (pair) (car pair))
(defsubst text-pair->global-number (pair) (cdr pair))
(defun text-mapping->local-to-global (map local)
(cond ((or (< local (text-mapping->range-begin map))
(> local (text-mapping->range-end map))) nil)
((eq (text-mapping->type map) 'sparse)
(cdr (assq local (text-mapping->block map))))
((eq (text-mapping->type map) 'dense)
(let ((result (aref (text-mapping->block map)
(- local (text-mapping->range-begin map)))))
(and (not (zerop result)) result)))))
(defun text-mapping->global-numbers (map)
(cond ((eq (text-mapping->type map) 'sparse)
(mapcar 'cdr (text-mapping->block map)))
((eq (text-mapping->type map) 'dense)
(let ((result nil))
(mapc (lambda (el)
(unless (zerop el) (setq result (cons el result))))
(map->text-nos (text-mapping->block map)))
(nreverse result)))))
(defun text-mapping->global-to-local (map global)
(cond ((eq (text-mapping->type map) 'sparse)
(cdr (rassq global (text-mapping->block map))))
((eq (text-mapping->type map) 'dense)
(let ((i (text-mapping->range-begin map))
(result nil))
(while (< i (text-mapping->range-end map))
(if (eq (aref (map->text-nos (text-mapping->block map))
(- i (text-mapping->range-begin map)))
global)
(setq result i i (text-mapping->range-end map))
(setq i (1+ i))))
result))))
;;; ================================================================
;;; mark
......
......@@ -685,32 +685,6 @@ than 0. Args: ITEMS-TO-PARSE PRE-FETCHED. Returns -1 if ITEMS-TO-PARSE is
(lyskom-parse-vector ;text-nos
(lyskom-parse-num) 'lyskom-parse-num)))
(defun lyskom-parse-sparse-map ()
"Parse a sparce l2g block."
(lyskom-create-sparse-map
(lyskom-parse-list (lyskom-parse-num)
'lyskom-parse-text-number-pair)))
(defun lyskom-parse-text-number-pair ()
(cons (lyskom-parse-num) (lyskom-parse-num)))
(defun lyskom-parse-text-mapping ()
"Parse a text-mapping"
(let ((have-more (lyskom-parse-1-or-0))
(kind (lyskom-parse-num)))
(cond ((= kind 0)
(lyskom-create-text-mapping have-more
'sparse
(lyskom-parse-sparse-map)))
((= kind 1)
(lyskom-create-text-mapping have-more
'dense
(lyskom-parse-map))))))
(defun lyskom-parse-who-info ()
"Parse a who-info."
(lyskom-create-who-info
......@@ -1029,6 +1003,31 @@ Args: TEXT-NO. Value: text-stat."
(lyskom-parse-num))) ;conf-no
(defun lyskom-parse-text-mapping (existing)
"Parse a Text-Mapping"
(let ((block-type nil))
(lyskom-create-text-mapping
(lyskom-parse-num)
(lyskom-parse-num)
existing
(lyskom-parse-1-or-0)
(let ((val (lyskom-parse-num)))
(cond ((= val 0) (setq block-type 'sparse))
((= val 1) (setq block-type 'dense)))
block-type)
(lyskom-parse-local-to-global-block block-type))))
(defun lyskom-parse-local-to-global-block (block-type)
"Parse a Local-To-Global-Block"
(cond ((eq block-type 'sparse)
(let ((len (lyskom-parse-num)))
(lyskom-parse-list len 'lyskom-parse-text-number-pair)))
((eq block-type 'dense)
(lyskom-parse-map))))
(defun lyskom-parse-text-number-pair ()
"Parse a Text-Number-Pair"
(lyskom-create-text-pair (lyskom-parse-num) (lyskom-parse-num)))
;;; ================================================================
;;; Parsing of complex datatypes without cache.
......
......@@ -1229,7 +1229,7 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA"
"Send local-to-global to server."
(lyskom-server-call
(lyskom-call kom-queue lyskom-ref-no handler data
'lyskom-parse-text-mapping)
'lyskom-parse-text-mapping no-of-texts)
(lyskom-send-packet kom-queue
(lyskom-format-objects 103
conf-no
......@@ -1244,7 +1244,7 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA"
"Send map-created-texts to the server."
(lyskom-server-call
(lyskom-call kom-queue lyskom-ref-no handler data
'lyskom-parse-text-mappinng)
'lyskom-parse-text-mappinng no-of-texts)
(lyskom-send-packet kom-queue
(lyskom-format-objects 104
author
......@@ -1257,8 +1257,9 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA"
(lyskom-server-call
(lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void)
(lyskom-send-packet kom-queue (lyskom-format-objects 105 conf-no keep))
(cache-del-conf-stat conf-no)))
(cache-del-conf-stat conf-no)))
;;; ================================================================
......
......@@ -1258,3 +1258,45 @@ car of each element is the recipient number and the cdr is the type."
(setq result (cons (misc-info->recipient-no misc)
result)))))
(nreverse result)))
(defun lyskom-find-text-by-date (conf-stat target-date)
"Search texts in CONF-STAT for a text added on or about TARGET-DATE.
Returns a cons of (LOCAL . GLOBAL)"
(let* ((lowest (conf-stat->first-local-no conf-stat))
(highest (+ lowest (conf-stat->no-of-texts conf-stat)))
(result nil)
(index (+ lowest (/ (- highest lowest) 2)))
(last-index (1- index))
(ix 0))
(while (/= last-index index)
(let* ((map (blocking-do 'local-to-global
(conf-stat->conf-no conf-stat)
index
1)))
(cond ((null map) (setq lowest highest))
((null (text-mapping->global-numbers map))
(setq highest index))
(t
(let* ((text-no (car (text-mapping->global-numbers map)))
(text-stat (blocking-do 'get-text-stat text-no))
(local-no (text-mapping->global-to-local map text-no))
(date (and text-stat
(lyskom-traverse misc
(text-stat->misc-info-list text-stat)
(when (memq (misc-info->type misc) lyskom-recpt-types-list)
(lyskom-traverse-break
(if (misc-info->sent-at misc)
(misc-info->sent-at misc)
(text-stat->creation-time text-stat))))))))
(when text-stat
(setq index local-no)
(if (lyskom-time-greater
(text-stat->creation-time text-stat)
target-date)
(setq highest index)
(setq lowest index))
(setq result text-stat))))))
(setq last-index index)
(setq index (+ lowest (/ (- highest lowest) 2))))
(cons last-index result)))
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