mship-edit.el 57.8 KB
Newer Older
David Byers's avatar
David Byers committed
1
2
;;; mship-edit.el --- Summary
;; TO DO
3
;; see tmp.el
4
;;
5
6
7
8
;; When showing hidden entries they are not put in the right position
;; in the buffer. lp--set-entry-visible needs to goto-char to the right
;; place in the buffer.
;;
9
10
11
;; Maybe move setting the membership priority to 
;; lyskom-change-membership-priority. 
;;
David Byers's avatar
David Byers committed
12
13
14
15
16
;; -------------------------------------------------------------------------
;; When prioritizing an entry we need to sort the read lists to put
;; the entries in the proper order. It's possible that we'll have to
;; change the prompt.
;;
17
18
;; Do this under lyskom-update-membership
;;
David Byers's avatar
David Byers committed
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
;; Test cases:
;;
;; Change the priority of the current conf to lower than one we have
;; unreads in. Should trigger prompt change.
;;
;; Change the priority of the current conf to higher than one that
;; was higher previously and had unreads. This should trigger a
;; prompt change.
;;
;; Re-order two confs we are not in by changing their priority. Check
;; that we get to read them in the correct order.
;;
;; Re-order two confs without changing their priority. Check that we
;; get to read them in the correct order.
;; -------------------------------------------------------------------------
;;
;; -------------------------------------------------------------------------
;; Changing priority might put the conference above or below the
;; current session priority. We need to fetch or delete maps.
;;
39
;; Do this under lyskom-update-membership. Done.
40
;;
David Byers's avatar
David Byers committed
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
;; Test cases:
;;
;; Prioritize a conf under the session priority to above the session
;; priority. Should give us more unreads. Might trigger prompt change.
;;
;; Prioritize a conf with unreads to under the session priority.
;; Should give us less unreads. Might trigger prompt change.
;;
;; While prefetching a conf, change its priority to below the session
;; priority. The prefetched maps should be discarded automatically.
;; -------------------------------------------------------------------------
;;          
;; What we need is a general function we use to change the priority of a
;; membership. Since we do all the updates in the background it's OK to
;; send an update off as soon as we change the priority of a membership.
;; 
;; This function should...
;; - Change the priority and placement of the membership in the server
;; - See if the priority has changed re the session priority and if so
;;   either start a prefetch for the conference or remove the unreads
;;   for the conference from all read lists.
;; - Remove and reinsert the unreads in the reading lists, then update
;;   the prompt.
;; - Sort the membership list.
;;
66
;; Done in lp--set-entry-pri-and-pos and lp--update-membership.
David Byers's avatar
David Byers committed
67
;;
68
69
70
71
72
73
74
75
76
;; TODO UNSORTED
;; Keep the unread counter updated. Hook in lyskom-mark-as-read
;; Keep the membership list update. Perhaps in lyskom-add-membership
;;      and associated functions to add, lyskom-remove-membership to
;;      remove.
;; Endast-function to all marked memberships
;; Uppskjut-function to all marked memberships
;; Remove and add membership functions.
;; 
David Byers's avatar
David Byers committed
77
78
79
80
81


;;; Commentary:
;; 

David Byers's avatar
David Byers committed
82
83
(require 'advice)

David Byers's avatar
David Byers committed
84
;;; Code:
85

David Byers's avatar
David Byers committed
86
(def-komtype lp--entry
87
88
  start-marker                          ; Where the entry is in the buffer
  end-marker                            ; Where it ends in the buffer
David Byers's avatar
David Byers committed
89
  priority                              ; The saved priority of the membership
90
91
92
  membership                            ; The membership
  selected                              ; Selected or not
  state                                 ; Expanded display or not
93
94
  visible                               ; Non-nil when visible
  extents                               ; Alist of extents/overlays
95
96
  )

97
98
99
100
(defvar lp--last-format-string nil
  "The cached format string for entries. 
Use lp--compute-format-string when you need the format string. Do not
access this variable directly.")
101
102
103
(defvar lp--last-window-width -1)

;;; Local variables in the prioritize buffer
104
105
;;; There should be no reason to use these at all. There are functional
;;; abstractions that let you access their contents.
106
107
108
109
110

(defvar lp--entry-list nil)
(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
111
(defvar lp--buffer-done nil)
112

113

114
115
;;; ============================================================
;;; Utility functions and really basic stuff
116
117

(defun lp--entry-update-extents (entry)
118
119
120
121
122
  "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."
123
124
125
126
127
128
129
130
131
132
133
134
  (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
135
136


137
138
139
140
141
142
143
144
145
146
147
(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
      (set-membership->priority mship new-priority)
      (lyskom-sort-membership)
      (cond
       ((and (>= old-priority lyskom-session-priority)
             (>= new-priority lyskom-session-priority))
148
149
        ; Don't (lyskom-sort-to-do-list) since lyskom-sort-membership will.
        )
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168

       ((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."

  ;; FIXME: We have to update all positions in the membership 
169
  ;; FIXME: list, not just the one we changed.
170
171
172
173
174

  (let ((mship (lyskom-get-membership conf-no t)))
    (when mship
      (set-membership->position mship new-position)
      (setq lyskom-membership (lyskom-move-in-list mship lyskom-membership new-position))
175
      (lyskom-update-membership-positions))))
176

David Byers's avatar
David Byers committed
177
178

;;; ============================================================
David Byers's avatar
David Byers committed
179
;; Entry drawing
David Byers's avatar
David Byers committed
180

181
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
207
208
209
210
211
(defun lp--entry-set-background (entry color)
  "Use extents or overlays to set the background of ENTRY to COLOR."
  (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))))
           (facename (intern (format "lyskom-%s-background" color)))
           (face (or (find-face facename) (lyskom-make-face facename t))))
      (unless extent
        (lyskom-xemacs-or-gnu
         (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) 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))))))


212
(defmacro lp--save-excursion (&rest body)
David Byers's avatar
David Byers committed
213
214
215
216
  "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."
217
218
  `(let* ((lp--saved-entry  (lp--entry-at (point)))
          (lp--saved-column (and lp--saved-entry
David Byers's avatar
David Byers committed
219
                                 (- (point)
220
221
222
223
224
                                    (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
225
         (goto-char (+ lp--saved-column (lp--entry->start-marker
226
227
228
                                         lp--saved-entry))))))


229
(defun lp--compute-format-string ()
David Byers's avatar
David Byers committed
230
231
232
  "Compute the format string for an entry in the buffer.
To save time, the format string is cached in `lp--last-format-string'.  It is
only recomputed if the window width changes."
233
234
235
236
237
238
  (if (and lp--last-format-string
           (eq (window-width) lp--last-window-width))
      lp--last-format-string
    (let ((total (- (window-width) 1 3 3 2 12 2 5 2 3 1)))
      (setq lp--last-window-width (window-width))
      (setq lp--last-format-string
David Byers's avatar
David Byers committed
239
            (concat "%#1c %=3#2s %#9c %=-" (number-to-string total)
240
241
242
243
                    "#3M  %=-12#4s %[%#13@%=5#5s%]  %[%#10@%#6c%]%[%#11@%#7c%]%[%#12@%#8c%]")))))

(defun lp--format-insert-entry (entry)
  "Format ENTRY and insert it into the current buffer at point."
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
  (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))

    (when (or (eq (lp--entry->state entry) 'expanded)
              (and (not (eq (membership->created-by (lp--entry->membership entry))
                            lyskom-pers-no))
                   (not (eq (membership->created-by (lp--entry->membership entry)) 0))
                   (not (eq (lp--entry->state entry) 'contracted))))
      (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
278
279
280


(defun lp--format-entry (conf-stat defer-info)
281
282
283
284
285
286
  (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
287
                                    (lp--entry->membership entry))))
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
           (string (lyskom-format
                    (lp--compute-format-string)
                    (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)
                    (lyskom-return-date-and-time
                     (membership->last-time-read (lp--entry->membership entry))
                     'time-yyyy-mm-dd)
                    (if un (int-to-string un) "")
                    
                    (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 ?.)
                    (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))))
328
329
                    '(lp--unread t)
                    )))
330
331
      (if defer-info
          (lyskom-replace-deferred defer-info string)
332
        (lyskom-insert-at-point string))
David Byers's avatar
David Byers committed
333

334
335
336
337
      (if (lp--entry->selected entry)
          (lp--entry-set-background entry (face-background-name 'kom-mark-face))
        (lp--entry-set-background entry nil)))))
      
David Byers's avatar
David Byers committed
338
339

(defun lp--format-entry-expansion (conf-stat defer-info)
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
  (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)))
                   (eq 0 (time->mon (membership->created-at membership)))
                   (eq 1 (time->mday (membership->created-at membership)))
                   (eq 70 (time->year (membership->created-at membership))))
              (lyskom-format "Ingen information om när medlemskapet skapades")
            (lyskom-format "%#1s %#2s av %#3P"
                           (if (membership-type->invitation (membership->type (lp--entry->membership entry)))
                               "Inbjuden" "Adderad")
                           (lyskom-return-date-and-time
                            (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)))))
367

368
369
370
371

(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"
372
373
374
375
  (let ((buffer-read-only nil))
    (insert-before-markers "\n")
    (forward-char -1)
    (set-lp--entry->start-marker entry (point-marker))
376
    (lp--format-insert-entry entry)
377
    (set-lp--entry->end-marker entry (point-marker))
378
    (lp--entry-update-extents entry)
379
    (forward-char 1)))
380
381

(defun lp--erase-entry (entry)
David Byers's avatar
David Byers committed
382
  "Erase the printed representation of the entry ENTRY in the buffer."
383
384
385
386
  (let ((buffer-read-only nil))
    (delete-region (lp--entry->start-marker entry)
                   (1+ (lp--entry->end-marker entry)))
    (set-lp--entry->start-marker entry nil)
387
388
    (set-lp--entry->end-marker entry nil)
    (lp--entry-update-extents entry)))
389
390
391

(defun lp--redraw-entry-mark (entry)
  "Redraw the mark for ENTRY."
392
393
394
395
  (let ((buffer-read-only nil))
    (lp--save-excursion
     (goto-char (lp--entry->start-marker entry))
     (insert (if (lp--entry->selected entry) ?* ?\ ))
396
397
398
     (if (lp--entry->selected entry)
         (lp--entry-set-background entry (face-background-name 'kom-mark-face))
       (lp--entry-set-background entry nil))
399
     (delete-char 1))))
400
401
402

(defun lp--redraw-entry (entry)
  "Redraw the entry ENTRY."
David Byers's avatar
David Byers committed
403
  (lp--save-excursion
404
405
406
407
408
   (when (lp--entry->start-marker entry)
     (goto-char (lp--entry->start-marker entry))
     (lp--erase-entry entry))
   (when (lp--entry->visible entry)
     (lp--print-entry entry))))
David Byers's avatar
David Byers committed
409

410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
(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
           (let ((bounds (next-text-property-bounds 
                          1 (lp--entry->start-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 unread (int-to-string unread) "")
                                         '(lp--unread t))))))))))
     conf-no (lyskom-find-unread conf-no)))
446
447


David Byers's avatar
David Byers committed
448
;;; ============================================================
David Byers's avatar
David Byers committed
449
;; List management
David Byers's avatar
David Byers committed
450

451
(defun lp--set-entry-list (entries)
David Byers's avatar
David Byers committed
452
  "Set the list of entries to ENTRIES."
453
454
455
456
457
458
  (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
459
460

(defun lp--conf-no-entry (conf-no)
David Byers's avatar
David Byers committed
461
  "Find the entry for a membership in CONF-NO."
David Byers's avatar
David Byers committed
462
463
464
  (let ((entries (lp--all-entries))
        (found nil))
    (while (and entries (null found))
David Byers's avatar
David Byers committed
465
      (when (eq conf-no (membership->conf-no (lp--entry->membership
David Byers's avatar
David Byers committed
466
467
468
469
470
                                              (car entries))))
        (setq found (car entries)))
      (setq entries (cdr entries)))
    found))

471
(defun lp--find-new-position (entry priority &optional pos)
David Byers's avatar
David Byers committed
472
473
  "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
474
475
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
476
477
478
479
entry priority"
  (let ((entries (lp--all-entries))
        (result nil)
        (tmp nil))
David Byers's avatar
David Byers committed
480
    (cond
David Byers's avatar
David Byers committed
481
482
483

     ;; Moving down. Return the last entry spotted with a higher
     ;; than requested priority
484
485
486
     ((if priority 
          (> (lp--entry->priority entry) priority)
        (< (lp--entry-position entry) pos))
David Byers's avatar
David Byers committed
487
      (while (and entries (null result))
488
489
490
        (when (if priority
                  (<= (lp--entry->priority (car entries)) priority)
                (>= (lp--entry-position (car entries)) pos))
David Byers's avatar
David Byers committed
491
492
493
494
495
496
497
          (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
498
499
500
     ((if priority
          (< (lp--entry->priority entry) priority)
        (> (lp--entry-position entry) pos))
David Byers's avatar
David Byers committed
501
      (while (and entries (null result))
502
503
504
505
506
        (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
507
508
509
510
     (t (setq result entry)))
    result))
  

511
512
513
514
(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
515
516
517
518
    (while (and (> pos 0) entry (not (lp--entry->visible entry)))
      (setq pos (1- pos))
      (setq entry (lp--get-entry pos)))
    (if (lp--entry->visible entry) entry nil)))
David Byers's avatar
David Byers committed
519

520
521
522
523
(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
524
(defun lp--entry-position (entry)
David Byers's avatar
David Byers committed
525
  "Return the position in the list for ENTRY."
David Byers's avatar
David Byers committed
526
527
528
529
  (- (length (lp--all-entries))
     (length (memq entry (lp--all-entries)))))


530
531
532
533
(defun lp--entry-at (where)
  "Return the entry at WHERE."
  (let ((entry-list (lp--all-entries))
        (found nil)
David Byers's avatar
David Byers committed
534
        (pos (save-excursion (goto-char where)
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
                             (beginning-of-line)
                             (point))))
    (while (and (not found) entry-list)
      (when (and (lp--entry->start-marker (car entry-list))
                 (lp--entry->end-marker (car entry-list))
                 (<= (lp--entry->start-marker (car entry-list)) pos)
                 (>= (lp--entry->end-marker (car entry-list)) pos))
        (setq found (car entry-list)))
      (setq entry-list (cdr entry-list)))
    found))

(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)))
552
  (let ((cur (lp--get-entry (lp--next-visible-entry to))))
553
554
    (if cur
        (goto-char (lp--entry->start-marker cur))
555
      (goto-char lp--list-end-marker))
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
    (lp--set-entry-list (lp--add-to-list to entry (lp--all-entries)))
    (lp--print-entry entry)))


(defun lp--remove-from-list (elem l)
  "Destructively emove the element at index ELEM from the list L."
  (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
578
579
580
(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)))
581

582
583
(defun lp--add-membership-callback (membership)
  (lp--update-buffer (membership->conf-no membership)))
David Byers's avatar
David Byers committed
584

585
586

(defun lp--update-buffer (conf-no)
David Byers's avatar
David Byers committed
587
  "Update the entry for CONF-NO in the buffer."
David Byers's avatar
David Byers committed
588
589
590
591
592
593
  (lp--save-excursion
    (let ((buffers (lyskom-buffers-of-category 'prioritize)))
      (mapcar (lambda (buffer)
                (set-buffer buffer)
                (let ((entry (lp--conf-no-entry conf-no))
                      (mship (lyskom-get-membership conf-no t)))
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608

                  ;; A new membership

                  (cond 
                   ((null entry)
                    (let* ((pos (or (membership->position mship)
                                    (- (length lyskom-membership)
                                       (length (memq mship lyskom-membership)))))
                           (elem (and pos (lp--get-entry pos)))
                           (entry (lyskom-create-lp--entry 
                                   nil
                                   nil
                                   (membership->priority mship)
                                   mship
                                   nil
609
                                   'normal
610
                                   t
611
                                   nil)))
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
                      (when pos
                        (save-excursion
                          (goto-char (lp--entry->start-marker elem))
                          (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 (lp--entry-position 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)))
                    ;; FIXME: Move the entry
                    )

                   (t (set-lp--entry->membership entry mship)
                      (lp--redraw-entry entry)))))
David Byers's avatar
David Byers committed
639
640
641
642
              buffers))))



643
644
645
(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
646
a list of results.  ARGS will be passed as additional arguments to FUNCTION.
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667

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
668
;; Menu and button functions
669
670

;;; ------------------------------------------------------------
David Byers's avatar
David Byers committed
671
672
;; Flag menu
;; Argument is a list of entry and flag
673
674

(defun lp--flag-menu-get (entry flag)
David Byers's avatar
David Byers committed
675
676
  "For the membership in ENTRY, return the value of flag FLAG.
FLAG must be one of 'invitation, 'secret or 'passive."
677
678
679
680
681
682
683
  (funcall
   (cond ((eq flag 'invitation) 'membership-type->invitation)
         ((eq flag 'secret) 'membership-type->secret)
         ((eq flag 'passive) 'membership-type->passive))
   (membership->type (lp--entry->membership entry))))

(defun lp--flag-menu-set (entry flag value)
David Byers's avatar
David Byers committed
684
685
  "For the membership in ENTRY, set FLAG to VALUE.
FLAG must be one of 'invitation, 'secret or 'passive."
686
687
688
689
690
691
692
693
  (funcall
   (cond ((eq flag 'invitation) 'set-membership-type->invitation)
         ((eq flag 'secret) 'set-membership-type->secret)
         ((eq flag 'passive) 'set-membership-type->passive))
   (membership->type (lp--entry->membership entry))
   value))

(defun lyskom-prioritize-flag-clear (buf arg text)
David Byers's avatar
David Byers committed
694
695
696
697
698
699
700
701
  "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."
702
703
704
705
706
707
708
  (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
709
710
711
712
713
714
715
716
  "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."
717
718
719
720
721
722
723
  (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
724
725
726
727
728
729
730
731
  "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."
732
733
734
735
736
737
738
739
  (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
740
      (save-excursion
741
        (set-buffer lyskom-buffer)
David Byers's avatar
David Byers committed
742
743
        (let ((result (blocking-do 'set-membership-type
                                   lyskom-pers-no
744
745
746
747
748
749
750
                                   (membership->conf-no (lp--entry->membership entry))
                                   (membership->type (lp--entry->membership entry)))))

          (unless result
            (message "Det gick inte: %s"
                     (lyskom-get-error-text lyskom-errno))))

David Byers's avatar
David Byers committed
751
        ;; Update the display
752
        (let ((mship
David Byers's avatar
David Byers committed
753
754
               (blocking-do 'query-read-texts
                            lyskom-pers-no
755
                            (membership->conf-no (lp--entry->membership entry)))))
David Byers's avatar
David Byers committed
756
          (lyskom-replace-membership mship)
757
758
759
760
761
762
          (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)
763
                       (lyskom-leave-current-conf))
764
765
766
                     (read-list-delete-read-info (membership->conf-no mship)
                                                 lyskom-to-do-list)
                     (lyskom-update-prompt t)))
767
                  (t (lyskom-prefetch-map (membership->conf-no mship) mship))))
768
769
770
          (blocking-do 'get-conf-stat (membership->conf-no mship))))
      (lp--redraw-entry entry))))

771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
(defun lp--toggle-invitation ()
  "Toggle the invitation bit of the current entry"
  (interactive)
  (lp--save-excursion
   (let ((cur (lp--entry-at (point))))
     (cond ((null cur) (error "No entry at point"))
           (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))))
     (cond ((null cur) (error "No entry at point"))
           (t (lyskom-prioritize-flag-toggle (current-buffer)
                                             (list cur 'passive)
                                             ""))))))

(defun lp--toggle-secret ()
  "Toggle the secret bit of the current entry"
  (interactive)
  (lp--save-excursion
   (let ((cur (lp--entry-at (point))))
     (cond ((null cur) (error "No entry at point"))
           (t (lyskom-prioritize-flag-toggle (current-buffer)
                                             (list cur 'secret)
                                             ""))))))

801
802
803


;;; ============================================================
David Byers's avatar
David Byers committed
804
805
;; Marking and unmarking memberships
;; 
806
807
808
809
810

(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)
811
  (lp--update-mode-line))
812
813
814

(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
815
  (mapcar (lambda (entry)
816
            (when entry
817
              (if (and state (lp--entry->visible entry))
818
                  (add-to-list 'lp--selected-entry-list entry)
David Byers's avatar
David Byers committed
819
                (setq lp--selected-entry-list
820
821
822
823
824
                      (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
825
  "Return a list of all selected entries."
826
827
828
  lp--selected-entry-list)

(defun lp--set-selected-entries (entry-list)
David Byers's avatar
David Byers committed
829
  "Set the selected entries to exactly the entries in ENTRY-LIST.
830
831
832
Forces a mode line update"
  (lp--do-select-entries (lp--all-selected-entries) nil)
  (lp--do-select-entries entry-list t)
833
  (lp--update-mode-line))
834

835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
;;; ============================================================
;;; Hiding and unhiding entries
;;; FIXME: This doesn't work yet

(defun lp--entry-set-visible (entry-list state)
  "Set the visibility of all entries in ENTRY-LIST to STATE."
  (when (null state)
    (lp--select-entries entry-list nil))
  (mapcar (lambda (entry) 
            (unless (eq (lp--entry->visible entry) state)
              (let ((pos (lp--get-entry 
                          (lp--next-visible-entry
                           (lp--entry-position entry)))))
                (if pos
                    (goto-char (lp--entry->start-marker pos))
                  (goto-char lp--list-end-marker))
              (set-lp--entry->visible entry state)
              (lp--redraw-entry entry))))
          entry-list))


856

857
;;; ------------------------------------------------------------
David Byers's avatar
David Byers committed
858
;; Server update functions
859

860
(defun lp--update-membership (entry old-pri old-pos)
David Byers's avatar
David Byers committed
861
  "Update the server and local versions of membership in ENTRY."
862
  (save-excursion
863
864
865
    (let ((saved-pos (lp--entry-position entry)))
      (set-buffer lyskom-buffer)
      (let ((mship (lp--entry->membership entry)))
866
867
868
869
870
871
        (unless (eq old-pos saved-pos)
          (lyskom-change-membership-position (membership->conf-no mship)
                                             saved-pos))
        (unless (eq old-pri (lp--entry->priority mship))
          (lyskom-change-membership-priority (membership->conf-no mship)
                                             (lp--entry->priority mship)))
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
        (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))))))
889
890


891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
;;; ============================================================
;;; 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
909
910
returned value has the same sign as DELTA. The result is clipped to the
size of the list."
911
912
913
914
915
  (let ((step (signum delta))
        (num (abs delta))
        (result 0))
    (while (> num 0)
      (setq pos (+ step pos))
David Byers's avatar
David Byers committed
916
917
918
919
920
921
      (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)))))))
922
923
924
    (* result step)))


925
;;; ------------------------------------------------------------
David Byers's avatar
David Byers committed
926
;; User-level functions
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943


(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
944
  "Toggle selection of the membership at WHERE."
945
946
  (interactive "d")
  (let ((entry (lp--entry-at where)))
947
948
949
950
    (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
951
952
  "Select all entries in the region.
START and END are the starting and ending points of the region."
953
954
955
956
957
  (interactive "r")
  (let ((entry-list (lp--map-region start end 'identity)))
    (lp--select-entries entry-list t)))

(defun lp--select-prioriy (priority)
David Byers's avatar
David Byers committed
958
  "Select all entries with a priority PRIORITY.
959
960
961
962
963
With numeric prefix argument select entries with that priority."
  (interactive "P")
  (lp--do-select-priority priority t))

(defun lp--deselect-prioriy (priority)
David Byers's avatar
David Byers committed
964
  "Deselect all entries with a priority PRIORITY.
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
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))))
      (unless entry (error "No membership at point"))
      (setq priority (membership->priority (lp--entry->membership entry)))))

  (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
986
  "Deselect all memberships."
987
988
989
990
991
  (interactive)
  (lp--set-selected-entries nil))



David Byers's avatar
David Byers committed
992
;;; ============================================================
David Byers's avatar
David Byers committed
993
;; Reprioritization functions
David Byers's avatar
David Byers committed
994

995
(defun lp--set-entry-pri-and-pos (entry priority position)
996
997
998
999
1000
1001
  "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))
1002
        (need-redraw nil))
1003
1004
1005
1006
1007
1008
1009
    (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)
      (setq need-redraw nil))
1010
    (sit-for 0)
1011
1012
1013
    (lp--update-membership entry old-pri old-pos)
    (when need-redraw (lp--redraw-entry entry))))

1014
1015
1016
(defun lp--yank ()
  "Insert all the selected memberships before the entry at point."
  (interactive)
1017
1018
1019
1020
1021
1022
1023
1024
1025
  (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)))
     (cond ((null cur) (error "No entry at point"))
           ((null entries) (error "No entries selected"))
           (t (mapcar 
               (lambda (entry)
1026
                 (lp--set-entry-pri-and-pos
1027
1028
1029
                  entry priority
                  (lp--entry-position (lp--find-new-position entry nil pos))))
               entries))))))
1030
1031
1032
          


David Byers's avatar
David Byers committed
1033
(defun lp--set-priority (priority)
David Byers's avatar
David Byers committed
1034
  "Set the priority of selected memberships to PRIORITY.
David Byers's avatar
David Byers committed
1035
1036
1037
Memberships that must be moved will be moved the shortest distance
possible in the list."
  (interactive "P")
1038
  (let* ((entries (or (lp--all-selected-entries)
David Byers's avatar
David Byers committed
1039
1040
                      (list (lp--entry-at (point))))))
    (unless entries
David Byers's avatar
David Byers committed
1041
      (error "No entries selected"))
David Byers's avatar
David Byers committed
1042
1043
1044
1045
1046
1047
1048
1049
    (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
1050
                    0 255 (lyskom-format 'priority-prompt
David Byers's avatar
David Byers committed
1051
                                         (membership->conf-no
David Byers's avatar
David Byers committed
1052
                                          (lp--entry->membership
David Byers's avatar
David Byers committed
1053
1054
1055
                                           (car entries)))) t)))))
    (lp--save-excursion
     (mapcar (lambda (entry)
David Byers's avatar
David Byers committed
1056
               (let ((new-pos (lp--entry-position
David Byers's avatar
David Byers committed
1057
                               (lp--find-new-position entry priority))))
1058
                 (lp--set-entry-pri-and-pos entry priority new-pos)))
1059
             entries))))
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083

(defun lp--bump-priority (amount)
  "Increase the priority of the current entry by one"
  (lp--save-excursion
   (let* ((cur (lp--entry-at (point)))
          (pri (and cur (lp--entry->priority cur)))
          (pos (lp--entry-position cur))
          (new-pri (+ pri amount)))
     (when (> new-pri 255) (setq new-pri 255))
     (when (< new-pri 0) (setq new-pri 0))

     (when (and cur
                (eq pri new-pri)
                (eq pri 0)
                (eq pos (1- (length (lp--all-entries)))))
       (error "Already at minimum priority"))

     (when (and cur
                (eq pri new-pri)
                (eq pri 255)
                (eq pos 0))
       (error "Already at maximum priority"))

     (cond ((null cur) (error "Nor on an entry"))
1084
1085
           (t (let ((new-pos (lp--entry-position 
                              (lp--find-new-position cur (+ pri amount)))))
1086
                (lp--set-entry-pri-and-pos cur new-pri new-pos)))))))
1087

1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104

(defun lp--increase-priority (arg)
  (interactive "p")
  (lp--bump-priority arg))

(defun lp--decrease-priority (arg)
  (interactive "p")
  (lp--bump-priority (- arg)))



(defun lp--move-up ()
  "Move the current entry up one notch."
  (interactive)
  (lp--save-excursion
   (let* ((cur (lp--entry-at (point)))
          (pos (and cur (lp--entry-position cur)))
1105
1106
          (place (and cur (> pos 0) (+ pos (lp--calculate-distance pos -1))))
          (prev (and place (lp--get-entry place))))
1107
1108
     (cond ((null cur) (error "Not on an entry"))
           ((null prev) (error "Beginning of list"))
1109
1110
1111
           (t (if (/= (lp--entry->priority cur)
                      (lp--entry->priority prev))
                  (progn
1112
                    (lp--set-entry-pri-and-pos cur
1113
                                               (lp--entry->priority prev)
1114
1115
1116
                                               (if (= pos (1+ place))
                                                   nil
                                                 (1+ place)))
1117
                    (lp--redraw-entry cur))
1118
                (lp--set-entry-pri-and-pos cur nil place)))))))
1119
1120
1121
1122
1123
1124
1125

(defun lp--move-down ()
  "Move the current entry up down notch."
  (interactive)
  (lp--save-excursion
   (let* ((cur (lp--entry-at (point)))
          (pos (and cur (lp--entry-position cur)))
1126
1127
          (place (and cur (+ pos (lp--calculate-distance pos 1))))
          (prev (and place (lp--get-entry place))))
1128
1129
     (cond ((null cur) (error "Not on an entry"))
           ((null prev) (error "End of list"))
1130
           (t (if (/= (lp--entry->priority cur)
1131
                      (lp--entry->priority prev))
1132
                  (progn
1133
                    (lp--set-entry-pri-and-pos cur
1134
                                               (lp--entry->priority prev)
1135
1136
1137
                                               (if (= pos (1- place))
                                                   nil
                                                 (1- place)))
1138
                    (lp--redraw-entry cur))
1139
                (lp--set-entry-pri-and-pos cur nil place)))))))
David Byers's avatar
David Byers committed
1140
1141
1142



1143
;;; ============================================================
David Byers's avatar
David Byers committed
1144
;; Motion commands
1145

David Byers's avatar
David Byers committed
1146
1147
1148
1149
1150
1151
1152
1153
(defmacro lp--save-column (&rest body)
  `(let ((lp--saved-column (current-column)))
     ,@body
     (end-of-line)
     (if (> (current-column) lp--saved-column)
         (progn (beginning-of-line)
                (forward-char lp--saved-column)))))

1154
1155
;;; FIXME: Deal with invisible entries

1156
1157
1158
1159
1160
(defun lp--previous-entry (count)
  "Move the cursor up COUNT lines.
The cursor will always move to the start of the target entry."
  (interactive "p")
  (let* ((entry (lp--entry-at (point)))
David Byers's avatar
David Byers committed
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
         (last-entry (lp--get-last-visible-entry))
         (first-entry (lp--next-visible-entry 0))
         (pos (lp--entry-position entry))
         (new-pos (cond ((null last-entry) nil)
                        ((and (null entry) (< (point)
                                              (lp--entry->start-marker 
                                               (lp--get-entry first-entry)))) 0)
                        ((and (null entry) (> (point) 
                                              (lp--entry->end-marker last-entry)))
                         (1- (length (lp--all-entries))))
                        (t (max 0 (+ pos (lp--calculate-distance pos (- count))))))))
David Byers's avatar
David Byers committed
1172
    (condition-case nil
David Byers's avatar
David Byers committed
1173
        (goto-char (lp--entry->start-marker (lp--get-entry new-pos)))
David Byers's avatar
David Byers committed
1174
      (error nil))))
1175
1176
1177
1178
1179
1180

(defun lp--next-entry (count)
  "Move the cursor down COUNT lines.
The cursor will always move to the start of the target entry."
  (interactive "p")
  (let* ((entry (lp--entry-at (point)))
David Byers's avatar
David Byers committed
1181
1182
1183
1184
1185
         (last-entry (lp--get-last-visible-entry))
         (first-entry (lp--next-visible-entry 0))
         (pos (lp--entry-position entry))
         (new-pos (cond ((null last-entry) nil)
                    ((and (null entry) (< (point) 
1186
1187
                                          (lp--entry->start-marker 
                                           (lp--get-entry
David Byers's avatar
David Byers committed
1188
                                            first-entry))))
David Byers's avatar
David Byers committed
1189
                     0)
1190
1191
                    ((and (null entry) (> (point) 
                                          (lp--entry->end-marker 
David Byers's avatar
David Byers committed
1192
                                           last-entry)))
David Byers's avatar
David Byers committed
1193
1194
                     (1- (length (lp--all-entries))))
                    (t (min (1- (length (lp--all-entries)))
David Byers's avatar
David Byers committed
1195
                            (+ pos (lp--calculate-distance pos count)))))))
1196
    (condition-case nil
David Byers's avatar
David Byers committed
1197
        (goto-char (lp--entry->start-marker (lp--get-entry new-pos)))
1198
1199
1200
1201
1202
1203
      (error nil))))

(defun lp--first-entry ()
  "Move point to the first entry in the membership list."
  (interactive)
  (condition-case nil
David Byers's avatar
David Byers committed
1204
1205
1206
1207
      (let ((entry (lp--get-entry (lp--next-visible-entry 0))))
        (cond ((null entry) (goto-char lp--list-end-marker))
              (t (goto-char (lp--entry->start-marker 
                             (lp--get-entry (lp--next-visible-entry 0)))))))
1208
    (error nil)))
1209

1210
1211
1212
1213
(defun lp--last-entry ()
  "Move point to the last entry in the membership list."
  (interactive)
  (condition-case nil
David Byers's avatar
David Byers committed
1214
1215
1216
      (let ((entry (lp--get-last-visible-entry)))
        (cond ((null entry) (goto-char lp--list-end-marker))
              (t (goto-char (lp--entry->start-marker entry)))))
1217
1218
1219
    (error nil)))

(defun lp--goto-priority (priority)
David Byers's avatar
David Byers committed
1220
1221
  "Move to the closest entry with priority PRIORITY.
If there is no entry with the specified priority, move to the nearest
1222
1223
1224
1225
1226
1227
entry with an adjacent priority."
  (interactive "P")
  (let* ((entry (lp--entry-at (point)))
         (seen-me nil)
         (done nil)
         (entry-list (lp--all-entries)))
1228

1229
    ;; Get the priority to move to
1230

1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
    (unless (numberp priority)
      (setq priority
            (lyskom-read-num-range 0 255 "Gå till prioritet: " t)))

    ;; Figure out where to move
    ;; Loop over all entries

    (while (and (not done) (cdr entry-list))
      (when (eq (car entry-list) entry) (setq seen-me t))
      (if (or (< (lp--entry->priority (car entry-list))
                 priority)
              (and seen-me (= (lp--entry->priority (car entry-list))
                              priority)))
          (setq done t)
        (setq entry-list (cdr entry-list))))

    (when entry-list
      (goto-char (lp--entry->start-marker (car entry-list))))))
    
(defun lp--toggle-entry-expansion ()
  "Toggle the expanded state of the current entry."
  (interactive)
  (let ((entry (lp--entry-at (point))))
    (when entry
David Byers's avatar
David Byers committed
1255
      (set-lp--entry->state
1256
1257
1258
       entry
       (if (eq (lp--entry->state entry) 'expanded) 'contracted 'expanded))
      (lp--redraw-entry entry))))
David Byers's avatar
David Byers committed
1259

1260
1261
1262
1263
1264
(defun lp--quit ()
  "Remove the membership buffer and quit"
  (interactive)
  (lyskom-undisplay-buffer))

1265

1266

David Byers's avatar
David Byers committed
1267
1268
1269
1270
1271
(defun lp--scroll-advice (fn)
  (let ((cur (current-column)))
    (funcall fn)
    (when (and (boundp 'lyskom-buffer-category)
               lyskom-buffer-category 'prioritize)
David Byers's avatar
David Byers committed
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
      (let ((last-entry (lp--get-last-visible-entry ))
            (first-entry (lp--next-visible-entry 0)))
        (cond ((null last-entry)
               (goto-char lp--list-end-marker))
              ((> (point) (lp--entry->end-marker last-entry))
               (goto-char (lp--entry->end-marker last-entry))
               (when (> (current-column) cur)
                 (beginning-of-line)
                 (forward-char cur)))

              ((< (point) (lp--entry->start-marker
                           (lp--get-entry first-entry)))
               (goto-char (lp--entry->start-marker 
                           (lp--get-entry first-entry)))
               (end-of-line)
               (when (> (current-column) cur)
                 (beginning-of-line)
                 (forward-char cur))))))))
David Byers's avatar
David Byers committed
1290
1291
1292
1293
1294
1295
1296
1297
1298

(defadvice scroll-up-command (around lp--scroll-up-advice activate)
  (lp--scroll-advice (lambda () ad-do-it)))

(defadvice scroll-down-command (around lp--scroll-up-advice activate)
  (lp--scroll-advice (lambda () ad-do-it)))



1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328


(defvar lp--mode-map nil
  "Keymap used in lp--mode")

(if lp--mode-map
    nil
  (setq lp--mode-map (make-keymap))
  (suppress-keymap lp--mode-map)
  (define-key lp--mode-map (kbd "SPC") 'lp--toggle-membership-selection)
  (define-key lp--mode-map (kbd "p")   'lp--set-priority)
  (define-key lp--mode-map (kbd "C-w") 'lp--select-region)
  (define-key lp--mode-map (kbd "C-y") 'lp--yank)
  (define-key lp--mode-map (kbd "#")   'lp--select-priority)
  (define-key lp--mode-map (kbd "M-DEL") 'lp--deselect-all)
  (define-key lp--mode-map (kbd "C-p") 'lp--previous-entry)
  (define-key lp--mode-map (kbd "<up>") 'lp--previous-entry)
  (define-key lp--mode-map (kbd "C-n") 'lp--next-entry)
  (define-key lp--mode-map (kbd "<down>") 'lp--next-entry)
  (define-key lp--mode-map (kbd "M-<") 'lp--first-entry)
  (define-key lp--mode-map (kbd "M->") 'lp--last-entry)
  (define-key lp--mode-map (kbd "g") 'lp--goto-priority)
  (define-key lp--mode-map (kbd "RET") 'lp--toggle-entry-expansion)
  (define-key lp--mode-map (kbd "+") 'lp--increase-priority)
  (define-key lp--mode-map (kbd "-") 'lp--decrease-priority)
  (define-key lp--mode-map (kbd "M-p") 'lp--move-up)
  (define-key lp--mode-map (kbd "M-n") 'lp--move-down)
  (define-key lp--mode-map (kbd "I") 'lp--toggle-invitation)
  (define-key lp--mode-map (kbd "H") 'lp--toggle-secret)
  (define-key lp--mode-map (kbd "P") 'lp--toggle-passive)
1329
  (define-key lp--mode-map (kbd "C-c C-c") 'lp--quit)
1330
  (define-key lp--mode-map (kbd "q") 'lp--quit)
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344

  (define-key lp--mode-map (kbd (lyskom-keys 'button2up)) 'kom-button-click)
  (define-key lp--mode-map (kbd (lyskom-keys 'button2)) 'kom-mouse-null)
  (define-key lp--mode-map (kbd (lyskom-keys 'button3)) 'kom-popup-menu)
  (define-key lp--mode-map (kbd (lyskom-keys 'button3up)) 'kom-mouse-null)
  (define-key lp--mode-map (kbd "*") 'kom-button-press)
  (define-key lp--mode-map (kbd "=") 'kom-menu-button-press)
  (define-key lp--mode-map (kbd "TAB") 'kom-next-link)
  (define-key lp--mode-map (kbd "M-TAB") 'kom-previous-link)
  (define-key lp--mode-map (kbd "C-i") 'kom-next-link)
  (define-key lp--mode-map (kbd "M-C-i") 'kom-previous-link)
  )


1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
;;; ============================================================
;; The mode

(defvar lp--mode-line '("" 
                        mode-line-modified
                        mode-line-buffer-identification
                        "   "
                        global-mode-string
                        "   %[("
                        mode-name
                        mode-line-process
                        minor-mode-alist
                        ")%] "
                        lp--mode-line-selected
                        "--"
                        (-3 . "%p")
                        "-%-"))

(defvar lp--mode-line-selected ""
  "String showing number of selected entries.")

1366
1367
1368
1369
1370
1371
1372
1373
(defun lp--update-mode-line ()
  (setq lp--mode-line-selected
        (cond ((= (length (lp--all-selected-entries)) 0)
               (lyskom-get-string 'no-selection))
               (t (format (lyskom-get-string 'selection)
                          (length (lp--all-selected-entries))))))
  (force-mode-line-update))

1374
1375
1376
1377
1378

(def-kom-command kom-handle-membership ()
  "Pop up a buffer to manage memberships in"
  (interactive)
  (set-buffer (lp--create-buffer))
1379
1380
  (lp--mode)
  (lp--first-entry))
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406

(defun lp--mode ()
  "\\<lyskom-prioritize-mode-map>Mode for prioritizing conferences in LysKOM.

Commands:
TBD.

All bindings:
\\{lyskom-prioritize-mode-map}
Entry to this mode runs lyskom-prioritize-mode-hook."
  (interactive)
  (setq major-mode 'lp--mode)
  (setq mode-name "Prioritize")
  (make-local-variable 'lp--last-format-string)
  (make-local-variable 'lp--last-window-width)
  (make-local-variable 'lp--entry-list)
  (make-local-variable 'lp--list-start-marker)
  (make-local-variable 'lp--list-end-marker)
  (make-local-variable 'lp--selected-entry-list)
  (make-local-variable 'lp--mode-line-selected)
  (setq lp--mode-line-selected "")

  (setq mode-line-format lp--mode-line)
  (lp--update-mode-line)
  (setq buffer-read-only t)
  (lyskom-use-local-map lp--mode-map)
David Byers's avatar
David Byers committed
1407
1408
1409
  (lyskom-add-hook 'lyskom-add-membership-hook
                   'lp--add-membership-callback
                    t)
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
;;  (lyskom-add-hook 'lyskom-remove-membership-hook 
;;                   'lyskom-prioritize-remove-membership
;;                   t)
;;  (lyskom-add-hook 'lyskom-replace-membership-hook 
;;                   'lyskom-prioritize-replace-membership
;;                   t)
  (run-hooks 'lp--mode-hook))


(defun lp--create-buffer ()
  "Create a buffer for managing memberships."
  (let ((buf (lyskom-get-buffer-create 'prioritize
1422
                                       (concat (buffer-name) "-membership")
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
                                       t))
        (entry-list nil))

    (lyskom-save-excursion
      (set-buffer buf)