Commit 595e3bef authored by David Byers's avatar David Byers

Membership-related improvements and bug fixes

Detailed changes:
> 	* reading.el (lyskom-membership-list-move): Return non-nil if
> 	moved.
> 	(lyskom-replace-membership): Sort the to-do list if the membership
> 	moved.
>
> 	* mship-edit.el (lp--update-buffer): Use regular save-excursion
> 	around the complete function, not lp--save-excursion.
>
> 	* reading.el (lyskom-replace-membership): Make it actually work.
>
> 	* lyskom-rest.el (lyskom-binsearch-internal): Use elt, not aref,
> 	so the thing can work on lists too -- searching for elt n in C is
> 	a lot faster than linear search in lisp.
> 	(lyskom-binsearch): Accept comparison function.
> 	(lyskom-binsearch-internal): User-supplied comparison function.
>
> 	* mship-edit.el (lp--mode-map): Added bindings for M-up and
> 	M-down (same as M-p and M-n).
> 	(lp--do-select-priority): Prompt for priority (defaults to
> 	priority of current entry)
> 	(lp--mode-map): M-# now bound to lp--deselect-priority
> 	(lp--mode-map): M-w now bound to lp--select-region (my fingers
> 	refuse to hit C-w when I don't want text to be deleted)
> 	(lp--mode-map): Bound <home> and <end>
> 	(lp--expand-entry): New function. Replaces lp--expand-all
> 	(lp--contract-entry): New function. Replaces lp--contract-all
>
parent bc4b0f34
2004-07-18 David Byers <byers@lysator.liu.se>
* reading.el (lyskom-membership-list-move): Return non-nil if
moved.
(lyskom-replace-membership): Sort the to-do list if the membership
moved.
* mship-edit.el (lp--update-buffer): Use regular save-excursion
around the complete function, not lp--save-excursion.
* reading.el (lyskom-replace-membership): Make it actually work.
* lyskom-rest.el (lyskom-binsearch-internal): Use elt, not aref,
so the thing can work on lists too -- searching for elt n in C is
a lot faster than linear search in lisp.
(lyskom-binsearch): Accept comparison function.
(lyskom-binsearch-internal): User-supplied comparison function.
* mship-edit.el (lp--mode-map): Added bindings for M-up and
M-down (same as M-p and M-n).
(lp--do-select-priority): Prompt for priority (defaults to
priority of current entry)
(lp--mode-map): M-# now bound to lp--deselect-priority
(lp--mode-map): M-w now bound to lp--select-region (my fingers
refuse to hit C-w when I don't want text to be deleted)
(lp--mode-map): Bound <home> and <end>
(lp--expand-entry): New function. Replaces lp--expand-all
(lp--contract-entry): New function. Replaces lp--contract-all
New membership list data structure:
* mship-edit.el (lyskom-change-membership-priority): New API for
lyskom-replace-membership.
......
......@@ -3438,28 +3438,42 @@ The list consists of text-nos."
(setq found t)))
found))
(defun lyskom-binsearch (num vector &optional first last+1)
"Return the index if NUM is a member of (present in) VECTOR.
VECTOR has to be sorted with regard to <."
(lyskom-binsearch-internal num vector
(defun lyskom-binsearch (el sequence &optional first last+1 fn)
"Return the index if EL is a member of (present in) SEQUENCE.
SEQUENCE has to be sorted with regard to the comparison function.
Optional arguments FIRST and LAST+1 should only be used if you know
what they are for.
Optional argument FN is the function to use for comparison. It should
take arguments A and B and return non-nil if A is less than B. If not
supplied, FN defaults to <."
(lyskom-binsearch-internal el sequence
(or first 0)
(or last+1 (length vector))))
(or last+1 (length sequence))
(or fn '<)))
(defun lyskom-binsearch-internal (num vector first last+1)
(defun lyskom-binsearch-internal (num vector first last+1 less-than)
"Return the index if ELT is a member of the sorted vector VECTOR."
(let* ((split (/ (+ first last+1) 2))
(splitval (aref vector split)))
(splitval (elt vector split)))
(cond
;; Only one element
((= (- last+1 first) 1) (if (= num splitval) split nil))
;; This is not really necessary, but it _might_ speed it up..
((= num splitval) split)
((= (- last+1 first) 1)
(if (not (or (funcall less-than num splitval)
(funcall less-than splitval num)))
split nil))
;; Search the left subtree
((< num splitval)
(lyskom-binsearch-internal num vector first split))
((funcall less-than num splitval)
(lyskom-binsearch-internal num vector first split less-than))
;; Search the left subtree
(t (lyskom-binsearch-internal num vector split last+1)))))
((funcall less-than splitval num)
(lyskom-binsearch-internal num vector split last+1 less-than))
;; Found
(t split))))
(defvar lyskom-verified-read-predicate nil)
(defun lyskom-verified-read-enter ()
......
......@@ -111,11 +111,7 @@
extents ; Alist of extents/overlays
))
(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.")
(defvar lp--last-window-width -1)
(defvar lp--format-string nil "The format string for entries.")
;;; Local variables in the prioritize buffer
;;; There should be no reason to use these at all. There are functional
......@@ -165,7 +161,8 @@ This function does not tell the server about the change."
(cond
((and (>= old-priority lyskom-session-priority)
(>= new-priority lyskom-session-priority))
(lyskom-sort-to-do-list))
;; Do nothing
)
((and (< old-priority lyskom-session-priority)
(>= new-priority lyskom-session-priority))
......@@ -280,17 +277,13 @@ even if the character at point is deleted."
(defun lp--compute-format-string ()
"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
To save time, the format string is cached in `lp--format-string'. It is
only recomputed if the window width changes."
(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 4 1)))
(setq lp--last-window-width (window-width))
(setq lp--conf-name-width total)
(setq lp--last-format-string
(concat "%#1c %=3#2s %#10c %=-" (number-to-string total)
"#3M %=-12#4s %[%#15@%=5#5s%] %[%#11@%#6c%]%[%#12@%#7c%]%[%#13@%#8c%]%[%#14@%#9c%]")))))
(let ((total (- (window-width) 1 3 3 2 12 2 5 2 4 1)))
(setq lp--conf-name-width total)
(setq lp--format-string
(concat "%#1c %=3#2s %#10c %=-" (number-to-string total)
"#3M %=-12#4s %[%#15@%=5#5s%] %[%#11@%#6c%]%[%#12@%#7c%]%[%#13@%#8c%]%[%#14@%#9c%]"))))
(defun lp--format-insert-entry (entry)
"Format ENTRY and insert it into the current buffer at point."
......@@ -335,7 +328,7 @@ only recomputed if the window width changes."
(let* ((un (lyskom-find-unread (membership->conf-no
(lp--entry->membership entry))))
(string (lyskom-format
(lp--compute-format-string)
lp--format-string
(if (lp--entry->selected entry) ?* ?\ )
(if (zerop (membership->priority
(lp--entry->membership entry)))
......@@ -594,19 +587,22 @@ entry priority"
(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))
(let* ((pos (save-excursion (goto-char where)
(beginning-of-line)
(point)))
(idx (lyskom-binsearch
pos (lp--all-entries) nil nil
(lambda (a b)
(cond ((numberp a)
(and (lp--entry->start-marker b)
(lp--entry->end-marker b)
(< a (lp--entry->start-marker b))))
(t
(and (lp--entry->start-marker a)
(lp--entry->end-marker a)
(< (lp--entry->end-marker a) b))))))))
(and idx (lp--get-entry idx))))
(defun lp--move-entry (entry to)
"Move the entry ENTRY to position TO in the list."
......@@ -648,62 +644,63 @@ entry priority"
"Update the entry for CONF-NO in the buffer.
If optional NEW-MSHIP is non-nil, then get the membership again."
(unless lp--inhibit-update
(lp--save-excursion
(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
((and (null entry) mship) ; New membership
(let* ((pos (membership->position mship))
(elem (and pos (lp--get-entry pos)))
(entry (lyskom-create-lp--entry
nil
nil
(membership->priority mship)
mship
nil
(if (memq (membership->created-by mship)
(list lyskom-pers-no 0))
'contracted
'expanded)
t
nil)))
(when pos
(save-excursion
(goto-char (if elem
(lp--entry->start-marker elem)
lp--list-end-marker))
(lp--set-entry-list
(lp--add-to-list pos entry (lp--all-entries)))
(lp--print-entry entry)))))
;; We have unsubscribed for good
((null mship)
(when entry
(lp--set-entry-list
(lp--remove-from-list entry
(lp--all-entries)))
(lp--erase-entry entry)))
;; The priority or position of a membership has changed
((or (/= (lp--entry->priority entry)
(membership->priority mship))
(/= (lp--entry-position entry)
(membership->position mship)))
(let ((new-pos (lp--entry-position
(lp--find-new-position
entry (membership->priority mship)))))
(lp--set-entry-pri-and-pos
entry (membership->priority mship) new-pos)
(set-lp--entry->membership entry mship)))
(t (set-lp--entry->membership entry mship)
(lp--redraw-entry entry)))))
(lp--save-excursion
(let ((entry (lp--conf-no-entry conf-no))
(mship (lyskom-get-membership conf-no t)))
(cond
((and (null entry) mship) ; New membership
(let* ((pos (membership->position mship))
(elem (and pos (lp--get-entry pos)))
(entry (lyskom-create-lp--entry
nil
nil
(membership->priority mship)
mship
nil
(if (memq (membership->created-by mship)
(list lyskom-pers-no 0))
'contracted
'expanded)
t
nil)))
(when pos
(save-excursion
(goto-char (if elem
(lp--entry->start-marker elem)
lp--list-end-marker))
(lp--set-entry-list
(lp--add-to-list pos entry (lp--all-entries)))
(lp--print-entry entry)))))
;; We have unsubscribed for good
((null mship)
(when entry
(lp--set-entry-list
(lp--remove-from-list entry
(lp--all-entries)))
(lp--erase-entry entry)))
;; The priority or position of a membership has changed
((or (/= (lp--entry->priority entry)
(membership->priority mship))
(/= (lp--entry-position entry)
(membership->position mship)))
(let ((new-pos (lp--entry-position
(lp--find-new-position
entry (membership->priority mship)))))
(lp--set-entry-pri-and-pos
entry (membership->priority mship) new-pos)
(set-lp--entry->membership entry mship)))
(t (set-lp--entry->membership entry mship)
(lp--redraw-entry entry))))))
buffers)))))
......@@ -1053,7 +1050,13 @@ 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)))))
(setq priority
(lyskom-read-num-range 0 255
(if select
"Markera medlemskap med prioritet: "
"Avmarkera medlemskap med prioritet: ")
nil
(membership->priority (lp--entry->membership entry))))))
(lp--select-entries
(mapcar (lambda (entry)
......@@ -1341,11 +1344,13 @@ entry with an adjacent priority."
(if (eq (lp--entry->state entry) 'expanded) 'contracted 'expanded))
(lp--redraw-entry entry))))
(defun lp--expand-all (arg)
"Expand all entries.
(defun lp--expand-entry (arg)
"Expand selected entries.
With prefix arg, expand only those that were created by someone else."
(interactive "P")
(let ((hidden-list (list lyskom-pers-no 0)))
(let ((entries (or (lp--all-selected-entries)
(list (lp--entry-at (point)))))
(hidden-list (list lyskom-pers-no 0)))
(mapcar (lambda (entry)
(when (and (or (null arg)
(not (memq (membership->created-by
......@@ -1354,13 +1359,15 @@ With prefix arg, expand only those that were created by someone else."
(not (eq (lp--entry->state entry) 'expanded)))
(set-lp--entry->state entry 'expanded)
(lp--redraw-entry entry)))
(lp--all-entries))))
entries)))
(defun lp--contract-all (arg)
"Contract all entries.
(defun lp--contract-entry (arg)
"Contract selected entries.
With prefix arg, contract only those that were created by self."
(interactive "P")
(let ((hidden-list (list lyskom-pers-no 0)))
(let ((entries (or (lp--all-selected-entries)
(list (lp--entry-at (point)))))
(hidden-list (list lyskom-pers-no 0)))
(mapcar (lambda (entry)
(when (and (or (null arg)
(memq (membership->created-by
......@@ -1369,7 +1376,7 @@ With prefix arg, contract only those that were created by self."
(not (eq (lp--entry->state entry) 'contracted)))
(set-lp--entry->state entry 'contracted)
(lp--redraw-entry entry)))
(lp--all-entries))))
entries)))
(defun lp--quit ()
"Remove the membership buffer and quit"
......@@ -1423,14 +1430,17 @@ With prefix arg, contract only those that were created by self."
(define-key lp--mode-map (kbd "C-k") '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 "M-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-#") 'lp--select-priority)
(define-key lp--mode-map (kbd "M-#") 'lp--deselect-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 "<home>") 'lp--first-entry)
(define-key lp--mode-map (kbd "<end>") 'lp--last-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)
......@@ -1439,12 +1449,16 @@ With prefix arg, contract only those that were created by self."
(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 "M-<up>") 'lp--move-up)
(define-key lp--mode-map (kbd "M-<down>") '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)
(define-key lp--mode-map (kbd "M") 'lp--toggle-message-flag)
(define-key lp--mode-map (kbd "C-c C-c") 'lp--quit)
(define-key lp--mode-map (kbd "q") 'lp--quit)
(define-key lp--mode-map (kbd "(") 'lp--expand-entry)
(define-key lp--mode-map (kbd ")") 'lp--contract-entry)
(define-key lp--mode-map (kbd (lyskom-keys 'button2up)) 'kom-button-click)
(define-key lp--mode-map (kbd (lyskom-keys 'button2)) 'kom-mouse-null)
......@@ -1511,8 +1525,8 @@ 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--format-string)
(make-local-variable 'lp--conf-name-width)
(make-local-variable 'lp--entry-list)
(make-local-variable 'lp--list-start-marker)
(make-local-variable 'lp--list-end-marker)
......@@ -1524,17 +1538,6 @@ Entry to this mode runs lyskom-prioritize-mode-hook."
(lp--update-mode-line)
(setq buffer-read-only t)
(lyskom-use-local-map lp--mode-map)
;; I'm hard-coding these instead
;;
;; (lyskom-add-hook 'lyskom-add-membership-hook
;; 'lp--add-membership-callback
;; t)
;; (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))
......
......@@ -315,16 +315,19 @@ reasonable guess."
(set-membership-list->size mship-list (1- (membership-list->size mship-list))))
(defun lyskom-membership-list-move (mship-list node)
"Move the node NODE in MSHIP-LIST to its new position."
"Move the node NODE in MSHIP-LIST to its new position.
Returns non-nil value if the membership actually moved."
(let* ((prev (mship-list-node->prev node))
(next (mship-list-node->next node))
(mship (mship-list-node->data node))
(moved nil)
(new-pos nil))
(cond
((lyskom-membership-list-compare-next mship next t) ; Move right
(setq prev nil)
(while (lyskom-membership-list-compare-next mship next t)
(setq moved t)
(setq new-pos (membership->position (mship-list-node->data next)))
(set-membership->position (mship-list-node->data next) (1- new-pos))
(setq prev next next (mship-list-node->next next)))
......@@ -333,6 +336,7 @@ reasonable guess."
((lyskom-membership-list-compare-prev mship prev) ; Move left
(setq next nil)
(while (lyskom-membership-list-compare-prev mship prev)
(setq moved t)
(setq new-pos (membership->position (mship-list-node->data prev)))
(set-membership->position (mship-list-node->data prev) (1+ new-pos))
(setq next prev prev (mship-list-node->prev prev)))
......@@ -366,8 +370,9 @@ reasonable guess."
(if next
(set-mship-list-node->prev next node)
(set-membership-list->tail mship-list node)))
)
(set-membership-list->tail mship-list node))
moved
))
......@@ -420,15 +425,18 @@ reasonable guess."
"Add MSHIP into lyskom-membership, sorted by priority."
(lyskom-with-lyskom-buffer
(lyskom-mship-cache-put mship)
(lp--update-buffer (membership->conf-no mship))))
(lp--update-buffer (membership->conf-no mship))
))
(defun lyskom-replace-membership (mship)
"Replace the membership MSHIP."
(lyskom-with-lyskom-buffer
(let ((node (lyskom-mship-cache-get (membership->conf-no mship))))
(set-mship-list-node->data node mship)
(if node
(lyskom-membership-list-move (lyskom-mship-cache-data) node)
(when (lyskom-membership-list-move (lyskom-mship-cache-data) node)
(lyskom-sort-to-do-list))
(lyskom-mship-cache-put mship)))
(lp--update-buffer (membership->conf-no mship))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment