mship-edit.el 27.7 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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
;;; TO DO
;;;
;;; -------------------------------------------------------------------------
;;; 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.
;;;
;;; 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.
;;;
;;; 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.
;;;
;;;

55
56
57
(def-komtype lp--entry 
  start-marker                          ; Where the entry is in the buffer
  end-marker                            ; Where it ends in the buffer
David Byers's avatar
David Byers committed
58
  priority                              ; The saved priority of the membership
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
  membership                            ; The membership
  selected                              ; Selected or not
  state                                 ; Expanded display or not
  )

(defvar lp--last-format-string nil)
(defvar lp--last-window-width -1)

;;; Local variables in the prioritize buffer

(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
74
75
76
77
78
79



;;; ============================================================
;;; Entry drawing

80
81
82
83
84
85
86
87
88
89
90
91
92
(defmacro lp--save-excursion (&rest body)
  `(let* ((lp--saved-entry  (lp--entry-at (point)))
          (lp--saved-column (and lp--saved-entry
                                 (- (point) 
                                    (lp--entry->start-marker
                                     lp--saved-entry)))))
     (save-excursion ,@body)
     (if (and lp--saved-entry
              (lp--entry->start-marker lp--saved-entry))
         (goto-char (+ lp--saved-column (lp--entry->start-marker 
                                         lp--saved-entry))))))


93
94
95
96
97
98
99
(defun lp--compute-format-string ()
  (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
100
            (concat "%#1c %=3#2s %#9c %=-" (number-to-string total) 
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
                    "#3M  %=-12#4s %=5#5s  %[%#10@%#6c%]%[%#11@%#7c%]%[%#12@%#8c%]")))))
          

(defun lp--find-unread (conf-no)
  (save-excursion
   (set-buffer lyskom-buffer)
   (let ((rlist (read-list->all-entries lyskom-to-do-list))
         (found nil))
     (while (and (not found) rlist)
       (when (eq conf-no (conf-stat->conf-no 
                          (read-info->conf-stat (car rlist))))
         (setq found (length (cdr (read-info->text-list (car rlist))))))
       (setq rlist (cdr rlist)))
     found)))

(defun lp--format-entry (entry)
  (let ((un (lp--find-unread (membership->conf-no
                              (lp--entry->membership entry))))
        (conf-stat (blocking-do 'get-conf-stat
                                (membership->conf-no 
                                 (lp--entry->membership entry)))))
    (concat 
     (lyskom-format (lp--compute-format-string)
                    (if (lp--entry->selected entry) ?* ?\ )
125
126
127
128
129
                    (if (zerop (membership->priority
                                (lp--entry->membership entry)))
                        "-"
                      (int-to-string (membership->priority
                                (lp--entry->membership entry))))
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
                    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 (eq lyskom-pers-no (conf-stat->supervisor conf-stat)) ?O ?\ )
                    (lyskom-default-button 'prioritize-flag-menu
                                           (list entry 'invitation)
                                           (list "%#1s (%=#2M)" 
                                                 "Inbjuden"
                                                 (membership->conf-no
                                                  (lp--entry->membership entry)))) 
                    (lyskom-default-button 'prioritize-flag-menu
                                           (list entry 'secret)
                                           (list "%#1s (%=#2M)" 
                                                 "Hemlig"
                                                 (membership->conf-no
                                                  (lp--entry->membership entry))))
                    (lyskom-default-button 'prioritize-flag-menu
                                           (list entry 'passive)
                                           (list "%#1s (%=#2M)" 
                                                 "Passiv"
                                                 (membership->conf-no
                                                  (lp--entry->membership entry)))))
     (if (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-format "\n        %#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)))
                        (membership->created-by (lp--entry->membership entry)))
       ""))))

(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"
  (insert-before-markers "\n")
  (forward-char -1)
  (set-lp--entry->start-marker entry (point-marker))
  (insert (lp--format-entry entry))
  (set-lp--entry->end-marker entry (point-marker))
  (forward-char 1))

(defun lp--erase-entry (entry)
  "Erase the printed representation of the entry ENTRY in the buffer"
  (delete-region (lp--entry->start-marker entry)
                 (1+ (lp--entry->end-marker entry)))
  (set-lp--entry->start-marker entry nil)
  (set-lp--entry->end-marker entry nil))

(defun lp--redraw-entry-mark (entry)
  "Redraw the mark for ENTRY."
David Byers's avatar
David Byers committed
190
  (lp--save-excursion
191
192
193
194
195
196
    (goto-char (lp--entry->start-marker entry))
    (insert (if (lp--entry->selected entry) ?* ?\ ))
    (delete-char 1)))

(defun lp--redraw-entry (entry)
  "Redraw the entry ENTRY."
David Byers's avatar
David Byers committed
197
198
199
200
201
  (lp--save-excursion
   (goto-char (lp--entry->start-marker entry))
   (lp--erase-entry entry)
   (lp--print-entry entry)))

202
203


David Byers's avatar
David Byers committed
204
205
206
207

;;; ============================================================
;;; Buffer functions

208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
(defun lp--create-buffer ()
  (interactive)
  (let ((buf (lyskom-get-buffer-create 'prioritize
                                       (concat (buffer-name) "-prioritize")
                                       t))
        (entry-list nil))

    ;;; First cache all the conf stats
    (lyskom-save-excursion
      (set-buffer buf)
      (erase-buffer)
      (make-local-variable 'lp--entry-list)
      (make-local-variable 'lp--list-start-marker)
      (make-local-variable 'lp--list-end-marker)
      (setq lp--entry-list nil)
      (lyskom-format-insert "\
Medlemskap för %#1M på %#2s

===============================================================================
 Prio   Möte                                            Senast inne  Oläst  IHP
-------------------------------------------------------------------------------
" lyskom-pers-no lyskom-server-name)
      (setq lp--list-start-marker (point-marker))
      (goto-char (point-max))
232
      (lyskom-sort-membership)
233
234
235
236
237
      (lyskom-display-buffer buf)
      (lyskom-traverse mship (lyskom-default-value 'lyskom-membership)
        (blocking-do 'get-conf-stat (membership->conf-no mship))
        (let ((entry (lyskom-create-lp--entry nil ; Start
                                              nil ; End
David Byers's avatar
David Byers committed
238
                                              (membership->priority mship)
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
                                              mship
                                              nil
                                              'normal)))
          (lp--print-entry entry)
          (setq entry-list (cons entry entry-list))))
      (lp--set-entry-list (nreverse entry-list))
      (setq lp--list-end-marker (point-marker))
      (insert "\
===============================================================================
 Markera medlemskap: SPC      Markera område: C-w      Flytta markerade:   C-y
 Sätt prioritet:     p        Öka prioritet:  +        Minska prioritet:   -
 Flytta upp:         M-p      Flytta ned:     M-n      Ändra flaggor:    I,H,P
 Avsluta och spara:  C-c C-c                           Mer hjälp:        C-h m
"))))

David Byers's avatar
David Byers committed
254
255
256
257
258


;;; ============================================================
;;; List management

259
260
261
262
263
264
265
266
(defun lp--set-entry-list (entries)
  "Set the list of entries to ENTRIES"
  (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
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311

(defun lp--conf-no-entry (conf-no)
  "Find the entry for a membership in conf-no"
  (let ((entries (lp--all-entries))
        (found nil))
    (while (and entries (null found))
      (when (eq conf-no (membership->conf-no (lp--entry->membership 
                                              (car entries))))
        (setq found (car entries)))
      (setq entries (cdr entries)))
    found))

(defun lp--find-new-position (entry priority)
  "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
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 
entry priority"
  (let ((entries (lp--all-entries))
        (result nil)
        (tmp nil))
    (cond 

     ;; Moving down. Return the last entry spotted with a higher
     ;; than requested priority
     ((> (lp--entry->priority entry) priority)
      (while (and entries (null result))
        (when (<= (lp--entry->priority (car entries)) priority)
          (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
     ((< (lp--entry->priority entry) priority)
      (while (and entries (null result))
        (while (and entries (null result))
          (when (< (lp--entry->priority (car entries)) priority)
            (setq result (car entries)))
          (setq entries (cdr entries)))))
     (t (setq result entry)))
    result))
  

312
313
314
315
(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
316
317
318
319
320
321
(defun lp--entry-position (entry)
  "Return the position in the list for entry POS."
  (- (length (lp--all-entries))
     (length (memq entry (lp--all-entries)))))


322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
(defun lp--entry-at (where)
  "Return the entry at WHERE."
  (let ((entry-list (lp--all-entries))
        (found nil)
        (pos (save-excursion (goto-char where) 
                             (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)))
  (let ((cur (lp--get-entry to)))
    (if cur
        (goto-char (lp--entry->start-marker cur))
347
      (goto-char lp--list-end-marker))
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
    (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))

(defun lp--list-move-element (elem to l)
  "Move element from position FROM to position TO in list L using side-fx."
  (lp--add-to-list to elem (lp--remove-from-list elem l)))

David Byers's avatar
David Byers committed
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398

(defun lyskom-prioritize-update-buffer (conf-no)
  "Update the entry for conf-no in the buffer"
  (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)))
                  (cond ((null entry)
                         ;; FIXME: Insert a new entry
                         )
                        ((null mship)
                         ;; FIXME: Delete an entry
                         )
                        ((/= (lp--entry->priority entry)
                             (membership->priority mship))
                         ;; FIXME: Move the entry
                         )
                        (t (set-lp--entry->membership mship)
                           (lp--redraw-entry entry)))))
              buffers))))



399
400
401
402
403
404
405
406
407
408
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
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
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
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
(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
a list of results. ARGS will be passed as additional arguments to FUNCTION.

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



;;; ============================================================
;;; Menu and button functions

;;; ------------------------------------------------------------
;;; Flag menu
;;; Argument is a list of entry and flag

(defun lp--flag-menu-get (entry flag)
  (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)
  (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)
  (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)
  (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)
  (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
      (save-excursion 
        (set-buffer lyskom-buffer)
        (let ((result (blocking-do 'set-membership-type 
                                   lyskom-pers-no 
                                   (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))))

        ;; Update the display 
        (let ((mship
               (blocking-do 'query-read-texts 
                            lyskom-pers-no 
                            (membership->conf-no (lp--entry->membership entry)))))
          (lyskom-replace-membership mship lyskom-membership)
          (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)
                       (set-read-list-empty lyskom-reading-list)
                       (lyskom-run-hook-with-args 'lyskom-change-conf-hook
                                                  lyskom-current-conf 0)
                       (setq lyskom-current-conf 0))
                     (read-list-delete-read-info (membership->conf-no mship)
                                                 lyskom-to-do-list)
                     (lyskom-update-prompt t)))
                  (t (lyskom-prefetch-map (membership->conf-no mship)
                                          mship))))
          (blocking-do 'get-conf-stat (membership->conf-no mship))))
      (lp--redraw-entry entry))))



;;; ============================================================
;;; Marking and unmarking memberships
;;; 

(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)
  (force-mode-line-update))

(defun lp--do-select-entries (entry-list state)
  "Set the selection value of all entries in ENTRY-LIST to STATE."
  (mapcar (lambda (entry) 
            (when entry
              (if state
                  (add-to-list 'lp--selected-entry-list entry)
                (setq lp--selected-entry-list 
                      (delq entry lp--selected-entry-list)))
              (set-lp--entry->selected entry state)
              (lp--redraw-entry-mark entry))) entry-list))

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

(defun lp--set-selected-entries (entry-list)
  "Set the selected entries to exactly the entries in entry-list.
Forces a mode line update"
  (lp--do-select-entries (lp--all-selected-entries) nil)
  (lp--do-select-entries entry-list t)
  (force-mode-line-update))


538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
;;; ------------------------------------------------------------
;;; Server update functions

(defun lp--update-membership (entry-list)
  "Update the server version of all entries in ENTRY-LIST"
  (save-excursion
    (set-buffer lyskom-buffer)
    (mapcar 
     (lambda (el)
       (let ((mship (lp--entry->membership el)))
         (initiate-add-member 'background nil 
                              (membership->conf-no mship)
                              lyskom-pers-no
                              (membership->priority mship)
                              (lp--entry-position el)
                              (membership->type mship))))
     entry-list)
    (lyskom-sort-membership)))


558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
;;; ------------------------------------------------------------
;;; User-level functions


(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)
  "Toggle selection of the membership that point is on."
578
579
  (interactive "d")
  (let ((entry (lp--entry-at where)))
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
    (when entry
      (lp--select-entries (list entry) (not (lp--entry->selected entry))))))

(defun lp--select-region (start end)
  "Select all entries in the region"
  (interactive "r")
  (let ((entry-list (lp--map-region start end 'identity)))
    (lp--select-entries entry-list t)))

(defun lp--select-prioriy (priority)
  "Select all entries with a certain priority.
With numeric prefix argument select entries with that priority."
  (interactive "P")
  (lp--do-select-priority priority t))

(defun lp--deselect-prioriy (priority)
  "Deselect all entries with a certain priority.
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 ()
  "Deselect all memberships"
  (interactive)
  (lp--set-selected-entries nil))



David Byers's avatar
David Byers committed
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
;;; ============================================================
;;; Reprioritization functions

(defun lp--set-priority (priority)
  "Set the priority of selected memberships. 
Memberships that must be moved will be moved the shortest distance
possible in the list."
  (interactive "P")
  (let* ((cur (lp--entry-at (point)))
         (entries (or (lp--all-selected-entries)
                      (list (lp--entry-at (point))))))
    (unless entries
      (error "No entries selected."))
    (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
                    0 255 (lyskom-format 'priority-prompt 
                                         (membership->conf-no
                                          (lp--entry->membership 
                                           (car entries)))) t)))))
    (lp--save-excursion
     (mapcar (lambda (entry)
               (let ((new-pos (lp--entry-position 
                               (lp--find-new-position entry priority))))
                 (set-lp--entry->priority entry priority)
654
655
656
657
                 (set-membership->priority
                  (lp--entry->membership entry) priority)
                 (lp--move-entry entry new-pos)
                 (lp--update-membership (list entry))))
David Byers's avatar
David Byers committed
658
659
660
661
662
             entries))))
                              



663
664
665
;;; ============================================================
;;; Motion commands

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
(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)))
         (pos (max 0 (- (lp--entry-position entry) count))))
    (goto-char (lp--entry->start-marker (lp--get-entry pos)))))

(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)))
         (pos (min (1- (length (lp--all-entries)))
                   (+ (lp--entry-position entry) count))))
    (condition-case nil
        (goto-char (lp--entry->start-marker (lp--get-entry pos)))
      (error nil))))

(defun lp--first-entry ()
  "Move point to the first entry in the membership list."
  (interactive)
  (condition-case nil
      (goto-char (lp--entry->start-marker (lp--get-entry 0)))
    (error nil)))
691

692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
(defun lp--last-entry ()
  "Move point to the last entry in the membership list."
  (interactive)
  (condition-case nil
      (goto-char
       (lp--entry->start-marker (lp--get-entry (1- (length lp--all-entries)))))
    (error nil)))

(defun lp--goto-priority (priority)
  "Move to the closest entry with priority ARG.
If there is no entry with the specified priority, move to the nearest 
entry with an adjacent priority."
  (interactive "P")
  (let* ((entry (lp--entry-at (point)))
         (seen-me nil)
         (done nil)
         (entry-list (lp--all-entries)))
709

710
    ;; Get the priority to move to
711

712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
    (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
      (set-lp--entry->state 
       entry
       (if (eq (lp--entry->state entry) 'expanded) 'contracted 'expanded))
      (lp--redraw-entry entry))))