mship-edit.el 70.3 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
;;;;; -*-coding: iso-8859-1;-*-
;;;;;
;;;;; $Id$
;;;;; Copyright (C) 1991-2002  Lysator Academic Computer Association.
;;;;;
;;;;; This file is part of the LysKOM Emacs LISP client.
;;;;; 
;;;;; LysKOM is free software; you can redistribute it and/or modify it
;;;;; under the terms of the GNU General Public License as published by 
;;;;; the Free Software Foundation; either version 2, or (at your option) 
;;;;; any later version.
;;;;; 
;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT
;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;;;;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
;;;;; for more details.
;;;;; 
;;;;; You should have received a copy of the GNU General Public License
;;;;; along with LysKOM; see the file COPYING.  If not, write to
;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN,
;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
;;;;; MA 02139, USA.
;;;;;
;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. 
;;;;;
;;;; ================================================================
;;;; ================================================================
;;;;
;;;; File: mship-edit.el
;;;;
;;;; Mode for editing the membership. Replaced prioritize.el
;;;;


(setq lyskom-clientversion-long 
      (concat lyskom-clientversion-long
	      "$Id$\n"))

;; KNOWN BUGS AND TO DO
;; --------------------
41
;;
42
;; Messed up redraw of an entry
43
;;
44
45
46
47
;; Sometimes an entry will be redrawn and appear twice, with one of
;; the old entries on the same line as one of the duplicates. This 
;; seems to happen if two redraws using delayed printing are initiated
;; at once (the second starts before the first one finishes).
48
;;
49
50
51
;; Remembers that lyskom-insert-membership and lyskom-replace-membership
;; call lp--update-buffer, so it's rarely necessary to call it from 
;; anywhere else.
52
;;
53
;; Endast-function to all marked memberships
54
;;
55
;; Uppskjut-function to all marked memberships
56
;;
57
;; Remove and add membership functions.
58
;;
David Byers's avatar
David Byers committed
59
60


David Byers's avatar
David Byers committed
61
62
(require 'advice)

David Byers's avatar
David Byers committed
63
;;; Code:
64

David Byers's avatar
David Byers committed
65
(def-komtype lp--entry
David Byers's avatar
David Byers committed
66
67
68
69
70
71
72
73
74
  (start-marker                         ; Where the entry is in the buffer
   end-marker                           ; Where it ends in the buffer
   priority                             ; The saved priority of the membership
   membership                           ; The membership
   selected                             ; Selected or not
   state                                ; Expanded display or not
   visible                              ; Non-nil when visible
   extents                              ; Alist of extents/overlays
   ))
75

76
(defvar lp--format-string nil "The format string for entries.")
77
78

;;; Local variables in the prioritize buffer
79
80
;;; There should be no reason to use these at all. There are functional
;;; abstractions that let you access their contents.
81
82

(defvar lp--entry-list nil)
83
84
(defvar lp--headers nil)
(defvar lp--header-end-marker nil)
85
86
87
(defvar lp--list-start-marker nil)
(defvar lp--list-end-marker nil)
(defvar lp--selected-entry-list nil)
David Byers's avatar
David Byers committed
88
(defvar lp--buffer-done nil)
89
(defvar lp--conf-name-width nil)
90
(defvar lp--inhibit-update nil)
91
(defvar lp--hidden-entries nil)
92
93
(defvar lp--entry-filter nil)

94

95

96
97
;;; ============================================================
;;; Utility functions and really basic stuff
98
99

(defun lp--entry-update-extents (entry)
100
101
102
103
104
  "Update the start and end positions for extents of ENTRY.
Update the start and end positions of all extents or overlays listed
in the extent list of ENTRY to match the start and end markers. If the
start or end markers point nowhere, detatch the extents. If overlays
are used, set the start and end positions to zero."
105
106
107
108
109
110
111
112
113
114
115
116
  (let ((extents (lp--entry->extents entry)))
    (while extents
      (lyskom-xemacs-or-gnu 
       (progn (set-extent-property (cdr (car extents)) 'end-open t)
              (set-extent-property (cdr (car extents)) 'start-open t)
              (set-extent-endpoints (cdr (car extents))
                                    (lp--entry->start-marker entry)
                                    (lp--entry->end-marker entry)))
       (progn (move-overlay (cdr (car extents)) 
                            (or (lp--entry->start-marker entry) 0)
                            (or (lp--entry->end-marker entry) 0))))
      (setq extents (cdr extents)))))
David Byers's avatar
David Byers committed
117

118
119
120
121
122
123
(defun lyskom-change-membership-priority (conf-no new-priority)
  "Change the priority of memberhip for CONF-NO to NEW-POSITION.
This function does not tell the server about the change."
  (let* ((mship (lyskom-get-membership conf-no t))
         (old-priority (and mship (membership->priority mship))))
    (when mship
124
125
      (set-membership->priority mship new-priority)
      (lyskom-replace-membership mship)
126

127
128
129
      (cond
       ((and (>= old-priority lyskom-session-priority)
             (>= new-priority lyskom-session-priority))
130
131
        ;; Do nothing
        )
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148

       ((and (< old-priority lyskom-session-priority)
             (>= new-priority lyskom-session-priority))
        (let ((mship (lyskom-get-membership conf-no t)))
          (when mship (lyskom-prefetch-map conf-no mship))))

       ((and (>= old-priority lyskom-session-priority)
             (< new-priority lyskom-session-priority))
        (read-list-delete-read-info conf-no lyskom-to-do-list)
        (when (eq conf-no lyskom-current-conf)
          (lyskom-leave-current-conf))
        (lyskom-update-prompt t))
      ))))

(defun lyskom-change-membership-position (conf-no new-position)
  "Change the position of memberhip for CONF-NO to NEW-POSITION.
This function does not tell the server about the change."
149
150
  (let* ((mship (lyskom-get-membership conf-no t))
         (old-position (membership->position mship)))
151
    (when mship
152
153
      (set-membership->position mship new-position)
       (lyskom-replace-membership mship))))
154

David Byers's avatar
David Byers committed
155
156

;;; ============================================================
David Byers's avatar
David Byers committed
157
;; Entry drawing
David Byers's avatar
David Byers committed
158

159
160
(defun lp--entry-set-background (entry color)
  "Use extents or overlays to set the background of ENTRY to COLOR."
David Byers's avatar
David Byers committed
161
162
163
164
165
166
167
168
169
170
171
172
  (save-excursion
    (set-buffer (marker-buffer (lp--entry->start-marker entry)))
    (if (null color)
        (let* ((extent (assq 'color (lp--entry->extents entry))))
          (when extent
            (lyskom-xemacs-or-gnu
             (delete-extent (cdr extent))
             (delete-overlay (cdr extent)))
            (set-lp--entry->extents entry 
                                    (delq extent (lp--entry->extents entry)))))

      (let* ((extent (cdr (assq 'color (lp--entry->extents entry))))
173
174
             (facename (intern (format "lyskom-%s-background" 
				       (lyskom-safe-color-name color))))
175
             (face (or (lyskom-find-face facename) (lyskom-make-face facename t))))
David Byers's avatar
David Byers committed
176
177
        (unless extent
          (lyskom-xemacs-or-gnu
178
179
180
181
           (setq extent (make-extent (lp--entry->start-marker entry)
                                     (lp--entry->end-marker entry)))
           (setq extent (make-overlay (lp--entry->start-marker entry)
                                      (lp--entry->end-marker entry)
David Byers's avatar
David Byers committed
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
                                      nil t)))
          (set-lp--entry->extents entry (cons (cons 'color extent)
                                              (lp--entry->extents entry))))
        (set-face-background face color)
        (lyskom-xemacs-or-gnu (progn (set-extent-property extent 'end-open t)
                                     (set-extent-property extent 'start-open t)
                                     (set-extent-property extent 'priority 1000)
                                     (set-extent-property extent 'face face))
                              (progn (overlay-put extent 'priority 1000)
                                     (overlay-put extent 'face face)))))))

(defun lp--entry-set-foreground (entry color)
  "Use extents or overlays to set the foreground of ENTRY to COLOR."
  (save-excursion 
    (set-buffer (marker-buffer (lp--entry->start-marker entry)))
    (if (null color)
        (let* ((extent (assq 'fcolor (lp--entry->extents entry))))
          (when extent
            (lyskom-xemacs-or-gnu
             (delete-extent (cdr extent))
             (delete-overlay (cdr extent)))
            (set-lp--entry->extents entry 
                                    (delq extent (lp--entry->extents entry)))))

      (let* ((extent (cdr (assq 'fcolor (lp--entry->extents entry))))
207
208
             (facename (intern (format "lyskom-%s-foreground" 
				       (lyskom-safe-color-name color))))
209
             (face (or (lyskom-find-face facename) (lyskom-make-face facename t))))
David Byers's avatar
David Byers committed
210
        (unless extent
211
          (lyskom-xemacs-or-gnu
212
213
214
215
           (setq extent (make-extent (lp--entry->start-marker entry)
                                     (lp--entry->end-marker entry)))
           (setq extent (make-overlay (lp--entry->start-marker entry)
                                      (lp--entry->end-marker entry) 
David Byers's avatar
David Byers committed
216
217
218
219
220
221
222
223
224
225
226
                                      nil t)))
          (set-lp--entry->extents entry (cons (cons 'fcolor extent)
                                              (lp--entry->extents entry))))
        (set-face-foreground face color)
        (lyskom-xemacs-or-gnu (progn (set-extent-property extent 'end-open t)
                                     (set-extent-property extent 'start-open t)
                                     (set-extent-property extent 'priority 1000)
                                     (set-extent-property extent 'face face))
                              (progn (overlay-put extent 'priority 1000)
                                     (overlay-put extent 'face face)))))))

227
228


229
(defmacro lp--save-excursion (&rest body)
David Byers's avatar
David Byers committed
230
231
232
233
  "Evecute BODY and restore the current location of point.
The location of point is in relation to the entry it is in.  Point
will move as the entry moves.  The location of point is restored
even if the character at point is deleted."
234
235
  `(let* ((lp--saved-entry  (lp--entry-at (point)))
          (lp--saved-column (and lp--saved-entry
David Byers's avatar
David Byers committed
236
                                 (- (point)
237
238
239
240
241
                                    (lp--entry->start-marker
                                     lp--saved-entry)))))
     (save-excursion ,@body)
     (if (and lp--saved-entry
              (lp--entry->start-marker lp--saved-entry))
David Byers's avatar
David Byers committed
242
         (goto-char (+ lp--saved-column (lp--entry->start-marker
243
244
245
                                         lp--saved-entry))))))


246
(defun lp--compute-format-string ()
David Byers's avatar
David Byers committed
247
  "Compute the format string for an entry in the buffer.
248
To save time, the format string is cached in `lp--format-string'.  It is
David Byers's avatar
David Byers committed
249
only recomputed if the window width changes."
250
251
252
253
254
  (let ((total (- (window-width) 1 3 3 2 12 2 5 2 4 1)))
    (setq lp--conf-name-width total)
    (setq lp--format-string
          (concat "%#1c %=3#2s %#10c %=-" (number-to-string total)
                  "#3M  %=-12#4s %[%#15@%=5#5s%]  %[%#11@%#6c%]%[%#12@%#7c%]%[%#13@%#8c%]%[%#14@%#9c%]"))))
255
256
257

(defun lp--format-insert-entry (entry)
  "Format ENTRY and insert it into the current buffer at point."
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
  (let* ((mship-conf-no (membership->conf-no (lp--entry->membership entry)))
         (adder-conf-no (membership->created-by (lp--entry->membership entry)))
         (mship-conf-stat (cache-get-conf-stat mship-conf-no))
         (adder-conf-stat (cache-get-conf-stat adder-conf-no)))

    (if (null mship-conf-stat)
        (lyskom-format-insert-at-point 
         "%#1D"
         (lyskom-create-defer-info 'get-conf-stat
                                   mship-conf-no
                                   'lp--format-entry
                                   (point-marker)
                                   (length lyskom-defer-indicator)
                                   "%#1s"
                                   entry))
      (lp--format-entry mship-conf-stat entry))

David Byers's avatar
David Byers committed
275
    (when (eq (lp--entry->state entry) 'expanded)
276
277
278
279
280
281
282
283
284
285
286
287
      (lyskom-insert-at-point "\n        ")
      (if (null adder-conf-stat)
          (lyskom-format-insert-at-point 
           "%#1D"
           (lyskom-create-defer-info 'get-conf-stat
                                     adder-conf-no
                                     'lp--format-entry-expansion
                                     (point-marker)
                                     (length lyskom-defer-indicator)
                                     "%#1s"
                                     entry))
        (lp--format-entry-expansion adder-conf-stat entry)))))
David Byers's avatar
David Byers committed
288
289
290


(defun lp--format-entry (conf-stat defer-info)
291
292
293
294
295
296
  (let ((entry nil))
    (if (lyskom-lp--entry-p defer-info)
        (progn (setq entry defer-info)
               (setq defer-info nil))
      (setq entry (defer-info->data defer-info)))
    (let* ((un (lyskom-find-unread (membership->conf-no
David Byers's avatar
David Byers committed
297
                                    (lp--entry->membership entry))))
298
           (string (lyskom-format
299
                    lp--format-string
300
301
302
303
304
305
306
307
308
309
310
                    (if (lp--entry->selected entry) ?* ?\ )
                    (if (zerop (membership->priority
                                (lp--entry->membership entry)))
                        "-"
                      (int-to-string (membership->priority
                                      (lp--entry->membership entry))))
                    (if (null conf-stat)
                        (lyskom-format 'conference-does-not-exist 
                                       (membership->conf-no 
                                        (lp--entry->membership entry)))
                      conf-stat)
311
312
313
                    (lyskom-format-time
                     'date
                     (membership->last-time-read (lp--entry->membership entry)))
314
                    (if un (int-to-string un) "")
David Byers's avatar
David Byers committed
315

316
317
318
                    (if (membership-type->invitation (membership->type (lp--entry->membership entry))) ?I ?.)
                    (if (membership-type->secret (membership->type (lp--entry->membership entry))) ?H ?.)
                    (if (membership-type->passive (membership->type (lp--entry->membership entry))) ?P ?.)
David Byers's avatar
David Byers committed
319
                    (if (membership-type->message-flag (membership->type (lp--entry->membership entry))) ?M ?.)
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
                    (if (and conf-stat (eq lyskom-pers-no (conf-stat->supervisor conf-stat))) ?O ?\ )
                    (lyskom-default-button 'prioritize-flag-menu
                                           (list entry 'invitation)
                                           (list "%#1s (%=#2M)"
                                                 (lyskom-get-string 'Invitation-mt-type)
                                                 (membership->conf-no
                                                  (lp--entry->membership entry))))
                    (lyskom-default-button 'prioritize-flag-menu
                                           (list entry 'secret)
                                           (list "%#1s (%=#2M)"
                                                 (lyskom-get-string 'Secret-mt-type)
                                                 (membership->conf-no
                                                  (lp--entry->membership entry))))
                    (lyskom-default-button 'prioritize-flag-menu
                                           (list entry 'passive)
                                           (list "%#1s (%=#2M)"
                                                 (lyskom-get-string 'Passive-mt-type)
                                                 (membership->conf-no
                                                  (lp--entry->membership entry))))
David Byers's avatar
David Byers committed
339
340
341
342
343
344
                    (lyskom-default-button 'prioritize-flag-menu
                                           (list entry 'message-flag)
                                           (list "%#1s (%=#2M)"
                                                 (lyskom-get-string 'Message-flag-mt-type)
                                                 (membership->conf-no
                                                  (lp--entry->membership entry))))
345
346
                    '(lp--unread t)
                    )))
347
348
      (if defer-info
          (lyskom-replace-deferred defer-info string)
349
        (lyskom-insert-at-point string))
David Byers's avatar
David Byers committed
350

David Byers's avatar
David Byers committed
351
352
      (if (membership-type->passive
           (membership->type (lp--entry->membership entry)))
353
          (lp--entry-set-foreground entry (lyskom-face-foreground kom-dim-face))
David Byers's avatar
David Byers committed
354
355
        (lp--entry-set-foreground entry nil))

356
357
358
359
360
361
362
363
364
365
366
367
368
      (cond ((lp--entry->selected entry)
             (lp--entry-set-background entry
                                       (lyskom-face-background kom-mark-face)))

            (t (lp--entry-set-background entry nil)))

      (cond ((eq (membership->conf-no (lp--entry->membership entry))
                 (lyskom-default-value 'lyskom-current-conf))
             (lp--entry-set-foreground entry (lyskom-face-foreground
                                              kom-url-face)))

            (t (lp--entry-set-foreground entry nil)))
)))
369

David Byers's avatar
David Byers committed
370
371

(defun lp--format-entry-expansion (conf-stat defer-info)
372
373
374
375
376
377
378
379
380
381
382
  (let ((entry nil))
    (if (lyskom-lp--entry-p defer-info)
        (progn (setq entry defer-info)
               (setq defer-info nil))
      (setq entry (defer-info->data defer-info)))

  (let* ((membership (lp--entry->membership entry))
         (string 
          (if (and (null conf-stat)
                   (eq 0 (time->sec (membership->created-at membership)))
                   (eq 0 (time->min (membership->created-at membership)))
383
                   (eq 1 (time->mon (membership->created-at membership)))
384
                   (eq 1 (time->mday (membership->created-at membership)))
385
                   (eq 1970 (time->year (membership->created-at membership))))
386
              (lyskom-get-string 'lp-no-creation-info)
387
            (lyskom-format "%#1s %#2s av %#3P"
388
389
390
                           (lyskom-get-string
                            (if (membership-type->invitation (membership->type (lp--entry->membership entry)))
                                'lp-invited 'lp-added))
391
392
                           (lyskom-format-time
                            'date-and-time
393
394
395
396
397
398
399
400
                            (membership->created-at (lp--entry->membership entry)))
                           (if (null conf-stat)
                               (lyskom-format 'person-does-not-exist
                                              (membership->created-by (lp--entry->membership entry)))
                             conf-stat)))))
    (if defer-info
        (lyskom-replace-deferred defer-info string)
      (lyskom-insert-at-point string)))))
401

402
403
404
405

(defun lp--print-entry (entry)
  "Print the entry ENTRY at the current position in the buffer.
The start and end markers of the entry are adjusted"
406
  (if (lp--entry-set-visible entry (lp--entry-compute-visible entry))
407
408
      (let ((buffer-read-only nil))
        (insert-before-markers "\n")
409
410
411
	(if (lp--entry->end-marker entry)
	    (set-marker (lp--entry->end-marker entry) nil))
        (set-lp--entry->end-marker entry (point-marker))
412
        (forward-char -1)
413
414
	(if (lp--entry->start-marker entry)
	    (set-marker (lp--entry->start-marker entry) nil))
415
416
        (set-lp--entry->start-marker entry (point-marker))
        (lp--format-insert-entry entry)
417
418
419
420
421

	; End marker should be before \n.
	(set-marker (lp--entry->end-marker entry)
		    (1- (lp--entry->end-marker entry)))

422
423
424
        (lp--entry-update-extents entry)
        (forward-char 1))
    (lp--erase-entry entry)))
425
426

(defun lp--erase-entry (entry)
David Byers's avatar
David Byers committed
427
  "Erase the printed representation of the entry ENTRY in the buffer."
428
  (let ((buffer-read-only nil))
429
430
431
432
    (when (and (lp--entry->start-marker entry)
               (lp--entry->end-marker entry))
      (delete-region (lp--entry->start-marker entry)
                     (1+ (lp--entry->end-marker entry))))
433
434
    (if (lp--entry->start-marker entry)
	(set-marker (lp--entry->start-marker entry) nil))
435
    (set-lp--entry->start-marker entry nil)
436
437
    (if (lp--entry->end-marker entry)
	(set-marker (lp--entry->end-marker entry) nil))
438
439
    (set-lp--entry->end-marker entry nil)
    (lp--entry-update-extents entry)))
440
441
442

(defun lp--redraw-entry-mark (entry)
  "Redraw the mark for ENTRY."
443
444
445
446
  (let ((buffer-read-only nil))
    (lp--save-excursion
     (goto-char (lp--entry->start-marker entry))
     (insert (if (lp--entry->selected entry) ?* ?\ ))
447
     (if (lp--entry->selected entry)
448
         (lp--entry-set-background entry (lyskom-face-background kom-mark-face))
449
       (lp--entry-set-background entry nil))
David Byers's avatar
David Byers committed
450
451
     (delete-char 1)
     (lp--entry-update-extents entry))))
452
453
454

(defun lp--redraw-entry (entry)
  "Redraw the entry ENTRY."
David Byers's avatar
David Byers committed
455
  (lp--save-excursion
456
457
458
459
460
461
462
463
   (if (null (lp--entry->start-marker entry))
       (goto-char
        (let ((ne (lp--get-entry
                   (lp--next-visible-entry 
                    (membership->position (lp--entry->membership entry))))))
          (if ne
              (lp--entry->start-marker ne)
            lp--list-end-marker)))
464
465
     (goto-char (lp--entry->start-marker entry))
     (lp--erase-entry entry))
466
467

   (lp--print-entry entry)))
David Byers's avatar
David Byers committed
468

469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
(defun lp--perform-in-all-buffers (fn &rest args)
  "Perform FN in all prioritization buffers. ARGS are arguments for FN.
Normally there should only be one buffer, but who knows..."
  (when lyskom-buffer
    (save-excursion
      (set-buffer lyskom-buffer)
      (let ((prioritize-buffers (lyskom-buffers-of-category 'prioritize)))
        (lyskom-traverse buffer prioritize-buffers
          (when (buffer-live-p buffer)
            (set-buffer buffer)
            (apply fn args)))))))


(defun lp--maybe-update-entry-for-conf (conf-no)
  (lp--perform-in-all-buffers
   (lambda (conf-no)
     (let ((entry (lp--conf-no-entry conf-no)))
       (when entry (lp--redraw-entry entry))))
   conf-no))

(defun lp--maybe-update-unreads (conf-no)
    (lp--perform-in-all-buffers
     (lambda (conf-no unread)
       (let ((entry (lp--conf-no-entry conf-no)))
         (when entry
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
           (let ((vis (lp--entry-compute-visible entry)))
             (cond ((not (eq vis (lp--entry->visible entry)))
                    (lp--redraw-entry entry))

                   ((lp--entry->visible entry)
                    (let ((bounds (lyskom-next-property-bounds 
                                   (lp--entry->start-marker entry) 
                                   (lp--entry->end-marker entry) 'lp--unread)))
                      (when bounds
                        (lp--save-excursion
                         (let ((buffer-read-only nil))
                           (delete-region (car bounds) (cdr bounds))
                           (goto-char (car bounds))
                           (insert (lyskom-format "%#2@%=5#1s"
                                                  (if (and unread (> unread 0))
                                                      (int-to-string unread) "")
                                                  '(lp--unread t)))))))))))))
511
     conf-no (lyskom-find-unread conf-no)))
512
513


David Byers's avatar
David Byers committed
514
;;; ============================================================
David Byers's avatar
David Byers committed
515
;; List management
David Byers's avatar
David Byers committed
516

517
(defun lp--set-entry-list (entries)
David Byers's avatar
David Byers committed
518
  "Set the list of entries to ENTRIES."
519
520
521
522
523
524
  (setq lp--entry-list entries))

(defun lp--all-entries ()
  "Return a list of all entries."
  lp--entry-list)

David Byers's avatar
David Byers committed
525
526

(defun lp--conf-no-entry (conf-no)
David Byers's avatar
David Byers committed
527
  "Find the entry for a membership in CONF-NO."
David Byers's avatar
David Byers committed
528
529
530
  (let ((entries (lp--all-entries))
        (found nil))
    (while (and entries (null found))
David Byers's avatar
David Byers committed
531
      (when (eq conf-no (membership->conf-no (lp--entry->membership
David Byers's avatar
David Byers committed
532
533
534
535
536
                                              (car entries))))
        (setq found (car entries)))
      (setq entries (cdr entries)))
    found))

537
(defun lp--find-new-position (entry priority &optional pos)
David Byers's avatar
David Byers committed
538
539
  "Find the new position for ENTRY it is were given priority PRIORITY.
If priority is lower than the entry priority this is the last position
David Byers's avatar
David Byers committed
540
541
currently occupied by an entry with a higher priority.  If priority is
higher, then it is the first position with a priority less than the
David Byers's avatar
David Byers committed
542
543
544
545
entry priority"
  (let ((entries (lp--all-entries))
        (result nil)
        (tmp nil))
David Byers's avatar
David Byers committed
546
    (cond
David Byers's avatar
David Byers committed
547
548
549

     ;; Moving down. Return the last entry spotted with a higher
     ;; than requested priority
550
551
552
     ((if priority 
          (> (lp--entry->priority entry) priority)
        (< (lp--entry-position entry) pos))
David Byers's avatar
David Byers committed
553
      (while (and entries (null result))
554
555
556
        (when (if priority
                  (<= (lp--entry->priority (car entries)) priority)
                (>= (lp--entry-position (car entries)) pos))
David Byers's avatar
David Byers committed
557
558
559
560
561
562
563
          (setq result tmp))
        (setq tmp (car entries))
        (setq entries (cdr entries)))
      (unless result (setq result tmp)))

     ;; Moving up. Return the first entry with a priority strictly
     ;; less than the requested one
564
565
566
     ((if priority
          (< (lp--entry->priority entry) priority)
        (> (lp--entry-position entry) pos))
David Byers's avatar
David Byers committed
567
      (while (and entries (null result))
568
569
570
571
572
        (when (if priority
                  (< (lp--entry->priority (car entries)) priority)
                (>= (lp--entry-position (car entries)) pos))
          (setq result (car entries)))
        (setq entries (cdr entries))))
David Byers's avatar
David Byers committed
573
574
575
576
     (t (setq result entry)))
    result))
  

577
578
579
580
(defun lp--get-last-visible-entry ()
  "Return the last visible entry in the list."
  (let* ((pos (1- (length (lp--all-entries))))
         (entry (lp--get-entry pos)))
David Byers's avatar
David Byers committed
581
582
583
    (while (and (> pos 0) entry (not (lp--entry->visible entry)))
      (setq pos (1- pos))
      (setq entry (lp--get-entry pos)))
584
    (if (and entry (lp--entry->visible entry)) entry nil)))
David Byers's avatar
David Byers committed
585

586
587
588
589
(defun lp--get-entry (pos)
  "Return the entry at position POS in the list."
  (elt lp--entry-list pos))

David Byers's avatar
David Byers committed
590
(defun lp--entry-position (entry)
David Byers's avatar
David Byers committed
591
  "Return the position in the list for ENTRY."
David Byers's avatar
David Byers committed
592
593
594
595
  (- (length (lp--all-entries))
     (length (memq entry (lp--all-entries)))))


596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
;;(defun lp--entry-at (where)
;;  "Return the entry at WHERE."
;;  (let* ((pos (save-excursion (goto-char where)
;;                              (beginning-of-line)
;;                              (point)))
;;         (idx (lyskom-binsearch 
;;               pos (lp--all-entries) nil nil
;;               (lambda (a b)
;;                 (cond ((numberp a)
;;                        (and (lp--entry->start-marker b)
;;                             (lp--entry->end-marker b)
;;                             (< a (lp--entry->start-marker b))))
;;                       (t
;;                        (and (lp--entry->start-marker a)
;;                             (lp--entry->end-marker a)
;;                             (< (lp--entry->end-marker a) b))))))))
;;    (and idx (lp--get-entry idx))))

614
615
(defun lp--entry-at (where)
  "Return the entry at WHERE."
616
617
618
619
620
621
622
623
  (let ((pos (save-excursion (goto-char where)
                             (beginning-of-line)
                             (point))))
    (lyskom-traverse entry (lp--all-entries)
      (when (and (lp--entry->visible entry)
                 (>= pos (lp--entry->start-marker entry))
                 (<= pos (lp--entry->end-marker entry)))
        (lyskom-traverse-break entry)))))
624

625
626
627
628
629
630
631

(defun lp--move-entry (entry to)
  "Move the entry ENTRY to position TO in the list."
  (when (or (< to 0) (> to (length (lp--all-entries))))
    (error "Position out of range: %d" to))
  (lp--erase-entry entry)
  (lp--set-entry-list (lp--remove-from-list entry (lp--all-entries)))
632
  (let ((cur (lp--get-entry (lp--next-visible-entry to))))
633
634
    (if cur
        (goto-char (lp--entry->start-marker cur))
635
      (goto-char lp--list-end-marker))
636
637
638
639
640
    (lp--set-entry-list (lp--add-to-list to entry (lp--all-entries)))
    (lp--print-entry entry)))


(defun lp--remove-from-list (elem l)
641
  "Destructively remove ELEM from the list L."
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
  (let* ((n (- (length l) (length (memq elem l)))))
    (cond ((= 0 n) (cdr l))
          ((= n (length l)) l)
          (t (setcdr (nthcdr (1- n) l) (nthcdr (1+ n) l))
             l))))

(defun lp--add-to-list (elem data l)
  "At the position ELEM, add DATA to the list L using side effects."
  (if (> elem (length l))
      (error "Args out of range: %S, %d" l elem))
  (if (= 0 elem)
      (cons data l)
    (setcdr (nthcdr (1- elem) l)
            (cons data (nthcdr elem l)))
    l))

David Byers's avatar
David Byers committed
658
659
660
(defun lp--list-move-element (el to list)
  "Move element EL by side effects so it appears at position TO in LIST."
  (lp--add-to-list to el (lp--remove-from-list el list)))
661

662
(defun lp--update-buffer (conf-no)
663
664
  "Update the entry for CONF-NO in the buffer.
If optional NEW-MSHIP is non-nil, then get the membership again."
665
  (unless lp--inhibit-update
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
    (lp--perform-in-all-buffers
     (lambda ()
       (lp--save-excursion
        (let ((entry (lp--conf-no-entry conf-no))
              (mship (lyskom-get-membership conf-no t)))

          (cond 
           ((and (null entry) mship)    ; New membership
            (let* ((pos (membership->position mship))
                   (elem (and pos (lp--get-entry 
                                   (lp--next-visible-entry pos))))
                   (entry (lyskom-create-lp--entry 
                           nil
                           nil
                           (membership->priority mship)
                           mship
                           nil
                           (if (memq (membership->created-by mship)
                                     (list lyskom-pers-no 0))
                               'contracted
                             'expanded)
                           t
                           nil)))
              (when pos
                (save-excursion
                  (goto-char (if elem
                                 (lp--entry->start-marker elem)
                               lp--list-end-marker))
                  (lp--set-entry-list
                   (lp--add-to-list pos entry (lp--all-entries)))
                  (lp--print-entry entry)))))

           ;; We have unsubscribed for good

           ((null mship)
            (when entry
              (lp--set-entry-list
               (lp--remove-from-list entry
                                     (lp--all-entries)))
              (lp--erase-entry entry)))

           ;; The priority or position of a membership has changed

           ((or (/= (lp--entry->priority entry)
                    (membership->priority mship))
                (/= (lp--entry-position entry)
                    (membership->position mship)))
713
714
715
716
            (let ((new-pos (or (membership->position mship)
                               (lp--entry-position
                                (lp--find-new-position 
                                 entry (membership->priority mship))))))
717
718
719
720
721
722
              (lp--set-entry-pri-and-pos
               entry (membership->priority mship) new-pos)
              (set-lp--entry->membership entry mship)))

           (t (set-lp--entry->membership entry mship)
              (lp--redraw-entry entry)))))))))
David Byers's avatar
David Byers committed
723
724
725



726
727
728
(defun lp--map-region (start end function &rest args)
  "For each element from START to END, apply FUNCTION.
Apply FUNCTION to each element in the region from START to END, returning
David Byers's avatar
David Byers committed
729
a list of results.  ARGS will be passed as additional arguments to FUNCTION.
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750

Args: START END FUNCTION ARGS."
  (let ((results nil)
        (entry nil))
    (save-excursion
      (goto-char (lp--entry->start-marker (lp--entry-at start)))
      (setq start (set-marker (make-marker) (point)))
      (goto-char (lp--entry->end-marker (lp--entry-at end)))
      (setq end (set-marker (make-marker) (point)))
      (goto-char start)

      (while (<= (point) end)
        (setq entry (lp--entry-at (point)))
        (setq results (cons (apply function entry args) results))
        (goto-char (lp--entry->end-marker entry))
        (forward-char 2)))
    results))



;;; ============================================================
David Byers's avatar
David Byers committed
751
;; Menu and button functions
752
753

;;; ------------------------------------------------------------
David Byers's avatar
David Byers committed
754
755
;; Flag menu
;; Argument is a list of entry and flag
756
757

(defun lp--flag-menu-get (entry flag)
David Byers's avatar
David Byers committed
758
759
  "For the membership in ENTRY, return the value of flag FLAG.
FLAG must be one of 'invitation, 'secret or 'passive."
760
761
762
  (funcall
   (cond ((eq flag 'invitation) 'membership-type->invitation)
         ((eq flag 'secret) 'membership-type->secret)
David Byers's avatar
David Byers committed
763
764
         ((eq flag 'passive) 'membership-type->passive)
         ((eq flag 'message-flag) 'membership-type->message-flag))
765
766
767
   (membership->type (lp--entry->membership entry))))

(defun lp--flag-menu-set (entry flag value)
David Byers's avatar
David Byers committed
768
769
  "For the membership in ENTRY, set FLAG to VALUE.
FLAG must be one of 'invitation, 'secret or 'passive."
770
771
772
  (funcall
   (cond ((eq flag 'invitation) 'set-membership-type->invitation)
         ((eq flag 'secret) 'set-membership-type->secret)
David Byers's avatar
David Byers committed
773
774
         ((eq flag 'passive) 'set-membership-type->passive)
         ((eq flag 'message-flag) 'set-membership-type->message-flag))
775
776
777
778
   (membership->type (lp--entry->membership entry))
   value))

(defun lyskom-prioritize-flag-clear (buf arg text)
David Byers's avatar
David Byers committed
779
780
781
782
783
784
785
786
  "Clear the membership flag the user clicked on.
This function should not be called directly.  It is called in response to
a mouse click.

BUF is the buffer in which the mouse click took place.  ARG is a list
of (ENTRY FLAG), where ENTRY is the entry the flag belongs to and FLAG
is one of invitation, secret or passive.  TEXT is the text that the user
clicked on."
787
788
789
790
791
792
793
  (interactive)
  (let ((entry (elt arg 0))
        (flag (elt arg 1)))
    (when (lp--flag-menu-get entry flag)
      (lyskom-prioritize-flag-toggle buf arg text))))

(defun lyskom-prioritize-flag-set (buf arg text)
David Byers's avatar
David Byers committed
794
795
796
797
798
799
800
801
  "Set the membership flag the user clicked on.
This function should not be called directly.  It is called in response to
a mouse click.

BUF is the buffer in which the mouse click took place.  ARG is a list
of (ENTRY FLAG), where ENTRY is the entry the flag belongs to and FLAG
is one of invitation, secret or passive.  TEXT is the text that the user
clicked on."
802
803
804
805
806
807
808
  (interactive)
  (let ((entry (elt arg 0))
        (flag (elt arg 1)))
    (unless (lp--flag-menu-get entry flag)
      (lyskom-prioritize-flag-toggle buf arg text))))

(defun lyskom-prioritize-flag-toggle (buf arg text)
David Byers's avatar
David Byers committed
809
810
811
812
813
814
815
816
  "Toggle the membership flag the user clicked on.
This function should not be called directly.  It is called in response to
a mouse click.

BUF is the buffer in which the mouse click took place.  ARG is a list
of (ENTRY FLAG), where ENTRY is the entry the flag belongs to and FLAG
is one of invitation, secret or passive.  TEXT is the text that the user
clicked on."
817
818
819
820
821
822
823
824
  (interactive)
  (let ((entry (elt arg 0))
        (flag (elt arg 1)))
    (save-excursion
      (set-buffer (marker-buffer (lp--entry->start-marker entry)))
      (lp--flag-menu-set entry flag (not (lp--flag-menu-get entry flag)))

      ;; Attempt to perform the change
David Byers's avatar
David Byers committed
825
      (save-excursion
826
        (set-buffer lyskom-buffer)
David Byers's avatar
David Byers committed
827
828
        (let ((result (blocking-do 'set-membership-type
                                   lyskom-pers-no
829
830
831
832
                                   (membership->conf-no (lp--entry->membership entry))
                                   (membership->type (lp--entry->membership entry)))))

          (unless result
833
834
            (lyskom-message 
             (lyskom-format 'lp-nope (lyskom-get-error-text lyskom-errno)))))
835

David Byers's avatar
David Byers committed
836
        ;; Update the display
837
        (let ((mship
David Byers's avatar
David Byers committed
838
839
               (blocking-do 'query-read-texts
                            lyskom-pers-no
840
841
                            (membership->conf-no (lp--entry->membership entry))
                            t 0)))
David Byers's avatar
David Byers committed
842
          (lyskom-replace-membership mship)
843
844
845
846
847
848
          (set-lp--entry->membership entry mship)
          (when (eq flag 'passive)
            (cond ((membership-type->passive (membership->type mship))
                   (save-excursion
                     (set-buffer lyskom-buffer)
                     (when (eq (membership->conf-no mship) lyskom-current-conf)
849
                       (lyskom-leave-current-conf))
850
851
852
                     (read-list-delete-read-info (membership->conf-no mship)
                                                 lyskom-to-do-list)
                     (lyskom-update-prompt t)))
853
                  (t (lyskom-prefetch-map (membership->conf-no mship) mship))))
854
855
856
          (blocking-do 'get-conf-stat (membership->conf-no mship))))
      (lp--redraw-entry entry))))

857
858
859
860
861
(defun lp--toggle-invitation ()
  "Toggle the invitation bit of the current entry"
  (interactive)
  (lp--save-excursion
   (let ((cur (lp--entry-at (point))))
862
     (cond ((null cur) (error (lyskom-get-string 'lp-no-entry)))
863
864
865
866
867
868
869
870
871
           (t (lyskom-prioritize-flag-toggle (current-buffer)
                                             (list cur 'invitation)
                                             ""))))))

(defun lp--toggle-passive ()
  "Toggle the passive bit of the current entry"
  (interactive)
  (lp--save-excursion
   (let ((cur (lp--entry-at (point))))
872
     (cond ((null cur) (error (lyskom-get-string 'lp-no-entry)))
873
874
875
876
           (t (lyskom-prioritize-flag-toggle (current-buffer)
                                             (list cur 'passive)
                                             ""))))))

877
878
879
880
881
(defun lp--toggle-message-flag ()
  "Toggle the passive bit of the current entry"
  (interactive)
  (lp--save-excursion
   (let ((cur (lp--entry-at (point))))
882
     (cond ((null cur) (error (lyskom-get-string 'lp-no-entry)))
883
884
885
886
           (t (lyskom-prioritize-flag-toggle (current-buffer)
                                             (list cur 'message-flag)
                                             ""))))))

887
888
889
890
891
(defun lp--toggle-secret ()
  "Toggle the secret bit of the current entry"
  (interactive)
  (lp--save-excursion
   (let ((cur (lp--entry-at (point))))
892
     (cond ((null cur) (error (lyskom-get-string 'lp-no-entry)))
893
894
895
896
           (t (lyskom-prioritize-flag-toggle (current-buffer)
                                             (list cur 'secret)
                                             ""))))))

897
898
899


;;; ============================================================
David Byers's avatar
David Byers committed
900
901
;; Marking and unmarking memberships
;; 
902
903
904
905
906

(defun lp--select-entries (entry-list state)
  "Set the selection value of all entries in ENTRY-LIST to STATE.
Forces a mode line update"
  (lp--do-select-entries entry-list state)
907
  (lp--update-mode-line))
908
909
910

(defun lp--do-select-entries (entry-list state)
  "Set the selection value of all entries in ENTRY-LIST to STATE."
David Byers's avatar
David Byers committed
911
  (mapcar (lambda (entry)
912
            (when entry
913
              (if (and state (lp--entry->visible entry))
914
                  (add-to-list 'lp--selected-entry-list entry)
David Byers's avatar
David Byers committed
915
                (setq lp--selected-entry-list
916
917
918
919
920
                      (delq entry lp--selected-entry-list)))
              (set-lp--entry->selected entry state)
              (lp--redraw-entry-mark entry))) entry-list))

(defun lp--all-selected-entries ()
David Byers's avatar
David Byers committed
921
  "Return a list of all selected entries."
922
923
924
  lp--selected-entry-list)

(defun lp--set-selected-entries (entry-list)
David Byers's avatar
David Byers committed
925
  "Set the selected entries to exactly the entries in ENTRY-LIST.
926
927
928
Forces a mode line update"
  (lp--do-select-entries (lp--all-selected-entries) nil)
  (lp--do-select-entries entry-list t)
929
  (lp--update-mode-line))
930

931
932
933
934
;;; ============================================================
;;; Hiding and unhiding entries
;;; FIXME: This doesn't work yet

935
936
937
(defun lp--entry-compute-visible (entry)
  "Compute the visibility of ENTRY."
  (not (lyskom-traverse filter lp--entry-filter
938
         (unless (apply (car filter) entry (cdr filter))
939
940
           (lyskom-traverse-break t)))))

941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
(defun lp--entry-set-visible (entry state)
  "Set the visibility of ENTRY to STATE"
  (let ((old-state (lp--entry->visible entry)))
    (unless (eq state old-state)
      (set-lp--entry->visible entry state)
      (if state
          (setq lp--hidden-entries (delq entry lp--hidden-entries))
        (setq lp--hidden-entries (cons entry lp--hidden-entries)))
      (lp--update-mode-line)))
  state)

(defun lp--show-all ()
  (interactive)
  (setq lp--entry-filter nil)
  (lyskom-traverse entry lp--hidden-entries
    (lp--redraw-entry entry))
  (setq lp--hidden-entries nil))

959
960


961

962
;;; ------------------------------------------------------------
David Byers's avatar
David Byers committed
963
;; Server update functions
964

965
(defun lp--update-membership (entry old-pri old-pos)
David Byers's avatar
David Byers committed
966
  "Update the server and local versions of membership in ENTRY."
967
  (save-excursion
968
969
970
    (let ((saved-pos (lp--entry-position entry)))
      (set-buffer lyskom-buffer)
      (let ((mship (lp--entry->membership entry)))
971
972
973
        (unless (eq old-pos saved-pos)
          (lyskom-change-membership-position (membership->conf-no mship)
                                             saved-pos))
974
        (unless (eq old-pri (lp--entry->priority entry))
975
          (lyskom-change-membership-priority (membership->conf-no mship)
976
                                             (lp--entry->priority entry)))
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
        (cond ((and (>= old-pri lyskom-session-priority)
                    (< (membership->priority mship) lyskom-session-priority))
               (when (eq lyskom-current-conf (membership->conf-no mship))
                 (lyskom-leave-current-conf))
               (read-list-delete-read-info (membership->conf-no mship)
                                           lyskom-to-do-list)
               (lyskom-update-prompt t))
              ((and (< old-pri lyskom-session-priority)
                    (>= (membership->priority mship) lyskom-session-priority))
               (lyskom-prefetch-map (membership->conf-no mship) mship)))

        (initiate-add-member 'background nil
                             (membership->conf-no mship)
                             lyskom-pers-no
                             (membership->priority mship)
                             (membership->position mship)
                             (membership->type mship))))))
994
995


996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
;;; ============================================================
;;; Support

(defun lp--next-visible-entry (pos)
  "Return the position of the first visible entry following POS."
  (let ((max (length (lp--all-entries)))
        (result nil))
  (while (and (< pos max) (null result))
    (if (lp--entry->visible (lp--get-entry pos))
        (setq result pos
              pos max)
      (setq pos (1+ pos))))
  (or result max)))
  

(defun lp--calculate-distance (pos delta)
  "Return one more than the number of entries between POS and POS+DELTA.
This includes visible and invisible entries. The sign of the
David Byers's avatar
David Byers committed
1014
1015
returned value has the same sign as DELTA. The result is clipped to the
size of the list."
1016
  (let ((step (lyskom-signum delta))
1017
1018
1019
1020
        (num (abs delta))
        (result 0))
    (while (> num 0)
      (setq pos (+ step pos))
David Byers's avatar
David Byers committed
1021
1022
1023
1024
1025
1026
      (if (< pos 0)
          (setq num 0)
        (setq result (1+ result))
        (let ((entry (lp--get-entry pos)))
          (cond ((null entry) (setq result (1+ result) num 0))
                ((lp--entry->visible (lp--get-entry pos)) (setq num (1- num)))))))
1027
1028
1029
    (* result step)))


1030
1031
1032
;;; ----------------------------------------------------------------
;;; Filtration

1033
1034
1035
1036
1037
(defun lp--entry-filter-active (filter)
  "Return non-nil if FILTER is an active entry filter."
  (assq filter lp--entry-filter))

(defun lp--add-entry-filter (filter &rest filter-args)
1038
1039
  "Add entry filter FILTER.
FILTER is a function that should take one argument, an lp--entry,
1040
1041
1042
1043
and return non-nil if the entry should be visible.

If optional arguments FILTER-ARGS are supplied, these are also
passed to the filter function."
1044
  (unless (symbolp filter) (error "entry filter must be a symbol"))
1045
1046
  (unless (assq filter lp--entry-filter)
    (setq lp--entry-filter (cons (cons filter filter-args) lp--entry-filter))
1047
1048
    (lp--apply-entry-filter)))

1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
(defun lp--replace-entry-filter (filter &rest filter-args)
  "Replace existing entry filter FILTER.

See `lp--add-entry-filter' for more information."
  (unless (symbolp filter) (error "entry filter must be a symbol"))
  (if (assq filter lp--entry-filter)
      (setcdr (assq filter lp--entry-filter) filter-args)
    (setq lp--entry-filter (cons (cons filter filter-args) lp--entry-filter)))
  (lp--apply-entry-filter))


1060
1061
(defun lp--del-entry-filter (filter)
  "Remove the entry filter FILTER."
1062
  (let ((el (assq filter lp--entry-filter)))
1063
1064
1065
1066
1067
1068
    (when el
      (setq lp--entry-filter (delq el lp--entry-filter))
      (lp--apply-entry-filter))))

(defun lp--apply-entry-filter ()
  "Apply the current filter list to all entries."
1069
1070
1071
1072
1073
1074
  (lp--save-excursion
   (lp--update-filter-description)
   (lyskom-traverse entry (lp--all-entries)
     (let ((vis (lp--entry-compute-visible entry)))
       (unless (eq vis (lp--entry->visible entry))
         (lp--redraw-entry entry))))))
1075
1076
1077
1078
1079

(defun lp--entry-filter-description ()
  "Return a string representing the current entry filters."
  (let (res)
    (lyskom-traverse filter lp--entry-filter
1080
      (let ((name (car filter)))
1081
1082
1083
1084
1085
1086
1087
1088
1089
        (when name (setq res (cons name res)))))
    (or (and res (mapconcat 'symbol-name (nreverse res) ", "))
        (lyskom-get-string 'lp-no-active-filter))))

(defun lp--update-filter-description ()
  "Update the filter description shown in the buffer."
  (lp--set-header 'filter (lyskom-format 'lp-active-filters
                                         (lp--entry-filter-description))))

1090
1091
1092

;; Filter functions should return the desired visibility state

1093
1094
1095
1096
(defun lp--entry-filter-read (entry)
  "Entry filter that displays only conferences with unread texts."
  (let ((n (lyskom-find-unread 
            (membership->conf-no (lp--entry->membership entry)))))
1097
1098
1099
    (or (eq (membership->conf-no (lp--entry->membership entry))
            (lyskom-default-value 'lyskom-current-conf))
        (and n (> n 0)))))
1100
1101
1102
1103
1104
1105

(defun lp--entry-filter-passive (entry)
  "Entry filter that displays only active memberships."
  (not (membership-type->passive 
        (membership->type (lp--entry->membership entry)))))

1106
1107
1108
1109
1110
(defun lp--entry-filter-after (entry time)
  "Hide entries read after a certain time"
  (not (lyskom-time-greater (membership->last-time-read
                             (lp--entry->membership entry))
                            time)))
1111

1112
1113
1114
1115
1116
(defun lp--entry-filter-before (entry time)
  "Hide entries read before a certain time"
  (lyskom-time-greater (membership->last-time-read
                        (lp--entry->membership entry))
                       time))
1117
1118
1119
1120


;;; ================================================================
;;; User-level functions
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137


(defun lp--select-membership ()
  "Select the membership that point is on."
  (interactive)
  (let ((entry (lp--entry-at (point))))
    (when entry
      (lp--select-entries (list entry) t))))

(defun lp--deselect-membership ()
  "Deselect the membership that point is on."
  (interactive)
  (let ((entry (lp--entry-at (point))))
    (when entry
      (lp--select-entries (list entry) nil))))

(defun lp--toggle-membership-selection (where)
David Byers's avatar
David Byers committed
1138
  "Toggle selection of the membership at WHERE."
1139
1140
  (interactive "d")
  (let ((entry (lp--entry-at where)))
1141
1142
1143
1144
    (when entry
      (lp--select-entries (list entry) (not (lp--entry->selected entry))))))

(defun lp--select-region (start end)
David Byers's avatar
David Byers committed
1145
  "Select all entries in the region. With prefix arg, deselect.
David Byers's avatar
David Byers committed
1146
START and END are the starting and ending points of the region."
1147
1148
  (interactive "r")
  (let ((entry-list (lp--map-region start end 'identity)))
David Byers's avatar
David Byers committed
1149
    (lp--select-entries entry-list (not current-prefix-arg))))
1150

David Byers's avatar
David Byers committed
1151
(defun lp--select-priority (priority)
David Byers's avatar
David Byers committed
1152
  "Select all entries with a priority PRIORITY.
1153
1154
1155
1156
With numeric prefix argument select entries with that priority."
  (interactive "P")
  (lp--do-select-priority priority t))

David Byers's avatar
David Byers committed
1157
(defun lp--deselect-priority (priority)
David Byers's avatar
David Byers committed
1158
  "Deselect all entries with a priority PRIORITY.
1159
1160
1161
1162
1163
1164
1165
1166
1167
With numeric prefix argument deselect entries with that priority."
  (interactive "P")
  (lp--do-select-priority priority nil))

(defun lp--do-select-priority (priority select)
  "Select or deselect all entries with priority PRIORITY.
SELECT specifies new select."
  (when (not (numberp priority))
    (let ((entry (lp--entry-at (point))))
1168
1169
      (setq priority
            (lyskom-read-num-range 0 255 
1170
1171
1172
1173
                                   (lyskom-get-string
                                    (if select
                                        'lp-mark-mship-with-prio
                                      'lp-unmark-mship-with-prio))
1174
                                   nil
1175
1176
1177
                                   (and entry
                                        (membership->priority
                                         (lp--entry->membership entry)))))))
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187

  (lp--select-entries
   (mapcar (lambda (entry)
             (and (eq priority (membership->priority
                                (lp--entry->membership entry)))
                  entry))
           (lp--all-entries))
   select))

(defun lp--deselect-all ()
David Byers's avatar
David Byers committed
1188
  "Deselect all memberships."
1189
1190
1191
1192
1193
  (interactive)
  (lp--set-selected-entries nil))



David Byers's avatar
David Byers committed
1194
;;; ============================================================
1195
;;; Reprioritization functions
David Byers's avatar
David Byers committed
1196

1197
(defun lp--set-entry-pri-and-pos (entry priority position)
1198
1199
1200
1201
1202
1203
  "Set the priority of ENTRY to PRIORITY and the position to POSITION.
If PRIORITY or POSITION is nil, the parameter is ignored.
If the position changes, lp--move-entry is called.
lp--update-membership is called automatically before this function exits."
  (let ((old-pri (lp--entry->priority entry))
        (old-pos (lp--entry-position entry))
1204
        (lp--inhibit-update t)
1205
        (need-redraw nil))
1206
1207
1208
1209
1210
1211
1212
1213
1214
    (when (and priority (not (eq priority old-pri)))
      (set-lp--entry->priority entry priority)
      (set-membership->priority (lp--entry->membership entry) priority)
      (setq need-redraw t))
    (when (and position (not (eq position old-pos)))
      (lp--move-entry entry position)
      (set-membership->position (lp--entry->membership entry) position)
      (setq need-redraw nil))
    (lyskom-replace-membership (lp--entry->membership entry))
1215
    (sit-for 0)
1216
1217
1218
    (lp--update-membership entry old-pri old-pos)
    (when need-redraw (lp--redraw-entry entry))))

1219
1220
1221
(defun lp--yank ()
  "Insert all the selected memberships before the entry at point."
  (interactive)
1222
1223
1224
1225
1226
  (lp--save-excursion
   (let* ((cur (lp--entry-at (point)))
          (pos (and cur (lp--entry-position cur)))
          (priority (and cur (lp--entry->priority cur)))
          (entries (lp--all-selected-entries)))
1227
1228
     (cond ((null cur) (error (lyskom-get-string 'lp-no-entry)))
           ((null entries) (error (lyskom-get-string 'lp-no-selection)))
1229
1230
           (t (mapcar 
               (lambda (entry)
1231
                 (lp--set-entry-pri-and-pos
1232
1233
1234
                  entry priority
                  (lp--entry-position (lp--find-new-position entry nil pos))))
               entries))))))
1235
1236
1237
          


David Byers's avatar
David Byers committed
1238
(defun lp--set-priority (priority)
David Byers's avatar
David Byers committed
1239
  "Set the priority of selected memberships to PRIORITY.
David Byers's avatar
David Byers committed
1240
1241
1242
Memberships that must be moved will be moved the shortest distance
possible in the list."
  (interactive "P")
1243
  (let* ((entries (or (lp--all-selected-entries)
David Byers's avatar
David Byers committed
1244
1245
                      (list (lp--entry-at (point))))))
    (unless entries
1246
      (error (lyskom-get-string 'lp-no-selection)))
David Byers's avatar
David Byers committed
1247
1248
1249
1250
1251
1252
1253
1254
    (unless (numberp priority)
      (cond ((> (length entries) 1)
             (setq priority
                   (lyskom-read-num-range
                    0 255 (lyskom-get-string 'priority-prompt-marked) t)))
            (t
             (setq priority
                   (lyskom-read-num-range
David Byers's avatar
David Byers committed
1255
                    0 255 (lyskom-format 'priority-prompt
David Byers's avatar
David Byers committed