Commit 3cf27df8 authored by David Byers's avatar David Byers
Browse files

Support aux-items on the server (e.g. recommended-conf)

New command: kom-server-status
Support more aux-item types
parent e0018801
2002-04-11 David Byers <david.byers@swipnet.se>
Show extended server status:
* commands2.el (kom-status-server): New command.
Support aux-items on the server:
* aux-items.el (lyskom-aux-item-terminating-button): Support
server aux-items.
* lyskom-buttons.el (lyskom-button-delete-aux): Support server
aux-items.
(lyskom-button-info-aux): Support server aux-items.
Handle more aux-item types:
* edit-text.el (kom-edit-add-world-readable): New command.
* aux-items.el (canonical-name): New aux-item definition·
(mx-list-name): Same here.
(send-comments-to): Ditto.
(world-readable): And once more.
(lyskom-print-mx-list-name): New function.
(lyskom-print-world-readable): New function.
(lyskom-edit-insert-world-readable): New function.
(lyskom-parse-world-readable): New function.
Beter kom-who-is-on-and-friend:
* commands1.el (lyskom-select-friends-from-who-list): Show
lyskom-pers-no when filtering friends. Perhaps this should be a
......
......@@ -123,21 +123,18 @@ return non-nil if the item is to be included in the list."
(defun lyskom-aux-item-terminating-button (item obj)
(if obj
(lyskom-format " %#1@%[[*]%]"
(lyskom-default-button 'aux
(cond ((lyskom-text-stat-p obj)
(list 'text
(text-stat->text-no
obj)
(aux-item->aux-no
item)))
((lyskom-conf-stat-p obj)
(list 'conf
(conf-stat->conf-no
obj)
(aux-item->aux-no
item)))
(t item))))
(lyskom-format
" %#1@%[[*]%]"
(lyskom-default-button
'aux
(cond ((lyskom-text-stat-p obj) (list 'text
(text-stat->text-no obj)
(aux-item->aux-no item)))
((lyskom-conf-stat-p obj) (list 'conf
(conf-stat->conf-no obj)
(aux-item->aux-no item)))
((eq obj 'server) (list 'server nil (aux-item->aux-no item)))
(t item))))
""))
(defun lyskom-aux-item-after-parse (item)
......@@ -280,11 +277,30 @@ return non-nil if the item is to be included in the list."
(info . lyskom-aux-item-info))
(def-aux-item recommended-conf 29
(status-print . lyskom-print-recommended-conf)
(info . lyskom-aux-item-info))
(def-aux-item allowed-content-type 30
(info . lyskom-aux-item-info))
(def-aux-item canonical-name 31
(info . lyskom-aux-item-info))
(def-aux-item mx-list-name 32
(info . lyskom-aux-item-info)
(status-print . lyskom-print-mx-list-name))
(def-aux-item send-comments-to 33
(into . lyskom-print-aux-item-info)
(status-print . lyskom-print-send-comments-to))
(def-aux-item world-readable 34
(info . lyskom-aux-item-info)
(text-print . lyskom-print-world-readable)
(parse . lyskom-parse-world-readable)
(edit-insert . lyskom-edit-insert-world-readable)
(text-print-when . header))
......@@ -602,5 +618,30 @@ return non-nil if the item is to be included in the list."
(lyskom-format 'creating-software-aux (aux-item->data item))
(lyskom-aux-item-terminating-button item obj))))
(defun lyskom-parse-world-readable ()
(and (looking-at (regexp-quote
(lyskom-get-string 'world-readable-text-edit-aux)))
""))
(defun lyskom-edit-insert-world-readable (item &optional obj)
(concat
(lyskom-format 'world-readable-text-edit-aux)
(lyskom-edit-generate-aux-item-flags (aux-item->flags item))))
(defun lyskom-print-world-readable (item &optional obj)
(concat (lyskom-format 'world-readable-text-aux)
(lyskom-aux-item-terminating-button item obj)))
(defun lyskom-print-mx-list-name (item &optional obj)
(lyskom-format-insert 'conf-mx-list-name
(aux-item->data item)
(lyskom-aux-item-terminating-button item obj)))
(defun lyskom-print-recommended-conf (item &optional obj)
(let ((conf-no (string-to-int (if (string-match " " (aux-item->data item))
(substring (aux-item->data item) 0 (match-beginning 0))
(aux-item->data item)))))
(lyskom-format-insert 'recommended-conf-aux conf-no)))
(provide 'lyskom-aux-items)
......@@ -2641,7 +2641,7 @@ to the first text that NEW is a comment or footnote to."
(completion-ignore-case t)
(object-type
(cdr (lyskom-string-assoc
(lyskom-completing-read 'what-kind-to-add-aux-to
(lyskom-completing-read (lyskom-get-string 'what-kind-to-add-aux-to)
completions
nil t)
completions)))
......@@ -2663,7 +2663,7 @@ to the first text that NEW is a comment or footnote to."
(rsv3 (lyskom-j-or-n-p 'which-aux-item-rsv3))
(rsv4 (lyskom-j-or-n-p 'which-aux-item-rsv4))
(inherit-limit (lyskom-read-number 'which-aux-item-inherit-limit))
(data (lyskom-read-string 'which-aux-item-data))
(data (lyskom-read-string (lyskom-get-string 'which-aux-item-data)))
(flags (lyskom-create-aux-item-flags nil inherit secret anonymous
rsv1 rsv2 rsv3 rsv4))
(item (lyskom-create-aux-item 0 tag 0 0 flags inherit-limit data)))
......@@ -2679,3 +2679,138 @@ to the first text that NEW is a comment or footnote to."
(blocking-do 'modify-text-info object-id nil (list item))))))
(when (eq object-type 'server)
(setq lyskom-server-info (blocking-do 'get-server-info)))))
;;; ================================================================
;;; Status fr LysKOM
;;;
;;; Skriv ut:
;;; * Serverns kanoniska namn (canonical-name eller ud kom-server-alist)
;;; * Serverns DNS-namn/IP och port
;;; * Serverns programvara och version
;;; * Hgsta existerande inlggsnummer
;;; * Antal sessioner
;;; * Serverns tid
;;;
(def-kom-command kom-status-server ()
"Show status information for the LysKOM server"
(interactive)
(blocking-do-multiple ((server-info (get-server-info))
(server-version (get-version-info))
(server-time (get-time))
(highest-text (find-previous-text-no lyskom-max-int))
(first-text (find-next-text-no 0))
(session-info (who-is-on-dynamic t t 0)))
(setq lyskom-server-info (blocking-do 'get-server-info))
(setq lyskom-server-version-info (blocking-do 'get-version-info))
(let* ((aux-items (server-info->aux-item-list lyskom-server-info))
(e-mail-address (lyskom-get-aux-item aux-items 13))
(faqs (lyskom-get-aux-item aux-items 14))
(recommended-conf (lyskom-get-aux-item aux-items 29))
(canonical-name-aux (car (lyskom-get-aux-item aux-items 31)))
(invisible-sessions 0)
(anonymous-sessions 0)
(active-sessions 0)
(inactive-sessions 0)
(unknown-activity-sessions 0)
(total-sessions (length session-info))
(idle-hide (* 60 (if (numberp kom-idle-hide) kom-idle-hide 30))))
(setq aux-items (delq canonical-name-aux aux-items))
;; ----------------------------------------
;; Compute session statistics
(lyskom-traverse session session-info
;; Record anonymity
(when (zerop (dynamic-session-info->person session))
(setq anonymous-sessions (1+ anonymous-sessions)))
;; Record activity
(if (session-flags->user_active_used (dynamic-session-info->flags session))
(if (> (dynamic-session-info->idle-time session) idle-hide)
(setq inactive-sessions (1+ inactive-sessions))
(setq active-sessions (1+ active-sessions)))
(setq unknown-activity-sessions (1+ unknown-activity-sessions)))
;; Record invisibility
(when (session-flags->invisible (dynamic-session-info->flags session))
(setq invisible-sessions (1+ invisible-sessions)))
)
;; ----------------------------------------
;; Print header
(lyskom-format-insert 'server-status-header
(cond ((cdr (lyskom-string-assoc lyskom-server-name kom-server-aliases)))
((cdr (lyskom-string-rassoc lyskom-server-name kom-server-aliases)))
(t lyskom-server-name))
(cond ((car (lyskom-string-rassoc lyskom-server-name kom-server-aliases)))
(t lyskom-server-name))
lyskom-server-port)
;; ----------------------------------------
;; Print software name and version
(lyskom-format-insert 'server-status-version
(version-info->server-software server-version)
(version-info->software-version server-version))
(lyskom-format-insert 'server-status-protocol
(version-info->protocol-version server-version))
;; ----------------------------------------
;; Print canonical name, if we have one
(when canonical-name-aux
(let ((canonical-name nil)
(canonical-port nil))
(if (string-match ":" (aux-item->data canonical-name-aux))
(setq canonical-name (substring (aux-item->data canonical-name-aux) 0 (match-beginning 0))
canonical-port (substring (aux-item->data canonical-name-aux) (1+ (match-beginning 0))))
(setq canonical-name (aux-item->data canonical-name-aux)))
(lyskom-format-insert 'server-status-server canonical-name canonical-port)))
;; ----------------------------------------
;; Print time
(lyskom-format-insert 'server-status-time
(let ((kom-print-relative-dates nil))
(lyskom-format-time 'date-and-time server-time)))
;; ----------------------------------------
;; Print session statistics
(lyskom-format-insert 'server-status-sessions
total-sessions
active-sessions
inactive-sessions
unknown-activity-sessions
invisible-sessions
anonymous-sessions
(/ idle-hide 60))
;; ----------------------------------------
;; Print info on text numbers
(lyskom-format-insert 'server-status-first-text first-text)
(lyskom-format-insert 'server-status-last-text highest-text)
;; ----------------------------------------
;; Print remaining aux-items
(lyskom-traverse-aux item aux-items
(if (lyskom-aux-item-definition-field item 'status-print)
(lyskom-aux-item-call item 'status-print item 'server)
(lyskom-format-insert 'status-aux-item
(format "%d/%d"
(aux-item->aux-no item)
(aux-item->tag item))
(aux-item->creator item)
(lyskom-aux-item-terminating-button item 'server))
))
;; ----------------------------------------
;; Print MOTD (if there is one)
(when (not (zerop (server-info->motd-of-lyskom server-info)))
(lyskom-insert 'server-status-has-motd)
(lyskom-view-text (server-info->motd-of-lyskom server-info)))
)))
......@@ -1342,6 +1342,14 @@ RECPT-TYPE is the type of recipient to add."
nil nil nil nil nil nil nil nil)
0 "")))
(defun kom-edit-add-world-readable ()
(interactive)
(lyskom-edit-insert-aux-item
(lyskom-create-aux-item 0 34 0 0
(lyskom-create-aux-item-flags
nil nil nil nil nil nil nil nil)
0 "")))
(defun kom-edit-insert-link ()
(interactive)
(let ((item (lyskom-read-link)))
......
......@@ -596,7 +596,9 @@ Read all about it at http://www.lysator.liu.se/history/")
(conf-has-motd . "\n%#1M has a notice on his/her mailbox:\n")
(conf-mship-priority . "Prioritet: %25#1n%#2?b%[ %#2s%]%[%]\n")
(status-conf-generic . "%-40#1s %#2s\n")
(status-aux-item . "Auxiliary information: %15#1s%#3s (skapad av %#2M)\n")
(status-aux-item . "Unknown auxiliary information: %11#1s%#3s (skapad av %#2M)\n")
(conf-mx-list-name . "Imported mailing list: %#1s %#2s\n")
(recommended-conf-aux . "Recommended conference: %#1M <%#1m>\n")
(Everybody . "Everyone")
(show-members-list-also-q . "List members? ")
......@@ -1438,8 +1440,10 @@ On since %#8s%#9s")
(label-secret . "Should others to be able to see the label? ")
(creating-software-aux . "Created with %#1s")
(world-readable-text-aux . "The article can be read without logging on")
(world-readable-text-edit-aux . "Make the article readable without logging on")
(cant-get-aux-item . "Can't find auxiliary information")
(cant-get-aux-item . "Can't find auxiliary information\n")
(aux-item-no-info . "No information available\n")
(aux-item-info . "\
Number: %#1d %#6s
......@@ -1460,8 +1464,9 @@ Contents: \"%#9s\"
(inherit-steps . "%#1d steps")
(aux-item-for . "Auxiliary information for ")
(conference-no . "conference <%#1m> %#1M")
(text-no . "text %#1n")
(aux-item-for-conference-no . "conference <%#1m> %#1M")
(aux-item-for-text-no . "text %#1n")
(aux-item-for-server . "the server")
(what-fast-reply-no . "Remark to which text? ")
(fast-reply-prompt . "Remark: ")
......@@ -1643,6 +1648,21 @@ You must become an active member of the conference to enter it.\n")
(lyskom-prioritize-flag-set-action . "Set")
(lyskom-prioritize-flag-clear-action . "Clear")
(server-status-header . "Status for LysKOM-server %#1s%#2?b%[ (%#2s:%#3d)%]%[%]\n\n")
(server-status-server . "Canonical server name: %#1s%#2?b%[:%#2s%]%[%]")
(server-status-version . "Software version: %#1s %#2s\n")
(server-status-protocol . "Protocol version: %15#1d\n")
(server-status-sessions . "\
Number of sessions: %21#1d (total)
%21#2d active in the last %#7d minutes
%21#3d inactive sessions
%21#4d unknown activity
%21#5d invisible sessions
%21#6d not logged on/secret/zombies\n")
(server-status-first-text . "Oldest existing article: %15#1n\n")
(server-status-last-text . "Youngest existing argicle: %15#1n\n")
(server-status-has-motd . "\nThe server has a notice:\n")
(server-status-time . "Serverns tid: %#1s\n")
))
......@@ -1795,7 +1815,7 @@ You must become an active member of the conference to enter it.\n")
(kom-remote-erase-messages . "Remote control erase messages")
(kom-remote-quit . "Remote control quit")
(kom-status-session . "Status (of a) session")
(kom-status-session . "Status (of) session")
(kom-customize . "Customize LysKOM")
(kom-next-kom . "Next LysKOM")
(kom-previous-kom . "Previous LysKOM")
......@@ -1837,6 +1857,7 @@ You must become an active member of the conference to enter it.\n")
(kom-remove-presentation . "Remove presentation")
(kom-set-motd-text . "Add notice")
(kom-create-aux-item . "Create auxiliary information")
(kom-status-server . "Status (of) server")
))
(lyskom-language-var lyskom-language-codes en
......@@ -2175,6 +2196,7 @@ You must become an active member of the conference to enter it.\n")
(define-key lyskom-en-mode-map (kbd "s c") 'kom-status-conf)
(define-key lyskom-en-mode-map (kbd "s u") 'kom-status-person)
(define-key lyskom-en-mode-map (kbd "s s") 'kom-status-session)
(define-key lyskom-en-mode-map (kbd "s k") 'kom-status-server)
(define-key lyskom-en-mode-map (kbd "s m") 'kom-send-message)
;; Running in) buffer
......
......@@ -1168,6 +1168,9 @@ depending on the value of `kom-lynx-terminal'."
((eq 'conf (car arg))
(conf-stat->aux-items
(blocking-do 'get-conf-stat (elt arg 1))))
((eq 'server (car arg))
(server-info->aux-item-list
(blocking-do 'get-server-info)))
(t nil))))
(while items
(when (eq (aux-item->aux-no (car items)) (elt arg 2))
......@@ -1179,13 +1182,23 @@ depending on the value of `kom-lynx-terminal'."
(lyskom-start-of-command nil)
(unwind-protect
(progn
(if (blocking-do (cond ((eq 'text (car arg)) 'modify-text-info)
((eq 'conf (car arg)) 'modify-conf-info))
(elt arg 1)
(list (aux-item->aux-no aux))
nil)
(cond ((eq 'text (car arg)) (cache-del-text-stat (elt arg 1)))
((eq 'conf (car arg)) (cache-del-conf-stat (elt arg 1))))
(unless (cond ((eq 'text (car arg))
(cache-del-text-stat (elt arg 1))
(blocking-do 'modify-text-info
(elt arg 1)
(list (aux-item->aux-no aux))
nil))
((eq 'conf (car arg))
(cache-del-conf-stat (elt arg 1))
(blocking-do 'modify-conf-info
(elt arg 1)
(list (aux-item->aux-no aux))
nil))
((eq 'server (car arg))
(prog1 (blocking-do 'modify-server-info
(list (aux-item->aux-no aux))
nil)
(lyskom-set-default 'lyskom-server-info (blocking-do 'get-server-info)))))
(lyskom-report-command-answer nil)))
(lyskom-end-of-command)))))
......@@ -1196,13 +1209,17 @@ depending on the value of `kom-lynx-terminal'."
(let ((aux nil))
(cond ((lyskom-aux-item-p arg))
((listp arg)
(let ((items (cond ((eq 'text (car arg))
(text-stat->aux-items
(blocking-do 'get-text-stat (elt arg 1))))
((eq 'conf (car arg))
(conf-stat->aux-items
(blocking-do 'get-conf-stat (elt arg 1))))
(t nil))))
(let ((items
(cond ((eq 'text (car arg))
(text-stat->aux-items
(blocking-do 'get-text-stat (elt arg 1))))
((eq 'conf (car arg))
(conf-stat->aux-items
(blocking-do 'get-conf-stat (elt arg 1))))
((eq 'server (car arg))
(server-info->aux-item-list
(blocking-do 'get-server-info)))
(t nil))))
(while items
(when (eq (aux-item->aux-no (car items)) (elt arg 2))
(setq aux (car items))
......@@ -1211,11 +1228,13 @@ depending on the value of `kom-lynx-terminal'."
(if aux
(let ((header (cond ((eq 'text (car arg))
(lyskom-format 'text-no (elt arg 1)))
(lyskom-format 'aux-item-for-text-no (elt arg 1)))
((eq 'conf (car arg))
(lyskom-format 'conference-no
(lyskom-format 'aux-item-for-conference-no
(blocking-do 'get-conf-stat
(elt arg 1))))
((eq 'server (car arg))
(lyskom-format 'aux-item-for-server))
(t "????"))))
(lyskom-start-of-command nil)
(unwind-protect
......@@ -1225,7 +1244,7 @@ depending on the value of `kom-lynx-terminal'."
header)
(lyskom-aux-item-info aux header)))
(lyskom-end-of-command)))
(lyskom-format-insert 'cant-get-aux-item))))
(lyskom-format-insert-before-prompt 'cant-get-aux-item))))
(defun lyskom-button-apply (buf arg text)
(apply (car arg) (cdr arg)))
......@@ -122,6 +122,7 @@
(define-key lyskom-sv-edit-prefix (kbd "C-a C-x") 'kom-edit-add-cross-reference)
(define-key lyskom-sv-edit-prefix (kbd "C-x C-p") 'kom-edit-add-personal-comments)
(define-key lyskom-sv-edit-prefix (kbd "C-x C-n") 'kom-edit-add-no-comments)
(define-key lyskom-sv-edit-prefix (kbd "C-x C-l") 'kom-edit-add-world-readable)
(define-key lyskom-sv-edit-prefix (kbd "C-x C-b") 'kom-edit-add-read-confirm-request)
(define-key lyskom-sv-edit-prefix (kbd "C-a ?") 'lyskom-help))
......@@ -576,7 +577,9 @@ i svensk datorhistoria. L
(conf-mship-priority . "Prioritet: %25#1n%#2?b%[ %#2s%]%[%]\n")
(conf-has-motd . "\n%#1M har en lapp p drren:\n")
(status-conf-generic . "%-40#1s %#2s\n")
(status-aux-item . "Tillggsinformation: %15#1s%#3s (skapad av %#2M)\n")
(status-aux-item . "Oknd tillggsinformation: %15#1s%#3s (skapad av %#2M)\n")
(conf-mx-list-name . "Importerad mailinglista: %#1s %#2s\n")
(recommended-conf-aux . "Rekommenderat mte: %#1M <%#1m>\n")
(Everybody . "Alla")
(show-members-list-also-q . "Vill du se medlemslistan ocks? ")
......@@ -1436,8 +1439,10 @@ Uppkopplad sedan %#8s%#9s")
(label-secret . "Skall andra kunna se namnet? ")
(creating-software-aux . "Skapad med %#1s")
(world-readable-text-aux . "Inlgget kan lsas utan inloggning")
(world-readable-text-edit-aux . "Gr inlgget lsbart utan inloggning")
(cant-get-aux-item . "Hittar inte tillggsinformationen")
(cant-get-aux-item . "Hittar inte tillggsinformationen\n")
(aux-item-no-info . "Ingen information tillgnglig\n")
(aux-item-info . "\
Nummer: %#1d %#6s
......@@ -1458,8 +1463,9 @@ Inneh
(inherit-steps . "%#1d steg")
(aux-item-for . "Tillggsinformation fr ")
(conference-no . "mte <%#1m> %#1M")
(text-no . "inlgg %#1n")
(aux-item-for-conference-no . "mte <%#1m> %#1M")
(aux-item-for-text-no . "inlgg %#1n")
(aux-item-for-server . "servern")
(what-fast-reply-no . "Anmrkning till vilket inlgg? ")
(fast-reply-prompt . "Anmrkning: ")
......@@ -1641,6 +1647,22 @@ Du m
(lyskom-prioritize-flag-toggle-action . "Vxla")
(lyskom-prioritize-flag-set-action . "Stt p")
(lyskom-prioritize-flag-clear-action . "Stng av")
(server-status-header . "Status fr LysKOM-server %#1s%#2?b%[ (%#2s:%#3d)%]%[%]\n\n")
(server-status-server . "Kanonisk server: %#1s%#2?b%[:%#2s%]%[%]")
(server-status-version . "Programversion: %#1s %#2s\n")
(server-status-protocol . "Protokollversion: %15#1d\n")
(server-status-sessions . "\
Antal sessioner: %21#1d (totalt)
%21#2d aktiva under de senaste %#7d minuterna
%21#3d inaktiva sessioner
%21#4d oknd aktivitet
%21#5d osynliga sessioner
%21#6d ej inloggade/hemliga/zombies\n")
(server-status-first-text . "ldsta befintliga text: %15#1n\n")
(server-status-last-text . "Yngsta befintliga text: %15#1n\n")
(server-status-has-motd . "\nServern har en lapp p drren:\n")
(server-status-time . "Serverns tid: %#1s\n")
))
(lyskom-language-var lyskom-month-names sv
......@@ -1835,6 +1857,7 @@ Du m
(kom-remove-presentation . "Ta bort presentation")
(kom-set-motd-text . "Addera lapp p drren")
(kom-create-aux-item . "Skapa tillggsinformation")
(kom-status-server . "Status (fr) servern")
))
(lyskom-language-strings lyskom-help-strings sv
......@@ -2615,6 +2638,7 @@ Visar vilka som f
(define-key lyskom-sv-mode-map (kbd "s m") 'kom-status-conf)
(define-key lyskom-sv-mode-map (kbd "s p") 'kom-status-person)
(define-key lyskom-sv-mode-map (kbd "s s") 'kom-status-session)
(define-key lyskom-sv-mode-map (kbd "s k") 'kom-status-server)
(define-key lyskom-sv-S-prefix (lyskom-keys ') 'kom-send-message)
(define-key lyskom-sv-S-prefix (lyskom-keys ') 'kom-send-message)
(define-key lyskom-sv-S-prefix [] 'kom-send-message)
......
......@@ -988,7 +988,7 @@ timeformat-* strings are tailored to be used as formats for this
function.
The arguments to the format string are (in order): year, month number
(starting with one for January), day-of-month number, hour, minute,
\(starting with one for January), day-of-month number, hour, minute,
second, full name of the day of the week, abbreviated name of the day
of the week.
......
......@@ -1794,6 +1794,7 @@ is a list of vectors, where each vector specifies an item.
kom-set-motd-text
kom-remove-presentation
kom-create-aux-item
kom-status-server
))
;;; ================================================================
......
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