Commit 7bbd3f78 authored by David Byers's avatar David Byers
Browse files

Start of a manage membership mode

parent be3918c2
1999-06-28 David Byers <davby@ida.liu.se>
* commands2.el (kom-set-session-priority): Default priority is
kom-default-session-priority, not 100.
* startup.el (kom-start-anew): Set the session priority from
kom-default-session-priority.
* vars.el.in (kom-default-session-priority): New variable.
* commands2.el (lyskom-send-message-trim-newlines): Don't trim
newlines if the message is not a string.
1999-06-27 David Byers <davby@ida.liu.se>
* services.el (initiate-set-membership-type): Don't delete the
......
......@@ -615,18 +615,19 @@ send. If DONTSHOW is non-nil, don't display the sent message."
))
(defun lyskom-send-message-trim-newlines ()
(let ((size (length lyskom-message-string)))
(while (and (> size 0)
(eq ?\n (aref lyskom-message-string (1- size))))
(setq size (1- size)))
(cond ((and (eq size 0)
(not (lyskom-j-or-n-p (lyskom-get-string
'send-empty-message-p))))
(setq lyskom-message-string nil))
((eq size 0)
(setq lyskom-message-string ""))
(t (setq lyskom-message-string (substring lyskom-message-string
0 size))))))
(when (stringp lyskom-message-string)
(let ((size (length lyskom-message-string)))
(while (and (> size 0)
(eq ?\n (aref lyskom-message-string (1- size))))
(setq size (1- size)))
(cond ((and (eq size 0)
(not (lyskom-j-or-n-p (lyskom-get-string
'send-empty-message-p))))
(setq lyskom-message-string nil))
((eq size 0)
(setq lyskom-message-string ""))
(t (setq lyskom-message-string (substring lyskom-message-string
0 size)))))))
(lyskom-external-function lyskom-resize-minibuffer-mode)
(lyskom-external-function resize-minibuffer-setup)
......@@ -1552,7 +1553,7 @@ membership info."
255
(lyskom-get-string 'set-session-priority)
t
100))))
(or kom-default-session-priority 100)))))
(setq lyskom-session-priority pri)
(lyskom-refetch)))
......
(def-komtype lp--entry
start-marker ; Where the entry is in the buffer
end-marker ; Where it ends in the buffer
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)
(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
(concat "%#1c %=3#2d %#9c %=-" (number-to-string total)
"#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) ?* ?\ )
(membership->priority (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 (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."
(save-excursion
(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."
(let ((col (- (point) (lp--entry->start-marker entry)))
(set (eq (lp--entry-at (point)) entry)))
(save-excursion
(goto-char (lp--entry->start-marker entry))
(lp--erase-entry entry)
(lp--print-entry entry))
(when set (goto-char (+ (lp--entry->start-marker entry) col)))))
(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 fr %#1M p %#2s
===============================================================================
Prio Mte Senast inne Olst IHP
-------------------------------------------------------------------------------
" lyskom-pers-no lyskom-server-name)
(setq lp--list-start-marker (point-marker))
(goto-char (point-max))
(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
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 omrde: C-w Flytta markerade: C-y
Stt 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 hjlp: C-h m
"))))
(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)
(defun lp--get-entry (pos)
"Return the entry at position POS in the list."
(elt lp--entry-list pos))
(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))
(goto-char (lp--list-end-marker)))
(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)))
(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))
;;; ------------------------------------------------------------
;;; 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."
(interactive)
(let ((entry (lp--entry-at (point))))
(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))
;;; ============================================================
;;; Motion commands
......@@ -191,8 +191,6 @@ CONNECT %s:%d HTTP/1.0\r\n\
host port)))))
(switch-to-buffer buffer)
(lyskom-mode) ;Clearing lyskom-default...
(if session-priority
(setq lyskom-session-priority session-priority))
(setq lyskom-buffer buffer)
(setq lyskom-default-user-name username)
(setq lyskom-default-password password)
......@@ -253,7 +251,7 @@ CONNECT %s:%d HTTP/1.0\r\n\
;; Can't use lyskom-end-of-command here.
(setq lyskom-executing-command nil)
;; Log in
(kom-start-anew t)
(kom-start-anew t session-priority)
(if (memq lyskom-buffer lyskom-buffer-list)
(while (not (eq lyskom-buffer (car lyskom-buffer-list)))
(setq lyskom-buffer-list
......@@ -380,7 +378,7 @@ CONNECT %s:%d HTTP/1.0\r\n\
;;; Start anew
(defun kom-start-anew (&optional lyskom-first-time-around)
(defun kom-start-anew (&optional lyskom-first-time-around session-priority)
"Start as a new person."
(interactive)
(lyskom-start-of-command 'kom-start-anew)
......@@ -468,6 +466,9 @@ CONNECT %s:%d HTTP/1.0\r\n\
(if (not lyskom-dont-read-user-area)
(lyskom-read-options))
(when (or session-priority kom-default-session-priority)
(setq lyskom-session-priority
(or session-priority kom-default-session-priority)))
(lyskom-run-hook-with-args 'lyskom-change-conf-hook
lyskom-current-conf
0)
......
......@@ -1316,6 +1316,18 @@ different packets.")
"Session number in the server for this connection"
local)
(def-kom-var kom-default-session-priority 0
"* The default session priority.
Only texts in conferences with a priority equal to or higher than this
will be shown by default.
To set the session priority in a running session, set the variable
lyskom-session-priority instead. The value of this variable is used
to initialize lyskom-session-priority when a new session is started."
local
server)
(def-kom-var lyskom-session-priority 0
"*This sessions priority.
Only texts in conferences with a priority equal to or higher than this
......
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