Implemented lyskom-find-text-by-date

src/ChangeLog

+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).

src/commands2.el

@@ -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)))
 
 
  ;;; ================================================================

src/komtypes.el

@@ -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

src/parse.el

@@ -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.

src/services.el

@@ -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)))
+
+
 
 ;;; ================================================================
 

src/utilities.el

@@ -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)))