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> 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. * commands1.el (kom-remove-presentation): New command.
* vars.el.in (lyskom-commands): Added kom-set-presentation and * vars.el.in (lyskom-commands): Added kom-set-presentation and
...@@ -13,7 +24,7 @@ ...@@ -13,7 +24,7 @@
(kom-set-motd): New command (kom-set-motd): New command
(lyskom-set-pres-or-motd-2): New function. (lyskom-set-pres-or-motd-2): New function.
Various bugs Various bugs:
* vars.el.in (lyskom-button-actions): Set pers actions for * vars.el.in (lyskom-button-actions): Set pers actions for
kom-list-news and kom-membership to the values they have for conf kom-list-news and kom-membership to the values they have for conf
(bug 293). (bug 293).
......
...@@ -684,7 +684,7 @@ ...@@ -684,7 +684,7 @@
;;; Rehacked: David K}gedal ;;; Rehacked: David K}gedal
(def-kom-command kom-set-unread (&optional arg conf-no) (def-kom-command kom-set-unread (&optional arg conf-no)
"Set number of unread articles in current conference." "Set number of unread articles in current conference."
(interactive "P") (interactive "P")
(setq conf-no (or conf-no lyskom-current-conf)) (setq conf-no (or conf-no lyskom-current-conf))
...@@ -914,15 +914,21 @@ ...@@ -914,15 +914,21 @@
(defun lyskom-time-greater (time1 time2) (defun lyskom-time-greater (time1 time2)
"Returns t if TIME2 is before TIME1 chronologically." "Returns t if TIME2 is before TIME1 chronologically."
(cond (cond
((< (time->year time2) (time->year time1))) ((< (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)))
((> (time->mon time2) (time->mon time1)) nil)
((< (time->mday time2) (time->mday time1))) ((< (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)))
((> (time->hour time2) (time->hour time1)) nil)
((< (time->min time2) (time->min time1))) ((< (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)))
((> (time->sec time2) (time->sec time1)) nil)
(t nil))) (t nil)))
......
...@@ -1418,14 +1418,55 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed." ...@@ -1418,14 +1418,55 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed."
(lyskom-create-map first (apply 'vconcat maplist))))) (lyskom-create-map first (apply 'vconcat maplist)))))
;;; ============================================================ ;;; ================================================================
;;; Local to global mapping ;;; Text-Mapping support
;;; - Sparse map
;;; - Text mapping
(def-komtype sparse-map mapping)
(def-komtype text-mapping have-more type mapping)
(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 ;;; mark
......
...@@ -685,32 +685,6 @@ than 0. Args: ITEMS-TO-PARSE PRE-FETCHED. Returns -1 if ITEMS-TO-PARSE is ...@@ -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-vector ;text-nos
(lyskom-parse-num) 'lyskom-parse-num))) (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 () (defun lyskom-parse-who-info ()
"Parse a who-info." "Parse a who-info."
(lyskom-create-who-info (lyskom-create-who-info
...@@ -1029,6 +1003,31 @@ Args: TEXT-NO. Value: text-stat." ...@@ -1029,6 +1003,31 @@ Args: TEXT-NO. Value: text-stat."
(lyskom-parse-num))) ;conf-no (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. ;;; Parsing of complex datatypes without cache.
......
...@@ -1229,7 +1229,7 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA" ...@@ -1229,7 +1229,7 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA"
"Send local-to-global to server." "Send local-to-global to server."
(lyskom-server-call (lyskom-server-call
(lyskom-call kom-queue lyskom-ref-no handler data (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-send-packet kom-queue
(lyskom-format-objects 103 (lyskom-format-objects 103
conf-no conf-no
...@@ -1244,7 +1244,7 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA" ...@@ -1244,7 +1244,7 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA"
"Send map-created-texts to the server." "Send map-created-texts to the server."
(lyskom-server-call (lyskom-server-call
(lyskom-call kom-queue lyskom-ref-no handler data (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-send-packet kom-queue
(lyskom-format-objects 104 (lyskom-format-objects 104
author author
...@@ -1260,6 +1260,7 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA" ...@@ -1260,6 +1260,7 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA"
(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." ...@@ -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) (setq result (cons (misc-info->recipient-no misc)
result))))) result)))))
(nreverse 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