;;;;; -*-coding: raw-text;-*- ;;;;; ;;;;; $Id: defvar.el,v 44.7.2.2 1999/10/13 12:13:00 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: defvar.el ;;;; Authos: David Byers ;;;; ;;;; This file contains definitions used to define variables ;;;; (defconst lyskom-clientversion-long "$Id: defvar.el,v 44.7.2.2 1999/10/13 12:13:00 byers Exp $\n" "Version for every file in the client.") (provide 'lyskom) ;; Just to get rid of a compiler warning (defvar kom-dont-read-saved-variables) (defvar lyskom-local-variables nil "List of variables to make local in a LysKOM buffer") (defvar lyskom-local-hooks nil "List of hooks to make local in a LysKOM buffer.") (defvar lyskom-protected-variables nil "List of variables that are protected from kill-buffer") (defvar lyskom-inherited-variables nil "List of variables inherited from the LysKOM buffer") (defvar lyskom-elisp-variables nil "Tells the client what flags and hooks that are to be saved in the server. These are the flags that are saved in the elisp-client part of the server.") (defvar lyskom-minibuffer-variables nil "These are variables that should be set in the minibuffer by lyskom-with-lyskom-minibuffer.") (defvar lyskom-minibuffer-values nil "Dynamic binding of values that minibuffer variables are to take on") (defmacro lyskom-save-variables (var-list &rest forms) "Save the values and property list of symbols in VAR-LIST and execute FORMS The symbol value, property list and buffer-local property of all variables is saved before executing FORMS and restored when FORMS have finished." (let ((sym1 (make-symbol "lyskom-saved-variables")) (sym2 (make-symbol "lyskom-saved-symbols")) (sym3 (make-symbol "lyskom-saved-local")) (sym4 (make-symbol "lyskom-saved-plist"))) (` (let* (((, sym2) (quote (, var-list))) ((, sym1) (mapcar 'symbol-value (, sym2))) ((, sym4) (mapcar 'symbol-plist (, sym2))) ((, sym3) (mapcar (function (lambda (v) (local-variable-p v (current-buffer)))) (, sym2)))) (unwind-protect (progn (,@ forms)) (while (, sym1) (if (car (, sym3)) (make-local-variable (car (, sym2)))) (set (car (, sym2)) (car (, sym1))) (setplist (car (, sym2)) (car (, sym4))) (setq (, sym1) (cdr (, sym1)) (, sym2) (cdr (, sym2)) (, sym3) (cdr (, sym3)) (, sym4) (cdr (, sym4))))))))) (put 'lyskom-save-variables 'edebug-form-spec '(sexp body)) (defmacro lyskom-with-lyskom-minibuffer (&rest forms) "Run FORMS after ensuring that LysKOM minibuffer variables will be set." (` (let* ((lyskom-minibuffer-values (mapcar 'symbol-value lyskom-minibuffer-variables))) (unwind-protect (progn (add-hook 'minibuffer-setup-hook 'lyskom-setup-minibuffer-variables) (,@ forms)) (remove-hook 'minibuffer-setup-hook 'lyskom-setup-minibuffer-variables))))) (put 'lyskom-with-lyskom-minibuffer 'edebug-form-spec '(body)) (defun lyskom-setup-minibuffer-variables () (let ((syms lyskom-minibuffer-variables) (vals lyskom-minibuffer-values)) (while syms (make-local-variable (car syms)) (set (car syms) (car vals)) (setq syms (cdr syms) vals (cdr vals))) (set-buffer-multibyte nil))) (defmacro def-kom-var (name value &rest args) "Define a variable with name NAME and initial value VALUE. Remaining args, ARGS may be A string Used as the documentation string for the variable A symbol A predefined property of the variable A list A widget specification for the variable Predefined properties are the following server Save the variable in the elisp block. Implies local. local Make the variable buffer-local. inherited The variable is inherited from parent buffer. Implies protected protected The variable is marked as permanent local. Implies local. minibuffer Inherit the variable as a local variable in the minibuffer. server-hook A hook stored in the server. local-hook A hook variable that is made local in LysKOM buffers." (let ((inherited nil) (protected nil) (elisp-block nil) (buffer-local nil) (widget-spec nil) (doc-string nil) (minibuffer nil) (arglist args)) (while arglist (cond ((stringp (car arglist)) (setq doc-string (car arglist))) ((consp (car arglist)) (setq widget-spec (` ((setq lyskom-custom-variables (cons (quote (, (list name (car arglist)))) lyskom-custom-variables)))))) ((symbolp (car arglist)) (cond ((eq (car arglist) 'server) (setq elisp-block (` ((if (and (not (memq (quote (, name)) lyskom-global-boolean-variables)) (not (memq (quote (, name)) lyskom-global-non-boolean-variables))) (add-to-list 'lyskom-elisp-variables (quote (, name)))) (add-to-list 'lyskom-local-variables (quote (, name))))))) ((eq (car arglist) 'server-hook) (setq elisp-block (` ((add-to-list 'lyskom-elisp-variables (quote (, name))) (add-to-list 'lyskom-local-hooks (quote (, name))))))) ((eq (car arglist) 'protected) (setq protected (` ((put (quote (, name)) 'permanent-local t) (add-to-list 'lyskom-protected-variables (quote (, name))) (add-to-list 'lyskom-local-variables (quote (, name))))))) ((eq (car arglist) 'inherited) (setq inherited (` ((add-to-list 'lyskom-inherited-variables (quote (, name))) (put (quote (, name)) 'permanent-local t) (add-to-list 'lyskom-protected-variables (quote (, name))) (add-to-list 'lyskom-local-variables (quote (, name))))))) ((eq (car arglist) 'local) (setq buffer-local (` ((add-to-list 'lyskom-local-variables (quote (, name))))))) ((eq (car arglist) 'local-hook) (setq buffer-local (` ((add-to-list 'lyskom-local-hooks (quote (, name))))))) ((eq (car arglist) 'minibuffer) (setq minibuffer (` ((add-to-list 'lyskom-minibuffer-variables (quote (, name))))))) (t (error "LysKOM: Unknown variable property: %S" (car arglist))))) (t (error "LysKOM: Strange variable argument type: %S" (car arglist)))) (setq arglist (cdr arglist))) (` (progn (dont-compile (if (and (boundp (quote (, name))) (or (not (boundp lyskom-is-loaded)) (not lyskom-is-loaded)) (listp kom-dont-read-saved-variables)) (add-to-list 'kom-dont-read-saved-variables (quote (, name))))) (defvar (, name) (, value) (, doc-string)) (,@ (apply 'append (list inherited protected elisp-block buffer-local minibuffer widget-spec ))))))) (put 'def-kom-var 'edebug-form-spec '(&define name form &rest sexp)) (provide 'lyskom-defvar) ;;;;; -*-coding: raw-text; unibyte: t; mode: emacs-lisp; -*- ;;;;; ;;;;; $Id: vars.el.in,v 44.41.2.2 1999/10/13 12:13:37 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: vars.el ;;;; ;;;; This file contains almost all the variables used in lyskom. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: vars.el.in,v 44.41.2.2 1999/10/13 12:13:37 byers Exp $\n")) (provide 'lyskom) (require 'lyskom-defvar "defvar") (defconst lyskom-global-boolean-variables '( kom-created-texts-are-read kom-dashed-lines kom-presence-messages kom-print-number-of-unread-on-entrance kom-read-depth-first kom-reading-puts-comments-in-pointers-last kom-confirm-multiple-recipients ) "List of flags that are to be saved as booleans in the common block. Dont change this. These are defined by the protocol.") (defconst lyskom-global-non-boolean-variables '( kom-default-mark ) "List of flags that are to be saved in the common block. These are the non-boolean ones. See: lyskom-global-boolean-variables. Dont change these. These are defined by the protocol.") (defun lyskom-protect-variable (sym) (put sym 'permanent-local t) (lyskom-local-variable sym) (add-to-list 'lyskom-protected-variables sym)) (defun lyskom-local-variable (sym) (add-to-list 'lyskom-local-variables sym)) (defun lyskom-inherited-variable (sym) (add-to-list 'lyskom-inherited-variable sym) (lyskom-protect-variable sym)) (defun lyskom-setup-local-variables () (mapcar 'make-local-variable lyskom-local-variables) (mapcar 'make-local-hook lyskom-local-hooks)) (defvar lyskom-is-loaded nil "Non-nil when lyskom has been loaded.") (def-kom-var kom-dont-read-saved-variables '(kom-dont-read-saved-variables lyskom-login-hook) "*Non nil means don't read some variables from the server. t means don't read any variables. A list means don't read variables that are in the list.") ;;;;;; ================================================================ ;;;;;; Emacs dependant variables ;; ;;(def-kom-var kom-emacs-knows-iso-8859-1 t ;; "*If non-nil then dont convert texts and other things to swascii. ;;This variable is not saved. It should be set in your .emacs ;; ;;This variable is not saved in the LysKOM server.") ;;;; ================================================================ ;;;; Variables and constants. ;;; User flags (def-kom-var kom-allow-incompleteness nil "*If nil, commands like kom-list-news will wait for the prefetch. If this flag is set to t, some commands may give incomplete answers, but it might give them faster, especially during the login phase." server ) (def-kom-var kom-bury-buffers t "*Controls the behaviour of kom-next-kom and its cousins. If this variable is non-nil the current buffer is sent to the back of the buffer list when one of the commands `kom-next-kom', `kom-previous-kom' or `kom-next-unread-kom' is invoked." server) (def-kom-var kom-write-texts-in-window nil "*Where to edit texts. One of nil, other, new-frame, other-frame, a string or a buffer. nil means edit texts in the same window as the LysKOM buffer. other means edit in another window, creating it if necessary. other-frame means edit in another frame, if there is one. new-frame means create a new frame for editing. The frame will be removed when editing is finished. a string or buffer means edit in the indicated buffer." server) (def-kom-var kom-view-commented-in-window 'other "*Where to view commented texts. See kom-write-texts-in-window for details" server) (def-kom-var kom-edit-filters-in-window nil "*Where to edit filters. See kom-write-texts-in-window for more information." server) (def-kom-var kom-list-membership-in-window 'other "*Where to list membership. See kom-write-texts-in-window for more information." server) (def-kom-var kom-customize-format 'long "*Format of the customize buffer. Must be long or short." server) (def-kom-var kom-user-prompt-format "%[%c% %m%] - " "*Format of LysKOM prompt when waiting for input." server) (def-kom-var kom-user-prompt-format-executing "%[%c% %m%]." "*Format of LysKOM prompt when executing a default command" server) (def-kom-var kom-enabled-prompt-format "%[%c% %m%] # " "*Format of LysKOM prompt when in enabled mode." server) (def-kom-var kom-enabled-prompt-format-executing "%[%c% %m%]." "*Format of LysKOM prompt when executing a default command in enabled mode." server) (def-kom-var kom-cite-string ">" "*String to insert before each line of a commented text." server) (def-kom-var kom-created-texts-are-read t "*Non-nil means automatically mark texts that you create as read." server) (def-kom-var kom-customize-in-window nil "*Where to customize LysKOM. See kom-write-texts-in-window" server) (def-kom-var kom-prioritize-in-window nil "*Where to prioritize conferences. See kom-write-texts-in-window" server) (def-kom-var kom-default-mark 100 "*If non-nil (must be an integer) then the user is not asked for type of mark." server) (def-kom-var kom-reading-puts-comments-in-pointers-last t "*If Non-nil the texts are shown with comments references at the end." server inherited) (def-kom-var kom-dashed-lines t "*If Non-nil then all texts will be surrounded by lines of dashes." server inherited) (def-kom-var kom-text-footer-format nil "*If non-nil, this specifies the format of a text footer. The following format directives are legal: %n The text number. %p The number of the author. %P The name of the author %- A bunch of dashes %f Information about the text in parentheses. Format letters can be prefixed with a number specifying the minimum field width. The field width can be prefixed with an equals sign which means that the field is exactly as wide as specified (contents may be truncated.) A negative field width means left justify the contents. The field width of %- is special. It specifies the maximum number of dashes the print. The actual number will be the maximum minus the length of the author's name, if it is included anywhere in the format string. When set, this variable overrides kom-dashed-lines and kom-show-author-at-end. The default format is equivalent to the following strings, depending on the settings of kom-dashed-lines and kom-show-author-at-end. kom-dashed-lines kom-show-author-at-end Format t t \"(%n) /%P/%42-%f\" t nil \"(%n) %42-%f\" nil t \"(%n) /%P/ %f\" nil nil \"(%n) %f\" " server inherited) (def-kom-var kom-show-author-at-end t "*If non-nil then the author will be shown at the end of each text." server inherited) (def-kom-var kom-print-number-of-unread-on-entrance t "*If Non-nil then print automatically the number of unread articles when entering a conference." server) (def-kom-var kom-presence-messages t "*If non-nil, lyskom prints continuous info about what other people are doing. Info is printed on the message line and never in the buffer. If minibuffer is used then no message is printed. If you want the messages in the buffer you could set the variable kom-presence-messages-in-buffer." server) (def-kom-var kom-presence-messages-in-buffer nil "*If t, lyskom prints information about what other people are doing in buffer. All printing is done just before the prompt. If nil no messages are printed. If 'presence then messages about people logging in, out and people changing name is printed." server) (def-kom-var kom-show-where-and-what t "*Non-nil means kom-who-is-on shows from which machine the user is running and what he is doing." server) (def-kom-var kom-idle-hide 30 "*The number of minutes of idle-time before a user is excluded from the list of users. This can be overridden by a prefix argument to `kom-who-is-on'." server) (def-kom-var kom-show-footnotes-immediately t "*Non-nil means show footnotes immediately following the text." server) (def-kom-var kom-follow-comments-outside-membership nil "*Show comments in conferences you are not a member of. If this variable is nil, texts with no recipient you are a member of will not be shown." server) (def-kom-var kom-who-buffer-size-when-displaying 10 "*Size of window to display the who-buffer. This is used when executing the kom-display-who-buffer command." server) (def-kom-var kom-read-depth-first t "*Non-nil means read comments and footnotes to a text before other texts." server) (def-kom-var kom-continuous-scrolling t "*Non-nil means scroll LysKOM window as text is inserted. The last viewed position (generally the most recent prompt) will always be visible." server) ;; Should this be set to nil if baud-rate is low? (def-kom-var kom-deferred-printing t "*Non-nil means delay printing of some information not in the cache. You might want to turn this off to have the old, linear behaviour.") (def-kom-var lyskom-defer-indicator "[...]" "String to display while LysKOM is waiting for the real string.") (def-kom-var kom-higher-priority-breaks nil "*Non-nil means allow texts from conferences with highter priority to break in. If the value is 'express then texts are allowed to break in the middle of a comment chain. Otherwise we dont let them in until the end of the comment tree." server) (def-kom-var lyskom-view-text-hook nil "*Hook that is called before a text is shown. When the hooks is called, text is bound to the text mass of the text and text-stat to the text-stat of the text to be shown.") (def-kom-var lyskom-send-message-hook '(lyskom-send-message-trim-newlines) "*Hook that is called before a personal, group or common message is sent. When called, lyskom-message-string is bound to the message that will be sent and lyskom-message-recipient to the conf-stat of the recipient or nil if the recipient does not exist or if the message is a common message. If lyskom-message-string is set to nil by a hook, the message will not be sent.") (def-kom-var lyskom-send-message-setup-hook nil "*Hook that is called when the minibuffer is entered to read a message.") (def-kom-var lyskom-send-message-exit-hook nil "*Hook that is called when the minibuffer is exited after reading a message.") (def-kom-var lyskom-send-text-hook nil "*Hook that is called before sending a text. Hook functions return t to signal suggess and nil to prevent the text from being sent.") (def-kom-var lyskom-after-load-hook nil "*Hook to run once after lyskom is loaded.") (def-kom-var lyskom-change-conf-hook nil "*Hook to run when changing conferences. The functions in this list are run with two arguments. The first is the current conf-no and the second is the conf-no being changed to.") (def-kom-var lyskom-login-hook nil "*What to do when logged in. This hook is called after we have logged in but before and command is accepted from the keyboard. It is called immediately before kom-login-hook.") (def-kom-var kom-login-hook nil "*What to do when logged in. This is a list of commands that are executed after we have logged in but before any command is accepted from the keyboard. See also lyskom-login-hook." server) (def-kom-var kom-do-when-done '(kom-review-all-marked-texts kom-display-time) "*What to do when all texts are read. This is a list of commands and lists of commands that are prompted for and executed when there are no more new texts. The last element in the list is the one that will never be removed from the list. A command can be one of: type prompt lyskom-function from the lyskom-command-name function. command \"Kommandot:\" name of function or definition of lambda expression keyboard macro \"Kommandot:\" keyboard macro definition." server) (def-kom-var kom-page-before-command nil "*This is a list of all commands before which the screen is cleared. If it isn't a list and isn't nil the screen is cleared before all commands." server) (def-kom-var kom-permissive-completion t "*If t, completion on logged-in persons will usually also include persons who are not logged in. Values other than t or nil are reserved for future use." server) (def-kom-var kom-membership-default-priority 100 "*Default priority when joining a new conference. If a valid priority then new conferences are read with this priority. Otherwise ask the user for a priority. Valid priorities are only the range 0-255." server) (def-kom-var kom-membership-default-placement 'last "*Tells the system where to put new conferences. The value can be one of the following: 'first => before all other conferences. 'last => after all other conferences. a number => at that position otherwise => the new conf is entered after all conferences." server) (def-kom-var lyskom-current-prompt nil "The current prompt or nil. This is either nil, indicating that there is currently no prompt, or one a symbol indcating which command is prompted in the LysKOM buffer." local) (def-kom-var lyskom-current-prompt-text nil "The current prompt text or nil. This is either nil, indicating that there is currently no prompt, or a string indicating the prompt shown in the LysKOM buffer." local) (def-kom-var kom-show-personal-messages-in-buffer t "*Buffer to show personal messages in. If nil, discard them. If t, insert them in the *kom* buffert. If non-nil and non-t this should be a buffer or a name of a (possibly nonexistent) buffer in which the message is inserted." server) (def-kom-var kom-pop-personal-messages nil "*Non-nil means pop up a buffer with personal messages as they arrive. kom-show-personal-messages-in-buffer decides which buffer to pop." server) (def-kom-var kom-ding-pause-amount 0.1 "*Amount of time to wait between successive beeps.") (def-kom-var kom-ding-on-new-letter nil "*Non-nil means ding if a message arrives in the letter box. See kom-ding-on-priority-break for valid values." server) (def-kom-var kom-ding-on-priority-break 1 "*Non-nil means ding if a higher priority text or conference breaks in. A number means the number of times to ding. A string is an argument for the program named by kom-audio-player." server) (def-kom-var kom-ding-on-wait-done 1 "*Non-nil means ding when busy-waiting finishes. A number means the number of times to ding. A string is an argument for the program named by kom-audio-player. A symbol is interpreted as a function to call." server) (def-kom-var kom-ding-on-common-messages 0 "*Non-nil means ding as common messages arrive. A number means the number of times to ding. A string is an argument for the program named by kom-audio-player. A symbol is interpreted as a function to call." server) (def-kom-var kom-ding-on-group-messages 1 "*Non-nil means ding as group messages arrive. A number means the number of times to ding. A string is an argument for the program named by kom-audio-player. A symbol is interpreted as a function to call." server) (def-kom-var kom-ding-on-personal-messages 2 "*Non-nil means ding as personal messages arrive. A number means the number of times to ding. A string is an argument for the program named by kom-audio-player. A symbol is interpreted as a function to call." server) (def-kom-var kom-ding-on-no-subject 2 "*How to ding if the user has not entered a subject line. A number means the number of times to ding. A string is an argument for the program named by kom-audio-player. A symbol is interpreted as a function to call." server) (def-kom-var kom-audio-player "audioplay" "*Program to play audio files.") (def-kom-var kom-default-message-recipient 'group "*Determines default recipient of personal messages. everybody means the default recipient is everybody. group means the default recipient is the group to which the last message was sent, if it was a group message. If the last message was a personal message or a common message, it means the same as sender. sender means the sender of the last message received." server) (def-kom-var lyskom-filter-outgoing-messages t "*t if outgoing remote-control messages and automatic replies are not to be displayed in the buffer.") (def-kom-var kom-friends nil "*List of people whose names should be formatted using kom-friends-face." server) (def-kom-var kom-default-face-scheme nil "*Face scheme to use per default for new logins.") (def-kom-var kom-text-properties t "*Non-nil means to insert text properties in the Emacs buffer for various LysKOM elements.") (def-kom-var kom-use-button-hints t "*Non-nil means use button hints for overriding default actions.") (def-kom-var kom-autowrap t "*Non-nil means auto wrap articles with discretion. A number means wrap articles shorter than the number (in bytes)." server) ;;; ;;; lyskom-button-actions has been moved to swedish-strings.el on account ;;; of there being a bunch of language-dependent strings in it. ;;; (def-kom-var lyskom-url-protocol-regexp "\\(file\\|ftp\\|gopher\\|http\\|https\\|news\\|wais\\|mailto\\|telnet\\):") (def-kom-var lyskom-text-buttons '( ;; Text numbers ("\\(\\<[0-9][0-9][0-9][0-9]\\([0-9]\\)?\\([0-9]\\)?\\([0-9]\\)?\\>\\)" ; Match text ; Button type 0 ; Portion that's a button 1 ; Portion that's the arg nil ; Face or nil (=default) ) ;; Email ("[^()<>@,;:\"\\\\\000- ]+@[^\000- <>;,.'\"!:?) \t\012\014]+\\(\\.[^\000- <>;,.'\"!:?)]+\\)+" email 0 0 kom-url-face) ;; URLs ("\\(www\\|ftp\\|home\\)\\.[^\t \012\014\"<>|\\]*[^\t \012\014\"<>|.,!(){}?'`:]" pseudo-url 0 nil kom-url-face) ("\\(file://\\|ftp://\\|gopher://\\|http://\\|https://\\|news:\\|wais://\\|mailto:\\|telnet:\\)[^\t \012\014\"<>|\\]*[^\t \012\014\"<>|.,!(){}?'`:]" url 0 nil kom-url-face) ("]*\\)\\s-*>" url 1 1 kom-url-face) ;; JySKom enhancements ("<(?m[|ö]te *\\([0-9]+\\)[^0-9]*)?>" conf 0 1 nil) ("<(?text *\\([0-9]+\\)[^0-9]*)?>" text 0 1 nil) ("<(?person *\\([0-9]+\\)[^0-9]*)?>" pers 0 1 nil) ;; Info node reference ("\\*Note[ \n\t]+\\([^:]*\\):\\([^.,\t]*\\)[.,\t]" info-node 1 2 kom-url-face) ) "List of buttons to install in the text mass of LysKOM objects. Each element is a list consisting of REGEXP TYPE BUTTON-MATCH BUTTON-ARG-MATCH FACE. REGEXP is the regexp to look for in the text. TYPE is the button type. Valid button types are defined in lyskom-button-actions BUTTON-MATCH is the number of the parenthesized expression that is the actual button. BUTTON-ARG-MATCH is the number of the expression to used as the button argument. FACE is the text face to apply to the button, or nil to use the default face.") (def-kom-var kom-url-viewer-preferences '("emacs" "netscape" "w3") "*LysKOM will attempt to use URL viewers in the order specified here. kom-url-managers is a list of all available viewers. Note that the elements are all strings. When you select an URL, this list is used to determine which URL viewer to use in the following manner: Each element is in turn matched against the manager regexp for each manager in kom-url-managers, and the first manager found that matches is used to display the URL. See kom-url-managers for a list of all available URL viewers. See kom-netscape-command and kom-mosaic-command for information specific to some URL viewers.") (def-kom-var kom-url-managers '(("default" ".*" "Browse-URL" lyskom-view-url-browse-url) ("w3" "\\(http\\|gopher\\|ftp\\)" "Emacs W3" lyskom-view-url-w3) ("netscape" ".*" "Netscape Navigator" lyskom-view-url-netscape) ("\\(emacs\\|dired\\)" "\\(ftp\\|file\\)" "dired" lyskom-view-url-dired) ("\\(emacs\\|telnet-mode\\)" "telnet" "emacs telnet" lyskom-view-url-telnet) ("\\(emacs\\|mail-mode\\)" "mailto" "mail-mode" lyskom-view-url-mailmode) ("mosaic" "\\(http\\|gopher\\|ftp\\|mailto\\|news\\|wais\\|file\\|telnet\\)" "NCSA Mosaic" lyskom-view-url-mosaic) ("lynx" "\\(http\\|gopher\\|ftp\\|mailto\\|news\\|wais\\|file\\|telnet\\)" "Lynx" lyskom-view-url-lynx)) "List of URL managers. Each element is a list consisting of (MANAGER-REGEXP PROTOCOLS NAME VIEW-FUNCTION). When LysKOM attempts to view an URL, kom-url-viewer-preferences is scanned, and the URL manager whose MANAGER-REGEXP first matches an element in kom-url-viewer-preferences and whose PROTOCOLS matches the protocol of the selected URL is used to view the URL by calling its VIEW-FUNCTION with the URL and the manager entry as arguments.") (def-kom-var kom-mosaic-command "/usr/local/bin/mosaic" "*Command to run to start Mosaic") (def-kom-var kom-netscape-command "netscape" "*Command to run to start Netscape. If a string, it should be a command that starts Netscape with no arguments. If a list, the first element must be a command that starts Netscape. The remaining elements are used as arguments to Netscape. For instance, a value of \"netscape\" is valid, but \"netscape -d host:0\" is not. Instead, the latter should be \(\"netscape\" \"-d\" \"host:0\"\)") (def-kom-var kom-lynx-terminal 'xterm "*Where to start Lynx. Valid values are 'xterm (start Lynx in an xterm) and 'terminal (start Lynx in Emacs terminal mode.") (def-kom-var kom-lynx-xterm-command '("xterm" "-geometry" "90x50+100+100" "-e" "lynx") "*Command to run to start Lynx in an xterm. Must be a list of strings, where the first element is the name of the xterm program, and the remaining elements are arguments to the xterm. The last elements should be \"-e\" \"lynx\", or something similar, to start Lynx.") (def-kom-var kom-lynx-terminal-command "lynx" "*Command to run Lynx in Emacs terminal mode. This can be either a string, to start Lynx with no arguments, or a list of strings, where the first element is the command, and the rest are arguments to Lynx.") (def-kom-var kom-confirm-multiple-recipients 'after "*Non-nil means ask the user for confirmation about recipients. When the user writes a comment to a text with more than one recipient he gets a y-or-n-p question for all recipients. 'before means check before opening the edit buffer. Anything else means check before sending the article." server) (def-kom-var kom-check-for-new-comments t "*Non-nil means check that no new comments have been written to a commented texts since the last check. A list means check in all conferences except those listed. A function means call the function and check if non-nil is returned. The function is called with the commented text's text-stat as an argument." server) (def-kom-var kom-check-commented-author-membership t "*Non-nil means check that the authors of the commented texts are members of at least one of the recipient conferences. If not, offer to add them as recipients." server) (def-kom-var kom-inhibit-typeahead nil "*If non-nil, discard keyboard input that arrives while a LysKOM command is executing. " server) (def-kom-var kom-max-buffer-size nil "*If non-nil, ensure that buffers won't grow any larger than this" local) (def-kom-var lyskom-print-complex-dates t "If non-nil, print today and yesterday using a special format.") (def-kom-var kom-show-namedays nil "*Non-nil means display namedays when running in swedish. This variable will eventually be replaced with something else." server) (def-kom-var kom-www-proxy nil "*Non-nil indicates a WWW proxy to use for the connection. This is useful behind a firewall if the proxy supports the CONNECT method. If this variable is a string, it is assumed to be a proxy specification for all LysKOM servers. If it is a list, it is assumed to be a list of pairs, (SERVER . PROXY) where SERVER is the server for which PROXY, a proxy specification is to be used. The special value t can be used for SERVER to indicate a default proxy. A proxy specification has the form \"HOST:PORT\" where HOST is the host name of the proxy and PORT is the port to connect to. The :PORT part is optional. If it is not specified, port 80 is assumed.") (def-kom-var kom-server-aliases '(("kom.lysator.liu.se" . "LysKOM") ("kom.ludd.luth.se" . "LuddKOM") ("rydkom.rydnet.lysator.liu.se" . "RydKOM") ("kom.csd.uu.se" . "CSD-KOM") ("striterax.medio.mh.se" . "MedioKOM") ("kom.mds.mdh.se" . "MdS-KOM") ("kom.stacken.kth.se" . "TokKOM") ("kom.cd.chalmers.se" . "CD-KOM")) "*An alist mapping server names to shorter identification strings") (def-kom-var kom-ansaphone-on nil "t if automatic replies to personal messages are in effect." local) (def-kom-var kom-ansaphone-record-messages t "*t if messages are recorded while the ansaphone is on." server) (def-kom-var kom-ansaphone-show-messages t "*t if messages are to be shown when they are recorded." server) (def-kom-var lyskom-ansaphone-messages nil "Messages collected by the automatic reply facility. The most recent message is the first message in the list." local) (def-kom-var lyskom-ansaphone-when-set (current-time-string) "Time when the auto-reply facility was enabled." local) (def-kom-var kom-remote-control t "*t if LysKOM may be remotely controlled." server) (def-kom-var kom-remote-controllers nil "*Persons who may control LysKOM using messages.By default you can always control your own sessions. See kom-self-control for more information." server) (def-kom-var kom-self-control t "*If non-nil, remote control commands are accepted from sessions logged in as the same user as the current session." server) (def-kom-var kom-ansaphone-replies '((group nil nil nil nil) (common nil nil nil nil)) "*List of automatic replies to various messages. A list of (MESSAGE-TYPE SENDER RECIPIENT TEXT REPLY) MESSAGE-TYPE is one of personal, group or common or nil SENDER is a list of integers or a single integer or nil RECIPIENT is a list of integers or a single integer or nil TEXT is a regular expression or nil REPLY is a string or nil When an incoming message arrives and the auto-reply facility is on, this list is checked for automatic replies. The message type, sender, recipient and text of the incoming messages is matched against the elements of this list. If a match is found, the corresponding reply is send. A nil in one of the message-type, sender, recipient or text components in the list is taken to mean a wildcard. A null reply means don't send a reply. If none of the elements match, KOM-ANSAPHONE-DEFAULT-REPLY is sent." server) (def-kom-var kom-default-language nil "*Which lagnuage to use for new sessions." server inherited protected) (def-kom-var lyskom-language nil ;; One might extend this into a list of languages, sorted in ;; preference order. "The language currently in use." local inherited protected) (def-kom-var lyskom-edit-mode-map nil "Mode map for LysKOM edit." local) (def-kom-var lyskom-edit-prefix nil "Mode-map for lyskom edit mode.") (def-kom-var lyskom-customize-map nil "Keymap for the customize buffer" local) ;;; ================================================================= ;;; ;;; Language-dependent variables ;;; (def-kom-var lyskom-onoff-table nil "A completion table for on and off selections." local) (def-kom-var lyskom-language-codes nil "A list of ISO 639 language codes" local) (put 'lyskom-language-codes 'lyskom-language-force t) (def-kom-var lyskom-filter-predicate-list nil "A list of legal filter comparison predicates." local) (def-kom-var lyskom-filter-what nil "A list of legal filter conditions and their textual representation." local) (def-kom-var lyskom-filter-actions nil "A list of legal filter actions an their textual representation." local) (def-kom-var lyskom-text-start nil "Regexp matching beginning of a text in lyskom buffer. Cf. paragraph-start.") (def-kom-var lyskom-filter-edit-map nil "Keymap for LysKOM filter edit" local) (def-kom-var lyskom-prioritize-mode-map nil "Keymap used in lyskom-prioritize-mode." local) (def-kom-var lyskom-prioritize-header-lines nil "Number of lines in the header of the prioritization buffer" local) (def-kom-var lyskom-prioritize-header nil "Header for the reprioritization buffer" inherited) (def-kom-var kom-ansaphone-default-reply nil "*Default message to send when the ansaphone is on." server) (def-kom-var kom-ispell-dictionary nil "*Dictionary to use for spell checking." server) (def-kom-var lyskom-button-actions nil "This variable defines valid button types in LysKOM. Each element is a list consisting of (TYPE LABEL DEFAULT ACTIONS HINTS). TYPE is the button type the entry defines LABEL is a textual representation for the button type, used in menu titles. If it is a symbol, that symbol will be looked up using lyskom-get-string. DEFAULT is the default action to take on a click. It must be a function. ACTIONS are other possible actions. The format of this entry is described below. HINTS is a list of hints to override the default action. This is described below. The ACTIONS entry is used to construct a pop-up menu. It is a list consisting of lists with the format (STRING . FUNCTION). STRING is the menu label and FUNCTION is the function to call when the menu item is selected. The HINTS entry is used to generate hints that the default action should be overridden. It is a list containing elements (COMMAND . HINT) where COMMAND is as interactive LysKOM command and HINT is a function to call. When a button is generated while the command COMMAND is being executed, HINT is used as a hint for a new default action. The user has the option to ignore or used the hint. Also see the function \"lyskom-add-button-action\"." local) (put 'lyskom-button-actions 'lyskom-language-force t) (def-kom-var kom-mercial nil "*When the user has seen all texts and has reached the view-time prompt, this string is used as the argument to lyskom-tell-server. Users are encouraged to use their best sense of humor." server) ;;; ================================================================= ;;; ;;; Inherited variables ;;; ;(eval-and-compile ; (def-kom-var lyskom-inherited-variables ; '( ; lyskom-buffer ; lyskom-proc ; lyskom-accept-async-flag ; lyskom-dynamic-session-info-flag ; lyskom-idle-time-flag ; lyskom-long-conf-types-flag ; lyskom-set-last-read-flag ; lyskom-uconf-stats-flag ; lyskom-z-lookup-flag ; lyskom-server-supports ; lyskom-collate-table ; lyskom-server-name ; lyskom-language ; ) ; "Variables that all buffers associated with a LysKOM buffer inherit.")) ;(eval-and-compile ; (def-kom-var lyskom-protected-variables ; (append '(lyskom-reset-var ; lyskom-dedicated-frame ; kill-buffer-hook ; lyskom-buffer-type ; lyskom-saved-window-configuration) ; lyskom-inherited-variables) ; "Variables that need to be permanent local variables.")) ;(mapcar 'lyskom-protect-variable ; lyskom-protected-variables) (defconst lyskom-commands '( describe-mode kom-slow-mode kom-quick-mode kom-send-message kom-create-conf kom-delete-conf kom-delete-text kom-display-time kom-go-to-conf kom-go-to-next-conf kom-jump kom-list-conferences kom-list-persons kom-list-news kom-list-re kom-membership ;; kom-list-marks kom-postpone kom-set-session-priority kom-prioritize kom-status-person kom-status-conf kom-add-self kom-list-summary kom-sub-self kom-quit kom-recover kom-start-anew kom-view kom-find-root-review kom-review-comments kom-review-tree kom-review-clear kom-review-last-normally-read kom-review-noconversion kom-review-next kom-find-root kom-review-by-to kom-review-more kom-review-first kom-review-all kom-view-commented-text kom-view-previous-commented-text kom-review-stack kom-review-presentation kom-review-backward kom-view-next-text kom-who-is-on kom-who-am-i ;; kom-display-who-buffer kom-list-clients kom-busy-wait kom-write-comment kom-comment-previous kom-write-footnote kom-private-answer kom-private-answer-previous kom-set-unread kom-write-text kom-send-letter kom-change-name kom-change-password kom-change-supervisor kom-change-presentation kom-get-appreciation kom-get-abuse kom-mark-text kom-unmark-text kom-review-marked-texts kom-review-all-marked-texts kom-add-recipient kom-add-copy kom-sub-recipient kom-move-text kom-add-comment kom-sub-comment kom-add-member kom-sub-member kom-change-conf-motd kom-set-garb-nice kom-set-super-conf kom-set-permitted-submitters kom-unset-conf-motd kom-save-text kom-edit-options kom-save-options kom-shutdown-server kom-sync-database kom-enable-adm-caps kom-disable-adm-caps kom-set-motd kom-remove-motd kom-force-logout kom-filter-author kom-filter-subject kom-filter-text kom-super-jump kom-filter-edit kom-list-filters kom-show-user-area kom-change-conf-type kom-change-auto-reply kom-toggle-auto-reply kom-list-messages kom-erase-messages kom-remote-autoreply kom-remote-set-message kom-remote-list-messages kom-remote-erase-messages kom-remote-quit kom-status-session kom-customize kom-change-language kom-calculate kom-next-kom kom-previous-kom kom-next-unread-kom )) ;(defconst lyskom-elisp-variables ; '(kom-permissive-completion ; kom-bury-buffers ; kom-ding-on-new-letter ; kom-ding-on-personal-messages ; kom-ding-on-group-messages ; kom-ding-on-common-messages ; kom-ding-on-priority-break ; kom-ding-on-wait-done ; kom-show-personal-messages-in-buffer ; kom-pop-personal-messages ; kom-user-prompt-format ; kom-user-prompt-format-executing ; kom-enabled-prompt-format ; kom-enabled-prompt-format-executing ; kom-do-when-done ; kom-higher-priority-breaks ; kom-login-hook ; kom-membership-default-placement ; kom-membership-default-priority ; kom-mercial ; kom-inhibit-typeahead ; kom-page-before-command ; kom-continuous-scrolling ; kom-permanent-filter-list ; kom-presence-messages-in-buffer ; kom-quit-hook ; kom-show-where-and-what ; kom-who-buffer-size-when-displaying ; kom-default-message-recipient ; kom-write-texts-in-window ; kom-edit-filters-in-window ; kom-list-membership-in-window ; kom-prioritize-in-window ; kom-customize-in-window ; kom-customize-format ; kom-cite-string ; kom-remote-control ; kom-remote-controllers ; kom-self-control ; kom-ansaphone-default-reply ; kom-ansaphone-replies ; kom-ansaphone-record-messages ; kom-ansaphone-show-messages ; kom-show-footnotes-immediately ; kom-follow-comments-outside-membership ; kom-friends ; kom-check-commented-author-membership ; lyskom-fetch-map-nos ; lyskom-new-text-hook ; lyskom-prefetch-conf-tresh ; lyskom-prefetch-confs ; lyskom-who-info-has-changed-hook ; lyskom-language) ; "Tells the client what flags and hooks that are to be saved in the server. ;These are the flags that are saved in the elisp-client part of the server.") ;;; ================================================================ ;;; Internal variables and constants (defconst lyskom-clientversion "0.45.2" "Version of the LysKOM elisp client.") (defconst lyskom-max-int 8388607 "The largest int emacs, and thus this LysKOM client, can handle.") (defconst lyskom-server-features '(((> 1 9 0) (lyskom-bcc-flag)) ((>= 1 9 0) (lyskom-accept-async-flag lyskom-dynamic-session-info-flag lyskom-idle-time-flag)) ((>= 1 8 0) (lyskom-long-conf-types-flag lyskom-set-last-read-flag lyskom-uconf-stats-flag)) ((>= 1 7 0) (lyskom-z-lookup-flag)) ((= 1 9 0) ((protocol-version 9))) ((= 1 8 0) ((protocol-version 8))) ((= 1 7 0) ((protocol-version 7))) ((= 1 7 1) ((protocol-version 7))) ((< 1 7 0) ((protocol-version 6)))) "List describing which features a certain server version has. Each element is a list containing the server version and what it supports: \(VERSION SUPPORTS\) VERSION is a list of \(RELATION MAJOR MINOR REVISION\) RELATION is one of >= \(features apply to server at or above the specified version\) or = \(features apply to only that server version\). MAJOR, MINOR and REVISION are integers that are compared to the actual server version. SUPPORTS is a list of cons pairs and symbols. Cons pairs are placed in the lyskom-server-supports list, symbols are interpreted as variable names set to 't'.") (def-kom-var lyskom-server-version '(0 0 0) "The version of the server. A list of three integers, major version, minor version and revision." local) (def-kom-var lyskom-server-supports nil "Assoc list of features supported by the LysKOM server. See lyskom-server-features for more information." inherited) (def-kom-var lyskom-idle-time-flag nil "t if idle time calls are supported by the server." inherited) (def-kom-var lyskom-dynamic-session-info-flag nil "t if dynamic session info is supported by the server." inherited) (def-kom-var lyskom-long-conf-types-flag nil "t if extended conf types are supported by the server." inherited) (def-kom-var lyskom-set-last-read-flag nil "t if the set-last-read call is supported by the server." inherited) (def-kom-var lyskom-uconf-stats-flag nil "t if the server supports the get-uconf-stat call." inherited) (def-kom-var lyskom-z-lookup-flag nil "t if the server supports regexp name lookups." inherited) (def-kom-var lyskom-accept-async-flag nil "t if the server supports the accept-async call." inherited) (def-kom-var lyskom-bcc-flag nil "t if the server supports the bcc misc items." inherited) (def-kom-var lyskom-max-packet-size lyskom-max-int "The largest possible packet size that can be transmitted to a TCP/IP connection. This should be unlimited, but in practise there are systems that limits this. This variable is automatically adjusted if any problems are detected.") (def-kom-var lyskom-pending-commands nil "Commands pending to be executed. When a command finishes, it checks this variable to see if another command should be run. It should be a lest where each element should be either a symbol or an expression. If it is a symbol it is invoked with `call-interactively', and an expression is evaluated with `eval'." local) (def-kom-var lyskom-do-when-done nil "Internal of kom-do-when-done." local) (def-kom-var lyskom-do-when-starting nil "Internal of kom-do-when-starting. Obsolete") (def-kom-var lyskom-sessions-with-unread nil "List of lyskom-sessions with unread texts. This is not buffer-local.") (def-kom-var lyskom-sessions-with-unread-letters nil "List of lyskom-sessions with unread letters. This is not buffer-local.") (def-kom-var lyskom-buffer nil "What is the lyskom-buffer we are connected to." inherited minibuffer) (def-kom-var lyskom-buffer-type nil "What type of buffer is the current buffer." local protected) (def-kom-var output nil "Uaark. Just to omit a warning...") (def-kom-var lyskom-errno nil "Errno of last lyskom error." local) (def-kom-var lyskom-parse-pos nil "Position of parsing.") (def-kom-var lyskom-unparsed-buffer nil "Buffer containing unparsed information from the server." local) (def-kom-var lyskom-unparsed-marker nil "Here are we inserting now." local) (def-kom-var lyskom-to-be-printed-before-prompt nil "Contains the strings to be printed out before the next prompt." local) (def-kom-var lyskom-other-clients-user-areas nil "Contains the parts of the user areas of unknown klients. The area is a pair: name . info (both strings)." local) (def-kom-var lyskom-pending-calls nil "Assoc-list of calls to LysKOM server that have not yet completed. Each element on the list has the format (REF-NO . KOM-QUEUE) REF-NO unique number assigned by lyskom-send-packet. KOM-QUEUE is a kom-queue. (See lyskom-call-data)." local) (def-kom-var lyskom-output-queues nil "Pending output to the server. This is a vector of ten elements, each of which is a kom-queue. calls from queues with a higher index (priority) are always sent first. At most lyskom-max-pending-calls calls are sent at once." local) (def-kom-var lyskom-max-pending-calls 20 "*Max number of calls that are transmitted to the server at once. Extra calls are queued in lyskom-output-queue and sent when the replies returns. This variable is not saved in the LysKOM server.") (def-kom-var lyskom-number-of-pending-calls 0 "Number of pending calls that are transmitted to the server." local) (def-kom-var lyskom-ref-no 0 "Next ref-no to use. These ref-nos are used to keep track of the different packets.") (def-kom-var lyskom-pers-no 0 "The pers-no of the current user." inherited) (def-kom-var lyskom-session-no 0 "Session number in the server for this connection" local) (def-kom-var lyskom-session-priority 0 "*This sessions priority. Only texts in conferences with a priority equal to or higher than this will be shown." local) (def-kom-var lyskom-proc nil "The process (network connection) that is associated with this buffer." inherited minibuffer) (def-kom-var lyskom-server-info nil "Info about the server" local) (def-kom-var lyskom-server-name "" "The name of the server" inherited) (def-kom-var lyskom-buffer-list nil "List of all LysKOM buffers.") (def-kom-var lyskom-static-session-info-cache nil "Cache of session." local) (def-kom-var lyskom-conf-cache nil "Cache of conference statuses." local) (def-kom-var lyskom-uconf-cache nil "Cache of small conference statuses." local) (def-kom-var lyskom-pers-cache nil "Cache of person statuses." local) (def-kom-var lyskom-text-cache nil "Cache of text statuses." local) (def-kom-var lyskom-text-mass-cache nil "Cache of texts." local) (def-kom-var lyskom-marked-text-cache nil "Cache of marks of all texts the current user has marked. " local) (def-kom-var lyskom-who-info-cache nil "Cache of people presently logged in in LysKOM." local) (def-kom-var lyskom-who-info-buffer nil "Buffer for the who info presentation." local) (def-kom-var lyskom-who-info-buffer-is-on nil "Says wether we are collecting who-information or not." local) (def-kom-var lyskom-is-parsing t "True when parsing a result. This is used to prevent parallell parsing since the parser is not reentrant." local) (def-kom-var lyskom-string-bytes-missing 0 "Number of bytes missing in the unparsed buffer when parsing a string. Set when parsing a string and there were not enough bytes in the buffer with the unparsed bytes. This variable is used to prevent reparsing before the string is complete. This variable is buffer-local in the unparsed-buffer.") (def-kom-var lyskom-last-viewed 0 ; "Postition of the first char of the last line that the user has had time to view. This is normally the pos of the first char of the prompt." local) (def-kom-var lyskom-mode-map nil "Keymap used in LysKOM mode." local) (def-kom-var lyskom-reading-list nil "List of articles to read in the current conference. Each element is a read-info. Only one of the elements is of the type CONF. This one is located last in the list (except for the elements of the type REVIEW, REVIEW-TREE or REVIEW-MARK). When reading an article with comments a list of the comments is built recursively if the flag kom-read-depth-first is non-nil. This is to keep track of the reading order. Articles can exist in several of the read-info elements. All unread articles in the conference are always present in the CONF type entry in this list even if also in other entries. (COMM-IN, FOOTN-IN) Some powerful reviewing commands requires to construct a list of articles that should be read. These use the type REVIEW. When reviewing trees and when every viewed article is supposed to be followed by all its comments then the type REVIEW-TREE is used. The first element is a dummy." local) (def-kom-var lyskom-to-do-list nil "List of conferences with unread texts. Each element is a read-info. All have the type 'CONF and there is one for every conference with unread articles that have been prefetched already. The list is sorted in falling priority. When going to a conference the first element (the one with the highest priority) is copied from this list to lyskom-reading-list. The first element is a dummy." local) (def-kom-var lyskom-quit-flag nil "A flag indicating if the filter was interrupted by C-g. It is set to the same value as quit-flag on filter exit.") (def-kom-var lyskom-inhibit-minibuffer-messages nil "A flag indicating whether asynchronous minibuffer messages are allowed. If this variable is non-nil, no asynchronous messages will appear.") (def-kom-var lyskom-is-saving nil "A flag indicating whether the server is saving at the moment.") ;;; These variables control prefetch of conf-stats, text-stats and texts: (def-kom-var lyskom-prefetch-conf-tresh 50 "*If fewer than lyskom-prefetch-conf-tresh texts are known, ask for more conf-stats from server. This is currently not used." server) (def-kom-var lyskom-prefetch-confs 10 "*Number of confs to ask about at once when checking for unread texts. This is currently not used." server) (def-kom-var lyskom-fetch-map-nos 50 "*Number of text-nos lyskom will fetch when fetching maps." server) (def-kom-var lyskom-fetch-membership-length 6 "*Number of entries in the membership-list that is fetched at a time. This should be optimized depending on how often you read lyskom and the activity in the first groups in you membership list. Best performance is achieved if you, when logging in, always have an unread article in one of the first lyskom-fetch-membership-length conferences.") (def-kom-var lyskom-prefetch-limit 10 "Number of prefetch requests the client will try to keep going at a time.") ;;; (def-kom-var lyskom-membership nil "Sorted membership-list of the logged in person." local) (def-kom-var lyskom-unread-confs nil "List containing all unread confs." local) (def-kom-var lyskom-dont-change-prompt nil "Non-nil during the entry of a text." local) (def-kom-var lyskom-command-to-do 'unknown "Atom describing what command to do. See the function lyskom-what-to-do." local) (def-kom-var lyskom-is-waiting nil "If non-nil then this is the condition for the waiting to be stopped. If t however just meaning user is waiting for a text with prompt. It is a form that will be evaluated (using eval) every time the asynchronous message \"new text\" is received. This is used by the command kom-busy-wait." local) (def-kom-var lyskom-current-conf 0 "Current conference. 0 means user is not reading any conf." local) (def-kom-var lyskom-current-text nil "Text-no of current text. nil means no text is current." local) (def-kom-var lyskom-last-written nil "Text-no of last text written. nil means no text written." local) (def-kom-var lyskom-previous-text nil "Text-no of previous text. Nil means no text." local) (def-kom-var lyskom-normally-read-texts nil "Stack of texts that are read normally. Used for kom-review-last-normally-read." local) (def-kom-var lyskom-current-subject "" "Current subject." local) (def-kom-var lyskom-last-added-rcpt 0 "The default conference when adding a recipient.") (def-kom-var lyskom-last-added-ccrcpt 0 "The default conference when adding a ccrecipient.") (def-kom-var lyskom-last-added-bccrcpt 0 "The default conference when adding a bccrecipient.") (def-kom-var lyskom-saved-file-name (concat default-directory "kom-text") "The default file name when saving a lyskom-text.") (def-kom-var lyskom-mode-hook nil "*Hook to run when lyskom-mode is entered.") (def-kom-var kom-quit-hook nil "*Hook to run when the LysKOM session is correctly ended." server) (def-kom-var kom-quit-when-idle t "Non-niil to automatically quit when LysKOM is full and the session is idle") (def-kom-var kom-permanent-filter-list nil "List of patterns to filter permanently" server) (def-kom-var kom-session-filter-list nil "List of patterns to filter during this session" local) (def-kom-var lyskom-filter-list nil "List of patterns that are filtered." local) (def-kom-var lyskom-new-text-hook nil "*Hook to run when a new text is created. This hook is run after the prompt is removed if it shall be changed but before the text Text 4711 {r skapad! is printed in the message area. And before the new prompt is printed. If the text: Text 4711 {r skapad! should not be printed then the hook should set the local variable no-message non-nil." server) (def-kom-var lyskom-who-info-has-changed-hook nil "*Hook to run every time the who-info-buffer has changed. The hook is run with current-buffer the lyskom buffer, not the who-info-buffer." server) (def-kom-var lyskom-personal-message-hook nil "*Hook to run when a personal message is received. When the hook is run 'sender' is bound to the pers-stat of the sender of the message (or possibly nil), 'recipient' is 0 if the message is a public message and otherwise the pers-no of the user, and 'message' is a string that holds the message.") (def-kom-var lyskom-executing-command t "Non-nil means the client is executing a command. Most commands can't be interrupted by another command." local) (def-kom-var lyskom-current-command nil "The command currently being executed." local) (def-kom-var lyskom-current-function nil "Sometimes set to the current high-level function being executed." local) (def-kom-var lyskom-current-function-phase nil "Sometimes set to the phase of the curreht high-level function being executed." local) (def-kom-var kom-low-priority -1 "*Priority that the current conference are set to when they are aborted. nil means don't alter priority. (That means that kom-go-to-next-conf might go to the same conference again.)") (def-kom-var lyskom-membership-is-read nil "T when the membership has been read." local) (def-kom-var lyskom-is-writing nil "t when the user is writing a text." local) (def-kom-var lyskom-debug-communications-to-buffer nil "Non-nil means all communications with the server is stored in a buffer. The name is stored in lyskom-debug-communications-to-buffer-buffer.") (def-kom-var lyskom-debug-what-i-am-doing t "Non-nil means asynchronous message 5 will be logged to the debug buffer. ") (def-kom-var lyskom-debug-communications-to-buffer-buffer "*kom*-debugs" "Name of the buffer to insert the communications with the server into if lyskom-debug-communications-to-buffer is non-nil.") (def-kom-var lyskom-doing-default-command nil "Non-nil if LysKOM is executing the default command." local) (def-kom-var lyskom-first-time-around nil "Non-nil if LysKOM is being entered for the first time." local) (def-kom-var lyskom-experimental-features nil "If non-nil, LysKOM is likely to blow up in your face." local) (def-kom-var lyskom-format-experimental nil "If non-nil, LysKOM is likely to make a fool out of you." local) (def-kom-var lyskom-count-var 0 "This variable is used for counting things in the client, such as unread texts in list-unread." local) (def-kom-var lyskom-default-conf-string nil "The default string to use for an unknown conference. Set this locally when inserting a conference name using lyskom-format-insert if you want to replace the usual description of an unknown conference.") (def-kom-var lyskom-default-pers-string nil "The default string to use for an unknown person Set this locally when inserting a conference name using lyskom-format-insert if you want to replace the usual description of an unknown person.") (def-kom-var lyskom-is-administrator nil "This variable is t if the user is in administrator mode and nil otherwise." local) (def-kom-var lyskom-last-personal-message-sender "" "Name of sender of last personal message received" local) (def-kom-var lyskom-last-group-message-recipient "" "Name of target for last group message received" local) (def-kom-var lyskom-is-new-user nil "An internal variable used in kom-start-anew") (def-kom-var lyskom-apo-timeout-s 1 "Seconds timeout for accept-process-output") (def-kom-var lyskom-apo-timeout-ms nil "Microseconds timeout for accept-process-output") (def-kom-var lyskom-collate-table nil "Table mapping characters to equivalent characters." inherited) (def-kom-var lyskom-dont-read-user-area nil "If non-nil the user area will not be read on login." local) (def-kom-var lyskom-allow-missing-subject nil) (def-kom-var lyskom-show-comments t "This should always be set to t.") ;+++SOJGE (def-kom-var kom-no-comments-to-motd nil "This should always be set to nil unless you are Klaus Zeuge.") ;+++SOJGE (def-kom-var lyskom-format-special '((html . lyskom-format-html) (enriched . lyskom-format-enriched)) "AList of (FORMAT . FUNCTION) specifying functions that format texts of that type. FORMAT is a symbol and FUNCTION is a function taking one argument and returning a formatted string.") (def-kom-var lyskom-send-text-transform-function nil "Function to call to transform text before sending it to the server. The function should accept a single argument and return the transformed texts that is to be sent to the server.") (def-kom-var lyskom-slow-mode nil "Non-nil when in slow mode" local) (def-kom-var lyskom-saved-read-only nil "Saved value of buffer-read-only when in slow mode." local) (defvar lyskom-line-start-chars-string "\"$&'()*+-./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]_`abcdefghijklmnopqrstuvwxyz¡£¤¥§©ª«­®±²³µ¶¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ" "Characters that may start a line in a paragraph to be broken.") (def-kom-var lyskom-line-start-chars nil "Computer-friendly version of lyskom-line-start-string") (def-kom-var lyskom-last-text-format-flags nil "List of flags specifying how the last text was reformatted. This variable should be dynamically bound whenever it needs to be used.") ;;; ====================================================================== ;;; Event hooks ;;; (def-kom-var lyskom-add-membership-hook nil "Functions to call when a membership is added" local-hook) (def-kom-var lyskom-replace-membership-hook nil "Functions to call when a membership is replaced" local-hook) (def-kom-var lyskom-remove-membership-hook nil "Functions to call when a membership is removed" local-hook) (def-kom-var lyskom-new-membership-list-hook nil "Functions to call when the entire membership list is replaced." local-hook) ;;; ====================================================================== ;;;; lyskom-tell-phrases-validation-keyword-list ;;; This is a list of keywords for kom-tell-phrases. ;;; These are the only keywords that are allowed in kom-tell-phrases. ;;; To coders of the elisp-client: ;;; If you add/delete a reference to any of these keywords make sure ;;; you update these changes. ;;; To everyone: ;;; The kom-tell-phrases list is checked against this list when the ;;; client is loaded, i.e. by lyskom-tell-phrases-validate that causes ;;; an error if any keyword is not present or any non-keyword is ;;; present. (defconst lyskom-tell-phrases-validation-keyword-list '( (kom-tell-silence) (kom-tell-send) (kom-tell-login) (kom-tell-read) (kom-tell-1st-pres) (kom-tell-write-comment) (kom-tell-write-footnote) (kom-tell-write-letter) (kom-tell-write-reply) (kom-tell-write-text) (kom-tell-conf-pres) (kom-tell-recover) (kom-tell-wait) (kom-tell-regret) (kom-tell-review) (kom-tell-change-name) (kom-tell-change-supervisor) (kom-tell-next-lyskom) ) "Users must not change this constant, but are encouraged to change the value of kom-tell-phrases for fun.") ;;; ================================================================ ;;; Commands lists that are removed from extended command depending on ;;; administrator status. (defconst lyskom-admin-removed-commands '(kom-enable-adm-caps)) (defconst lyskom-noadmin-removed-commands '(kom-disable-adm-caps kom-remove-motd kom-set-motd kom-shutdown-server kom-sync-database)) ;;; ================================================================ ;;; Externally defined variables (environment) (def-kom-var lyskom-default-server "kom.lysator.liu.se" "*Default LysKOM server.") (def-kom-var lyskom-default-user-name nil "*Default LysKOM user name." local) (def-kom-var lyskom-default-password nil "Default LysKOM PASSWORD." local) (def-kom-var mode-line-conf-name nil "Conf name that is present on the mode-line." local) ;; ;; Set up default faces in case no face scheme is selected ;; (def-kom-var lyskom-faces '(kom-active-face kom-url-face kom-me-face kom-highlight-face kom-text-face kom-subject-face kom-text-no-face kom-friends-face kom-presence-face kom-first-line-face) "This is a list of the faces that LysKOM uses.") (def-kom-var lyskom-face-schemes '((default (kom-active-face default "blue4" nil) (kom-url-face default "BlueViolet" nil) (kom-me-face bold "blue3" "lavender") (kom-highlight-face highlight nil) (kom-text-face default nil nil) (kom-subject-face default nil nil) (kom-text-no-face kom-active-face nil nil) (kom-friends-face default "blue3" "lavender") (kom-presence-face italic "dim gray" nil) (kom-first-line-face default nil nil)) (inverse (kom-active-face default "lightblue" nil) (kom-url-face default "Moccasin" nil) (kom-me-face bold "gold" "black") (kom-highlight-face highlight nil nil) (kom-text-face default nil nil) (kom-subject-face default "Khaki" nil) (kom-text-no-face kom-active-face nil nil) (kom-friends-face default "red" nil) (kom-presence-face italic "grey" nil) (kom-first-line-face default nil nil)) (monochrome (kom-active-face default nil nil) (kom-url-face default nil nil) (kom-me-face bold nil nil) (kom-highlight-face highlight nil nil) (kom-text-face default nil nil) (kom-subject-face default nil nil) (kom-text-no-face kom-active-face nil nil) (kom-friends-face underline nil nil) (kom-presence-face italic nil nil) (kom-first-line-face default nil nil)) (minimal (kom-active-face default nil nil) (kom-url-face default nil nil) (kom-me-face default nil "lavender") (kom-highlight-face highlight nil nil) (kom-text-face default nil nil) (kom-subject-face default nil nil) (kom-text-no-face default nil nil) (kom-friends-face default nil "alice blue") (kom-presence-face italic "dim gray" nil) (kom-first-line-face default nil nil)) (highlight (kom-active-face default nil "aliceblue") (kom-url-face default nil "yellow") (kom-me-face bold "darkblue" "thistle") (kom-highlight-face highlight nil nil) (kom-text-face default nil nil) (kom-text-no-face default nil nil) (kom-friends-face default "darkblue" "thistle") (kom-subject-face default nil nil) (kom-presence-face italic "dim gray" nil) (kom-first-line-face default nil "lavender"))) "Face schemes for LysKOM. This variable is an association list that defines the face and color schemes in LysKOM. The car of each element is the scheme key, a symbol, and the cdr is a list of face definitions. Each face definition in tur, is a list of four elements: the face name, the base face, foreground color and background color. When LysKOM defines a face from such a specification, the base face is first copied and then the foreground and background colors are set. If it permissible to substitute nil for any element except the face name. For instance, (kom-me-face bold \"yellow\" \"red\") will cause kom-me-face to be bold with yellow text on a red background." ) ;;; ============================================================ ;;; History lists ;;; (defvar lyskom-command-history nil) (defvar lyskom-expression-history nil) (defvar lyskom-message-history nil) (defvar lyskom-language-history nil) ;;; ============================================================ ;;; MULE workaround (put 'enable-multibyte-characters 'permanent-local t) (provide 'lyskom-vars) ;;; vars.el ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: macros.el,v 44.14.2.2 1999/10/13 12:13:18 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: macros.el ;;;; ;;;; This file contains the macros which must be loaded before lyskom can ;;;; be compiled. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: macros.el,v 44.14.2.2 1999/10/13 12:13:18 byers Exp $\n")) ;;; ;;; Require parts of the widget package. We do this to avoid generating ;;; errors later on. This sucks. ;;; (require 'custom) (require 'widget) ;;; ====================================================================== ;;; lyskom-traverse - traverse a sequence. ;;; (defmacro lyskom-traverse (atom sequence &rest body) "Bind ATOM to each element in SEQUENCE and execute BODY. Value returned is always nil." (list 'let* (list '(__i__ 0) (list '__sequence__ sequence) '(__len__ (length __sequence__)) atom) (list 'if '(listp __sequence__) (append (list 'while '__sequence__ (list 'setq atom '(car __sequence__))) body (list '(setq __sequence__ (cdr __sequence__)))) (append (list 'while '(< __i__ __len__) (list 'setq atom '(aref __sequence__ __i__))) body (list '(setq __i__ (1+ __i__))))))) (put 'lyskom-traverse 'edebug-form-spec '(sexp form body)) ;;; ====================================================================== ;;; lyskom-save-excursion Does not save point and mark. ;;; (defmacro lyskom-save-excursion (&rest forms) "Save-excursion without saving point and mark." (list 'let (list '(__buffer__ (current-buffer))) (list 'unwind-protect (cons 'progn forms) '(set-buffer __buffer__)))) (put 'lyskom-save-excursion 'edebug-form-spec t) (put 'lyskom-provide-macro 'lisp-indent-hook 2) ;;; ====================================================================== ;;; Some useful macros to make the code more readable. ;;; (defmacro char-in-string (char string) "Return t if the character CHAR is member of STRING. Otherwise return nil." (list 'null (list 'not (list 'string-match (list 'regexp-quote (list 'char-to-string char)) string)))) (defmacro ++ (var) "Increment the variable VAR and return the value." (list 'setq var (list '1+ var))) (defmacro -- (var) "Decrement the variable VAR and return the value." (list 'setq var (list '1- var))) (defmacro when (expr &rest body) "Execute BODY if EXPR evaluates to non-nil" (list 'if expr (cons 'progn body))) (put 'when lisp-indent-function 1) (put 'when 'edebug-form-spec t) (defmacro unless (expr &rest body) "Execute BODY if EXPR evaluates to non-nil" (append (list 'if expr nil) body)) (put 'unless lisp-indent-function 1) (put 'unless 'edebug-form-spec t) ;;; ====================================================================== ;;; Multiple blocking read from server ;;; (defmacro blocking-do-multiple (bind-list &rest body) "Bind variables according to BIND-LIST and then eval BODY. The value of the last form in BODY is returned. Each element in BIND-LIST is a list (SYMBOL FORM) which binds SYMBOL to the result of the server call FORM, which is the same as used in blocking-do. All the forms in BIND-LIST are evaluated before and symbols are bound." (let ((bindsym 'multiple-bind-sym) (index 0)) (` (let (((, bindsym) (lyskom-blocking-do-multiple (list (,@ (mapcar (function (lambda (x) (` (list '(, (car (car (cdr x)))) (,@ (cdr (car (cdr x)))))))) bind-list)))))) (let ((,@ (mapcar (function (lambda (bpat) (prog1 (` ((, (car bpat)) (elt (, bindsym) (, index)))) (setq index (1+ index))))) bind-list))) (,@ body)))))) (put 'blocking-do-multiple 'edebug-form-spec '(sexp body)) (put 'blocking-do-multiple 'lisp-indent-function 1) ;;; ====================================================================== ;;; These macros do magic things to the compiler to avoid gratuitous ;;; compiler warnings. ;;; (eval-and-compile (defvar lyskom-expected-unresolved-functions nil)) (defmacro lyskom-external-function (fn) (` (eval-when-compile (setq lyskom-expected-unresolved-functions (cons (quote (, fn)) lyskom-expected-unresolved-functions))))) (defmacro lyskom-end-of-compilation () (` (eval-when-compile (progn (if (and (boundp 'byte-compile-unresolved-functions) (consp (car-safe byte-compile-unresolved-functions)) (symbolp (car-safe (car-safe byte-compile-unresolved-functions)))) (mapcar (function (lambda (x) (setq byte-compile-unresolved-functions (delq (assq x byte-compile-unresolved-functions) byte-compile-unresolved-functions)))) lyskom-expected-unresolved-functions)) (if lyskom-compatibility-definitions (message "Compatibility definitions: %s" (mapconcat '(lambda (sym) (symbol-name sym)) lyskom-compatibility-definitions ", "))))))) ;;; ================================================================ ;;; Faces (defmacro lyskom-make-face (name &rest body) (` (if (memq (, name) (face-list)) nil (,@ body)))) (put 'lyskom-make-face 'lisp-indent-function 1) (provide 'lyskom-macros) ;;; ============================================================ ;;; Keymap handling ;;; (defmacro lyskom-use-local-map (keymap) "Use keymap KEYMAP as local map in this buffer. KEYMAP is made local in the current buffer, and its value is copied from the LysKOM buffer." (` (progn (make-local-variable (quote (, keymap))) (setq (, keymap) (lyskom-default-value (quote (, keymap)))) (use-local-map (, keymap))))) ;;; ============================================================ ;;; Widget gunk ;;; (defmacro lyskom-widget-wrapper (fn) (` (if (not (fboundp (quote (, fn)))) (defun (, fn) (&rest args) (require 'custom) ; lww (require 'widget) ; lww (require 'wid-edit) ; lww (require 'wid-browse) ; lww (require 'cus-edit) ; lww (require 'cus-face) ; lww (apply (quote (, fn)) args))))) (lyskom-widget-wrapper define-widget) (lyskom-widget-wrapper widget-at) (lyskom-widget-wrapper widget-value) (lyskom-widget-wrapper widget-button-click) (lyskom-widget-wrapper widget-setup) (lyskom-widget-wrapper widget-value-set) (lyskom-widget-wrapper widget-insert) (lyskom-widget-wrapper widget-create) (lyskom-widget-wrapper widget-get) (lyskom-widget-wrapper widget-put) ;;; ============================================================ ;;; Signal gunk ;;; (defmacro lyskom-ignore-errors (&rest forms) (` (condition-case nil (progn (,@ forms)) (error nil)))) (put 'ignore-errors 'edebug-form-spec '(sexp form body)) ;;; ============================================================ ;;; Local variables ;;; (defmacro lyskom-setq-default (name value) (` (lyskom-set-default (quote (, name)) (, value)))) ;;; Local Variables: ;;; eval: (put 'lyskom-traverse 'lisp-indent-hook 2) ;;; eval: (put 'lyskom-save-excursion 'lisp-indent-hook 2) ;;; eval: (put 'lyskom-ignore-errors 'lisp-indent-hook 2) ;;; end: ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: compatibility.el,v 44.13.4.2 1999/10/13 12:12:57 byers Exp $ ;;;;; Copyright (C) 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: compatibility.el ;;;; ;;;; This file contains functions that may not exist in all supported ;;;; versions of Gnu Emacs. XEmacs-specific and Emacs 18-specific code ;;;; should go in some other file. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: compatibility.el,v 44.13.4.2 1999/10/13 12:12:57 byers Exp $\n")) ;;; ====================================================================== ;;; Use lyskom-provide to supply a definition that is only to be used ;;; if no definition already exists. The definition will be evaluated at ;;; both compile and run time. ;;; ;;; lyskom-provide-macros behaves like defmacro ;;; lyskom-provide-function behaves like defun ;;; lyskom-provide-subst behaves like defsubst ;;; (eval-and-compile (defvar lyskom-compatibility-definitions nil "Functions defined or redefined because they are incompatible with LysKOM")) ;;; ============================================================ ;;; lyskom-compatibility-forms ;;; lyskom-compatibility-definition ;;; (defmacro lyskom-compatibility-forms (predicate &rest forms) "If PREDICATE is nil, evaluate FORMS at compile and run time" (` (eval-and-compile (if (not (, predicate)) (progn (,@ forms)))))) (defmacro lyskom-compatibility-definition (predicate definition) "If PREDICATE is nil, evaluate DEFINITION at compile and run time. Definition should be a function definition of some kind, with syntax similar to defun or defmacro. To simply define a function if it is not already defined, used one of the lyskom-provide-* functions instead." (` (progn ;(eval-when-compile ; (if (not (, predicate)) ; (message "Compatibility %S for %S" ; (quote (, (car definition))) ; (quote (, (car (cdr definition))))))) (eval-and-compile (if (not (, predicate)) (progn (, definition) (setq lyskom-compatibility-definitions (cons (quote (, (car (cdr definition)))) lyskom-compatibility-definitions)))))))) ;;; ============================================================ ;;; lyskom-provide ;;; lyskom-provide-macro ;;; lyskom-provide-function ;;; lyskom-provide-subst ;;; ;;; Define functions if they are not already defined ;;; (defmacro lyskom-provide (definer name rest) (` (progn ;(eval-when-compile ; (if (not (fboundp (quote (, name)))) ; (message "Compatibility %S for %S" ; (quote (, definer)) ; (quote (, name))))) (eval-and-compile (if (not (fboundp (quote (, name)))) (progn (setq lyskom-compatibility-definitions (cons (quote (, name)) lyskom-compatibility-definitions)) ((, definer) (, name) (,@ rest)))))))) (defmacro lyskom-provide-macro (name &rest rest) "If NAME is not already defined, define it as a macro." (` (lyskom-provide defmacro (, name) (, rest)))) (defmacro lyskom-provide-function (name &rest rest) "If NAME is not already defined, define it as a function." (` (lyskom-provide defun (, name) (, rest)))) (defmacro lyskom-provide-subst (name &rest rest) "If NAME is not already defined, define it as a defsubst." (` (lyskom-provide defsubst (, name) (, rest)))) ;;; ============================================================ ;;; lyskom-xemacs-or-gnu ;;; (defmacro lyskom-xemacs-or-gnu (xemacs-form gnu-form) "Eval XEMACS-FORM in XEmacs and GNU-FORM in Gnu Emacs." (` (if (string-match "XEmacs" (emacs-version)) (, xemacs-form) (, gnu-form)))) ;;; ====================================================================== ;;; ====================================================================== ;;; ====================================================================== ;;; (lyskom-provide-macro byte-code-function-p (obj) (` (compiled-function-p (, obj)))) (lyskom-provide-function characterp (obj) (integerp obj)) (lyskom-compatibility-forms (fboundp 'frame-width) (fset 'frame-width 'screen-width)) ;;; ====================================================================== ;;; Definition of map-keymap that hopefully works like the one in XEmacs ;;; except that the sort-first argument is ignored. ;;; (lyskom-provide-function map-keymap (fn keymap &optional sort-first) (let ((r 0)) (cond ((vectorp keymap) (while (< r (length keymap)) (if (aref keymap r) (funcall fn r (aref keymap r))) (setq r (1+ r)))) (t (mapcar (function (lambda (x) (funcall fn (car x) (cdr x)))) (cdr keymap)))))) (lyskom-provide-function set-keymap-parent (keymap new-parent) (let ((tail keymap)) (while (and tail (cdr tail) (not (eq (car (cdr tail)) 'keymap))) (setq tail (cdr tail))) (if tail (setcdr tail new-parent)))) (defconst lyskom-xemacs-keysym '((mouse-1 . (button1)) (mouse-2 . (button2)) (mouse-3 . (button3)) (down-mouse-3 . (button3)) (C-å . (control aring)) (C-ä . (control adiaeresis)) (C-Å . (control Aring)) (C-Ä . (control Adiaeresis)) (å . aring) (Å . Aring) (ä . adiaeresis) (Ä . Adiaeresis))) (defconst lyskom-gnu-keysym '((C-å . (control å)) (C-ä . (control ä)) (C-Å . (control Å)) (C-Ä . (control Ä)) (å . ?\å) (Å . ?\Å) (ä . ?\ä) (Ä . ?\Ä) (ö . ?\ö) (Ö . ?\Ö))) (defun lyskom-keys (binding) (cond ((vectorp binding) (apply 'vector (mapcar 'lyskom-keysym binding))) (t binding))) (defun lyskom-keysym (sym) "Look up the proper symbol to bind sym to" (lyskom-xemacs-or-gnu (or (cdr (assq sym lyskom-xemacs-keysym)) sym) (or (cdr (assq sym lyskom-gnu-keysym)) (let ((name (symbol-name sym))) (and (= (length name) 1) (elt name 0))) sym))) ;;; ============================================================ ;;; Text property and extents stuff ;;; (lyskom-provide-function map-extents (&rest args)) (lyskom-provide-function next-text-property-bounds (count pos prop &optional object) "Return the COUNTth bounded property region of property PROP after POS. If COUNT is less than zero, search backwards. This returns a cons \(START . END) of the COUNTth maximal region of text that begins after POS \(starts before POS) and has a non-nil value for PROP. If there aren't that many regions, nil is returned. OBJECT specifies the buffer or string to search in." (or object (setq object (current-buffer))) (let ((begin (if (stringp object) 0 (point-min))) (end (if (stringp object) (length object) (point-max)))) (catch 'hit-end (if (> count 0) (progn (while (> count 0) (if (>= pos end) (throw 'hit-end nil) (and (get-char-property pos prop object) (setq pos (next-single-property-change pos prop object end))) (setq pos (next-single-property-change pos prop object end))) (setq count (1- count))) (and (< pos end) (cons pos (next-single-property-change pos prop object end)))) (while (< count 0) (if (<= pos begin) (throw 'hit-end nil) (and (get-char-property (1- pos) prop object) (setq pos (previous-single-property-change pos prop object begin))) (setq pos (previous-single-property-change pos prop object begin))) (setq count (1+ count))) (and (> pos begin) (cons (previous-single-property-change pos prop object begin) pos)))))) ;;; ============================================================ ;;; Basic stuff (lyskom-provide-function char-to-int (c) c) (defvar enable-multibyte-characters nil) (lyskom-provide-function set-buffer-multibyte (arg) (put 'enable-multibyte-characters 'permanent-local t) (make-local-variable 'enable-multibyte-characters) (setq enable-multibyte-characters arg)) (lyskom-provide-function set-process-coding-system (proc &optional encoding decoding)) ;;; ====================================================================== ;;; Event stuff (lyskom-provide-function event-point (e) "Return the character position of the given mouse event. If the event did not occur over a window, or did not occur over text, then this returns nil. Otherwise, it returns an index into the buffer visible in the event's window." (car (cdr (event-start e)))) (lyskom-provide-function event-glyph (e)) (defun lyskom-get-buffer-window-list (buffer &optional minibuf frame) "Return windows currently displaying BUFFER, or nil if none. See `walk-windows' for the meaning of MINIBUF and FRAME." (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows) (walk-windows (function (lambda (window) (if (eq (window-buffer window) buffer) (setq windows (cons window windows))))) minibuf frame) windows)) (lyskom-provide-function window-list (&optional frame minibuf window) "Return a list of windows on FRAME, beginning with WINDOW. FRAME and WINDOW default to the selected ones. Optional second arg MINIBUF t means count the minibuffer window even if not active. If MINIBUF is neither t nor nil it means not to count the minibuffer even if it is active." (setq window (or window (selected-window)) frame (or frame (selected-frame))) (if (not (eq (window-frame window) frame)) (error "Window must be on frame.")) (let ((current-frame (selected-frame)) list) (unwind-protect (save-window-excursion (select-frame frame) (walk-windows (function (lambda (cur-window) (if (not (eq window cur-window)) (setq list (cons cur-window list))))) minibuf) (setq list (cons window list))) (select-frame current-frame)))) (lyskom-provide-function replace-in-string (str regexp newtext &optional literal) "Replaces all matches in STR for REGEXP with NEWTEXT string. Optional LITERAL non-nil means do a literal replacement. Otherwise treat \\ in NEWTEXT string as special: \\& means substitute original matched text, \\N means substitute match for \(...\) number N, \\\\ means insert one \\." (if (not (stringp str)) (error "(replace-in-string): First argument must be a string: %s" str)) (if (stringp newtext) nil (error "(replace-in-string): 3rd arg must be a string: %s" newtext)) (let ((rtn-str "") (start 0) (special) match prev-start) (while (setq match (string-match regexp str start)) (setq prev-start start start (match-end 0) rtn-str (concat rtn-str (substring str prev-start match) (cond (literal newtext) (t (mapconcat (function (lambda (c) (if special (progn (setq special nil) (cond ((eq c ?\\) "\\") ((eq c ?&) (substring str (match-beginning 0) (match-end 0))) ((and (>= c ?0) (<= c ?9)) (if (> c (+ ?0 (length (match-data)))) ;; Invalid match num (error "(replace-in-string) Invalid match num: %c" c) (setq c (- c ?0)) (substring str (match-beginning c) (match-end c)))) (t (char-to-string c)))) (if (eq c ?\\) (progn (setq special t) nil) (char-to-string c))))) newtext "")))))) (concat rtn-str (substring str start)))) (lyskom-provide-function buffer-live-p (object) "T of OBJECT is an editor buffer that has not been deleted." (and (bufferp object) (buffer-name object))) ;;; Local Variables: ;;; eval: (put 'lyskom-provide-macro 'lisp-indent-hook 2) ;;; eval: (put 'lyskom-provide-function 'lisp-indent-hook 2) ;;; eval: (put 'lyskom-provide-subst 'lisp-indent-hook 2) ;;; eval: (put 'lyskom-compatibility-forms 'lisp-indent-hook 2) ;;; eval: (put 'lyskom-compatibility-definition 'lisp-indent-hook 2) ;;; end: ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: language.el,v 44.10.2.2 1999/10/13 12:13:12 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: language.el ;;;; Author: Niels Möller ;;;; ;;;; (require 'lyskom-vars "vars") ;;; Variables ;;(defvar lyskom-language-symbols nil ;; "Symbols with language data bound to them") (defvar lyskom-languages nil "A alist of defined languages. Each entry is a pair (SYMBOL . (NAME NAME ...)) where symbol is the symbol used for identification, and the NAMEs are names of the language.") (defvar lyskom-language-categories nil "Categories used") (defvar lyskom-language-vars nil "A list of all language-dependent variables.") (defun lyskom-language-var-internal (var language val) "Defines a language-local variable value." (or (memq var lyskom-language-vars) (setq lyskom-language-vars (cons var lyskom-language-vars))) (let* ((alist (get var 'lyskom-language-var)) (entry (assq language alist))) (if entry (setcdr entry val) (put var 'lyskom-language-var (cons (cons language val) alist))))) (defmacro lyskom-language-var (var language val) (list 'lyskom-language-var-internal (list 'quote var) (list 'quote language) (list 'quote val))) (put 'lyskom-language-var 'lisp-indent-function 2) (defun lyskom-set-language-vars (language) (mapcar (function (lambda (var) (if (or (not (symbol-value var)) (get var 'lyskom-language-force)) (set var (eval (cdr (assq language (get var 'lyskom-language-var)))))))) lyskom-language-vars)) ;;; Keymaps (defvar lyskom-language-keymaps nil "A list of all language-dependent variables.") (defun lyskom-language-keymap-internal (keymap language langmap) "Defines a language-local variable value." ;; If the "real" keymap has no value, set it to an empty keymap (if (eval keymap) nil (set keymap (make-sparse-keymap))) ;; Add it to the list of keymaps (or (memq keymap lyskom-language-keymaps) (setq lyskom-language-keymaps (cons keymap lyskom-language-keymaps))) ;; Modify the property list (let* ((alist (get keymap 'lyskom-language-keymap)) (entry (assq language alist))) (if entry (setcdr entry langmap) (put keymap 'lyskom-language-keymap (cons (cons language langmap) alist))))) (defmacro lyskom-language-keymap (keymap language langmap) (list 'lyskom-language-keymap-internal (list 'quote keymap) (list 'quote language) (list 'quote langmap))) (put 'lyskom-language-keymap 'lisp-indent-function 2) (defun lyskom-set-language-keymaps (language) (mapcar (function (lambda (map) (set-keymap-parent (symbol-value map) (eval (cdr (assq language (get map 'lyskom-language-keymap))))))) lyskom-language-keymaps)) ;(defun lyskom-set-language-keymaps (language) ; (mapcar ; (function ; (lambda (map) ; (setcdr (symbol-value map) ; (eval (cdr (assq language ; (get map 'lyskom-language-keymap))))))) ; lyskom-language-keymaps)) ;;; String catalogs (defun lyskom-language-strings-internal (category language alist) "Associates names to symbols. CATEGORY and LANGUAGE determines what kind of association to create. ALIST is a mapping from symbols to strings." ;; Record category (or (memq category lyskom-language-categories) (setq lyskom-language-categories (cons category lyskom-language-categories))) (let ((record (get category 'lyskom-language-symbols))) (mapcar (function (lambda (pair) (let* ((symbol (car pair)) (string (cdr pair)) (llist (get symbol category)) (entry (assq language llist))) ;; Record symbol (or (memq symbol record) (setq record (cons symbol record))) (if entry (setcdr entry string) (put symbol category (cons (cons language string) llist)))))) alist) (put category 'lyskom-language-symbols record))) (defmacro lyskom-language-strings (category language alist) (list 'lyskom-language-strings-internal (list 'quote category) (list 'quote language) alist)) (put 'lyskom-language-strings 'lisp-indent-function 2) (defsubst lyskom-get-string-internal (symbol category) (cdr (assq lyskom-language (get symbol category)))) (defsubst lyskom-get-string-error (function symbol category) (signal 'lyskom-internal-error (list function (list symbol category ": string not found")))) (defun lyskom-get-string (symbol &optional category) "Returns string assiciated with SYMBOL" (or (lyskom-get-string-internal symbol (or category 'lyskom-message)) (lyskom-get-string-error 'lyskom-get-string symbol (or category 'lyskom-message)))) (defun lyskom-get-strings (symbols &optional category) "Returns an alist of (symbol . string) pairs according to CATEGORY and lyskom-language. Kind of inverse to lyskom-define-language." (mapcar (function (lambda (symbol) (cons symbol (lyskom-get-string symbol category)))) symbols)) (defun lyskom-get-menu-string (symbol) "Returns the name of a menu(item) Looks for the 'lyskom-menu category, or 'lyskom-command if 'lyskom-menu is not found." (or (lyskom-get-string-internal symbol 'lyskom-menu) (lyskom-get-string-internal symbol 'lyskom-command) (lyskom-get-string-error 'lyskom-get-menu-string symbol 'lyskom-menu))) (defun lyskom-string-check-category (category) "Returns list of names for the category, and their supported languages" (mapcar (function (lambda (symbol) (let ((info (get symbol category))) (if info (cons symbol (mapcar 'car info)))))) (get category 'lyskom-language-symbols))) (defun lyskom-define-language (language &rest names) (let ((match (assq language lyskom-languages))) (if match (setcdr match names) (setq lyskom-languages (cons (cons language names) lyskom-languages)))) (unless (and lyskom-language kom-default-language) (setq lyskom-language language) (setq kom-default-language language))) (defun lyskom-language-name (language) "Return the name of language code LANGUAGE in the current language." (save-excursion (when lyskom-buffer (set-buffer lyskom-buffer)) (or (cdr (assq language lyskom-language-codes)) (lyskom-format (cdr (assq '-- lyskom-language-codes)) (symbol-name language))))) (defun lyskom-set-language (language) "Set the current language to LANGUAGE." (cond ((not (assq language lyskom-languages)) (lyskom-format-insert-before-prompt 'language-not-loaded (lyskom-language-name language)) nil) (t (setq lyskom-language language) (lyskom-set-language-vars language) (lyskom-set-language-keymaps language) (lyskom-update-menus) (lyskom-update-prompt t) t))) (provide 'lyskom-language) ;;; language.el ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: swedish-strings.el,v 44.33.2.2 1999/10/13 12:13:33 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: swedish-strings.el ;;;; ;;;; This file contains all strings in the LysKOM elisp client. ;;;; Language: Swedish. ;;;; ;;;; ================================================================ ;;;; (require 'lyskom-vars "vars") (require 'lyskom-language "language") (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: swedish-strings.el,v 44.33.2.2 1999/10/13 12:13:33 byers Exp $\n")) ;;; ================================================================ ;;; The language definition (lyskom-define-language 'sv "Svenska") ;;; ================================================================ ;;; lyskom-edit-mode-map (defvar lyskom-sv-edit-mode-map nil) (lyskom-language-keymap lyskom-edit-mode-map sv lyskom-sv-edit-mode-map) ;;; Set the keymap for lyskom-edit-mode (defvar lyskom-sv-edit-prefix nil) (if lyskom-sv-edit-mode-map nil (setq lyskom-sv-edit-mode-map (make-sparse-keymap)) (define-prefix-command 'lyskom-sv-edit-prefix) (define-prefix-command 'lyskom-sv-edit-review-prefix) (define-prefix-command 'lyskom-sv-edit-insert-prefix) (define-key lyskom-sv-edit-mode-map "\C-c" 'lyskom-sv-edit-prefix) (define-key lyskom-sv-edit-mode-map "\C-c?" 'lyskom-help) (define-key lyskom-sv-edit-mode-map "\C-c}" 'lyskom-sv-edit-review-prefix) (define-key lyskom-sv-edit-mode-map "\C-c]" 'lyskom-sv-edit-review-prefix) (define-key lyskom-sv-edit-mode-map "\C-c\C-]" 'lyskom-sv-edit-review-prefix) (define-key lyskom-sv-edit-mode-map [(control c) (control })] 'lyskom-sv-edit-review-prefix) (define-key lyskom-sv-edit-prefix (lyskom-keys [C-Å]) 'lyskom-sv-edit-review-prefix) (define-key lyskom-sv-edit-prefix (lyskom-keys [C-å]) 'lyskom-sv-edit-review-prefix) (define-key lyskom-sv-edit-mode-map (lyskom-keys [mouse-2]) 'kom-button-click-or-yank) (define-key lyskom-sv-edit-mode-map (lyskom-keys [down-mouse-3]) 'kom-popup-menu) (define-key lyskom-sv-edit-mode-map [mouse-3] 'kom-mouse-null) (define-key lyskom-sv-edit-mode-map "\C-c*" 'kom-button-press) (define-key lyskom-sv-edit-mode-map "\C-c\C-i" 'lyskom-sv-edit-insert-prefix) (define-key lyskom-sv-edit-mode-map "\C-c\C-c" 'kom-edit-send) (define-key lyskom-sv-edit-mode-map "\C-c\C-s" 'kom-ispell-message) (define-key lyskom-sv-edit-mode-map "\C-c\C-k" 'kom-edit-quit) (define-key lyskom-sv-edit-mode-map "\C-c}?" 'lyskom-help) (define-key lyskom-sv-edit-mode-map "\C-c}\C-k" 'kom-edit-show-commented) (define-key lyskom-sv-edit-mode-map "\C-c}k" 'kom-edit-show-commented) (define-key lyskom-sv-edit-mode-map "\C-c\C-i?" 'lyskom-help) (define-key lyskom-sv-edit-mode-map "\C-c\C-i\C-k" 'kom-edit-insert-commented) (define-key lyskom-sv-edit-mode-map "\C-c\C-y" 'kom-edit-insert-commented) (define-key lyskom-sv-edit-mode-map "\C-c\C-i1" 'kom-edit-insert-digit-text) (define-key lyskom-sv-edit-mode-map "\C-c\C-i2" 'kom-edit-insert-digit-text) (define-key lyskom-sv-edit-mode-map "\C-c\C-i3" 'kom-edit-insert-digit-text) (define-key lyskom-sv-edit-mode-map "\C-c\C-i4" 'kom-edit-insert-digit-text) (define-key lyskom-sv-edit-mode-map "\C-c\C-i5" 'kom-edit-insert-digit-text) (define-key lyskom-sv-edit-mode-map "\C-c\C-i6" 'kom-edit-insert-digit-text) (define-key lyskom-sv-edit-mode-map "\C-c\C-i7" 'kom-edit-insert-digit-text) (define-key lyskom-sv-edit-mode-map "\C-c\C-i8" 'kom-edit-insert-digit-text) (define-key lyskom-sv-edit-mode-map "\C-c\C-i9" 'kom-edit-insert-digit-text) (define-key lyskom-sv-edit-mode-map "\C-c\C-i " 'kom-edit-insert-text) (define-prefix-command 'lyskom-sv-edit-add-prefix) (define-key lyskom-sv-edit-mode-map "\C-c\C-a" 'lyskom-sv-edit-add-prefix) (define-key lyskom-sv-edit-mode-map "\C-c\C-a\C-m" 'kom-edit-add-recipient) (define-key lyskom-sv-edit-mode-map "\C-c\C-a\C-k" 'kom-edit-add-comment) (define-key lyskom-sv-edit-mode-map "\C-c\C-a\C-e" 'kom-edit-add-copy) (define-key lyskom-sv-edit-mode-map "\C-c\C-a\C-f" 'kom-edit-move-text) (define-key lyskom-sv-edit-mode-map "\C-c\C-a?" 'lyskom-help)) ;;(defvar lyskom-header-separator ;; (substitute-command-keys ;; "\\\ ;;--- Skriv nedan. \ ;;Skicka in=\\[kom-edit-send], \ ;;Avbryt=\\[kom-edit-quit], \ ;;Annat se \\[describe-mode] ---") ;; "*String to separate headers from text body.") ;; ;;(defvar lyskom-swascii-header-separator nil ;; "The swascii version of lyskom-header-separator.") ;;(defvar lyskom-header-subject "\304rende: " ;; "*String to prompt for subject in the edit buffer.") ;; ;;(defvar lyskom-swascii-header-subject nil ;; "The swascii version of lyskom-header-subject.") (defconst lyskom-strings-missing '()) ;;; ================================================================ ;;; Iso-8859-1 converting ;;; Author: Linus Tolke Y ;;(defvar iso-8859-1-table ;; " ;; ;; !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~ ;; ;; !c#$Y|$\"c+?!-R~C+23'u$-,10?????AAAA[][CE@EEIIIIDNOOOO\\*\\UUU^YTBaaaa{}{ce`eeiiiidnoooo|/|uuu~yty" ;; "*This is a table of the chars corresponding value in SWASCII. ;;Used by the function iso-8859-1-to-swascii function.") ;; ;; ;;(defun iso-8859-1-to-swascii (string) ;; "Returns a string without characters with code > 127. ;;What chars are converted to is controlled by the iso-8859-1-table." ;; ;; If argument is a vector of strings ;; (if (vectorp string) ;; (apply 'vector (mapcar 'iso-8859-1-to-swascii string)) ;; (let ((tmp (copy-sequence string)) ;; (i 0) ;; (len (length string))) ;; (while (< i len) ;; (aset tmp i (aref iso-8859-1-table ;; (aref tmp i))) ;; (setq i (1+ i))) ;; tmp))) ;;; The alist formely known as lyskom-strings (lyskom-language-strings lyskom-message sv '( ;; From vars.el: ;; From komtypes.el: nil ;; From clienttypes.el: nil ;; From startup.el: (server-q . "LysKOM-server? (%#1s) ") (try-connect . "LysKOM elisp-klient version %#1s.\nF\366rs\366ker koppla upp mot %#2s.\n") (protocoll-error . "Protocol error. Servers says: %#1s") (connection-done . "Uppkopplingen klar. Serverns versionsnummer \344r %#1s.\n\n") (what-is-your-name . "Vad heter du? ") (password . "L\366senord? ") (wrong-password . "Fel l\366sen.\n") (are-logged-in . "Du \344r nu inloggad. V\344nta ett tag.\n") (you-have-motd . "\nDu har en lapp p\345 d\366rren:\n\n") (lyskom-motd-was-garbed . "\nLoginmeddelandet finns inte! Det meddelande som ska visas efter inloggning har f\366rsvunnit. Kontakta LysKOM-administrat\366ren.\n") (presentation-encouragement . "Du har ingen presentation. Det skulle vara trevligt om du skrev en. Anv\344nd kommandot \304p. Om du inte vill skriva n\345gon presentation tryck fs.\n") (first-greeting . "%#1s Det tycks vara f\366rsta g\345ngen du anv\344nder LysKOM. V\344lkommen! Kontrollera att du stavat ditt namn r\344tt. Anv\344nd g\344rna ditt fullst\344ndiga namn och organisation, t ex \"Eskil Block, FOA\". Om du stavat ditt namn fel, eller vill \344ndra ditt namn, svara nej p\345 fr\345gan nedan. Observera att all information \344n s\345 l\344nge sparas s\345 att vem som helst kan l\344sa den. Dock \344r l\366senordet krypterat. Om du \344r os\344ker p\345 hur man anv\344nder LysKOM kan du h\344mta en manual via anonym ftp fr\345n ftp.lysator.liu.se. Fr\345ga din systemadministrat\366r om du \344r os\344ker.\n") (is-name-correct . "\304r namnet %#1s korrekt? ") (personal-password . "Ange ett personligt l\366sen: ") (repeat-password . "Repetera f\366r kontroll: ") (repeat-failure . "Du angav inte samma l\366senord b\344gge g\345ngerna.\n") (could-not-create-you . "Det gick inte att skapa personen.\n") (presentation-subject . "%#1s") (presentation-form . "Namn:\t\nAdress:\t\nStad:\t\nTelefon: Email-adress:\nWWW:\t\n\nAnnat:\t") (presentation-help . "Du skriver just nu din presentation.\n") (not-present-anywhere . "Ej n\344rvarande i n\345got m\366te.") (secret-person . "Hemlig person") (in-secret-conference . "Hemligt m\366te (%#1d).") (start-new-session-same-server . "Du k\366r redan mot den servern. Vill du starta en ny session? ") (new-session-in-buffer . "\n\n---- Ny session startad %s ----\n\n") ;; From internal.el: (shaky-tcp . "Nu n\345r jag inte servern. TCP/IP-f\366rbindelsen \344r skakig%#1s") (retrying-tcp . "Jag f\366rs\366ker igen.") ;; From parse.el: (protocol-error . "protokollfel: %s") ;; From services.el: (interrupted . "Kommandot avbrutet\n") ;; From cache.el: ;; No entries. ;; From commands1.el: (appreciation . "Du \344r mycket vacker och mycket klok. M\345nga \344lskar dig b\345de till kropp och till sj\344l. Du kommer att \366ver\366sas med rikedom och f\345 stor lycka i ditt liv. Var glad att just du \344r du. Det har du all anledning att vara. Fantomen \366nskar dig en bra dag.\n\n") (abuse . "Du \344r mycket ful och mycket dum. M\345nga hatar dig b\345de till kropp och till sj\344l. Du kommer att \366ver\366sas med sjukdomar och inte f\345 n\345gon som helst lycka i ditt liv. Du borde verkligen ta dig samman och g\366ra n\345got av ditt liv \344ven om det inte \344r mycket att starta med. Guran vill helst s\344tta en giftpil i dig.\n\n") (what-conf-to-delete . "Vilket m\366te/person vill du utpl\345na: ") (what-conf-to-change . "Vilket m\366te vill du \344ndra: ") (confirm-delete-pers-or-conf . "Ta bort %#1s %#2s? ") (the-pers . "personen") (the-conf . "m\366tet") (deletion-not-confirmed . "Utpl\345ningen avbruten\n") (somebody-else-deleted-that-conf . "N\345gon annan tog precis bort m\366tet.\n") (conf-is-deleted . "Ok, nu \344r %#1s utpl\345nad.\n") (you-could-not-delete . "%#1M kunde inte utpl\345nas av dig.\n") (you-have-deleted-yourself . "Du har utpl\345nat dig sj\344lv.\n") (what-text-to-delete . "Vilket inl\344gg skall tas bort? ") (deleting-text . "Radering av text %#1:n...") (presentation-for-whom . "Vilket m\366te/person? ") (somebody-deleted-that-conf . "N\345gon tog precis bort m\366tet.\n") (review-presentation-of . "\305terse presentation av %#1M.\n") (has-no-presentation . "%#1:M har ingen presentation.\n") (have-to-read . "Du m\345ste l\344sa ett inl\344gg f\366rst.\n") (no-comment-to . "Det finns inget kommenterat inl\344gg att titta p\345.\n") (who-letter-to . "Vem vill du skicka brev till? ") (has-motd . "%#1P har en lapp p\345 d\366rren:\n\n") (motd-persist-q . "Vill du fortfarande skicka brevet? ") (who-to-add . "Vem vill du addera? ") (where-to-add . "Vilket m\366te skall han/hon adderas till? ") (where-to-add-self . "Vilket m\366te vill du bli medlem i? ") (priority-q . "Prioritet p\345 m\366tet? (0 (passivt medlemskap), 1 (l\345g) - 255 (h\366g)) ") (done . "klart.\n") (nope . "Det gick inte.\n") (cant-find-supervisor . "Hittar inte organisat\366ren f\366r %#1M.\n") (is-read-protected-contact-supervisor . "%#1M \344r slutet. Skicka ett brev till %#2P f\366r medlemsskap.\n") (conf-does-not-exist . "\nM\366tet finns inte.\n") (who-to-exclude . "Vem vill du utesluta? ") (where-from-exclude . "Vilket m\366te skall han/hon uteslutas ifr\345n? ") (leave-what-conf . "Vilket m\366te vill du g\345 ur? ") (error-fetching-person . "Fel i personh\344mtningen.\n") (error-fetching-conf . "Fel i m\366tesh\344mtningen.\n") (name-of-conf . "Vad ska m\366tet heta? ") (anyone-member . "F\345r vem som helst bli medlem? ") (secret-conf . "Hemligt m\366te? ") (comments-allowed . "F\345r man skriva kommentarer? ") (anonymous-allowed . "F\345r man skriva anonyma texter? ") (what-comment-no . "Kommentera text nummer: ") (what-footnote-no . "Fotnotera text nummer: ") (confusion-what-to-comment . "Jag f\366rst\345r inte vilken text du vill kommentera.\n") (confusion-what-to-footnote . "Jag f\366rst\345r inte vilken text du vill skriva en fotnot till.\n") (what-private-no . "Personligt svar till text nummer: ") (confusion-who-to-reply-to . "Jag f\366rst\345r inte vems inl\344gg du vill skriva ett privat svar till.\n") (confusion-what-to-answer-to . "Jag f\366rst\345r inte vilken text du vill besvara.\n") (confusion-what-to-view . "Jag f\366rst\345r inte vilken text du vill \345terse.\n") (quit-in-spite-of-unsent . "Vill du avsluta sessionen trots os\344nt meddelande? ") (really-quit . "Vill du verkligen avsluta sessionen? ") (session-ended . " ***************************** Lyskom-sessionen \344r avslutad. *****************************\n") (session-auto-ended . " =========================================================== Kopplar ned fr\345n LysKOM eftersom LysKOM \344r fullt och du har l\344st klart allting. Kom tillbaks senare. ===========================================================\n\n") (what-to-change-pres-you . "Vilket m\366te/person vill du \344ndra presentationen f\366r (dig sj\344lv): ") (who-to-put-motd-for . "Vilket m\366te/person vill du s\344tta lapp p\345 d\366rr f\366r (dig sj\344lv): ") (cant-get-conf-stat . "Kan ej h\344mta m\366tesstatus f\366r m\366tet.\n") (go-to-conf-p . "G\345 till m\366te: ") (want-become-member . "Vill du bli medlem? ") (no-ok . "Nehej.\n") (who-to-remove-motd-for . "Vilket m\366te/person vill du ta bort lapp p\345 d\366rr f\366r (dig sj\344lv): ") (conf-all-read . "%#1M - inga ol\344sta.\n") (no-in-conf . "Du \344r inte n\344rvarande i n\345got m\366te.\n") (search-for-pers . "Ange s\366kvillkor (RETURN f\366r alla personer): ") (search-for-conf . "Ange s\366kvillkor (RETURN f\366r alla m\366ten): ") (search-re . "Ange s\366kuttryck (regulj\344rt uttryck): ") (name-to-be-changed . "Ange det namn som skall \344ndras: ") (no-such-conf-or-pers . "M\366tet eller personen finns ej.\n") (new-name . "Nytt namn: ") (who-to-change-supervisor-for . "Vem vill du \344ndra organisat\366r f\366r? ") (new-supervisor . "Ny organisat\366r: ") (text-to-mark . "Vilket inl\344gg vill du markera? ") (text-to-unmark . "Vilket inl\344gg vill du avmarkera? ") (what-mark . "Vilken markering vill du s\344tta? ") (unmarking-textno . "Avmarkering av text %#1n...") (marking-textno . "Markering av text %#1n...") (new-passwd-again . "Mata in det nya l\366senordet igen f\366r kontroll: ") (what-mark-to-view . "Vilken markering vill du \345terse? ") (whos-passwd . "Vem vill du \344ndra l\366senord f\366r? (dig sj\344lv) ") (old-passwd . "Mata in ditt l\366senord: ") (new-passwd . "Mata in det nya l\366senordet: ") (changing-passwd . "\304ndrar l\366senordet...") (retype-dont-match . "L\366senorden \344r inte samma. G\366r om.\n") (palindrome . "(ett palindrom!) ") (lyskom-name . "Anv\344ndare") (is-in-conf . "N\344rvarande i m\366te") (from-machine . "K\366r fr\345n") (is-doing . "G\366r") (lyskom-client . "Klient") (text-to-add-recipient . "Vilket inl\344gg vill du addera mottagare till:") (text-to-add-copy . "Vilket inl\344gg vill du addera en extra kopia till:") (text-to-add-bcc . "Vilket inl\344gg vill du skicka för kännedom:") (text-to-delete-recipient . "Vilket inl\344gg vill du subtrahera mottagare fr\345n:") (text-to-move . "Vilket inl\344gg vill du flytta: ") (text-to-add-comment-to . "Vilket inl\344gg vill du addera en kommentar till:") (text-to-delete-comment-from . "Vilket inl\344gg vill du subtrahera en kommentar fr\345n:") (where-on-list-q . "Placering p\345 listan? (0-%#1d) ") (member-in-conf . "Bli medlem i %#1M...") (add-member-in . "Addera %#1P som medlem i %#2M...") (unsubscribe-to . "Uttr\344da ur %#1M...") (exclude-from . "Utesluta %#1P fr\345n %#2M...") (unsubscribe-failed . "\nDet gick inte. %#1P var kanske aldrig medlem i %#2M?\n") (You . "Du") (could-not-create-conf . "M\366tet \"%#1s\" kunde ej skapas.\n") (created-conf-no-name . "M\366te nummer %[%#3@%#1:m %#2:M%], skapat.\n") (cant-read-textno . "Du f\345r inte l\344sa text %#1:n") (not-supervisor-for . "Du \344r inte organisat\366r f\366r %#1M.\n") (go-to-conf . "G\345 till %#1M.\n") (cant-go-to-his-mailbox . "Du f\345r inte g\345 till %#1Ms brevl\345da.\n") (not-member-of-conf . "Du \344r inte medlem i %#1M.\n") (about-to-change-name-from . "%#1M\n") (change-name-done . "Klart. Nytt namn: %[%#2@%#1:M%].\n") (change-name-nope . "Det gick inte bra att \344ndra till %#1s.\nFelkod %#3d. %#2s.\n") (change-supervisor-from-to . "\304ndra organisat\366r f\366r %#1M till %#2P...") (change-supervisor-nope . "\nDet gick inte. Kanske du inte f\345r \344ndra organisat\366r f\366r %#1M?\n") (no-marked-texts . "Du har inga markerade inl\344gg.\n") (no-marked-texts-mark . "Du har inga markerade inl\344gg med markeringen %#1d.\n") ;;; For later ; (northward . "norrut") ; (southward . "s\366derut") ; (permanent-sundown . "Solen kommer inte att g\345 upp. Flytta %#1s!") ; (permanent-sunup . "Solen kommer inte att g\345 ned. Fytta %#1s!") ; (sunup-soon . "Solen g\345r snart upp") ; (sundown-recently . "Solen gick nyligen ned") ; (after-sunset . "Solen har g\345tt ned") ; (before-sunup . "Solen har inte g\345tt upp \344nnu") ; (sun-is-up . "Solen \344r uppe") ;;; (weekdays . ["s\366ndag" "m\345ndag" "tisdag" "onsdag" "torsdag" "fredag" "l\366rdag" "s\366ndag"]) (time-is . "Det \344r %#1s %#2s(enligt servern).") (time-format-exact . "%#7s %4#1d-%02#2d-%02#3d %02#4d:%02#5d:%02#6d") (xmaseve . "\nJulafton! Har du \366ppnat dina julklappar \344n?") (xmasday . "Juldagen.\nDu har väl varit i julottan?") (newyearday . "Gott nytt %#1d!") (newyearevelate . "Mindre \344n en timme kvar...") (newyeareve . "Gott nytt \345r!") (cgdag . "Konungens födelsedag.") (sixjune . "Sveriges nationaldag och svenska flaggans dag") (holdnose . "H\345ll f\366r n\344san...") (lysbday . " P\345 denna dag, \345r 1973, grundades Lysator, och det var en stor dag i svensk datorhistoria. L\344s mer p\345 http://www.lysator.liu.se/history/") (total-users . " Sammanlagt %#1d anv\344ndare.\n") (total-visible-users . " Sammanlagt %#1d synliga anv\344ndare.\n") (total-active-users . " Sammanlagt %#1d aktiva anv\344ndare.\n") (total-visible-active-users . " Sammanlagt %#1d synliga aktiva anv\344ndare.\n") (who-to-add-q . "Vilket m\366te/person vill du addera som mottagare? ") (who-to-add-copy-q . "Vilket m\366te/person vill du addera som kopiemottagare? ") (who-to-sub-q . "Vilket m\366te/person vill du subtrahera som mottagare? ") (who-to-move-from-q . "Fr\345n vilket m\366te vill du flytta texten? ") (who-to-move-to-q . "Vart vill du flytta texten? ") (adding-name-as-recipient . "Adderar %#1M som mottagare till text %#2n...") (adding-name-as-copy . "Adderar %#1M som kopiemottagare till text %#2n...") (remove-name-as-recipient . "Subtraherar %#1M som mottagare fr\345n text %#2n...") (moving-name . "Flyttar text %#3n fr\345n %#1M till %#2M...") (text-to-add-q . "Vilket inl\344gg vill du addera som kommentar? ") (text-to-remove-q . "Vilket inl\344gg vill du subtrahera som kommentar? ") (add-comment-to . "Adderar text %#1n som kommentar till text %#2n...") ; (sub-comment-to . "Subtraherar text %#1n som kommentar till text %#2n...") (comment-keep-recpt-p ."Ska %#1s vara mottagare? ") (comment-all-relevant-p . "Inl\344gget har flera mottagare. \304r alla relevanta? ") (please-edit-recipients . "\304ndra mottagarlistan och skicka in inl\344gget igen.") (checking-rcpt . "Kontrollerar mottagare...") (checking-rcpt-done . "Kontrollerar mottagare...klart") (checking-comments . "Kontrollerar kommenterade texter...") (checking-comments-done . "Kontrollerar kommenterade texter...klart") (please-check-commented-texts . "Återse de kommenterade texterna och deras kommentarer.") (have-unread-comment . "Skicka in trots olästa kommentarer till text %#1n? ") (add-recipient-p . "Addera %#1P som mottagare? ") (matching-regexp . "M\366ten/personer som matchar '%#1s'\n") (who-is-active-all . "Visar alla sessioner.\n") (who-is-active-last-minutes . "Visar alla sessioner som har varit aktiva de senaste %#1d minuterna.\n") (showing-invisibles . "Visar osynliga sessioner.\n") (null-who-info . "Det finns inga (aktiva) inloggade.\n") (no-other-lyskom-r . "Det finns inga fler aktiva LysKOM-sessioner.\n") (no-lyskom-session . "Det finns ingen aktiv LysKOM-session.") (no-unread-lyskom-r . "Hittar ingen aktiv LysKOM-session med olästa.\n") (no-unread-lyskom . "Hittar ingen aktiv LysKOM-session med olästa.") ;; From commands2.el: (your-memberships . "Ditt medlemskap i olika KOM-m\366ten:\n") (memberships-header . "Senast inne Prio Ol\344sta M\366tesnamn\n") (memberships-line . "%16#1s %#2d\t%#3d\t%#4M\n") (conf-for-status . "Vilket m\366te vill du se statusen f\366r? ") (no-such-conf . "M\366tet finns ej.\n") (status-record . "Status f\366r m\366te %#1M (%#2m) %#3s\n\n") (change-type-prompt . "\304ndra m\366testyp f\366r m\366te %#1M (%#2m) %#3s\n") (Mailbox . "Brevl\345da") (Protected . "Skyddat") (no-comments . "original") (closed . "slutet") (created-by . "Skapat av person %25#1p %#3s(%#2P)\n") (created-at . "Skapad:%35#1s\n") (members . "Antal medlemmar: %25#1d\n") (garb-nice . "Livsl\344ngd p\345 inl\344gg (dagar):%14#1d\n") (lowest-local-no . "L\344gsta existerande lokala nummer: %8#1d\n") (highest-local-no . "H\366gsta existerande lokala nummer: %8#1d\n") (last-text-time . "Tid f\366r senaste inl\344gg: %18#1s (st\345r det i din cache)\n") (no-of-motd . "Lapp p\345 d\366rren i text nummer: %12#1n\n") (superconf-is-no-name . "Superm\366te: %25#1m %#3s(%#2M)\n") (permitted-submitters-no-name . "Till\345tna f\366rfattare:%22#1m %#3s(%#2M)\n") (supervisor-is-no-name . "Organisat\366r: %25#1p %#3s(%#2P)\n") (presentation-no . "Presentation: %25#1n\n") (conf-has-motd . "\n%#1M har en lapp p\345 d\366rren:\n") (Everybody . "Alla") (show-members-list-also-q . "Vill du se medlemslistan ocks\345? ") (show-membership-info-q . "Visa antalet ol\344sta? ") (conf-has-these-members . "\n%#1M har f\366ljande medlemmar:\n") (member-list-header . "Senast inne Osett Namn\n\n") (secret-membership . "*** Hemlig rad ***\n") (conf-membership-line . "%#1s%#2M\n") (pers-for-status . "Vem vill du se statusen f\366r? ") (no-such-pers . "Det finns ingen s\345dan person.\n") (pers-status-record . "Status f\366r person %#1P (%#2p)\n") (created-time . "Skapad:%34#1s\n\n") (created-confs . "Skapade m\366ten:%27#1d\n") (created-persons . "Skapade personer:%24#1d\n") (created-texts . "Skapade texter:%26#1d\n") (created-lines . "Skapade rader:%27#1d\n") (created-chars . "Antal skapade tecken:%20#1d\n") (no-of-sessions . "Antal sessioner:%25#1d\n") (present-time-d-h-m-s . "N\344rvarotid:%19#1d d %02#2d:%02#3d:%02#4d\n") (last-log-in . "Senast inne:%29#1s\n") (user-name . "Anv\344ndare: %30#1s\n") (read-texts . "L\344sta texter:%28#1d\n") (marked-texts . "Markerade texter:%24#1d\n") (time-for-last-letter . "Tid f\366r senaste brev:%20#1s (st\345r det i din cache)\n") (superconf . "Superm\366te:%31#1m %#3s(%#2M)\n") (supervisor . "Organisat\366r:%29#1p %#3s(%#2P)\n") (member-of-confs . "Medlem i (antal m\366ten):%18#1d\n") (presentation . "Presentation: %24#1n\n") (show-membership-list-also-q . "Vill du se vilka m\366ten personen \344r medlem i ocks\345? ") (not-allowed-see-confs . "Du f\345r inte se vilka m\366ten %#1P \344r medlem i.\n") (is-member-of . "\n%#1P \344r medlem i f\366ljande m\366ten:\n") (membership-list-header . "Senast inne Osett Namn\n\n") (pers-membership-line . "%#1s%#2s%#3M\n") (is-supervisor-mark . "O ") (who-to-send-message-to . "Vem vill du skicka meddelandet till? (%s) ") (send-empty-message-p . "Meddelandet \344r tomt. Vill du \344nd\345 skicka det? ") (his-total-unread . "\n%#1M har totalt %#2d ol\344sta.\n") (message-prompt . "Meddelande: ") (message-sent-to-user . "================================================================ Ditt meddelande till %#2M: %#1t ---------------------------------------------------------------- ") (message-sent-to-all . "================================================================ Ditt allm\344nna meddelande l\366d: %#1t ---------------------------------------------------------------- ") (message-all-info . "S\344nd allm\344nt meddelande\n") (message-recipient-info . "S\344nd meddelande till %#1M\n") (message-nope . "Du kunde inte skicka meddelandet. Mottagaren var kanske inte inloggad. Meddelandet du f\366rs\366kte s\344nda till %#1M var: %#2t\n") (only-last . "Endast l\344sa senaste (0 - %#1d) i %#2s: ") (only-error . "N\345got gick galet. Sorry.\n") (you-have-unreads . "Du har %#1d ol\344sta inl\344gg i %#2M\n") (you-have-an-unread . "Du har 1 ol\344st inl\344gg i %#1M\n") (you-have-unreads-special . "Du har %#1d okommenterade inl\344gg i %#2M\n") (you-have-an-unread-special . "Du har 1 okommenterat inl\344gg i %#1M\n") (you-have-read-everything . "Du har sett alla nyheter.\n") (total-unreads . "\nDu har %#1d ol\344sta inl\344gg.\n") (total-unread . "\nDu har 1 ol\344st inl\344gg.\n") (waiting-for-anything . "Du v\344ntar p\345 ett inl\344gg i vilket m\366te som helst.\n") (waiting-higher-than . "Du v\344ntar p\345 ett inl\344gg i ett m\366te med h\366gre prioritet \344n %#1d.\n") (have-to-be-in-conf-with-unread . "Du m\345ste g\345 till ett icketomt m\366te f\366rst.\n") (Texts . "Inl\344gg") (Date . "Datum") (Lines . "Rad.") (Author . "F\366rfattare") (Subject . "\304rende") (could-not-read . "Du fick inte l\344sa denna text (%#1n).\n") (multiple-choice . "Flera alternativ finns.") (does-not-exist . "Detta kommando finns inte.") (summary-line . "%=-8#1n%#2s%4#3d %[%#4@%#5:P%] %[%#6@%#7r%]\n") (what-mark-to-list . "Vilken markering vill du lista? ") (you-have-marks . "Du har %#1d inl\344gg markerade markerade med %#2d.\n") (you-have-marks-all . "Du har %#1d markerade inl\344gg.\n") ;; Only people fixing bugs or recieving bugg-reports should ;; change these: (buggreport-compilestart . "Skapar buggrapporten...") (buggreport-compileend . "Skapar buggrapporten...klart") (buggreport-description . "Detta gjorde jag: \(Fyll i dina kommentarer nedan\)\n================\n\n ================ Bland informationen nedan finns ocks\345 en lista p\345 de 100 sist tryckta tangenterna i din emacs. Om du nyligen loggat in kan den inneh\345lla ditt lyskoml\366senord. Titta igenom den och \344ndra det som \344r ditt l\366senord till * * * eller m i t t l \366 s e n eller n\345got annat l\344mpligt. N\344r du skrivit klart skall du skicka in din buggrapport till LysKOMs elispklientutvecklare. Det sker antingen: * med email till bug-lyskom@lysator.liu.se * med vanligt brev till: \tLysator \tc/o ISY \tLink\366ping University \tS-581 83 Linkoping \tSWEDEN. M\344rk kuvertet \"LysKOM buggrapport f\366r elispklienten\".\n\n") (buggreport-internals . "LysKOMs interna information:\n\n") (buggreport-version . "lyskom-version:") (buggreport-emacs-version . "emacs-version:") (buggreport-system-id . "system-id:") (buggreport-ctl-arrow-doc . "ctrl-doc:") (buggreport-unparsed . "\nlyskom-unparsed-buffer:") (buggreport-command-keys . "Nyss tryckta tangenter:") (buggreport-backtrace . "\n*Backtrace*:\n%#1s\n") (buggreport-communications . "\nlyskom-debug-communications-to-buffer-buffer:") (buggreport-all-kom-variables . "\n\nAndra variabler:\n***** *********") (buggreport-instead-of-byte-comp . "byte-code(\"byte-string\"") (buggreport-subject . "Bugg-rapport elisp-klienten version %#1s") (not-logged-in . "Du \344r inte inloggad. ") ;; +++ cant seem to find where these are used: (name-is-not-in-conf . "%#1s \344r inte n\344rvarande i n\345got m\366te.\n") (name-is-in-conf . "%#1s \344r n\344rvarande i\n%#2s\n") (connected-during . "Uppkopplingstid: %#1d sekunder.\n") ;; +++ (conf-to-set-permitted-submitters-q . "Vilket m\366te vill du s\344tta till\345tna f\366rfattare f\366r? ") (conf-to-set-super-conf-q . "Vilket m\366te vill du s\344tta superm\366te f\366r? ") (new-super-conf-q . "Vilket m\366te vill du ha som superm\366te? ") (new-permitted-submitters-q . "M\366te med till\345tna f\366rfattare till %#1s? (alla) ") (super-conf-for-is . "\304ndra superm\366te f\366r %#1M till %#2M...") (permitted-submitters-removed-for-conf . "Till\345t alla f\366rfattare i m\366te %#1M...") (submitters-conf-for-is . "\304ndra till\345tna f\366rfattare f\366r m\366te %#1M till\nmedlemmarna i %#2M...") (conf-to-set-garb-nice-q . "Vilket m\366te vill du s\344tta livsl\344ngd f\366r? ") (new-garb-nice-q . "Vilket v\344rde vill du s\344tta livsl\344ngden till? ") (garb-nice-for-is . "\304ndra livsl\344ngden f\366r %#1M till %#2d...") (really-shutdown . "\304r du s\344ker p\345 att du vill st\344nga av servern? ") (closing-server . "St\344nga av servern...") (really-sync . "\304r du s\344ker p\345 att du vill spara databasen? ") (syncing-server . "Spara databasen...") (administrator . "administrat\366r") (no-longer-administrator . "en normal anv\344ndare igen") (you-are-now . "Ok, du k\366r nu som %#1s.\n") (setting-motd . "S\344tter loginmeddelandet till text %#1n.\n") (set-motd-success . "Du har satt ett nytt loginmeddelande.\n") (set-motd-failed . "Det gick inte. Du var kanske inte administrat\366r.\n") (removing-motd . "Tar bort loginmeddelandet.\n") (removed-motd . "Du har tagit bort loginmeddelandet.\n") (who-to-throw-out . "Vilken session vill du kasta ut? ") (throwing-out . "Kastar nu ut session %#1d... ") (postpone-prompt . "Hur lite vill du l\344sa nu? ") (set-session-priority . "S\344tt l\344sniv\345: ") ;; From review.el: (no-review-done . "Du m\345ste \345terse innan du han \345terse mer.\n") (review-how-many . "\305terse hur m\345nga?") (review-how-many-more . "\305terse ytterligare hur m\345nga?") (latest-n . "senaste %#1d") (first-n . "f\366rsta %#1d") (info-by-whom . "%#1s av vem: ") (info-to-conf . "%#1s till m\366te: ") (all-confs . "alla m\366ten") ;; +++ not used? (info-by-to . "%#1s av %#2P till %#3M fram\345t.") (no-get-conf . "Du f\345r inte h\344mta m\366tet.\n") (no-get-pers . "Du f\345r inte h\344mta personen.\n") (no-review-info . "Ej till\345tet \345terse %#1s\n") ;; +++ (review-info . "\305terse %#1s") (review-info-by-to . "\305terse %#1s av %#2P till %#3M fram\345t.\n") (review-more-info-by-to . "\305terse %#1s av %#2P till %#3M fram\345t.\n") (review-rest . "resten") (review-more . "n\344sta %#1d") (you-review . "Du \345terser nu %#1s.\n") (read-text-first . "Du m\345ste l\344sa en text f\366rst.\n") (cannot-read-last-text . "Du kan inte l\344sa den senast l\344sta texten.\n") (review-n-texts . "\305terse %#1d inl\344gg.\n") (review-marked . "\305terse %#1d markerade.\n") (review-text-no . "\305terse text nummer %#1n\n") (review-one-comment . "\305terse en kommentar till inl\344gg %#1n.\n") (review-many-comments . "\304terse %#2d kommentarer till inl\344gg %#1n.\n") (read-normally-read . "Hur m\345nga vill du se igen? ") (review-conf-gone . "M\366tet finns inte.\n") (review-pers-gone . "Personen finns inte.\n") (review-cant-read-conf . "Du kan inte \345terse inl\344gg till ett slutet m\366te du inte \344r med i.\n") (review-cant-read-letterbox . "Du kan inte \345terse inl\344gg till n\345gon annans brevl\345da.\n") (review-cant-read-empty . "M\366tet \344r tomt.\n") (cant-review-everything . "Du kan inte \345terse alla texter i LysKOM.\n") (more-than-one-root . "Inlägg %#1n har mer än ett urinlägg.\n") (more-than-one-root-review . "Inlägg %#1n har mer än ett urinlägg, men endast ett träd kommer att visas.\n") ;; From edit-text.el: (press-C-c-C-c . "Tryck C-c C-c f\366r att skicka in texten.") (recipient . "Mottagare:") (recipient-prefix . "[Mm]") (carbon-copy . "Extra kopia:") (blank-carbon-copy . "För kännedom:") (carbon-copy-prefix . "[Ee]") (blank-carbon-copy-prefix . "[Ff]") (header-subject . "\304rende: ") (header-separator . "\\\ --- Skriv nedan. \ Skicka in=\\[kom-edit-send], \ Avbryt=\\[kom-edit-quit], \ Annat se \\[describe-mode] ---") (text-mass . "%#4s%#1s\n%#2s\n%#3s") (comment-to-by . "%#1s till text %#2n%#3s.\n") (already-sent . "Du har redan skickat denna text en g\345ng. S\344nd \344nd\345? ") (subject . "\304rende: ") (subject-prefix . "[\304\344\\{\\[]") (enter-subject-idi . "Skriv ett \344rende.") (which-text-include . "Vilken text skall vi inkludera? ") (added-recipient . "Mottagare som skall adderas: ") (added-carbon-copy . "Extra kopia till m\366te: ") (added-blank-carbon-copy . "För kännedom till: ") (text-to-comment-q . "Vilket inlägg vill du kommentera? ") (conf-has-motd-no . "M\366tet har en lapp p\345 d\366rren. (%#1d)\n\n%#2s") (still-want-to-add . "Vill du fortfarande addera m\366tet? ") (could-not-create-text . "\nTexten kunde ej skapas. Felet: %#2s.\n") (no-get-text . "Du fick inte h\344mta texten.") (unknown-header . "Ok\344nd information p\345 raden") (transform-error . "Skicka in oformatterat (%#1s)? ") ;; From view-text.el: (line . " /1 rad/ ") (lines ." /%#1d rader/ ") (marked-by-you . "Markerad av dig.\n") (marked-by-you-and-one . "Markerad av dig och n\345gon annan.\n") (marked-by-you-and-several . "Markerad av dig och %#1d andra.\n") (marked-by-one . "Markerad av 1 person.\n") (marked-by-several . "Markerad av %#1d personer.\n") ;; The format of this function should coincide with the ;; format of the lyskom-text-start variable. DONT change ;; one without changing the other. (time-yyyy-mm-dd-hh-mm . "%4#1d-%02#2d-%02#3d %02#4d:%02#5d") ;; used by lyskom-print-time (time-y-m-d-h-m . "%4#1d-%02#2d-%02#3d %02#4d:%02#5d ") (today-time-format-string . "%#6s %02#4d:%02#5d") (yesterday-time-format-string . "%#6s %02#4d:%02#5d") (today . "idag") (yesterday . "ig\345r") (no-such-text-no . "Det finns inget s\345dant inl\344gg. (%#1:n)\n") (head-Subject . "\304rende: ") (Recipient . "Mottagare") (Extra-recipient . "Extra kopia") (Hidden-recipient . "För kännedom") (Strange-recipient . "Underlig mottagare") (send-at . " S\344nt: %#1s\n") (sent-by . " S\344nt av %#1P\n") (recieved-at . " Mottaget: %#1s\n") (comment-to-text . "Kommentar till text %#1n") (footnote-to-text . "Fotnot till text %#1n") (comment-in-text . "Kommentar i text %#1n") (footnote-in-text . "Fotnot i text %#1n") (comment-to-text-by . "Kommentar till text %#1n av %#2P") (footnote-to-text-by . "Fotnot till text %#1n av %#2P") (comment-in-text-by . "Kommentar i text %#1n av %#2P") (footnote-in-text-by . "Fotnot i text %#1n av %#2P") (written-by . " av %#1P\n") ;; From async.el: (name-has-changed-to-name . "%#1:P har nu bytt namn till %#2:P") (name-has-changed-to-name-r . "%[%#3@%#1:P%] har nu bytt namn till %[%#3@%#2:P%]\n") (you-changed-name-to . "Nu har du bytt namn till %[%#2@%#1:P%].\n") (database-sync . "Databasen synkas.") (lyskom-is-full . "\ =========================================================== Meddelande fr\345n LysKOM-systemet: N\345gon f\366rs\366kte koppla upp, men misslyckades eftersom alla tillg\344ngliga f\366rbindelser \344r upptagna. Logga ut och kom tillbaks senare om du v\344ntar nu. ===========================================================\n") (has-entered . "Nu har %#1:P g\345tt in i LysKOM.") (has-entered-r . "%#2@Nu har %#1P g\345tt in i LysKOM.\n") (has-left . "Nu har %#1:P g\345tt ur LysKOM.") (has-left-r . "%#2@Nu har %#1P g\345tt ur LysKOM.\n") (unknown . "ok\344nd") (secret-person . "Hemlig person") (message-broadcast . "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Allm\344nt meddelande fr\345n %#1P (%#3s): %#2t ---------------------------------------------------------------- ") (message-from . "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Personligt meddelande fr\345n %#1P (%#3s): %#2t ---------------------------------------------------------------- ") (message-from-to . "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Gruppmeddelande till %#3M\nfr\345n %#2P (%#4s): %#1t ---------------------------------------------------------------- ") (text-is-created . "Text %#1n \344r skapad!") ;; Used in mode-line-process (mode-line-waiting . ": v\344ntar") (mode-line-working . ": arbetar") (mode-line-saving . ": sparar") (mode-line-down . ": nerkopplad") ;; From completing-read.el: (person-or-conf-no-regexp . "\\`[ \t]*[mpMP]\\w*[ \t]+\\([0-9]+\\)\\'") (session-no-regexp . "\\`[ \t]*[sS]\\w*[ \t]+\\([0-9]+\\)\\'") ;;n From prioritize.el: (cant-move-nothing-nowhere . "Kan inte flytta ingenting n\345gonstans.") (goto-priority-prompt . "Hoppa till prioritet: ") (priority-prompt . "Ny prioritet för %#1M: ") (priority-prompt-marked . "Ny prioritet på markerade möten: ") (beginning-of-list . "B\366rjan av listan") (end-of-list . "Slutet av listan") (reprioritize-from . "Prioritera om fr\345n: ") (reprioritize-to . "Prioritera om till: ") (no-selection . "Ingen markerad") (selection . "%d markerade") (cannot-get-membership . "Kan ej h\344mta medlemsskap f\366r dig.") (cannot-get-pers-stat . "Kan ej h\344mta personstatus f\366r dig.") (prioritize-help . "u,n Flytta m\366te, SPC markera, p prioritera markerade, q avsluta, C-h m hj\344lp") (your-priorities . " Prioritet M\366tesnamn ---------------------------------------------------------------------------- ") (your-membship . "Ditt medlemsskap i olika KOM-m\366ten: Prio M\366tesnr M\366tesnamn\n") (prio-row . " %5#1d%5#2m %#3M\n") (too-high-goto-2 . "Du st\345r f\366r h\366gt upp. G\345 ner till rad 2.") (too-low-go-up . "Du kan inte pusha sista raden. G\345 upp en rad.") (all-confs-popped . "Alla m\366ten \344r poppade.") (prio-died . "Flyttningen misslyckades. Sorry. D\366da bufferten.") (new-priority . "Ny prioritet? (0 (l\345g) - 255 (h\366g)) ") (new-prio . "%6#1d") ;; From flags.el: (saving-settings . "Sparar inst\344llningarna...") (saving-settings-done . "Sparar inst\344llningarna...klart") (hang-on . "V\344nta ett tag...\n") (no-changes . "Ingenting beh\366vde sparas eftersom inga variabler hade \344ndrats.\n") (could-not-save-options . "Kunde ej spara inst\344llningarna.\n") (could-not-create-area . "Kunde ej skapa texten.\n") (could-not-set-user-area . "Kunde ej st\344lla om user-arean. Servern s\344ger felmeddelande: %#1d\n") (you-dont-exist . "Du finns inte.\n") (error-in-options . "Det fanns ett fel i en av dina variabler (%#1s) Det stod \"%#2s\" i user-arean. Den s\344tts till nil ist\344llet. Skicka en bugrapport.\n") ;; From elib-string.el: ;; No entries. ;; From lyskom-rest.el: (mode-line-unread . " Ol\344sta ") (mode-line-letters . "brev ") (error-code . "Felkod %#2d: %#1s.\n") (error-in-kom-do-when-done . "Variabeln kom-do-when-done har ett felaktigt v\344. Du b\366r s\344tta den till ett b\344ttre v\344rde.\n") (extended-command . "LysKOM: ") (wait-for-server . "LysKOM v\344ntar p\345 svar fr\345n servern. V\344nta tills du f\345r en prompt.\n") (review-text-q . "\305terse text nummer: ") (completely-read-conf . "Du har sett alla texter i detta m\366te.\n") (not-in-any-conf . "Du l\344ser inte n\345got m\366te just nu.\n") (all-conf-unread-r . "Du har l\344st ut alla m\366ten.\n") (all-conf-unread-s . "Du har l\344st ut alla m\366ten. ") (one-unread . "%#1M - 1 ol\344st\n") (several-unread . "%#1M - %#2d ol\344sta\n") (enter-conf . "%#1M\n") (save-on-file-q . "Spara inl\344gg p\345 fil: (%#1s) ") (wait-for-prompt . "V\344nta p\345 prompten.") (conference-no . "") (person-no . "") (prompt-several-messages . "(%d meddelanden)") (prompt-single-message . "(%d meddelande)") (go-to-pri-conf-prompt . "G\345 till n\344sta prioriterade m\366te") (read-pri-text-conf . "L\344sa n\344sta prioriterade text") (review-next-text-prompt . "\305terse n\344sta text") (review-next-comment-prompt . "\305terse n\344sta kommentar") (review-next-marked-prompt . "\305terse n\344sta markerade") (read-next-letter-prompt . "L\344sa n\344sta brev") (read-next-footnote-prompt . "L\344sa n\344sta fotnot") (read-next-comment-prompt . "L\344sa n\344sta kommentar") (read-next-text-prompt . "L\344sa n\344sta text") (go-to-conf-of-marked-prompt . "\305terse (n\344sta) markerade") (go-to-next-conf-prompt . "G\345 till n\344sta m\366te") (go-to-your-mailbox-prompt . "G\345 till din brevl\345da") (the-command . "Kommandot: %#1C") (error-in-login-hook . "Det fanns ett fel i din kom-login-hook: %#1s\n") (give-a-number . "Mata in ett tal: ") (yes-regexp . "\\`[jJ][aA]\\'") (no-regexp . "\\`[nN][eE][jJ]\\'") (yes-or-no-nag . "Svara bara ja eller nej.") (yes-or-no . "(ja eller nej) ") (y-or-n-instring . "jJnN") (j-or-n-nag . "Svara bara j eller n. ") (j-or-n . "(j eller n) ") (y-instring . "jJ") (person-does-not-exist . "Person %#1d (finns inte).") (conference-does-not-exist . "M\366te %#1d (finns inte).") (person-is-anonymous . "Anonym person") (process-signal . "Signal fr\345n processen.") (closed-connection . " ************************************************** %#2s Lyskom-sessionen onormalt st\344ngd. Felmeddelande: %#1s**************************************************") (dead-session . "LysKOM-sessionen \344r inte aktiv.") (error-not-found . "Fel nummer %#1d. Ingen klartextf\366rklaring finns.") ;; Useful in more place than one: (illegal-command . "Otill\345tet kommando.\n") (no-such-text . "Det finns inget s\345dant inl\344gg.\n") (no-such-text-m . "Det finns inget s\345dant inl\344gg.") (everybody . "alla") (everything . "allt") (anybody . "vem som helst") (forward . "fram\345t") (backward . "bak\345t") (wait . "V\344nta ett tag...\n") (comment . "Kommentar") (comment-prefix . "[Kk]") (footnote . "Fotnot") (footnote-prefix . "[Ff]") (by . " av %#1P") (text-created . "Text nummer %#1n \344r skapad.\n") (resolve-session . "Ange vilken session: ") (starting-program . "Startar %#1s...") (super-jump . "Filtrerar \344rende \"%#1r\" i m\366te \"%#2M\"\n") (no-recipient . "Inl\344gget har ingen mottagare.\n") (filtered . "[Filtrerad]") (filter-error-specification . "Fel i filterspecifikationen") (filter-error-bad-not . "Fel i filterspecifikation efter 'not'") (filter-error-unknown-key . "Filternyckeln '%S' \344r ok\344nd.") (filter-error-key-arg . "Fel filterdata (%S %S)") (filter-tree . "Hoppar \366ver text %#1n \"%#2r\" av %#3P och dess kommentarstr\344d.\n") (filter-text . "Hoppar \366ver text %#1n \"%#2r\" av %#3P.\n") (filter-permanent . "Permanent? ") (filter-action . "Hur vill du filtrera? ") (filter-in-conf . "I vilket m\366te? (alla) ") (filter-subject . "Filtrera vilket \344rende? ") (filter-which-text . "Filtrera inl\344gg som inneh\345ller: ") (filter-author . "Filtrera vilken f\366rfattare? ") (permanent . "(permanent)") (temporary . "(tillf\344llig)") (filter-edit-buffer-name . "*LysKOM Filter Edit*") (filter-edit-empty-list . "Listan \344r tom") (filter-edit-start-of-list . "Listans b\366rjan") (filter-edit-end-of-list . "Listans slut") (filter-edit-filter-how . "Hur vill du filtrera? ") (filter-edit-filter-what . "Vad vill du filtrera? ") (filter-edit-bad-argument . "Felaktig inmatning: %s") (filter-edit-outside-entry . "Kan inte utf\366ra kommandot utanf\366r ett filter") (filter-edit-outside-list . "Kan inte utf\366ra operationen utanf\366r listan") (filter-edit-end-of-pattern . "Filtrets slut") (filter-edit-save-p . "Spara f\366r\344ndringar? ") (filter-edit-remove-empty . "Tomma filter g\366r att alla texter filtreras. Vill du ta bort dessa? ") (filter-edit-restart-p . "Du har gjort \344ndringar. Vill du verkligen b\366rja om? ") (filter-edit-help . "p,n Upp/ned, i/M-i Ny rad/filter, d/M-d Radera rad/filter, C-h m Mer hj\344lp") (filter-edit-header . "\304ndra filter f\366r \"%s\"\n") (filter-edit-saving . "Sparar \344ndringarna...") (filter-edit-saving-done . "Sparar \344ndringarna...klart") (filter-edit-saving-error . "Kunde inte spara \344ndringarna!") (filter-edit-insert-pred . "%#1s (=,!=): ") (filter-edit-insert-arg . "%#1s %#2s (vad): ") (no-filters . "Inga filter har definierats.\n") (view-filters-header . "\nAktiva filter:\n\n") (view-filters-footer . "") (ansaphone-new-message . "Nytt automatsvar: ") (ansaphone-message . "Svarsmeddelande: ---------------------------------------------------------------------- %#1t ---------------------------------------------------------------------- ") (ansaphone-state . "Automatsvar \344r nu %#1s.") (ansaphone-state-r . "Automatsvar \344r nu %#1s.\n") (ansaphone-messages-gone . "Sparade meddelanden raderade.") (ansaphone-no-messages . "Inga meddelanden.\n") (ansaphone-message-list-start . "Sparade meddelanden:\n\n") (ansaphone-message-list-end . "\n\n") (ansaphone-message-header . "Automatiskt svar (satt %#1s):\n") (remote-erase-messages . "Fj\344rrstyrning (%#1P %#2s): Sparade meddelanden raderade\n") (remote-set-message . "Fj\344rrstyrning (%#1P %#2s): Svarsmeddelande: ---------------------------------------------------------------------- %#3t ---------------------------------------------------------------------- ") (remote-set-ansaphone . "Fj\344rrstyrning (%#1P %#2s): Automatsvar \344r nu %#3s\n") (remote-list-messages . "Fj\344rrstyrning (%#1P %#2s): Meddelanden listade\n") (remote-quit . "Fj\344rrstyrning(%#1P %#2s): Avsluta\n") (illegal-remote . "Otill\345ten fj\344rrstyrning: Tid: %#1s Fr\345n: %#2P <%#2p> Till: %#3P <%#3p> Text: %#4t") (illegal-remote-reply . "Fj\344rrstyrning inte accepterad: %#1s") (remote-not-in-list . "Otill\345ten person") (remote-bad-command . "Felaktigt kommando") (remote-unknown-error . "Ok\344nt fel") (remote-control-who . "Kontrollera vilken session? ") (remote-control-autoreply . "Automatsvar p\345 eller av? ") (state-on . "p\345slaget") (state-off . "avslaget") (text-popup-title . "Inl\344gg %#1s") (conf-popup-title . "M\366te %#1s") (pers-popup-title . "Person %#1s") (url-popup-title . "URL %#1s") (generic-popup-title . "%#1s") (who-i-am-not-present . "%#1P \344r inte n\344rvarande i n\345got m\366te\n") (who-i-am-present . "%#1P \344r n\344rvarande i %#2M\n") (who-i-am-client . "Programmet heter lyskom.el, version %#1s.\n") (who-i-am-server . "Detta \344r %#1s, version %#2s.\n") (who-i-am-emacs . "Det k\366rs under %#1s.\n") (no-such-session-r . "Det finns ingen s\345dan session. Personen kanske inte \344r inloggad.\n") (person-not-logged-in-r . "%#1P \344r inte inloggad.\n") (session-status . "Session %#1d \344r %#2P <%#2p> %#5s %#7s %#4M K\366r %#6D fr\345n %#3s\n") (session-status-9 . "Session %#1d \344r %#2P <%#2p> %#5s %#7s %#4M K\366r %#6D fr\345n %#3s Uppkopplad sedan %#8s%#9s") (session-status-inactive . "\nHar inte varit aktiv p\345 %#1s\n") (one-day . "en dag") (one-hour . "en timme") (one-minute . "en minut") (days . "dagar") (hours . "timmar") (minutes . "minuter") (and . "och") (session-is-active . " och \344r aktiv.\n") (session-is-invisible . "Denna session \344r osynlig.\n") (status-for-session . "Sessionsstatus f\366r vilken person? ") (unknown-doing-what . "Existerar") (doing-where-conn . "i") (doing-nowhere-conn . "men \344r") (waiting-for-membership . "V\344ntar p\345 att medlemskapslistan ska l\344sas in...%d/%d") ;; From slow.el (no-such-command . "Det finns inget s\345dant kommando.\n") (command-completions . "Du kan mena n\345gon av f\366ljande:\n %#1s\n") (which-language . "Ändra språk till: ") (send-formatted . "Skicka in som formatterad text? ") (changing-language-to . "Byter till %#1s.\n") (language-not-loaded . "%#1s finns inte tillgängligt.\n") (reformat-html . "(HTML)") (reformat-enriched . "(Enriched)") (reformat-filled . "(Ombruten)") (need-library . "Paketet \"%#1s\" behövs för att utföra detta kommando.\n") (calc-expression . "Uttryck: ") )) ;;; ================================================================ ;;; The commands and their associated functions ;;; The Alist formely known as lyskom-commands (lyskom-language-strings lyskom-command sv '( (describe-mode . "Hj\344lp") (kom-slow-mode . "L\345ngsamma kommandon") (kom-quick-mode . "Snabba kommandon") (kom-send-message . "S\344nda meddelande") (kom-create-conf . "Skapa m\366te") (kom-delete-conf . "Utpl\345na") (kom-delete-text . "Radera inl\344gg") (kom-display-time . "Se tiden") (kom-go-to-conf . "G\345 till m\366te") (kom-go-to-next-conf . "G\345 till n\344sta m\366te") (kom-jump . "Hoppa \366ver alla kommentarer") (kom-list-conferences . "Lista m\366ten") (kom-list-persons . "Lista personer") (kom-list-news . "Lista nyheter") (kom-list-re . "Lista (med) regexpar") (kom-membership . "Lista medlemsskap") ;; (kom-list-marks "Lista markeringar") (kom-postpone . "Uppskjuta l\344sning") (kom-set-session-priority . "S\344tt l\344sniv\345") (kom-prioritize . "Prioritera m\366ten") (kom-status-person . "Status (f\366r) person") (kom-status-conf . "Status (f\366r) m\366te") (kom-add-self . "Bli medlem i m\366te") (kom-list-summary . "Lista \344renden") (kom-sub-self . "Uttr\344da ur m\366te") (kom-quit . "Sluta") (kom-recover . "\305terstarta kom") (kom-start-anew . "B\366rja med nytt namn") (kom-view . "\305terse inl\344gg") (kom-find-root-review . "\305terse tr\344d") (kom-review-comments . "\305terse alla kommentarer") (kom-review-tree . "\305terse alla kommentarer rekursivt") (kom-review-clear . "\305terse hoppa") (kom-review-last-normally-read . "\305terse igen") (kom-review-noconversion . "\305terse omodifierat") (kom-review-next . "\305terse n\344sta") (kom-find-root . "\305terse urinl\344gget") (kom-review-by-to . "\305terse senaste") (kom-review-more . "\305terse fler inl\344gg") (kom-review-first . "\305terse f\366rsta") (kom-review-all . "\305terse alla") (kom-view-commented-text . "\305terse det kommenterade") (kom-view-previous-commented-text . "\305terse det f\366reg\345ende kommenterade") (kom-review-stack . "\305terse lista") (kom-review-presentation . "\305terse presentation") (kom-review-backward . "(\305terse) Bakl\344nges") (kom-view-next-text . "L\344sa n\344sta inl\344gg") (kom-who-is-on . "Vilka \344r inloggade") (kom-who-am-i . "Var (\344r) jag") ; (kom-display-who-buffer "Visa vilkalistan") (kom-list-clients . "Lista klienter") (kom-busy-wait . "V\344nta p\345 ett inl\344gg") (kom-write-comment . "Kommentera inl\344gget") (kom-comment-previous . "Kommentera f\366reg\345ende inl\344gg") (kom-write-footnote . "Fotnot till inl\344gg") (kom-private-answer . "Personligt svar") (kom-private-answer-previous . "Personligt svar p\345 f\366reg\345ende inl\344gg") (kom-set-unread . "Endast l\344sa senaste") (kom-write-text . "Skriva ett inl\344gg") (kom-send-letter . "Skicka brev") (kom-change-name . "\304ndra namn") (kom-change-password . "\304ndra l\366senord") (kom-change-supervisor . "\304ndra organisat\366r") (kom-change-presentation . "\304ndra presentation") (kom-get-appreciation . "F\345 uppmuntran") (kom-get-abuse . "F\345 sk\344ll") (kom-mark-text . "Markera (inl\344gg)") (kom-unmark-text . "Avmarkera (inl\344gg)") (kom-review-marked-texts . "\305terse markerade") (kom-review-all-marked-texts . "\305terse alla markerade") (kom-add-recipient . "Addera mottagare") (kom-add-copy . "Addera extra kopiemottagare") (kom-add-bcc . "Addera för kännedom") (kom-sub-recipient . "Subtrahera mottagare") (kom-move-text . "Flytta inl\344gg") (kom-add-comment . "Addera kommentar") (kom-sub-comment . "Subtrahera kommentar") (kom-add-member . "Addera medlem") (kom-sub-member . "Uteslut medlem") (kom-change-conf-motd . "S\344tt lapp p\345 d\366rren") (kom-set-garb-nice . "\304ndra livsl\344ngd") (kom-set-super-conf . "\304ndra superm\366te") (kom-set-permitted-submitters . "\304ndra till\345tna f\366rfattare") (kom-unset-conf-motd . "Ta bort lapp p\345 d\366rren") (kom-save-text . "Spara text (p\345 fil)") (kom-edit-options . "\304ndra variabler") (kom-save-options . "Spara variabler") (kom-shutdown-server . "St\344ng av servern") (kom-sync-database . "Spara databasen") (kom-enable-adm-caps . "\326verg\345 till administrat\366rsmod") (kom-disable-adm-caps . "\326verg\345 till normalmod") (kom-set-motd . "S\344tt loginmeddelande") (kom-remove-motd . "Ta bort loginmeddelande") (kom-force-logout . "Kasta ut en session") (kom-filter-author . "Filtrera f\366rfattare") (kom-filter-subject . "Filtrera \344rende") (kom-filter-text . "Filtrera inneh\345ll") (kom-super-jump . "Superhoppa") (kom-filter-edit . "\304ndra filter") (kom-list-filters . "Lista filter") (kom-show-user-area . "Visa user-arean") (kom-change-conf-type . "\304ndra m\366testyp") (kom-change-auto-reply . "\304ndra svarsmeddelande") (kom-toggle-auto-reply . "Automatsvar") (kom-list-messages . "Lista meddelanden") (kom-erase-messages . "Radera meddelanden") (kom-remote-autoreply . "Fj\344rrkontrollera automatsvar") (kom-remote-set-message . "Fj\344rrkontrollera \344ndra svarsmeddelande") (kom-remote-list-messages . "Fj\344rrkontrollera lista meddelanden") (kom-remote-erase-messages . "Fj\344rrkontrollera radera meddelanden") (kom-remote-quit . "Fj\344rrkontrollera avsluta") (kom-status-session . "Status (f\366r) session") (kom-customize . "Inställningar (för) LysKOM") (kom-next-kom . "Nästa LysKOM") (kom-previous-kom . "Föregående LysKOM") (kom-next-unread-kom . "Nästa olästa LysKOM") (kom-change-language . "Ändra språk") (kom-calculate . "Beräkna") )) (lyskom-language-var lyskom-language-codes sv '((aa . "Afar") (ab . "Abkhasianska") (af . "Afrikaans") (am . "Amhariska") (ar . "Arabiska") (as . "Assamesiska") (ay . "Aymara") (az . "Azerbajanska") (ba . "Bashkiriska") (be . "Vitryska") (bg . "Bulgariska") (bh . "Bihariska") (bi . "Bislamska") (bn . "Bengaliska") (bo . "Tibetanska") (br . "Bretangneska") (ca . "Katalanska") (co . "Korsikanska") (cs . "Tjeckiska") (cy . "Walesiska") (da . "Danska") (de . "Tyska") (dz . "Bhutanska") (el . "Grekiska") (en . "Engelska") (eo . "Esperanto") (es . "Spanska") (et . "Estniska") (eu . "Baskiska") (fa . "Persiska") (fi . "Finska") (fj . "Fiji") (fo . "Faröiska") (fr . "Franska") (fy . "Frisiska") (ga . "Irländska") (gd . "Skotsk Gäliska") (gl . "Galiciska") (gn . "Guarani") (gu . "Gujaratiska") (ha . "Hausa") (he . "Hebreiska") (hi . "Hindi") (hr . "Kroatiska") (hu . "Ungerska") (hy . "Armeniska") (ia . "Interlingua") (id . "Indonesiska") (ie . "Interlingue") (ik . "Inupiak") (is . "Isländska") (it . "Italienska") (iu . "Inuktitut") (ja . "Japanska") (jw . "Javanesiska") (ka . "Georgiska") (kk . "Kazakhstanska") (kl . "Grönländska") (km . "Kambodianska") (kn . "Kannada") (ko . "Koreanska") (ks . "Kashmiriska") (ku . "Kurdiska") (ky . "Kirghiz") (la . "Latinska") (ln . "Lingala") (lo . "Laotesiska") (lt . "Litauiska") (lv . "Lettiska") (mg . "Malagasiska") (mi . "Maori") (mk . "Makedonska") (ml . "Malayalam") (mn . "Mongolska") (mo . "Moldaviska") (mr . "Marathi") (ms . "Malaysiska") (mt . "Maltesiska") (my . "Burmesiska") (na . "Nauruiska") (ne . "Nepalska") (nl . "Holländska") (no . "Norska") (oc . "Occitanska") (om . "Oromo") (or . "Oriya") (pa . "Pundjabiska") (pl . "Polska") (ps . "Pashtu") (pt . "Protugisiska") (qu . "Quechua") (rm . "Rhätoromanska") (rn . "Kirundiska") (ro . "Rumänska") (ru . "Ryska") (rw . "Kiyarwanda") (sa . "Sanskrit") (sd . "Sindhi") (sg . "Sangho") (sh . "Serbokroatiska") (si . "Singhalesiska") (sk . "Slovakiska") (sl . "Slovenska") (sm . "Samoanska") (sn . "Shoniska") (so . "Somaliska") (sq . "Albanska") (sr . "Serbiska") (ss . "Siswatiska") (st . "Sesothiska") (su . "Sudanesiska") (sv . "Svenska") (sw . "Swahili") (ta . "Tamilska") (te . "Telugu") (tg . "Tajikiska") (th . "Thailändska") (ti . "Tigrinya") (tk . "Turkmenistanska") (tl . "Tagalog") (tn . "Sichuanska") (to . "Tongiska") (tr . "Turkiska") (ts . "Tsongiska") (tt . "Tatariska") (tw . "Twi") (ug . "Uiguriska") (uk . "Ukrainska") (ur . "Urdu") (uz . "Uzbekistanska") (vi . "Vietnamesiska") (vo . "Volapük") (wo . "Wolof") (xh . "Xhosa") (yi . "Yiddish") (yo . "Yorouba") (za . "Zhuang") (zh . "Kinesiska") (zu . "Zulu") (-- . "Okänt språk (%#1s)"))) (lyskom-language-strings lyskom-menu sv '((lyskom . "LysKOM") (read . "L\344s") (dont-read . "Hoppa") (write . "Skriv") (conference . "M\366te") (person . "Person") (other . "Annat") (move . "G\345") (info . "Om") (send . "S\344nd") (recievers . "Mottagare") (commented . "Kommenterar") (kom-edit-send . "Skicka in") (kom-edit-send-anonymous . "Skicka anonymt") (kom-edit-quit . "Kasta bort") (kom-ispell-message . "Stavningskontroll") (kom-edit-add-recipient . "Addera mottagare") (kom-edit-add-copy . "Addera extra kopiemottagare") (kom-edit-show-commented . "\305terse det kommenterade") (kom-edit-insert-commented . "Citera det kommenterade"))) ;;(defvar lyskom-swascii-commands nil ;; "The swascii-versions of lyskom-commands.") (lyskom-language-var lyskom-onoff-table sv '(("p\345" . on) ("av" . off))) (lyskom-language-var lyskom-filter-predicate-list sv '(("=" . nil) ("!=" . t))) (lyskom-language-var lyskom-filter-what sv '((author . "F\366rfattare") (author-no . "F\366rfattare (nummer)") (author-re . "F\366rfattare (regexp)") (subject . "\304rende") (subject-re . "\304rende (regexp)") (recipient . "Mottagare") (recipient-no . "Mottagare (nummer)") (recipient-re . "Mottagare (regexp)") (text . "Inneh\345ll") (text . "Inneh\345ll (regexp)"))) (lyskom-language-var lyskom-filter-actions sv '((skip-text . "Hoppa \366ver") (dontshow . "Visa inte") (skip-tree . "Hoppa \366ver kommentarer"))) ;;(defvar lyskom-swascii-filter-actions nil ;; "The swascii-versions of lyskom-filter-actions.") ;;(defvar lyskom-swascii-filter-what nil ;; "The swascii version of lyskom-filter-what") (lyskom-language-var lyskom-text-start sv "[0-9]+ +\\(199[0-9]-[0-1][0-9]-[0-3][0-9]\\|idag\\|igår\\) +[0-2][0-9]:[0-5][0-9] +/[0-9]+ rad\\(er\\)?/ ") (defconst lyskom-keybindings-missing '(lyskom-previous-prefix)) (defvar lyskom-sv-mode-map nil) (lyskom-language-keymap lyskom-mode-map sv lyskom-sv-mode-map) (if lyskom-sv-mode-map nil (setq lyskom-sv-mode-map (make-keymap)) (suppress-keymap lyskom-sv-mode-map) (define-prefix-command 'lyskom-sv-review-prefix) (define-prefix-command 'lyskom-sv-change-prefix) (define-prefix-command 'lyskom-sv-next-prefix) (define-prefix-command 'lyskom-sv-list-prefix) (define-prefix-command 'lyskom-sv-S-prefix) (define-prefix-command 'lyskom-sv-filter-get-prefix) (define-key lyskom-sv-mode-map "f" 'lyskom-sv-filter-get-prefix) (define-key lyskom-sv-mode-map "n" 'lyskom-sv-next-prefix) (define-key lyskom-sv-mode-map "l" 'lyskom-sv-list-prefix) (define-key lyskom-sv-mode-map "s" 'lyskom-sv-S-prefix) ;; emacs 19 (define-key lyskom-sv-mode-map (lyskom-keys [ä]) 'lyskom-sv-change-prefix) (define-key lyskom-sv-mode-map (lyskom-keys [Ä]) 'lyskom-sv-change-prefix) (define-key lyskom-sv-mode-map (lyskom-keys [Å]) 'lyskom-sv-review-prefix) (define-key lyskom-sv-mode-map (lyskom-keys [å]) 'lyskom-sv-review-prefix) (define-key lyskom-sv-mode-map (lyskom-keys [f ä]) 'kom-filter-subject) (define-key lyskom-sv-mode-map (lyskom-keys [f Ä]) 'kom-filter-subject) (define-key lyskom-sv-mode-map (lyskom-keys [l ä]) 'kom-list-summary) (define-key lyskom-sv-mode-map (lyskom-keys [l Ä]) 'kom-list-summary) (define-key lyskom-sv-mode-map [ä] 'lyskom-sv-change-prefix) (define-key lyskom-sv-mode-map [Ä] 'lyskom-sv-change-prefix) (define-key lyskom-sv-mode-map [Å] 'lyskom-sv-review-prefix) (define-key lyskom-sv-mode-map [å] 'lyskom-sv-review-prefix) (define-key lyskom-sv-mode-map [f ä] 'kom-filter-subject) (define-key lyskom-sv-mode-map [f Ä] 'kom-filter-subject) (define-key lyskom-sv-mode-map [l ä] 'kom-list-summary) (define-key lyskom-sv-mode-map [l Ä] 'kom-list-summary) (define-key lyskom-sv-mode-map (lyskom-keys [mouse-2]) 'kom-button-click) (define-key lyskom-sv-mode-map (lyskom-keys [down-mouse-3]) 'kom-popup-menu) (define-key lyskom-sv-mode-map [mouse-3] 'kom-mouse-null) (define-key lyskom-sv-mode-map "*" 'kom-button-press) (define-key lyskom-sv-mode-map "\C-i" 'kom-next-link) (define-key lyskom-sv-mode-map "\M-\C-i" 'kom-previous-link) (define-key lyskom-sv-mode-map "{" 'lyskom-sv-change-prefix) ; krullar (define-key lyskom-sv-mode-map "[" 'lyskom-sv-change-prefix) (define-key lyskom-sv-mode-map "}" 'lyskom-sv-review-prefix) (define-key lyskom-sv-mode-map "]" 'lyskom-sv-review-prefix) ;; (define-key lyskom-sv-mode-map "\344" 'lyskom-sv-change-prefix) ; 8-bit keymap ;; (define-key lyskom-sv-mode-map "\304" 'lyskom-sv-change-prefix) ;; (define-key lyskom-sv-mode-map "\345" 'lyskom-sv-review-prefix) ;; (define-key lyskom-sv-mode-map "\305" 'lyskom-sv-review-prefix) ;; (define-key lyskom-sv-mode-map "\M-{" 'lyskom-sv-change-prefix) ;; (define-key lyskom-sv-mode-map "\M-[" 'lyskom-sv-change-prefix) ;; (define-key lyskom-sv-mode-map "\M-}" 'lyskom-sv-review-prefix) ;; (define-key lyskom-sv-mode-map "\M-]" 'lyskom-sv-review-prefix) ;;(define-key lyskom-sv-mode-map "vi" 'vilka) ;; These should be first in order to be last in the menu of alternatives. (define-key lyskom-sv-mode-map "{?" 'lyskom-help) (define-key lyskom-sv-mode-map "}?" 'lyskom-help) (define-key lyskom-sv-mode-map "f?" 'lyskom-help) (define-key lyskom-sv-mode-map "n?" 'lyskom-help) (define-key lyskom-sv-mode-map "l?" 'lyskom-help) (define-key lyskom-sv-mode-map "s?" 'lyskom-help) (define-key lyskom-sv-mode-map "e" 'kom-set-unread) (define-key lyskom-sv-mode-map "a" 'kom-extended-command) (define-key lyskom-sv-mode-map " " 'kom-next-command) (define-key lyskom-sv-mode-map "\n" 'kom-page-next-command) (define-key lyskom-sv-mode-map "\r" 'kom-line-next-command) (define-key lyskom-sv-mode-map "j" 'kom-page-next-command) (define-key lyskom-sv-mode-map "?" 'describe-mode) (define-key lyskom-sv-mode-map "b" 'kom-send-letter) (define-key lyskom-sv-mode-map "g" 'kom-go-to-conf) (define-key lyskom-sv-mode-map "i" 'kom-write-text) (define-key lyskom-sv-mode-map "k" 'kom-write-comment) (define-key lyskom-sv-mode-map "K" 'kom-comment-previous) (define-key lyskom-sv-mode-map "F" 'kom-write-footnote) (define-key lyskom-sv-mode-map "p" 'kom-private-answer) (define-key lyskom-sv-mode-map "P" 'kom-private-answer-previous) (define-key lyskom-sv-mode-map "h" 'kom-jump) (define-key lyskom-sv-mode-map "H" 'kom-super-jump) (define-key lyskom-sv-mode-map "lm" 'kom-list-conferences) (define-key lyskom-sv-mode-map "ln" 'kom-list-news) (define-key lyskom-sv-mode-map "lp" 'kom-list-persons) (define-key lyskom-sv-mode-map "lr" 'kom-list-re) (define-key lyskom-sv-mode-map "ls" 'kom-membership) (define-key lyskom-sv-mode-map "l{" 'kom-list-summary) (define-key lyskom-sv-mode-map "l[" 'kom-list-summary) ;; (define-key lyskom-sv-mode-map "l\344" 'kom-list-summary) ; 8-bit emacs ;; (define-key lyskom-sv-mode-map "l\304" 'kom-list-summary) ;; (define-key lyskom-sv-mode-map "l\M-{" 'kom-list-summary) ; 7(8)-bit emacs ;; (define-key lyskom-sv-mode-map "l\M-[" 'kom-list-summary) (define-key lyskom-sv-mode-map "lf" 'kom-list-filters) (define-key lyskom-sv-mode-map "m" 'kom-add-self) (define-key lyskom-sv-mode-map "M" 'kom-mark-text) (define-key lyskom-sv-mode-map "A" 'kom-unmark-text) (define-key lyskom-sv-mode-map "ni" 'kom-view-next-new-text) (define-key lyskom-sv-mode-map "nm" 'kom-go-to-next-conf) (define-key lyskom-sv-mode-map "nl" 'kom-next-kom) (define-key lyskom-sv-mode-map "no" 'kom-next-unread-kom) (define-key lyskom-sv-mode-map "fl" 'kom-previous-kom) (define-key lyskom-sv-mode-map "S" 'kom-quit) (define-key lyskom-sv-mode-map "q" 'kom-quit) (define-key lyskom-sv-mode-map "z" 'kom-bury) (define-key lyskom-sv-mode-map "R" 'kom-recover) (define-key lyskom-sv-mode-map "t" 'kom-display-time) (define-key lyskom-sv-mode-map "fu" 'kom-get-appreciation) (define-key lyskom-sv-mode-map "fs" 'kom-get-abuse) (define-key lyskom-sv-mode-map "ft" 'kom-move-text) (define-key lyskom-sv-mode-map "f{" 'kom-filter-subject) (define-key lyskom-sv-mode-map "f[" 'kom-filter-subject) ;; (define-key lyskom-sv-mode-map "f\344" 'kom-filter-subject) ;; (define-key lyskom-sv-mode-map "f\304" 'kom-filter-subject) ;; (define-key lyskom-sv-mode-map "f\M-{" 'kom-filter-subject) ;; (define-key lyskom-sv-mode-map "f\M-[" 'kom-filter-subject) (define-key lyskom-sv-mode-map "ff" 'kom-filter-author) (define-key lyskom-sv-mode-map "fi" 'kom-filter-text) (define-key lyskom-sv-mode-map "v" 'kom-who-is-on) (define-key lyskom-sv-mode-map "J" 'kom-who-am-i) (define-key lyskom-sv-mode-map "V" 'kom-busy-wait) (define-key lyskom-sv-mode-map "{p" 'kom-change-presentation) (define-key lyskom-sv-mode-map "{f" 'kom-filter-edit) (define-key lyskom-sv-mode-map "{m" 'kom-change-auto-reply) (define-key lyskom-sv-mode-map "} " 'kom-view) (define-key lyskom-sv-mode-map "}0" 'kom-initial-digit-view) (define-key lyskom-sv-mode-map "}1" 'kom-initial-digit-view) (define-key lyskom-sv-mode-map "}2" 'kom-initial-digit-view) (define-key lyskom-sv-mode-map "}3" 'kom-initial-digit-view) (define-key lyskom-sv-mode-map "}4" 'kom-initial-digit-view) (define-key lyskom-sv-mode-map "}5" 'kom-initial-digit-view) (define-key lyskom-sv-mode-map "}6" 'kom-initial-digit-view) (define-key lyskom-sv-mode-map "}7" 'kom-initial-digit-view) (define-key lyskom-sv-mode-map "}8" 'kom-initial-digit-view) (define-key lyskom-sv-mode-map "}9" 'kom-initial-digit-view) (define-key lyskom-sv-mode-map "}k" 'kom-view-commented-text) (define-key lyskom-sv-mode-map "}K" 'kom-view-previous-commented-text) (define-key lyskom-sv-mode-map "}a?" 'lyskom-help) (define-key lyskom-sv-mode-map "}ak" 'kom-review-comments) (define-key lyskom-sv-mode-map "}ar" 'kom-review-tree) (define-key lyskom-sv-mode-map "}h" 'kom-review-clear) (define-key lyskom-sv-mode-map "}i" 'kom-review-last-normally-read) (define-key lyskom-sv-mode-map "}n" 'kom-review-next) (define-key lyskom-sv-mode-map "}o" 'kom-review-noconversion) (define-key lyskom-sv-mode-map "}r" 'kom-find-root) (define-key lyskom-sv-mode-map "}u" 'kom-find-root) (define-key lyskom-sv-mode-map "}s" 'kom-review-by-to) (define-key lyskom-sv-mode-map "}y" 'kom-review-more) (define-key lyskom-sv-mode-map "}A" 'kom-review-all) (define-key lyskom-sv-mode-map "}f" 'kom-review-first) (define-key lyskom-sv-mode-map "}l" 'kom-review-stack) (define-key lyskom-sv-mode-map "}p" 'kom-review-presentation) (define-key lyskom-sv-mode-map "}t" 'kom-find-root-review) (define-key lyskom-sv-mode-map "}m" 'kom-review-marked-texts) (define-key lyskom-sv-mode-map "}am" 'kom-review-all-marked-texts) (define-key lyskom-sv-mode-map "}a " 'kom-review-all) (define-key lyskom-sv-mode-map "B" 'kom-review-backward) (define-key lyskom-sv-mode-map "sm" 'kom-status-conf) (define-key lyskom-sv-mode-map "sp" 'kom-status-person) (define-key lyskom-sv-mode-map "ss" 'kom-status-session) ;; Running in buffer (define-key lyskom-sv-mode-map "\M-p" 'backward-text) (define-key lyskom-sv-mode-map "\M-n" 'forward-text) (define-key lyskom-sv-mode-map "st" 'kom-save-text) (define-key lyskom-sv-mode-map "\C-?" 'scroll-down) ) ;;;============================================================== ;;; Keymap for filter editing ;;; (defvar lyskom-sv-filter-edit-map nil) (lyskom-language-keymap lyskom-filter-edit-map sv lyskom-sv-filter-edit-map) (if lyskom-sv-filter-edit-map () (setq lyskom-sv-filter-edit-map (make-keymap)) (suppress-keymap lyskom-sv-filter-edit-map) (define-key lyskom-sv-filter-edit-map "p" 'lyskom-filter-edit-prev-pattern) (define-key lyskom-sv-filter-edit-map "P" 'lyskom-filter-edit-prev-entry) (define-key lyskom-sv-filter-edit-map "n" 'lyskom-filter-edit-next-pattern) (define-key lyskom-sv-filter-edit-map "N" 'lyskom-filter-edit-next-entry) (define-key lyskom-sv-filter-edit-map "\C-P" 'lyskom-filter-edit-prev-pattern) (define-key lyskom-sv-filter-edit-map "\C-N" 'lyskom-filter-edit-next-pattern) (define-key lyskom-sv-filter-edit-map "\C-B" 'lyskom-filter-edit-prev-pattern) (define-key lyskom-sv-filter-edit-map "\C-F" 'lyskom-filter-edit-next-pattern) (define-key lyskom-sv-filter-edit-map "\M-p" 'lyskom-filter-edit-prev-entry) (define-key lyskom-sv-filter-edit-map "\M-n" 'lyskom-filter-edit-next-entry) (define-key lyskom-sv-filter-edit-map "d" 'lyskom-filter-edit-delete-pattern) (define-key lyskom-sv-filter-edit-map "\M-d" 'lyskom-filter-edit-delete-entry) (define-key lyskom-sv-filter-edit-map "D" 'lyskom-filter-edit-delete-pattern) (define-key lyskom-sv-filter-edit-map "\C-D" 'lyskom-filter-edit-delete-pattern) (define-key lyskom-sv-filter-edit-map "i" 'lyskom-filter-edit-insert-pattern) (define-key lyskom-sv-filter-edit-map "I" 'lyskom-filter-edit-insert-pattern) (define-key lyskom-sv-filter-edit-map "\M-i" 'lyskom-filter-edit-insert-entry) (define-key lyskom-sv-filter-edit-map "<" 'lyskom-filter-edit-beginning-of-list) (define-key lyskom-sv-filter-edit-map ">" 'lyskom-filter-edit-end-of-list) (define-key lyskom-sv-filter-edit-map "\M-<" 'lyskom-filter-edit-beginning-of-list) (define-key lyskom-sv-filter-edit-map "\M->" 'lyskom-filter-edit-end-of-list) (define-key lyskom-sv-filter-edit-map "q" 'lyskom-filter-edit-quit) (define-key lyskom-sv-filter-edit-map "x" 'lyskom-filter-edit-expunge) (define-key lyskom-sv-filter-edit-map "s" 'lyskom-filter-edit-save) (define-key lyskom-sv-filter-edit-map "g" 'lyskom-filter-edit-revert) (define-key lyskom-sv-filter-edit-map "t" 'lyskom-filter-edit-toggle-permanent) (define-key lyskom-sv-filter-edit-map "a" 'lyskom-filter-edit-toggle-action) (define-key lyskom-sv-filter-edit-map "?" 'lyskom-filter-edit-brief-help) (define-key lyskom-sv-filter-edit-map "h" 'lyskom-filter-edit-brief-help) ) ;;;(if lyskom-prioritize-mode-map ;;; nil ;;; (setq lyskom-prioritize-mode-map (make-keymap)) ;;; (suppress-keymap lyskom-prioritize-mode-map) ;;; (define-key lyskom-prioritize-mode-map [mouse-2] 'kom-button-click) ;;; (define-key lyskom-prioritize-mode-map "\C-?" 'previous-line) ;;; (define-key lyskom-prioritize-mode-map " " 'next-line) ;;; (define-key lyskom-prioritize-mode-map "\C-k" 'kom-prioritize-kill) ;;; (define-key lyskom-prioritize-mode-map "\C-y" 'kom-prioritize-yank) ;;; (define-key lyskom-prioritize-mode-map "p" 'kom-prioritize-set-priority) ;;; (define-key lyskom-prioritize-mode-map "\C-c\C-c" 'kom-prioritize-quit) ;;; (define-key lyskom-prioritize-mode-map "q" 'kom-prioritize-quit) ;;; (define-key lyskom-prioritize-mode-map "S" 'kom-prioritize-quit) ;;; (define-key lyskom-prioritize-mode-map "u" 'kom-prioritize-move-up) ;;; (define-key lyskom-prioritize-mode-map "n" 'kom-prioritize-move-down) ;;;) (defvar lyskom-sv-prioritize-mode-map nil) (lyskom-language-keymap lyskom-prioritize-mode-map sv lyskom-sv-prioritize-mode-map) (if lyskom-sv-prioritize-mode-map nil (setq lyskom-sv-prioritize-mode-map (make-keymap)) (suppress-keymap lyskom-sv-prioritize-mode-map) (define-key lyskom-sv-prioritize-mode-map (lyskom-keys [mouse-2]) 'kom-button-click) (define-key lyskom-sv-prioritize-mode-map (lyskom-keys [down-mouse-3]) 'kom-popup-menu) (define-key lyskom-sv-prioritize-mode-map [mouse-3] 'kom-mouse-null) (define-key lyskom-sv-prioritize-mode-map "*" 'kom-button-press) (define-key lyskom-sv-prioritize-mode-map "?" 'kom-prioritize-help) (define-key lyskom-sv-prioritize-mode-map "\C-k" 'kom-prioritize-select) (define-key lyskom-sv-prioritize-mode-map "\C-y" 'kom-prioritize-yank) (define-key lyskom-sv-prioritize-mode-map " " 'kom-prioritize-select) (define-key lyskom-sv-prioritize-mode-map "\C-m" 'kom-prioritize-next-line) (define-key lyskom-sv-prioritize-mode-map "\C-j" 'kom-prioritize-next-line) (define-key lyskom-sv-prioritize-mode-map [down] 'kom-prioritize-next-line) (define-key lyskom-sv-prioritize-mode-map "\C-n" 'kom-prioritize-next-line) (define-key lyskom-sv-prioritize-mode-map "\C-?" 'kom-prioritize-previous-line) (define-key lyskom-sv-prioritize-mode-map "\M-\C-?" 'kom-prioritize-deselect-all) (define-key lyskom-sv-prioritize-mode-map [up] 'kom-prioritize-previous-line) (define-key lyskom-sv-prioritize-mode-map "\C-p" 'kom-prioritize-previous-line) (define-key lyskom-sv-prioritize-mode-map "p" 'kom-prioritize-previous-line) (define-key lyskom-sv-prioritize-mode-map [(meta up)] 'kom-prioritize-move-up) (define-key lyskom-sv-prioritize-mode-map "\M-p" 'kom-prioritize-move-up) (define-key lyskom-sv-prioritize-mode-map "u" 'kom-prioritize-move-up) (define-key lyskom-sv-prioritize-mode-map [(meta down)] 'kom-prioritize-move-down) (define-key lyskom-sv-prioritize-mode-map "\M-n" 'kom-prioritize-move-down) (define-key lyskom-sv-prioritize-mode-map "d" 'kom-prioritize-move-down) (define-key lyskom-sv-prioritize-mode-map "n" 'kom-prioritize-move-down) (define-key lyskom-sv-prioritize-mode-map "\M-<" 'kom-prioritize-beginning) (define-key lyskom-sv-prioritize-mode-map "\M->" 'kom-prioritize-end) (define-key lyskom-sv-prioritize-mode-map "r" 'kom-prioritize-reprioritize) (define-key lyskom-sv-prioritize-mode-map "g" 'kom-prioritize-goto-priority) (define-key lyskom-sv-prioritize-mode-map "p" 'kom-prioritize-set-priority) (define-key lyskom-sv-prioritize-mode-map "s" 'kom-prioritize-save) (define-key lyskom-sv-prioritize-mode-map "q" 'kom-prioritize-quit) (define-key lyskom-sv-prioritize-mode-map "\C-c\C-c" 'kom-prioritize-quit) (define-key lyskom-sv-prioritize-mode-map "\t" 'kom-next-link) (define-key lyskom-sv-prioritize-mode-map "\M-\C-i" 'kom-previous-link) ) (lyskom-language-var lyskom-prioritize-header-lines sv 2) (lyskom-language-var lyskom-prioritize-header sv " Prio M\366te ----------------------------------------------------------------------------- ") ;;;; ============================================================ ;;;; Strings and things for the customize mode ;;;; (defvar lyskom-sv-customize-map nil) (lyskom-language-keymap lyskom-customize-map sv lyskom-sv-customize-map) (if lyskom-sv-customize-map nil (setq lyskom-sv-customize-map (make-sparse-keymap)) (define-key lyskom-sv-customize-map "\t" 'widget-forward) (define-key lyskom-sv-customize-map "\M-\t" 'widget-backward) (define-key lyskom-sv-customize-map "\C-m" 'widget-button-press) (define-key lyskom-sv-customize-map (lyskom-keys [mouse-2]) 'widget-button-click) (define-key lyskom-sv-customize-map (lyskom-keys [mouse-3]) 'lyskom-widget-click) (define-key lyskom-sv-customize-map "\C-c\C-c" 'lyskom-customize-save-and-quit) (define-key lyskom-sv-customize-map "\C-c\C-k" 'lyskom-customize-quit) (define-key lyskom-sv-customize-map "\C-c\C-s" 'lyskom-customize-save) (define-key lyskom-sv-customize-map "\C-c\C-a" 'lyskom-customize-apply) (define-key lyskom-sv-customize-map "?" 'lyskom-customize-help) ) (lyskom-language-strings lyskom-custom-strings sv '( ;; ;; Widget strings ;; (which-person . "Ange en person: ") (which-conf . "Ange ett möte: ") (which-conf-or-person . "Ange en person eller ett möte: ") (which-name . "Ange ett namn: ") (some-person . "Person %#1d") (invalid-value . "Otillåtet värde (%#1S)") (unknown-command . "Okänt kommando (%#1s)") ;; ;; Help messages ;; (default-help-echo . "Ändra värdet på %#1s.") (change-this-name . "Ändra namnet på denna rad.") (show-doc . "Visa hjälptexten.") (hide-doc . "Dölj hjälptexten.") (select-command . "Välj kommando.") (select-what-to-execute . "Exekvera kommando eller tangentbordsmakro.") (select-url-viewer . "Välj en WWW-läsare.") (select-number . "Ange hur många gånger.") (select-audio-file . "Ange en ljudfil.") (select-priority . "Ange prioritet.") (select-buffer . "Ange buffert.") (select-buffer-size . "Ange buffertstorlek.") ;; ;; Strings that are used in types and so forth ;; (buffer-name . "%#1s-inställningar") (other-window . "Något annat fönster ") (other-frame . "I en annan frame ") (new-frame . "I en ny frame ") (lyskom-window . "LysKOM-buffertens fönster ") (window-on-buffer . "Ett fönster som visar bufferten") (on . "På") (off . "Av") (yes . "Ja ") (no . "Nej") (max-text-length . "För inlägg kortare än: ") (turned-off . "Avslaget ") (number-of-times . "Några gånger") (sound-file . "Ljudfil") (selected-mark . "Markering") (ask . "Fråga varje gång") (before . "Före texten") (after . "Efter texten") (depth-first . "I kommentarsordning") (time-order . "I tidsordning") (express-break . "Omedelbart efter de har skapats") (break . "Efter aktuell kommentarskedja ") (no-break . "Efter aktuellt möte ") (command . "Kommando") (command-list . "Kommandolista") (some-persons . "För vissa personer") (name . "Namn") (page-none . "Aldrig ") (page-all . "Före varje kommando ") (page-some . "Före följande kommandon") (ask-every-time . "Fråga varje gång ") (fixed-priority . "Fast prioritet") (messages-in-lyskom-buffer . "I LysKOM-bufferten ") (discard-messages . "Ingenstans ") (in-named-buffer . "I namngiven buffert") (everybody-rcpt . "Alla") (group-rcpt . "Senaste gruppmeddelandes mottagare") (sender-rcpt . "Senaste meddelandes avsändare") (viewer-program . "WWW-läsare") (no-viewer . "(ingenting valt)") (default-viewer . "Browse-URL (alla)") (netscape-viewer . "Netscape Navigator (alla)") (emacs-w3-viewer . "Emacs W3-mode (HTTP, Goper, FTP)") (emacs-general-viewer . "Emacs (FTP, Telnet, Mail)") (emacs-dired-viewer . "Emacs Dired (FTP)") (emacs-mail-viewer . "Emacs Mail-mode (Mail)") (emacs-telnet-viewer . "Emacs Telnet-mode (telnet)") (mosaic-viewer . "NCSA Mosaic (alla)") (lynx-viewer . "Lynx (alla)") (dont-check . "Ingen bekräftelse") (check-before-open . "Bekräfta innan inlägget skrivs") (check-before-send . "Bekräfta innan inlägget sänds") (no-size-limit . "Ingen begränsning") (max-size-in-bytes . "Begränsning (i bytes)") (execute . "Utför") (kbd-macro . "Tangentbordmakro") (command . "Kommando") (enter-kbd-macro . "Mata in tangentbordsmakro. Avsluta med %#1s") (long-format . "Visa hjälptexter") (short-format . "Göm hjälptexter ") ;; ;; Misc doc strings ;; (lyskom . "Inställningar för LysKOM") (lyskom-doc . "\ \\[lyskom-customize-save-and-quit] för att spara och avsluta, \\[lyskom-customize-save] för att spara utan att avsluta \\[lyskom-customize-quit] för att avsluta utan att spara \\[widget-forward] flyttar till nästa inställning \\[widget-button-press] ändrar värdet Hälptexter: [?] Visa hjälptext [!] Göm hjälptext Listor mm.: [INS] Lägg till rad [DEL] Ta bort rad [*] Ändra värde") (section . "------------------------------------------------------------------------------\n") (look-and-feel-misc . "Diverse utseende och beteende\n") (window-locations . "Fönster\n") (windows-where . "Hur skall fönster skapas:\n") (reading . "Beteende vid läsning\n") (writing . "Beteende vid skrivning\n") (urls . "Hantering av URLer\n") (personal-messages . "Hantering av personliga meddelanden\n") (remote-control . "Fjärrstyrning av LysKOM\n") (hooks . "Hook-funktioner\n") (audio-cues . "Ljudsignaler\n") (audio-cues-when . "Ge ljudsignal:\n") (automatic-replies . "Automatiskt svar\n") (audio-cues-doc . "\ Efterföljande inställningar bestämmer vilken ljudsignal LysKOM skall ge i olika situationer. Följande alternativ går att välja: Avslaget Ingen ljudsignal alls kommer att ges. Några gånger Emacs kommer att pipa en eller flera gånger när händelsen inträffar. Antal pip anges också. Ljudfil Emacs kommer att spela upp den angivna ljudfilen. Programmet som angavs ovan som ljudspelarprogram används för att spela ljudet.") (sending-doc . "\ Följande inställningar slår på eller av vissa kontroller vid inskickning av inlägg. Kontrollerna är avsedda att hindra att man gör någonting dumt. Bekräfta multipla mottagare Om ett inlägg eller kommentar har flera mottagare så kan LysKOM fråga vilka av mottagarna som är relevanta för inlägget. Antingen görs detta innan man skriver inlägget (då får man en fråga för varje defaultmottagare), eller när man skickar in inlägget (då får man bekräfta alla mottagare i klump.) Det går också att slå av helt. Kontroll av kommenterad författares medlemsskap Kontrollera att författaren till det kommenterade inlägget är medlem i någon av mottagarna för kommentaren. Om så inte är fallet, erbjuder LysKOM att lägga till författaren som mottagare till inlägget. Kontroll av olästa kommentarer När detta är påslaget så kontrollerar LysKOM att det inlägg man kommenterar inte har några kommentarer man inte har läst. Detta är främst användbart för att undvika att man skriver någonting som någon annan redan har skrivit.") (windows-doc . "\ Följande inställningar bestämmer hur fönster skapas i LysKOM. Alternativen som finns är följande: Något annat fönster I ett annat fönster i samma frame som LysKOM. Om det bara finns ett fönster så kommer ett nytt att skapas (och tas bort när man är klar.) I en annan frame I en annan frame än LysKOM. Om det bara finns en frame så kommer en ny frame att skapas, och tas bort när man är klar. I en ny frame En ny frame skapas för ändamålet, och tas bort när man är klar. LysKOM-buffertens fönster LysKOM-buffertens fönster kommer att användas, och LysKOM kommer att återställas till fönstret när man är färdig. Ett fönster som visar bufferten Om det finns ett fönster någonstans som visar den angivna bufferten så kommer detta fönster att användas. Det kan till exempel vara användbart om man hela tiden har ett fönster öppet, men inte beöver det just medan man utför något visst kommando.") ;; ;; Doc strings for variables ;; (kom-emacs-knows-iso-8859-1-doc . "\ Påslaget betyder att Emacs förväntas förstå ISO-8859-1. Avslaget innebär att swascii accepteras i kommandonamn med mera. Skall vara påslaget.") (kom-bury-buffers-doc . "\ Bestämmer hur bufferten hanteras när man går till ett annat KOM med Nästa LysKOM och liknande funktioner. Påslaget innebär att den aktuella bufferten läggs sist i buffertlistan när man byter LysKOM.") (kom-write-texts-in-window-doc . "\ Bestämmer i vilket fönster nya texter skrivs.") (kom-prioritize-in-window-doc . "\ Bestämmer i vilket fönster man prioriterar om möten.") (kom-edit-filters-in-window-doc . "\ Bestämmer i vilket fönster man ändrar filter.") (kom-customize-in-window-doc . "\ Bestämmer i vilket fönster man gör dessa inställningar.") (kom-view-commented-in-window-doc . "\ Bestämmer i vilket fönster man visar kommenterarer medan man skriver nya.") (kom-list-membership-in-window-doc . "\ Bestämmer i vilket fönster man listar medlemsskap.") (kom-user-prompt-format-doc . "\ Format för LysKOM-prompten. Vissa teckenkombinationer sätter in speciella texter: %c - Sätter in kommandot som körs om man trycker på SPC eller RET. %[ - Sätter in '[' om automatsvar är påslaget. %] - Sätter in ']' om automatsvar är avstängt. %m - Sätter in information om antal inspelade meddelanden. %s - Sätter in LysKOM-systemets namn %S - Sätter in LysKOM-serverns namn %p - Sätter in namnet på den person som är inloggad. %w - Sätter in namn på aktuellt möte. %# - Sätter in sessionsnummer. % - Sätter in mellanslag om det ser ut att behövas. %% - Sätter in ett procenttecken. Nägra exempel: \"%[%c% %m%] - \" Standardprompt \"%[%s: %c% %m%] - \" Till exempel \"LysKOM: Se tiden - \"") (kom-user-prompt-format-executing-doc . "\ Format för LysKOM-prompten efter man trycker på SPC eller RET. Vissa teckenkombinationer sätter in speciella texter: %c - Sätter in kommandot som körs om man trycker på SPC eller RET. %[ - Sätter in '[' om automatsvar är påslaget. %] - Sätter in ']' om automatsvar är avstängt. %m - Sätter in information om antal inspelade meddelanden. %s - Sätter in LysKOM-systemets namn %S - Sätter in LysKOM-serverns namn %p - Sätter in namnet på den person som är inloggad. %w - Sätter in namn på aktuellt möte. %# - Sätter in sessionsnummer. % - Sätter in mellanslag om det ser ut att behövas. %% - Sätter in ett procenttecken. Nägra exempel: \"%[%c% %m%].\" Standardprompt \"%[%s: Kör %c% %m%]...\" Till exempel \"LysKOM: Kör Se tiden...\"") (kom-cite-string-doc . "\ Text som sätts in före varje rad i ett citerat inlägg. Normalt brukar någonting i stil med \"> \" användas. Notera dock att det inte är brukligt att citera KOM-inlägg som man gör med sladdpost och News eftersom det kommenterade inlägget oftast finns tillgängligt.") (kom-created-texts-are-read-doc . "\ Om detta är påslaget kommer alla inlägg man själv skriver att läsmarkeras automatiskt. Om inställningen är avslagen så får man läsa sådant man själv skriver.") (kom-default-mark-doc . "\ Det markeringsvärde som används för nya markeringar. Om inget markerings- värde är valt frågar LysKOM varje gång man markerar en text. Värden mellan 1 och 255 är tillåtna.") (kom-reading-puts-comments-in-pointers-last-doc . "\ Bestämmer om kommentarslänkar visas före eller efter en text. Normalt brukar man visa kommentarslänkar efter texten. Före: 398331 1996-09-24 13:22 /2 rader/ George Berkeley Mottagare: Filosofimötet <1226> Kommentar i text 398374 av John Locke Ärende: ------------------------------------------------------------ En abstrakt idé är en självmotsägelse. (398331) ----------------------------------- Efter: 398331 1996-09-24 13:22 /2 rader/ George Berkeley Mottagare: Filosofimötet <1226> Ärende: ------------------------------------------------------------ En abstrakt idé är en självmotsägelse. (398331) ----------------------------------- Kommentar i text 398374 av John Locke ") (kom-show-author-at-end-doc . "\ Om detta är påslaget så visas namnet på författaren efter inläggstexten. Naturligtvis så visas även namnet i inläggshuvudet. Påslaget (med streckade linjer också påslaget): 892342 1996-09-24 19:21 /2 rader/ Claude Shannon Mottagare: Presentation (av nya) Medlemmar Ärende: Claude Shannon ------------------------------------------------------------ Informationsteoretiker (892342) /Claude Shannon/------------------------------ Avslaget: 892342 1996-09-24 19:21 /2 rader/ Claude Shannon Mottagare: Presentation (av nya) Medlemmar Ärende: Claude Shannon ------------------------------------------------------------ Informationsteoretiker (892342) ----------------------------------- Om man har streckade linjer avslaget så visas författaren på samma sätt, men de streckade linjerna finns naturligtvis inte med.") (kom-dashed-lines-doc . "\ Om detta är påslaget visas streckade linjer före och efter inläggstexten, annars visas en tomrad efter ärenderaden, och ingenting speciellt i slutet. Påslaget: 892343 1996-09-24 19:21 /2 rader/ Tycho Brahe Mottagare: Presentation (av nya) Medlemmar Ärende: Tycho Brahe ------------------------------------------------------------ Astronom och upptäckare av stjärnor med hemvist på Ven. (892343) ----------------------------------- Avslaget: 892343 1996-09-24 19:21 /2 rader/ Tycho Brahe Mottagare: Presentation (av nya) Medlemmar Ärende: Tycho Brahe Astronom och upptäckare av stjärnor med hemvist på Ven. (892343) De flesta brukar ha detta påslaget.") (kom-autowrap-doc . "\ Om detta är påslaget så kommer LysKOM att försöka bryta om raderna i stycken vars rader egentligen är längre än skärmen är bred. Stycken som verkar vara förformatterade av författaren bryts dock aldrig om.") (kom-print-number-of-unread-on-entrance-doc . "\ Om detta är påslaget så visas antalet olästa i ett möte när man går till mötet: Påslaget: Gå till nästa möte... Presentation (av nya) medlemmar - 3 olästa Läsa nästa text - Avslaget: Gå till nästa möte... Presentation (av nya) medlemmar Läsa nästa text - ") (kom-presence-messages-doc . "\ Om man vill ha meddelanden i minibufferten när någon loggar in, ut eller byter namn i LysKOM bör man slå på den här inställningen. Meddelanden visas i minibufferten. Om man vill ha information om endast vissa personer går det att ange en lista av personer. Vill man inte ha några meddelanden alls är det bara att ange en tom lista.") (kom-presence-messages-in-buffer-doc . "\ Om man vill ha meddelanden i LysKOM-bufferten när någon loggar in, ut eller byter namn i LysKOM bör man slå på den här inställningen. Meddelanden visas i minibufferten. Om man vill ha information om endast vissa personer går det att ange en lista av personer. Vill man inte ha några meddelanden alls är det bara att ange en tom lista.") (kom-show-where-and-what-doc . "\ Information i vilkalistan om varifrån en person är inloggad och vad personen gör visas bara om detta är påslaget. Påslaget: Användare Närvarande i möte Kör från Gör -------------------------------------------------------------------------- 6810 George Berkeley Filosofimötet berkeley@emp1.tcd.ie (Skriver en kommentar.) 7571 John Locke Filosofimötet eridy@cc.ox.ac.uk (Väntar.) Avslaget: Användare Närvarande i möte -------------------------------------------------------------------------- 6810 George Berkeley Filosofimötet 7571 John Locke Filosofimötet") (kom-idle-hide-doc . "\ I vilkalistan visas per default enbart de sessioner som har varit aktiva under den senaste tiden. Denna inställning bestämmer hur många minuter en session får ha varit stilla och ändå visas i vilkalistan.") (kom-show-footnotes-immediately-doc . "\ Fotnoter visas normalt på samma sätt som kommentarer, men om detta är påslaget så visas fotnoter direkt efter inlägget de hör till.") (kom-follow-comments-outside-membership-doc . "\ Normalt så visar inte LysKOM kommentarer till ett inlägg om man inte är medlem i något av mötena kommentaren har som mottagare. Om man vill följa kommentarskedjor utanför de möten man är medlem i kan man slå på den här inställningen.") (kom-read-depth-first-doc . "\ LysKOM kan visa inlägg antingen i den ordning de skapades, eller i den ordning de ligger i kommentarsträdet. Ta till exempel följande inlägg: Inlägg 1002 är inte en kommentar till någonting. Inlägg 1003 och 1004 är kommentarer till inlägg 1002. Inlägg 1005 och 1007 är kommentarer till inlägg 1004 och inlägg 1006 är en kommentar till inlägg 1003. Då ser kommentarsträdet ut ungefär så här: 1002 +-- 1003 --- 1006 | +-- 1004 +-- 1005 | +-- 1007 Om man läser inläggen i tidsordning kommer de att visas i ordningen 1002, 1003, 1004, 1005, 1006 och 1007. I kommentarsordning blir det i stället 1003, 1003, 1006, 1004, 1005 och 1007.") (kom-continuous-scrolling-doc . "\ Påslaget innebär att klienten scrollar bufferten medan ny text sätts in, så man ser det senaste som har satts in. Detta fungerar bra om man har en snabb terminal, men kan vara värt att slå av om terminalen är långsam, och scrollning i Emacs tar tid.") (kom-deferred-printing-doc . "\ För att snabba upp LysKOM så skrivs vissa saker, som person- och mötesnamn inte ut omedelbart, utan skrivs först ut som \"[...]\", vilket sedan byts ut mot den rätta utskriften när texten finns tillgänglig. Detta snabbar upp svarstiderna i klienten ganska mycket, men går att stänga av med den här inställningen om man tycker det ser otrevligt ut.") (kom-higher-priority-breaks-doc . "\ När texter kommer in till möten som har högre prioritet än det man läser kan klienten låta en läsa dessa texter omedelbart, efter den aktuella kommentarskedjan eller efter man har läst ut mötet.") (kom-login-hook-doc . "\ Kommandon som skall köras när man loggar in, innan någon inmatning från tangentbordet tas emot. Till exempel kan man göra Lista nyheter här för att få se en lista av nyheter varje gång man loggar in.") (kom-do-when-done-doc . "\ Kommandon som skall köras när man har läst ut alla inlägg. Det är ganska vanligt att man har Återse alla markerade här. Både tangentbordsmakron och regelrätta funktioner går bra.") (kom-page-before-command-doc . "\ LysKOM-bufferten kan scrollas före alla kommandon så att text som sätts in av kommandot hamnar överst i fönstret. Denna variabel talar om före vilka kommandon detta skall ske.") (kom-permissive-completion-doc . "\ Om detta är påslaget så kommer TAB bara att fylla ut namn på inloggade personer när kommandot bara kan utföras på inloggade personer (till exempel Status (för) session och Sända messelande.) Om det är avslaget kommer TAB att fylla ut även med namn på personer som inte är inloggade.") (kom-membership-default-priority-doc . "\ Detta bestämmer hur prioriteten på möten man går med i sätts. Om det är en siffra mellan 1 och 255 så kommer nya medlemskap att få den prioriteten. I annat fall kommer klienten att fråga för varje nytt medlemskap vilken prioritet det skall ha.") (kom-show-personal-messages-in-buffer-doc . "\ Denna inställning bestämmer var personliga meddelanden, gruppmeddelanden och allmänna meddelanden visas. Meddelanden kan antingen visas i LysKOM-bufferten, kastas bort helt eller visas i en namngiven buffert.") (kom-pop-personal-messages-doc . "\ Om personliga meddelanden skall visas i en egen buffert och denna inställning också är påslagen så kommer den bufferten att visas så fort ett meddelande anländer.") (kom-audio-player-doc . "\ Om man vill att LysKOM skall spela ljudfiler i stället för att pipa vid olika tillfällen måste denna inställning peka ut ett program som klarar att spela ljudfilerna. Programmet skall ta ett argument: namnet på filen som skall spelas.") (kom-default-message-recipient-doc . "\ Denna inställning bestämmer vem som kommer att vara defaultmottagare för personliga meddelande man skickar. Alternativen som finns är att meddelanden per default är allmänna, att avsändaren för det senast mottagna meddelandet skall vara default eller att mottagaren för det senaste gruppmeddelandet (eller avsändaren av det senaste personliga eller almänna meddelandet) skall vara mottagare.") (lyskom-filter-outgoing-messages-doc . "\ Om denna inställning är påslagen så kommer meddelanden som skickas automatiskt, till exempel automatiska svar och svar på fjärkontrollförsök även att visas som om man hade skickat det manuellt.") (kom-friends-doc . "\ Namnen på personerna i denna lista kommer att visas med ett speciellt utseende i LysKOM-bufferten.") (kom-url-viewer-preferences-doc . "\ Denna inställning bestämmer vilken WWW-läsare som i första hand skall användas för att öppna URLer som förekommer i LysKOM. Om den första läsaren i listan inte klarar den typ av URL som man försöker öppna så används nästa läsare och så vidare.") (kom-mosaic-command-doc . "\ Denna inställning talar om vilket kommando som skall användas för att starta Mosaic.") (kom-netscape-command-doc . "\ Denna inställning anger kommandot för att köra Netscape.") (kom-inhibit-typeahead-doc . "\ Normalt sparas tangenttryckningar som görs medan klienten är upptagen, och utförs när det blir möjligt. Om denna inställning är avslagen så kommer LysKOM enbart att utföra kommandon som ges när klienten inte arbetar.") (kom-max-buffer-size-doc . "\ Det är möjligt att begränsa LysKOM-buffertens storlek genom att ange hur stor den får bli i den här variabeln. Om bufferten blir för stor kommer information från buffertens början att tas bort.") (kom-ansaphone-record-messages-doc . "\ LysKOM kan \"spela in\" meddelanden som kommer när funktionen för automatiskt svar är påslagen. Denna inställning bestämmer om så sker eller inte.") (kom-ansaphone-show-messages-doc . "\ Om denna inställning är påslagen kommer LysKOM att visa inkomna personliga meddelanden även om automatiskt svar är påslaget.") (kom-ansaphone-default-reply-doc . "\ Automatsvararen skickar detta meddelande om inget annat meddelande har specificerats via någon annan mekanism (och den är bara till för försiktiga experter.)") (kom-remote-control-doc . "\ Påslagen innebär att det går att fjärrstyra klienten. Fjärrstyrningen är dock begränsad till vissa personer.") (kom-remote-controllers-doc . "\ Personerna i denna lista får fjärrstyra klienten.") (kom-self-control-doc . "\ Om detta är påslaget får användaren som är inloggad styra klienten från en annan session. Detta är ett alternativ till att lägga in sig själv i listan över tillåtna fjärrstyrare.") (kom-customize-format-doc . "\ Dokumentation till inställningarna kan vara på eller avslagen när inställningsfönstret öppnas. Dokumentationen kan alltid visas eller gömmas för varje enskild inställning genom att använda frågetecknet eller utropstecknet som står till höger om inställningen.") (kom-default-language-doc . "\ Språk som skall användas i LysKOM. Om du ändrar inställningen här så kommer inte inställningen ändras för aktuell session, utan du måste ge kommandot Ändra språk också.") (kom-ispell-dictionary-doc . "\ Ordlista som skall användas av stavningskontrollen i LysKOM. Om detta är satt till kom-ispell-dictionary så kommer variabeln ispell-dictionary att användas istället.") (kom-show-namedays-doc . "\ Påslaget innebär att dagens namn visas när man ser tiden. Antagligen så kommer detta att ersättas av ett nytt kommando i någon kommande version av elispklienten, men det var visst någon som ville ha det, så ...") ;; ;; Tags for variables ;; (kom-emacs-knows-iso-8859-1-tag . "Emacs förstår ISO-8859-1:") (kom-bury-buffers-tag . "Begrav buffertar när man byter LysKOM:") (kom-customize-in-window-tag . "Inställningar för LysKOM: ") (kom-write-texts-in-window-tag . "Skriv inlägg: ") (kom-prioritize-in-window-tag . "Prioritera möten: ") (kom-edit-filters-in-window-tag . "Ändra filter: ") (kom-view-commented-in-window-tag . "Återse kommenterer: ") (kom-list-membership-in-window-tag . "Lista medlemsskap: ") (kom-user-prompt-format-tag . "Promptformat:") (kom-user-prompt-format-executing-tag . "Promptformat vid körning:") (kom-higher-priority-breaks-tag . "Läs prioriterade texter: ") (kom-created-texts-are-read-tag . "Läsmarkera skapade texter: ") (kom-default-mark-tag . "Defaultmarkering: ") (kom-print-number-of-unread-on-entrance-tag . "Visa olästa när man går till ett möte: ") (kom-follow-comments-outside-membership-tag . "Följ kommentarskedjor utanför medlemskap: ") (kom-show-footnotes-immediately-tag . "Visa fotnoter omedelbart: ") (kom-membership-default-priority-tag . "Prioritet för nya medlemskap: ") (kom-dashed-lines-tag . "Streckade linjer kring inläggstexten: ") (kom-autowrap-tag . "Automatisk radbrytning vid läsning: ") (kom-show-author-at-end-tag . "Visa författarens namn efter inlägget: ") (kom-reading-puts-comments-in-pointers-last-tag . "Kommentarslänkar visas:") (kom-read-depth-first-tag . "Läsordning:") (kom-deferred-printing-tag . "Fördröjda utskrifter:") (kom-continuous-scrolling-tag . "Omedelbar scrollning:") (kom-presence-messages-tag . "Närvaromeddelanden på eller av: ") (kom-presence-messages-in-buffer-tag . "Närvaromeddelanden i LysKOM-bufferten:") (kom-page-before-command-tag . "Rensa skärmen:") (kom-idle-hide-tag . "Antal minuter en session får vara inaktiv och ändå visas: ") (kom-show-where-and-what-tag . "Visa varifrån personer är inloggade och vad de gör: ") (kom-login-hook-tag . "Kommandon som körs vid login:") (kom-do-when-done-tag . "Kommandon som körs efter allt är utläst:") (kom-permissive-completion-tag . "Petig utfyllnad av namn:") (kom-show-personal-messages-in-buffer-tag . "Var visas meddelanden: ") (kom-pop-personal-messages-tag . "Ploppa upp meddelandebufferten: ") (kom-default-message-recipient-tag . "Defaultmottagare för meddelanden:") (kom-audio-player-tag . "Ljudspelarprogram:") (kom-ding-on-new-letter-tag . "När det kommer brev: ") (kom-ding-on-priority-break-tag . "När det kommer prioriterade inlägg:") (kom-ding-on-wait-done-tag . "När man har väntat klart: ") (kom-ding-on-common-messages-tag . "Vid allmänna meddelanden: ") (kom-ding-on-group-messages-tag . "Vid gruppmeddelanden: ") (kom-ding-on-personal-messages-tag . "Vid personliga meddelanden: ") (kom-ding-on-no-subject-tag . "När ärenderad saknas: ") (lyskom-filter-outgoing-messages-tag . "Visa automatiska meddelanden:") (kom-friends-tag . "Vänner och bekanta:") (kom-url-viewer-preferences-tag . "Öppna URLer med följande program:") (kom-mosaic-command-tag . "Kommando för att starta NCSA Mosaic:") (kom-netscape-command-tag . "Kommando för att starta Netscape Navigator:") (kom-cite-string-tag . "Citatmarkering: ") (kom-confirm-multiple-recipients-tag . "Bekräfta multipla mottagare: ") (kom-check-commented-author-membership-tag . "Kontrollera kommenterad författares medlemskap:") (kom-check-for-new-comments-tag . "Kontrollera olästa kommentarer: ") (kom-ansaphone-record-messages-tag . "Spara meddelanden då automatiskt svar är påslaget: ") (kom-ansaphone-show-messages-tag . "Visa meddelanden då automatiskt svar är påslaget: ") (kom-ansaphone-default-reply-tag . "Svarsmeddelande:") (kom-inhibit-typeahead-tag . "Buffra tangenttryckningar:") (kom-max-buffer-size-tag . "Maximal buffertstorlek:") (kom-remote-control-tag . "Fjärrstyrning: ") (kom-self-control-tag . "Tillåt fjärrstyrning av mig själv: ") (kom-remote-controllers-tag . "Tillåtna fjärrstyrare:") (kom-customize-format-tag . "Visa hjälptexterna för inställningar:") (kom-default-language-tag . "Språk: ") (kom-show-namedays-tag . "Visa dagens namn:") (kom-ispell-dictionary-tag . "Ordlista:") ) ) ;;;; ============================================================ ;;;; The default Ansaphone message goes here. The more complex ;;;; message specification probably should too, but it's not here ;;;; yet. People who know how to use it are smart enough to do it ;;;; right. (lyskom-language-var kom-ansaphone-default-reply sv "Jag l\344ser inte LysKOM just nu. Skicka g\344rna ett brev i st\344llet.") ;;;; ============================================================ ;;;; Other language-dependent variables ;;;; (lyskom-language-var kom-ispell-dictionary sv "svenska") ;;;; ============================================================ ;;;; Text buttom menuse go here. This will probably be moved back ;;;; to vars.el.in when the strings have been replaced by ;;;; symbols, but for now they'll stay here. (lyskom-language-var lyskom-button-actions sv '((text text-text lyskom-button-view-text (("\305terse texten" . lyskom-button-view-text) ("\305terse omodifierat" . lyskom-button-review-noconversion) ("\305terse tr\344d" . lyskom-button-review-tree) ("\305terse urinl\344gget" . lyskom-button-find-root) ("Kommentera texten" . lyskom-button-comment-text) ("Personligt svar" . lyskom-button-private-comment-text) ("Markera texten" . lyskom-button-mark-text) ("Avmarkera texten" . lyskom-button-unmark-text)) nil ; ((nil lyskom-print-text footer lyskom-button-comment-text)) ) (conf conf-text lyskom-button-view-conf-presentation (("Visa presentation" . lyskom-button-view-conf-presentation) ("Visa m\366tesstatus" . lyskom-button-view-conf-status) ("G\345 till m\366tet" . lyskom-button-goto-conf) ("Skicka gruppmeddelande" . lyskom-button-send-message) ("Bli medlem i m\366tet" . lyskom-button-add-self) ("Uttr\344d ur m\366tet" . lyskom-button-sub-self)) ((kom-list-news . lyskom-button-goto-conf) (kom-membership . lyskom-button-goto-conf))) (pers pers-text lyskom-button-view-pers-presentation (("Visa presentation" . lyskom-button-view-pers-presentation) ("Visa personstatus" . lyskom-button-view-pers-status) ("Skicka brev" . lyskom-button-mail) ("S\344nd meddelande" . lyskom-button-send-message)) nil) (url url-text lyskom-button-open-url (("\326ppna" . lyskom-button-open-url) ("Kopiera" . lyskom-button-copy-url)) nil) (info-node info-node-text lyskom-button-goto-info-node (("\362 öppna" . lyskom-button-goto-info-node)) nil) (email email-text lyskom-button-open-email (("Skicka mail" . lyskom-button-open-email) ("Kopiera" . lyskom-button-copy-email)) nil))) ;;;; ================================================================ ;;;; Tell phrases should really be configured with the default ;;;; language used at the server and not for person reading if they ;;;; happens to differ. This is of coarse because they are sent to the ;;;; server for everybody else to see. ;;;; Aronsson was here 4 DEC 1990, thus creating version 0.18 ; Created *-tell-* ;;;; kom-tell-phrases ;;; To coders of the elisp-client: ;;; if you change kom-tell-phrases here, make sure the list of valid ;;; keywords is updated it in vars.el. ;;; lyskom-tell-phrases-validation-keyword-list, lyskom-tell-phrases-validate (eval-when-compile (defvar kom-tell-phrases)) (lyskom-language-strings kom-tell-phrases sv '((kom-tell-silence . "") ; Why ? (kom-tell-send . "F\366rs\366ker l\344gga in en text.") (kom-tell-login . "Loggar in.") (kom-tell-read . "L\344ser.") (kom-tell-1st-pres . "Skriver den f\366rsta presentationen.") (kom-tell-write-comment . "Skriver en kommentar.") (kom-tell-write-footnote . "Skriver en fotnot.") (kom-tell-write-letter . "Skriver ett brev.") (kom-tell-write-reply . "Skriver ett privat svar.") (kom-tell-write-text . "Skriver inl\344gg.") (kom-tell-conf-pres . "Skriver presentation f\366r ett nytt m\366te.") (kom-tell-recover . "\305terstartar kom. Suck.") (kom-tell-wait . "V\344ntar.") (kom-tell-regret . "\305ngrar sig och sl\344nger inl\344gget.") (kom-tell-review . "\305terser.") (kom-tell-change-name . "\304ndrar sitt namn till n\345got annat.") (kom-tell-change-supervisor . "\304ndrar organisat\366r f\366r n\345got.") (kom-tell-next-lyskom . "Hoppar till ett annat LysKOM."))) (if (and (boundp 'kom-tell-phrases) kom-tell-phrases) (lyskom-language-strings kom-tell-phrases sv (mapcar (function (lambda (x) (cond ((and (consp x) (symbolp (car x)) (stringp (cdr x))) x) ((and (consp x) (symbolp (car x)) (consp (cdr x)) (stringp (car (cdr x)))) (cons (car x) (car (cdr x)))) (t nil)))) kom-tell-phrases))) ;; Placed here because this must NOT be evaluated before ;; kom-tell-phrases is defined: (lyskom-language-var kom-mercial sv (lyskom-get-string 'kom-tell-wait 'kom-tell-phrases)) ;;; (lyskom-language-strings lyskom-error-texts sv '((error-0 . "Inget fel har intr\344ffat") (error-2 . "\304nnu ej implementerat") (error-3 . "Inte l\344ngre implementerat") (error-4 . "Felaktigt l\366senord") (error-5 . "Str\344ngen f\366r l\345ng") (error-6 . "Du \344r inte inloggad") (error-7 . "Ingen f\345r logga in i LysKOM just nu") (error-8 . "Du f\366rs\366kte anv\344nda m\366te nummer 0") (error-9 . "Odefinierat eller hemligt m\366te") (error-10 . "Odefinierad eller hemlig person") (error-11 . "Ingen skriv- eller l\344sr\344ttighet") (error-12 . "Otill\345ten operation") (error-13 . "Du \344r inte medlem i m\366tet") (error-14 . "Inget s\345dant textnummer") (error-15 . "Du kan inte anv\344nda globalt textnummer 0") (error-16 . "Inget s\345dant lokalt textnummer") (error-17 . "Du kan inte anv\344nda lokalt textnummer 0") (error-18 . "Namnet f\366r kort eller f\366r l\345ngt eller inneh\345ller felaktiga tecken") (error-19 . "Index utanf\366r gr\344nserna") (error-20 . "M\366tet existerar redan") (error-21 . "Personen existerar redan") (error-22 . "Hemligt, men ej l\344sskyddat") (error-23 . "Du f\345r inte \344ndra person/m\366tesflaggan") (error-24 . "Fel i databasen. Attans otur.") (error-25 . "Otill\345tet misc-f\344lt. (Internt fel)") (error-26 . "Otill\345ten infotyp. (Bug i klienten)") (error-27 . "Redan mottagare till denna text") (error-28 . "Redan kommentar till denna text") (error-29 . "Redan fotnot till denna text") (error-30 . "Inte mottagare till denna text") (error-31 . "Inte kommentar till denna text") (error-32 . "Inte fotnot till denna text") (error-33 . "F\366r m\345nga mottagare") (error-34 . "F\366r m\345nga kommentarer") (error-35 . "F\366r m\345nga fotnoter") (error-36 . "F\366r m\345nga markeringar") (error-37 . "Du \344r inte f\366rfattare till texten") (error-38 . "Du kan inte koppla upp dig till servern") (error-39 . "Minnet slut") (error-40 . "Servern har ballat ur") (error-41 . "Klienten tror att servern s\344ger att den inte f\366rst\345r klienten") (error-42 . "Ingen s\345dan session finns") (error-43 . "Ogiltigt regulj\344rt uttryck") (error-44 . "Texten \344r inte markerad") (error-45 . "Tillf\344lligt fel. F\366rs\366k senare") (error-46 . "Serven v\344grade ta emot en array") (error-47 . "Mottagaren tar inte emot anonyma texter"))) (provide 'lyskom-language-sv) ;;; swedish-strings.el ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: english-strings.el,v 44.32.2.2 1999/10/13 12:13:05 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: english-strings.el ;;;; ;;;; This file contains all strings in the LysKOM elisp client. ;;;; Language: English. ;;;; Matches version 36.11 of swedish-strings.el ;;;; ================================================================ ;;;; ;;;; Translation from swedish-strings.el: David Byers ;;;; (require 'lyskom-vars "vars") (require 'lyskom-language "language") (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: english-strings.el,v 44.32.2.2 1999/10/13 12:13:05 byers Exp $")) ;;; ================================================================ ;;; The language definition (lyskom-define-language 'en "English" "Engelska") ;;; ================================================================ ;;; lyskom-edit-mode-map English version (defvar lyskom-en-edit-mode-map nil) (lyskom-language-keymap lyskom-edit-mode-map en lyskom-en-edit-mode-map) ;;; Set the keymap for lyskom-edit-mode (defvar lyskom-en-edit-prefix nil) (if lyskom-en-edit-mode-map nil (setq lyskom-en-edit-mode-map (make-sparse-keymap)) (define-prefix-command 'lyskom-en-edit-prefix) (define-prefix-command 'lyskom-en-edit-review-prefix) (define-prefix-command 'lyskom-en-edit-insert-prefix) (define-key lyskom-en-edit-mode-map "\C-c" 'lyskom-en-edit-prefix) (define-key lyskom-en-edit-mode-map "\C-c?" 'lyskom-help) (define-key lyskom-en-edit-mode-map "\C-c\C-r" 'lyskom-en-edit-review-prefix) (define-key lyskom-en-edit-mode-map "\C-c\C-i" 'lyskom-en-edit-insert-prefix) (define-key lyskom-en-edit-mode-map (lyskom-keys [mouse-2]) 'kom-button-click-or-yank) (define-key lyskom-en-edit-mode-map (lyskom-keys [down-mouse-3]) 'kom-popup-menu) (define-key lyskom-en-edit-mode-map [mouse-3] 'kom-mouse-null) (define-key lyskom-en-edit-mode-map "\C-c*" 'kom-button-press) (define-key lyskom-en-edit-mode-map "\C-c\C-c" 'kom-edit-send) (define-key lyskom-en-edit-mode-map "\C-c\C-s" 'kom-ispell-message) (define-key lyskom-en-edit-mode-map "\C-c\C-k" 'kom-edit-quit) (define-key lyskom-en-edit-mode-map "\C-cr?" 'lyskom-help) (define-key lyskom-en-edit-mode-map "\C-c\C-r\C-c" 'kom-edit-show-commented) (define-key lyskom-en-edit-mode-map "\C-c\C-i?" 'lyskom-help) (define-key lyskom-en-edit-mode-map "\C-c\C-i\C-c" 'kom-edit-insert-commented) (define-key lyskom-en-edit-mode-map "\C-c\C-i\C-y" 'kom-edit-insert-commented) (define-key lyskom-en-edit-mode-map "\C-c\C-i1" 'kom-edit-insert-digit-text) (define-key lyskom-en-edit-mode-map "\C-c\C-i2" 'kom-edit-insert-digit-text) (define-key lyskom-en-edit-mode-map "\C-c\C-i3" 'kom-edit-insert-digit-text) (define-key lyskom-en-edit-mode-map "\C-c\C-i4" 'kom-edit-insert-digit-text) (define-key lyskom-en-edit-mode-map "\C-c\C-i5" 'kom-edit-insert-digit-text) (define-key lyskom-en-edit-mode-map "\C-c\C-i6" 'kom-edit-insert-digit-text) (define-key lyskom-en-edit-mode-map "\C-c\C-i7" 'kom-edit-insert-digit-text) (define-key lyskom-en-edit-mode-map "\C-c\C-i8" 'kom-edit-insert-digit-text) (define-key lyskom-en-edit-mode-map "\C-c\C-i9" 'kom-edit-insert-digit-text) (define-key lyskom-en-edit-mode-map "\C-c\C-i " 'kom-edit-insert-text) (define-prefix-command 'lyskom-en-edit-add-prefix) (define-key lyskom-en-edit-mode-map "\C-c\C-a" 'lyskom-en-edit-add-prefix) (define-key lyskom-en-edit-mode-map "\C-c\C-a\C-r" 'kom-edit-add-recipient) (define-key lyskom-en-edit-mode-map "\C-c\C-a\C-c" 'kom-edit-add-copy) (define-key lyskom-en-edit-mode-map "\C-c\C-a\C-m" 'kom-edit-move-text) (define-key lyskom-en-edit-mode-map "\C-c\C-a?" 'lyskom-help)) ;;(defvar lyskom-header-separator ;; (substitute-command-keys ;; "\\\ ;;--- Write below. \ ;;Post: \\[kom-edit-send], \ ;;Kill: \\[kom-edit-quit], \ ;;Help: \\[describe-mode] ---") ;; "*String to separate headers from text body.") ;; ;;(defvar lyskom-swascii-header-separator nil ;; "The swascii version of lyskom-header-separator.") ;; ;;(defvar lyskom-header-subject "Subject: " ;; "*String to prompt for subject in the edit buffer.") ;; ;; ;;(defvar lyskom-swascii-header-subject nil ;; "The swascii version of lyskom-header-subject.") (defconst lyskom-strings-missing '(cgdag sixjune holdnose)) ;;; Formely known as lyskom-strings (lyskom-language-strings lyskom-message en '( ; From vars.el: ; From komtypes.el: nil ; From clienttypes.el: nil ; From startup.el: (server-q . "LysKOM server? (%#1s) ") (try-connect . "LysKOM elisp client version %#1s.\nAttempting to connect to %#2s.\n") (protocoll-error . "Protocol error. Servers says: %#1s") (connection-done . "Connection established. Server version is %#1s.\n\n") (what-is-your-name . "What is your name? ") (password . "Your Password? ") (wrong-password . "Incorrect password.\n") (are-logged-in . "You have entered LysKOM. Please wait...\n") (you-have-motd . "\nYou have a note on your door:\n\n") (lyskom-motd-was-garbed . "\nThe login message does not exist! The message that was supposed to be shown after login has disappeared. Please contact the LysKOM administrator.\n") (presentation-encouragement . "You have not written a presentation. Please write a presentation by using the command Ap. If you do not want to write a presentations, please type fk.\n") (first-greeting . "%#1s This appears to be the first time you use LysKOM. Welcome! Please make sure you have spelled your name correctly. You should use your full name and organisation, eg. \"Joe Hacker, MIT\". If your name is spelled incorrectly, or you wish to change it, answer 'no' to the question below. At present the LysKOM server stores most of the information so that anybody can read it. Only passwords are encrypted. If you ar uncertain about how to use LysKOM, you can retrieve a manual by anonymous ftp to ftp.lysator.liu.se. Ask your system administrator for help on how to do this. ") (is-name-correct . "Is the name %#1s correct? ") (personal-password . "Enter a personal password: ") (repeat-password . "Repeat for confirmation: ") (repeat-failure . "The passwords were not the same.\n") (could-not-create-you . "LysKOM couldn't create that user.\n") (presentation-subject . "%#1s") (presentation-form . "Name:\t\nAddress:\t\n\t\nTelephone:\t Email-address:\t\nWWW:\t\n\nOther:\t") (presentation-help . "You are writing your presentation.\n") (not-present-anywhere . "Not in any conference.") (secret-person . "Secret user") (in-secret-conference . "Secret conference (%#1d).") (start-new-session-same-server . "You are already connected to that server. Do you want a new session? ") (new-session-in-buffer . "\n\n---- New session at %s ----\n\n") ; From internal.el: (shaky-tcp . "At the moment I can't reach the server. The TCP/IP connection is shaky%#1s") (retrying-tcp . "Retrying.") ; From parse.el: (protocol-error . "protocol error: %s") ; From services.el: (interrupted . "Interrupted\n") ; From cache.el: ; No entries. ; From commands1.el: (appreciation . "You are a very special person, beautiful and wise, respected by everybody around you. You are doing a splendid job. Many people love you, body and soul. You make life easier for others. You are a very warm and sensitive person. Be proud of being You! You have a very good reason.\n\n") (abuse . "You are a nuisance, ugly and stupid, disrespected by everybody around you. You are doing a worthless job. Many people hate you, body and soul. You make life harder for others. You are a very cold and unfeeling person. Be ashamed of being You! You have a very good reason.\n\n") (what-conf-to-delete . "Conference/user to delete: ") (what-conf-to-change . "Conference to modify: ") (confirm-delete-pers-or-conf . "Really delete %#1s %#2s? ") (the-pers . "the user") (the-conf . "the conference") (deletion-not-confirmed . "Deletion aborted\n") (somebody-else-deleted-that-conf . "Somebody else just deleted the conference.\n") (conf-is-deleted . "OK, %#1s is now deleted.\n") (you-could-not-delete . "%#1M can't be deleted by you.\n") (you-have-deleted-yourself . "You have deleted yourself.\n") (what-text-to-delete . "Remove which article? ") (deleting-text . "Removing article %#1:n...") (presentation-for-whom . "Which conference/user? ") (somebody-deleted-that-conf . "Somebody just deleted that conference.\n") (review-presentation-of . "Review presentation of %#1M.\n") (has-no-presentation . "%#1:M has no presentation.\n") (have-to-read . "You must read an article first.\n") (no-comment-to . "There is no commented article.\n") (who-letter-to . "Send a letter to whom? ") (has-motd . "%#1P has a note on the door:\n\n") (motd-persist-q . "Send the letter? ") (who-to-add . "Whom do you want to add? ") (where-to-add . "To which conference? ") (where-to-add-self . "Join which conference? ") (priority-q . "Conference priority? (0 (passive membership), 1 (low) - 255 (high)) ") (done . "done.\n") (nope . "didn't work.\n") (cant-find-supervisor . "Can't find supervisor of %#1M.\n") (is-read-protected-contact-supervisor . "%#1M is closed. Send a letter to %#2P to apply for membership.\n") (conf-does-not-exist . "\nThe conference doesn't exist.\n") (who-to-exclude . "Who do you want to remove? ") (where-from-exclude . "From which conference? ") (leave-what-conf . "Leave which conference? ") (error-fetching-person . "Error retreiving user.\n") (error-fetching-conf . "Error retreiving conference.\n") (name-of-conf . "Conference name? ") (anyone-member . "May anyone join? ") (secret-conf . "Secret conference? ") (comments-allowed . "Are comments allowed? ") (anonymous-allowed . "Are anonymous articles allowed? ") (what-comment-no . "Comment article number: ") (what-footnote-no . "Footnote article number: ") (confusion-what-to-comment . "I can't figure out which article you want to comment.\n") (confusion-what-to-footnote . "I can't figure out to which article you want to write a footnote to.\n") (what-private-no . "Private reply to article number: ") (confusion-who-to-reply-to . "I can't figure out which article you want to write a private reply to.\n") (confusion-what-to-answer-to . "I can't figure out which article you want to write a reply to.\n") (quit-in-spite-of-unsent . "You have an unsent article. Do you really want to quit? ") (confusion-what-to-view . "I can't figure out which article you want to view.\n") (really-quit . "Do you really want to quit LysKOM? ") (session-ended . " -------------------------------------------- LysKOM session finished You are now disconnected from the server --------------------------------------------\n") (session-auto-ended . " ============================================================ Disconnecting from LysKOM since all connections are in use and you have finished reading. Please come back later. ============================================================\n\n") (what-to-change-pres-you . "Change presentation of who/what (yourself): ") (who-to-put-motd-for . "Post note on the door of who/what (yourself): ") (cant-get-conf-stat . "Cannot get the status of that conference.\n") (go-to-conf-p . "Go to conference: ") (want-become-member . "Do you want to join? ") (no-ok . "Okiedokie, whatever you say.\n") (who-to-remove-motd-for . "Remove note from the door of who/what: ") (conf-all-read . "%#1M - no unread articles.\n") (no-in-conf . "You are not present in any conference.\n") (search-for-pers . "Enter search key (RETURN for all users): ") (search-for-conf . "Enter search key (RETURN for all conferences): ") (search-re . "Enter search regexp: ") (name-to-be-changed . "Name to change: ") (no-such-conf-or-pers . "The conference or user doesn't exist.\n") (new-name . "New name: ") (who-to-change-supervisor-for . "Change supervisor of who/what? ") (new-supervisor . "New supervisor: ") (text-to-mark . "Mark which article? ") (text-to-unmark . "Unmark which article? ") (what-mark . "Set which mark? ") (unmarking-textno . "Unmarking article %#1n...") (marking-textno . "Marking article %#1n...") (new-passwd-again . "Repeat the new password for confirmation: ") (what-mark-to-view . "Review which mark? ") (whos-passwd . "Change password for whom? (yourself) ") (old-passwd . "Your old password: ") (new-passwd . "Your new password: ") (changing-passwd . "Changing password...") (retype-dont-match . "You didn't reenter the same passwrod. Try again.\n") (palindrome . "(a palindrome!) ") (lyskom-name . "User") (is-in-conf . "In conference") (from-machine . "At") (is-doing . "Activity") (lyskom-client . "Client") (text-to-add-recipient . "Add recipient to which article:") (text-to-add-copy . "Add recipient of carbon copy of which article:") (text-to-add-bcc . "Add recipient of blind carbon copy of which article:") (text-to-delete-recipient . "Remove recipient from which article:") (text-to-move . "Which text do you want to move: ") (text-to-add-comment-to . "Add comment to which article:") (text-to-delete-comment-from . "Remove comment from which article:") (where-on-list-q . "Placement in your list? (0-%#1d) ") (member-in-conf . "Joining to %#1M...") (add-member-in . "Adding %#1P as a member of %#2M...") (unsubscribe-to . "Leaving %#1M...") (exclude-from . "Removing %#1P from %#2M...") (unsubscribe-failed . "\nDidn't work. Perhaps %#1P isn't a member of %#2M?\n") (You . "You") (could-not-create-conf . "Couldn't create the conference \"%#1s\".\n") (created-conf-no-name . "Conference number %[%#3@%#1:m %#2:M%] has been created.\n") (cant-read-textno . "You are not allowed to read article %#1:n") (not-supervisor-for . "You are not the supervisor of %#1M.\n") (go-to-conf . "Go to conference %#1M.\n") (cant-go-to-his-mailbox . "You are not allowed to go to %#1M's mailbox.\n") (not-member-of-conf . "You are not a member of %#1M.\n") (about-to-change-name-from . "%#1M\n") (change-name-done . "Done. New name: %[%#2@%#1:M%].\n") (change-name-nope . "Couldn't change name to %#1s. Error code %#3d. %#2s.\n") (change-supervisor-from-to . "Change supervisor of %#1M to %#2P...") (change-supervisor-nope . "\nDidn't work. Perhaps you are not allowed to change the supervisor of %#1M?\n") (no-marked-texts . "You have not marked any articles.\n") (no-marked-texts-mark . "You have not marked any articles with mark %#1d.\n") (weekdays . ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday"]) (time-is . "The time is %#1s %#2s(according to the server).") (time-format-exact . "%#7s %4#1d-%02#2d-%02#3d %02#4d:%02#5d:%02#6d") (xmaseve . "Christmas eve!\nYou didn't open any gifts early, did you?") (xmasday . "Christmas day.\nDid you get any nice gifts this year?") (newyearday . "\nMay %#1d be a prosperous and good year for you!") (newyeareve . "Happy New Year!") (newyearevelate . "Less than an hour to go...") (lysbday . " On this day, in 1973, the Lysator Academic Computer Society was formed, and it was a great day in the history of computing in Sweden. Read all about it at http://www.lysator.liu.se/history/") (total-users . " A total of %#1d users.\n") (total-visible-users . " A total of %#1d visible users.\n") (total-active-users . " A total of %#1d active users.\n") (total-visible-active-users . " A total of %#1d visible active users.\n") (who-to-add-q . "Add who/what as a recipient? ") (who-to-add-copy-q . "Add which conference/user as recipient of a carbon copy? ") (who-to-sub-q . "Remove who/what as a recipient? ") (who-to-move-from-q . "Move from where? ") (who-to-move-to-q . "Move to where? ") (adding-name-as-recipient . "Adding %#1M as recipient of article %#2n...") (adding-name-as-copy . "%#1M will receive a carbon copy of article %#2n...") (remove-name-as-recipient . "Removing %#1M as recipient of article %#2n...") (moving-name . "Moving text %#3n from %#1M to %#2M...") (text-to-add-q . "Add which article as a comment? ") (text-to-remove-q . "Remove which article as a comment? ") (add-comment-to . "Adding article %#1n as a comment to text %#2n...") (sub-comment-to . "Removing article %#1n as a comment to article %#2n...") (comment-keep-recpt-p ."Should %#1s remain a recipient? ") (comment-all-relevant-p . "There are multiple recipients. Are they all relevant? ") (please-edit-recipients . "Modify the recipient list and send the article again.") (add-recipient-p . "Add recipient %#1P? ") (checking-rcpt . "Checking recipients...") (checking-rcpt-done . "Checking recipients...done") (checking-comments . "Checking commented articles...") (checking-comments-done . "Checking commented articles...done") (please-check-commented-texts . "Review the commented text and its comments.") (have-unread-comment . "Send despite unread comments to text %#1n? ") (matching-regexp . "Conferences/users matching `%#1s'\n") (who-is-active-all . "Showing all sessions.\n") (who-is-active-last-minutes . "Showing all sessions active tha last %#1d minutes.\n") (showing-invisibles . "Showing invisible sessions.\n") (null-who-info . "No one (active) is logged on.\n") (no-other-lyskom-r . "There are not other active LysKOM sessions.\n") (no-lyskom-session . "There are no active LysKOM-sessions.") (no-unread-lyskom-r . "There is no active LysKOM session with unread texts.\n") (no-unread-lyskom . "There is no active LysKOM session with unread texts.") ; From commands2.el: (your-memberships . "Your LysKOM conference memberships:\n") (memberships-header . "Last access Prio Unread Conference\n") (memberships-line . "%16#1s %#2d\t%#3d\t%#4M\n") (conf-for-status . "Get status of which conference? ") (no-such-conf . "The conference doesn't exist.\n") (status-record . "Status of conference %#1M (%#2m) %#3s\n\n") (change-type-prompt . "Change conference type for %#1M (%#2m) %#3s\n") (Mailbox . "Mailbox") (Protected . "Protected") (no-comments . "No comments") (closed . "Closed") (created-by . "Created by person %24#1p %#3s(%#2P)\n") (created-at . "Created:%34#1s\n") (members . "Number of members: %19#1d\n") (garb-nice . "Expiration time (in days):%16#1d\n") (lowest-local-no . "Lowest local number: %21#1d\n") (highest-local-no . "Highest local number: %20#1d\n") (last-text-time . "Time of last article: %20#1s (accordning to your cache)\n") (no-of-motd . "Note on the door in article: %13#1n\n") (superconf-is-no-name . "Superconference: %25#1m %#3s(%#2M)\n") (permitted-submitters-no-name . "Allowed authors: %25#1m %#3s(%#2M)\n") (supervisor-is-no-name . "Supervisor: %30#1p %#3s(%#2P)\n") (presentation-no . "Presentation: %25#1n\n") (conf-has-motd . "\n%#1M has a note on the door:\n") (Everybody . "Everyone") (show-members-list-also-q . "List members? ") (show-membership-info-q . "Show number of unreads? ") (conf-has-these-members . "\n%#1M has the following members:\n") (member-list-header . "Last entered Unread Name\n\n") (secret-membership . "--- Secret line ---\n") (conf-membership-line . "%#1s%#2M\n") (pers-for-status . "Get status of which user? ") (no-such-pers . "The user doesn't exist.\n") (pers-status-record . "Status of user %#1P (%#2p)\n") (created-time . "Created:%34#1s\n\n") (created-confs . "Conferences created:%22#1d\n") (created-persons . "Users created:%28#1d\n") (created-texts . "Articles created:%25#1d\n") (created-lines . "Lines created:%28#1d\n") (created-chars . "Characters created:%23#1d\n") (no-of-sessions . "Session count:%28#1d\n") (present-time-d-h-m-s . "Total presence:%16#1d d %02#2d:%02#3d:%02#4d\n") (last-log-in . "Last session:%29#1s\n") (user-name . "User: %36#1s\n") (read-texts . "Articles read:%28#1d\n") (marked-texts . "Articles marked:%26#1d\n") (time-for-last-letter . "Time of last letter:%22#1s (accordning to your cache)\n") (superconf . "Superconference: %25#1m %#3s(%#2M)\n") (supervisor . "Supervisor: %30#1p %#3s(%#2P)\n") (member-of-confs . "Member of (conferences):%18#1d\n") (presentation . "Presentation: %25#1n\n") (show-membership-list-also-q . "List memberships? ") (not-allowed-see-confs . "You are not premitted to see which conferences %#1P is a member of.\n") (is-member-of . "\n%#1P is a member of the following conferences:\n") (membership-list-header . "Last access Unread Conference\n\n") (pers-membership-line . "%#1s%#2s%#3M\n") (is-supervisor-mark . "O ") (who-to-send-message-to . "Send message to whom? (%s) ") (send-empty-message-p . "The message is empty. Send it anyway? ") (his-total-unread . "\n%#1M has a total of %#2d unread articles.\n") (message-prompt . "Message: ") (message-sent-to-user . "================================================================ Your message for %#2M: %#1t ---------------------------------------------------------------- ") (message-sent-to-all . "================================================================ Your public message: %#1t ---------------------------------------------------------------- ") (message-all-info . "Send public message\n") (message-recipient-info . "Send message to %#1M\n") (message-nope . "Unable to send the message. Perhaps the recipient isn't logged on. The message you were sending to %#1M was: %#2t\n") (only-last . "Last (0 - %#1d) articles in %#2s: ") (only-error . "Something went wrong. Sorry.\n") (you-have-unreads . "You have %#1d unread articles in %#2M\n") (you-have-an-unread . "You have 1 unread article in %#1M\n") (you-have-unreads-special . "You have %#1d uncommented articles in %#2M\n") (you-have-an-unread-special . "You have 1 uncommented article in %#1M\n") (you-have-read-everything . "No news (is bad news).\n") (total-unreads . "\nYou have %#1d unread articles.\n") (total-unread . "\nYou have 1 unread article.\n") (waiting-for-anything . "You are waiting for an article in any conference.\n") (waiting-higher-than . "You are waiting for an article in any conference with a priority higher than %#1d.\n") (have-to-be-in-conf-with-unread . "You must go to a non-empty conference first.\n") (Texts . "Article") (Date . "Date") (Lines . "Len.") (Author . " Author") (Subject . " Subject") (could-not-read . "You couldn't read the article (%#1n).\n") (multiple-choice . "There are several alternatives.") (what-mark-to-list . "List which mark? ") (you-have-marks . "You have %#1d texts marked with %#2d.\n") (you-have-marks-all . "You have %#1d marked texts.\n") (does-not-exist . "Unknown command.") ; Only people fixing bugs or recieving bug-reports should change these: (summary-line . "%=-8#1n%#2s%4#3d %[%#4@%#5:P%] %[%#6@%#7r%]\n") ; Only people fixing bugs or recieving bugg-reports should change these: (buggreport-compilestart . "Creating bug report...") (buggreport-compileend . "Creating bug report...done") (buggreport-description . "This is what I was doing: \(Fill in your comments below\)\n================\n\n ================ In the information below are the 100 most recently pressed keys from your emacs. If you recently logged on, you password may be contained in this list. If that is the case, change the characters corresponding to your password to asterisks. When you have finished writing this, send your bug report to the LysKOM developers. You can do this either by email to bug-lyskom@lysator.liu.se or by mailing a hardcopy of your bug report to: Lysator, c/0 ISY, Linkoping Univerity, S-581 83 Linkoping, SWEDEN. Mark the envelope with \"LysKOM bug report\"\n\n") (buggreport-internals . "LysKOM's internal information:\n\n") (buggreport-version . "lyskom-version:") (buggreport-emacs-version . "emacs-version:") (buggreport-system-id . "system-id:") (buggreport-ctl-arrow-doc . "ctrl-doc:") (buggreport-unparsed . "\nlyskom-unparsed-buffer:") (buggreport-command-keys . "Recently pressed keys:") (buggreport-backtrace . "\n*Backtrace*:\n%#1s\n") (buggreport-communications . "\nlyskom-debug-communications-to-buffer-buffer:") (buggreport-all-kom-variables . "\n\nOther variables:\n***** *********") (buggreport-instead-of-byte-comp . "byte-code(\"byte-string\"") (buggreport-subject . "Bugreport elisp-client version %#1s") (not-logged-in . "You are not logged on. ") (name-is-not-in-conf . "%#1s is not in any conference.\n") (name-is-in-conf . "%#1s is in\n%#2s\n") (connected-during . "Connect time: %#1d seconds.\n") (conf-to-set-permitted-submitters-q . "For which conference do you want to set the allowed authors? ") (conf-to-set-super-conf-q . "Set superconference of which conference? ") (new-super-conf-q . "Which conferece do you want as superconference? ") (new-permitted-submitters-q . "Allow members of which conference as authors in %#1s? (all) ") (super-conf-for-is . "Changing superconference of %#1M to %#2M...") (permitted-submitters-removed-for-conf . "Allowing all authors to conference %#1M...") (submitters-conf-for-is . "Changing authors admitted to conference %#1M to the members of %#2M...") (conf-to-set-garb-nice-q . "Set expiration time for which conference? ") (new-garb-nice-q . "After how many days shall articles be removed? ") (garb-nice-for-is . "Changing expiration for %#1M to %#2d...") (really-shutdown . "Are you sure you want to shut down the server? ") (closing-server . "Shutting down the server...") (really-sync . "Are you sure you want to save the database? ") (syncing-server . "Saving the database...") (administrator . "administrator") (no-longer-administrator . "a regular user again") (you-are-now . "Ok, you are now running as %#1s.\n") (setting-motd . "Changing login message to article %#1n.\n") (set-motd-success . "You have set a new login message.\n") (set-motd-failed . "Didn't work. Perhaps you were not an administrator.\n") (removing-motd . "Removing the login message.\n") (removed-motd . "You have removed the login message.\n") (who-to-throw-out . "Which session do you want to kill? ") (throwing-out . "Killing session %#1d... ") (postpone-prompt . "How much do you want to read now? ") (set-session-priority . "Set reading level: ") ; From review.el: (no-review-done . "You need to review something before you can review more.\n") (review-how-many . "Review how many?") (review-how-many-more . "Review how many more?") (latest-n . "last %#1d") (first-n . "first %#1d") (info-by-whom . "%#1s by whom: ") (info-to-conf . "%#1s to conference: ") (info-by-to . "%#1s by %#2P to %#3M forward.") (all-confs . "all conferences") (no-get-conf . "You are not allowed to access that conferene.\n") (no-get-pers . "You are not allowed to access that user.\n") (no-review-info . "You are not allowed to review %#1s\n") (review-info . "Review %#1s") (review-info-by-to . "Review %#1s by %#2P to %#3M forwards.\n") (review-more-info-by-to . "Review %#1s by %#2P to %#3M forwards.\n") (review-rest . "the rest") (review-more . "%#1d more") (you-review . "You are now reviewing %#1s.\n") (read-text-first . "You must read a article first.\n") (cannot-read-last-text . "You cannot review the last read article.\n") (review-n-texts . "Review %#1d articles.\n") (review-marked . "Review %#1d marked articles.\n") (review-text-no . "Review article %#1n\n") (review-one-comment . "Review one comment to article %#1n.\n") (review-many-comments . "Review %#2d comments to article %#1n.\n") (read-normally-read . "How many articles to you want to read again? ") (review-conf-gone . "The conference does not exist.\n") (review-pers-gone . "The user does not exist.\n") (review-cant-read-conf . "You can't review articles to a closed conference you are not a member of.\n") (review-cant-read-letterbox . "You can't review articles to somebody else's mailbox.\n") (review-cant-read-empty . "The conference is empty.\n") (cant-review-everything . "You cannot review every artible in LysKOM.\n") (more-than-one-root . "Article %#1n has more than one root.\n") (more-than-one-root-review . "\ Article %#1n has more than one root but only one of the trees will be shown.\n") ; From edit-text.el: (press-C-c-C-c . "Enter C-c C-c to post the article.") (recipient . "Recipient:") (recipient-prefix . "[Rr]") (carbon-copy . "Carbon copy:") (blank-carbon-copy . "Blind Carbon copy:") (carbon-copy-prefix . "[Cc]\\([Aa]\\|[Cc]\\)") (blank-carbon-copy-prefix . "[Bb]\\([Ll]\\|[Cc][Cc]\\)") (header-subject . "Subject: ") (header-separator . "\\\ --- Write below. \ Post: \\[kom-edit-send], \ Kill: \\[kom-edit-quit], \ Help: \\[describe-mode] ---") (text-mass . "%#4s%#1s\n%#2s\n%#3s") (comment-to-by . "%#1s to article %#2n%#3s.\n") (already-sent . "You have already posted this article. Post it anyway? ") (subject . "Subject: ") (subject-prefix . "[Ss]") (enter-subject-idi . "Enter a subject.") (which-text-include . "Include which article? ") (added-recipient . "Recipient: ") (added-carbon-copy . "Carbon copy to conference: ") (added-blank-carbon-copy . "Blind carbon copy to conference: ") (text-to-comment-q . "Which article to you want to comment? ") (conf-has-motd-no . "The conference has a note on the door. (%#1d)\n\n%#2s") (still-want-to-add . "Do you still want to add the conference as a recipient? ") (could-not-create-text . "\nCouldn't create the article. Error: %#2s.\n") (no-get-text . "You were not allowed to retrieve the article.") (unknown-header . "Unknown header") (transform-error . "Skicka in oformatterat (%#1s)? ") ; From view-text.el: (line . " /1 line/ ") (lines ." /%#1d lines/ ") (marked-by-you . "Marked by you.\n") (marked-by-you-and-one . "Marked by dig and someone else.\n") (marked-by-you-and-several . "Marked by you and %#1d other users.\n") (marked-by-one . "Marked by 1 user.\n") (marked-by-several . "Marked by %#1d users.\n") ;; The format of this function should coincide with the format of the ;; lyskom-text-start variable. DONT change one without changing the other. (time-yyyy-mm-dd-hh-mm . "%4#1d-%02#2d-%02#3d %02#4d:%02#5d") ; used by lyskom-print-time (time-y-m-d-h-m . "%4#1d %02#3d/%02#2d %02#4d:%02#5d ") (today-time-format-string . "%#6s %02#4d:%02#5d") (yesterday-time-format-string . "%#6s %02#4d:%02#5d") (today . "today") (yesterday . "yesterday") (no-such-text-no . "The article doesn't exist. (%#1:n)\n") (head-Subject . "Subject: ") (Recipient . "Recipient") (Extra-recipient . "CC") (Hidden-recipient . "BCC") (Strange-recipient . "Also to") (send-at . " Posted: %#1s\n") (sent-by . " Posted by %#1P\n") (recieved-at . " Received: %#1s\n") (comment-to-text . "Comment to article %#1n") (footnote-to-text . "Footnote to article %#1n") (comment-in-text . "Comment in article %#1n") (footnote-in-text . "Footnote in article %#1n") (comment-to-text-by . "Comment to article %#1n by %#2P") (footnote-to-text-by . "Footnote to article %#1n by %#2P") (comment-in-text-by . "Footnote in article %#1n by %#2P") (footnote-in-text-by . "Footnote in article %#1n by %#2P") (written-by . " by %#1P\n") ; From async.el: (name-has-changed-to-name . "%#1:P has changed name to %#2:P") (name-has-changed-to-name-r . "%[%#3@%#1:P%] has changed name to %[%#3@%#2:P%]\n") (you-changed-name-to . "You have now changed your name to %[%#2@%#1:P%].\n") (database-sync . "Synching database.") (lyskom-is-full . "\ =========================================================== Message from the LysKOM-system: Somebody tried to connect, but failed since all connections available to LysKOM are in use. Please leave and return later if you are just waiting for an article. ===========================================================\n") (has-entered . "%#1:P has entered LysKOM.") (has-entered-r . "%#2@%#1P has entered LysKOM.\n") (has-left . "%#1:P has left LysKOM.") (has-left-r . "%#2@%#1P has left LysKOM.\n") (unknown . "unknown") (secret-person . "Secret user") (message-broadcast . "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Public message from %#1P (%#3s): %#2t ---------------------------------------------------------------- ") (message-from . "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Personal message from %#1P (%#3s): %#2t ---------------------------------------------------------------- ") (message-from-to . "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Group message to %#3M\nfrom %#2P (%#4s): %#1t ---------------------------------------------------------------- ") (text-is-created . "Article %#1n has been created!") ; Used in mode-line-process (mode-line-waiting . ": waiting") (mode-line-working . ": working") (mode-line-saving . ": saving") (mode-line-down . ": down") ; From completing-read.el: (person-or-conf-no-regexp . "\\`[ \t]*[mpMP]\\w*[ \t]+\\([0-9]+\\)\\'") (session-no-regexp . "\\`[ \t]*[sS]\\w*[ \t]+\\([0-9]+\\)\\'") ; From prioritize.el: (cant-move-nothing-nowhere . "Can't move nothing anywhere.") (goto-priority-prompt . "Got to priority: ") (priority-prompt . "New priority for %#1M: ") (priority-prompt-marked . "New priority for selected conferences: ") (beginning-of-list . "Beginning of list") (end-of-list . "End of list") (reprioritize-from . "Reprioritize from: ") (reprioritize-to . "Reprioritize to: ") (no-selection . "No selection") (selection . "%d selected") (cannot-get-membership . "Cannot retrieve your membership list.") (cannot-get-pers-stat . "Cannot retrieve your personal status.") (prioritize-help . "u,n Move conference, SPC select, p prioritize selection, q quit, C-h m help") (your-priorities . " Priority Conference ---------------------------------------------------------------------------- ") (your-membship . "Your memberships: Prio Conf# Conference\n") (prio-row . " %5#1d%5#2m %#3M\n") (too-high-goto-2 . "You are too high up, move down to line two.") (too-low-go-up . "You can't push the last line. Move up one line.") (all-confs-popped . "All conferences have been popped.") (prio-died . "Couldn't complete the move. Sorry. Kill the buffer.") (new-priority . "New priority? (0 (low) - 255 (high)) ") (new-prio . "%6#1d") ; From flags.el: (saving-settings . "Saving options...") (saving-settings-done . "Saving options...done") (hang-on . "Wait a moment...\n") (no-changes . "Nothing was saved since no options had been changed.\n") (could-not-save-options . "Couldn't save options.\n") (could-not-create-area . "Couldn't create the article.\n") (could-not-set-user-area . "Couldn't alter the user-area. The server says error: %#1d\n") (you-dont-exist . "You don't exist. Go away.\n") (error-in-options . "There was an error in one of your variables (%#1s) It was set to \"%#2s\" in the user area. It is set to nil instead. Send a bug report.\n") ; From elib-string.el: ; No entries. ; From lyskom-rest.el: (mode-line-unread . " Unread ") (mode-line-letters . "letters ") (error-code . "Error code %#2d: %#1s.\n") (error-in-kom-do-when-done . "The variable kom-do-when-done has an erroneous value. You should set it to a better value.\n") (extended-command . "LysKOM: ") (wait-for-server . "LysKOM is waiting for a response from the server. Wait for the prompt.\n") (review-text-q . "Review article: ") (completely-read-conf . "You have seen all the articles in this conference.\n") (not-in-any-conf . "You are not in a conference now.\n") (all-conf-unread-r . "You have nothing unread.\n") (all-conf-unread-s . "You have nothing unread. ") (one-unread . "%#1M - one unread article\n") (several-unread . "%#1M - %#2d unread articles\n") (enter-conf . "%#1M\n") (save-on-file-q . "Save which article in file: (%#1s) ") (wait-for-prompt . "Wait for the prompt.") (conference-no . "") (person-no . "") (prompt-several-messages . "(%d messages)") (prompt-single-message . "(%d message)") (go-to-pri-conf-prompt . "Go to next prioritized conference") (read-pri-text-conf . "Read next prioritized article") (review-next-text-prompt . "Review next article") (review-next-comment-prompt . "Review next comment") (review-next-marked-prompt . "Review next marked article") (read-next-letter-prompt . "Read next letter") (read-next-footnote-prompt . "Read next footnote") (read-next-comment-prompt . "Read next comment") (read-next-text-prompt . "Read next article") (go-to-conf-of-marked-prompt . "Review next marked") (go-to-next-conf-prompt . "Go to next conference") (go-to-your-mailbox-prompt . "Go to your mailbox") (the-command . "Command: %#1C") (error-in-login-hook . "There was an error in your kom-login-hook: %#1s\n") (give-a-number . "Enter a number: ") (yes-regexp . "\\`[yY][eE][sS]\\'") (no-regexp . "\\`[nN][oO]\\'") (yes-or-no-nag . "Answer yes or no.") (yes-or-no . "(yes or no) ") (y-or-n-instring . "yYnN") (j-or-n-nag . "Answer y or n. ") (j-or-n . "(y or n) ") (y-instring . "yY") (person-does-not-exist . "User %#1d (does not exist).") (conference-does-not-exist . "Conference %#1d (does not exist).") (person-is-anonymous . "Anonymous user") (process-signal . "Signal from the process.") (dead-session . "No active LysKOM session.") (closed-connection . " ************************************************** %#2s LysKOM session killed abnormallly Error message: %#1s**************************************************") (error-not-found . "Error code %#1d. No explanation available.") ; Useful in more place than one: (illegal-command . "Illegal command.\n") (no-such-text . "The article doesn't exist.\n") (no-such-text-m . "The article doesn't exist.") (everybody . "everyone") (everything . "everything") (anybody . "anyone") (forward . "forward") (backward . "backward") (wait . "Wait a moment...\n") (comment . "Comment") (comment-prefix . "[Cc][Oo]") (footnote . "Footnote") (footnote-prefix . "[Ff]") (by . " by %#1P") (text-created . "Article %#1n has been created.\n") (resolve-session . "Which session: ") (starting-program . "Starting %#1s...") (super-jump . "Filtering subject \"%#1r\" in conference \"%#2M\"\n") (no-recipient . "There are no recipients for this article.\n") (filtered . "[Filtered]") (filter-error-specification . "Error in the filter specification") (filter-error-bad-not . "Error in the filter specification after 'not'") (filter-error-unknown-key . "The filter key '%S' is unknown.") (filter-error-key-arg . "Bad filter data (%S %S)") (filter-tree . "Skipping article %#1n \"%#2r\" by %#3P and all its comments.\n") (filter-text . "Skipping article %#1n \"%#2r\" by %#3P.\n") (filter-permanent . "Permanent? ") (filter-action . "Filter how? ") (filter-in-conf . "In which conference? (all) ") (filter-subject . "Filter which subject? ") (filter-which-text . "Filter articles containing: ") (filter-author . "Filter which author? ") (permanent . "(permanent)") (temporary . "(temporary)") (filter-edit-buffer-name . "*LysKOM Filter Edit*") (filter-edit-empty-list . "Empty list") (filter-edit-start-of-list . "Beginning of list") (filter-edit-end-of-list . "End of list") (filter-edit-filter-how . "Filter how? ") (filter-edit-filter-what . "What do you want to filter? ") (filter-edit-bad-argument . "Bad input: %s") (filter-edit-outside-entry . "Can't do that outside a filter") (filter-edit-outside-list . "Can't do that outside the list") (filter-edit-end-of-pattern . "End of filter") (filter-edit-save-p . "Save changes? ") (filter-edit-remove-empty . "Empty filters cause all articles to be filtered. Do you want to remove these? ") (filter-edit-restart-p . "You have made changes. Really revert? ") (filter-edit-help . "p Up, n Down, i New line, M-i New filter, d Delete line, M-d Delete filter") (filter-edit-header . "Edit filters on \"%s\"\n") (filter-edit-saving . "Saving changes...") (filter-edit-saving-done . "Saving changes...done") (filter-edit-saving-error . "Couldn't save changes!") (filter-edit-insert-pred . "%#1s (=,!=): ") (filter-edit-insert-arg . "%#1s %#2s (what): ") (no-filters . "No filters are defined.\n") (view-filters-header . "\nActive filters:\n\n") (view-filters-footer . "") (ansaphone-new-message . "New Ansaphone message: ") (ansaphone-message . "Ansaphone message: ---------------------------------------------------------------------- %#1t ---------------------------------------------------------------------- ") (ansaphone-state . "The Ansaphone is %#1s.") (ansaphone-state-r . "The Ansaphone is now %#1s.\n") (ansaphone-messages-gone . "Recorded messages have been erased.") (ansaphone-no-messages . "No recorded messages.\n") (ansaphone-message-list-start . "Recorded messages:\n\n") (ansaphone-message-list-end . "\n\n") (ansaphone-message-header . "Automatic reply (set %#1s):\n") (remote-erase-messages . "Remote control (%#1P %#2s): Erased recorded messages\n") (remote-set-message . "Remote control (%#1P %#2s): Ansaphone message: ---------------------------------------------------------------------- %#3t ---------------------------------------------------------------------- ") (remote-set-ansaphone . "Remote control (%#1P %#2s): The ansaphone is %#3s\n") (remote-list-messages . "Remote control (%#1P %#2s): Listed recorded messages\n") (remote-quit . "Remote control (%#1P %#2s): Quit\n") (illegal-remote . "Illegal remote control attempt: Time: %#1s From: %#2P <%#2p> To : %#3P <%#3p> Text: %#4t") (illegal-remote-reply . "Remote control rejected: %#1s") (remote-not-in-list . "Unauthorised person") (remote-bad-command . "Unknown or malformed command") (remote-unknown-error . "Unknown error") (remote-control-who . "Remotely control which session? ") (remote-control-autoreply . "Ansaphone on or off? ") (state-on . "on") (state-off . "off") (text-popup-title . "Article %#1s") (conf-popup-title . "Conference %#1s") (pers-popup-title . "User %#1s") (url-popup-title . "URL %#1s") (generic-popup-title . "%#1s") (who-i-am-not-present . "%#1P (not in any conference) \n") (who-i-am-present . "%#1P is present in %#2M\n") (who-i-am-client . "The programs is lyskom.el, version %#1s.\n") (who-i-am-server . "This is %#1s, version %#2s.\n") (who-i-am-emacs . "Running under %#1s.\n") (no-such-session-r . "That session does not exist. Perhaps the user is not logged on.\n") (person-not-logged-in-r . "%#1P is not logged on.\n") (session-status . "Session %#1d is %#2P <%#2p> %#5s %#7s %#4M Using %#6D from %#3s\n") (session-status-9 . "Session %#1d is %#2P <%#2p> %#5s %#7s %#4M Using %#6D from %#3s On since %#8s%#9s") (session-status-inactive . "\nHas been inactive for %#1s\n") (one-day . "one day") (one-hour . "one hour") (one-minute . "one minute") (days . "days") (hours . "hours") (minutes . "minutes") (and . "and") (session-is-active . " and is currently active.\n") (session-is-invisible . "This session is invisible.\n") (status-for-session . "Session status for whom? ") (unknown-doing-what . "Exists") (doing-where-conn . "in") (doing-nowhere-conn . "but is") (waiting-for-membership . "Waiting for the membership list to be fetched...%d/%d") ;; From slow.el (no-such-command . "There is no such command.\n") (command-completions . "You may mean one of the following:\n %#1s\n") (which-language . "Change language to: ") (send-formatted . "Send as formatted text? ") (changing-language-to . "Changing to %#1s.\n") (language-not-loaded . "%#1s is unavailable.\n") (reformat-html . "(HTML)") (reformat-enriched . "(Enriched)") (reformat-filled . "(Filled)") (need-library . "The \"%#1s\" package is required for this command.\n") (calc-expression . "Expression: ") )) ;;; ================================================================ ;;; The commands and their associated functions ;;; Formely known as lyskom-commands (lyskom-language-strings lyskom-command en '( (describe-mode . "Help") (kom-slow-mode . "Long commands") (kom-quick-mode . "Short commands") (kom-send-message . "Send message") (kom-create-conf . "Create conference") (kom-delete-conf . "Delete conference") (kom-delete-text . "Remove article") (kom-display-time . "Time") (kom-go-to-conf . "Go (to) conference") (kom-go-to-next-conf . "(Go to) next conference") (kom-jump . "Skip (all) comments") (kom-list-conferences . "List conferences") (kom-list-persons . "List users") (kom-list-news . "List news") (kom-list-re . "List (using) regexps") (kom-membership . "List memberships") ;; (kom-list-marks . "List marks") (kom-postpone . "Postpone reading") (kom-set-session-priority . "Set reading level") (kom-prioritize . "Prioritize conferences") (kom-status-person . "Status (of) user") (kom-status-conf . "Status (of) conference") (kom-add-self . "Join (a) conference") (kom-list-summary . "List article (subjects)") (kom-sub-self . "Leave (a) conference") (kom-quit . "Quit") (kom-recover . "Recover") (kom-start-anew . "New User") (kom-view . "Review article") (kom-find-root-review . "Review tree") (kom-review-comments . "Review all comments") (kom-review-tree . "Review all comments recursively") (kom-review-clear . "Review and skip") (kom-review-last-normally-read . "Review again") (kom-review-noconversion . "Review unconverted") (kom-review-next . "Review next") (kom-find-root . "Review original (article)") (kom-review-by-to . "Review last") (kom-review-first . "Review first") (kom-review-all . "Review all") (kom-review-more . "Review more") (kom-view-commented-text . "Review (the) commented (article)") (kom-view-previous-commented-text . "Review (the) previously commented (article)") (kom-review-stack . "Review stack") (kom-review-presentation . "Review presentation") (kom-review-backward . "(Review) Backwards") (kom-view-next-text . "(Read) next article") (kom-who-is-on . "Who is on") (kom-who-am-i . "Where (am) i") ; (kom-display-who-buffer . "Display who (list)") (kom-list-clients . "List clients") (kom-busy-wait . "Wait (for news)") (kom-write-comment . "(Write) comment") (kom-comment-previous . "(Write) comment (to) previous article") (kom-write-footnote . "(Write) footnote") (kom-private-answer . "(Write) personal reply (by letter)") (kom-private-answer-previous . "(Write) personal (reply to) previous article (by letter)") (kom-set-unread . "Only (the) last") (kom-write-text . "Write (an) article") (kom-send-letter . "Write (a) letter") (kom-change-name . "Change name") (kom-change-password . "Change password") (kom-change-supervisor . "Change supervisor") (kom-change-presentation . "Change presentation") (kom-get-appreciation . "(Please) pat my head") (kom-get-abuse . "(Please) kick my butt") (kom-mark-text . "Mark (article)") (kom-unmark-text . "Unmark (article)") (kom-review-marked-texts . "Review marked (articles)") (kom-review-all-marked-texts . "Review all marked (articles)") (kom-add-recipient . "Add recipient") (kom-add-copy . "Add (recipient of) carbon copy") (kom-add-bcc . "Addera (recipient of) blind carbon copy") (kom-sub-recipient . "Remove recipient") (kom-move-text . "Move text") (kom-add-comment . "Add comment") (kom-sub-comment . "Remove comment") (kom-add-member . "Add (a) member") (kom-sub-member . "Remove (a) member") (kom-change-conf-motd . "(Post) note (on the) door") (kom-set-garb-nice . "Change expiration") (kom-set-super-conf . "Change superconference") (kom-set-permitted-submitters . "Change allowed authors") (kom-unset-conf-motd . "Remove note (from the door)") (kom-save-text . "Save article (in file)") (kom-edit-options . "Change options") (kom-save-options . "Save options") (kom-shutdown-server . "Shut down (server)") (kom-sync-database . "Save (the) database") (kom-enable-adm-caps . "Become administrator") (kom-disable-adm-caps . "Become (normal) user") (kom-set-motd . "Change login message") (kom-remove-motd . "Remove login message") (kom-force-logout . "Kill session") (kom-filter-author . "Filter author") (kom-filter-subject . "Filter subject") (kom-super-jump . "Super jump") (kom-filter-edit . "Edit filters") (kom-filter-text . "Filter contents") (kom-list-filters . "List filters") (kom-show-user-area . "Show user area") (kom-change-conf-type . "Change conference type") (kom-change-auto-reply . "Change ansaphone message") (kom-toggle-auto-reply . "Ansaphone") (kom-list-messages . "List messages") (kom-erase-messages . "Erase messages") (kom-remote-autoreply . "Remote control ansaphone") (kom-remote-set-message . "Remote control change ansaphone message") (kom-remote-list-messages . "Remote control list messages") (kom-remote-erase-messages . "Remote control erase messages") (kom-remote-quit . "Remote control quit") (kom-status-session . "Status (of a) session") (kom-next-kom . "Next LysKOM") (kom-previous-kom . "Previous LysKOM") (kom-next-unread-kom . "Next unread LysKOM") (kom-customize . "Customize LysKOM") (kom-change-language . "Change language") (kom-calculate . "Calculate") )) (lyskom-language-var lyskom-language-codes en '((aa . "Afar") (ab . "Abkhazian") (af . "Afrikaans") (am . "Amharic") (ar . "Arabic") (as . "Assamese") (ay . "Aymara") (az . "Azerbaijani") (ba . "Bashkir") (be . "Byelorussian") (bg . "Bulgarian") (bh . "Bihari") (bi . "Bislama") (bn . "Bengali") (bo . "Tibetan") (br . "Breton") (ca . "Catalan") (co . "Corsican") (cs . "Czech") (cy . "Welsh") (da . "Danish") (de . "German") (dz . "Bhutani") (el . "Greek") (en . "English") (eo . "Esperanto") (es . "Spanish") (et . "Estonian") (eu . "Basque") (fa . "Persian") (fi . "Finnish") (fj . "Fiji") (fo . "Faroese") (fr . "French") (fy . "Frisian") (ga . "Irish") (gd . "Scots Gaelic") (gl . "Galician") (gn . "Guarani") (gu . "Gujarati") (ha . "Hausa") (he . "Hebrew") (hi . "Hindi") (hr . "Croatian") (hu . "Hungarian") (hy . "Armenian") (ia . "Interlingua") (id . "Indonesian") (ie . "Interlingue") (ik . "Inupiak") (is . "Icelandic") (it . "Italian") (iu . "Inuktitut") (ja . "Japanese") (jw . "Javanese") (ka . "Georgian") (kk . "Kazakh") (kl . "Greenlandic") (km . "Cambodian") (kn . "Kannada") (ko . "Korean") (ks . "Kashmiri") (ku . "Kurdish") (ky . "Kirghiz") (la . "Latin") (ln . "Lingala") (lo . "Laotian") (lt . "Lithuanian") (lv . "Latvian Lettish") (mg . "Malagasy") (mi . "Maori") (mk . "Macedonian") (ml . "Malayalam") (mn . "Mongolian") (mo . "Moldavian") (mr . "Marathi") (ms . "Malay") (mt . "Maltese") (my . "Burmese") (na . "Nauru") (ne . "Nepali") (nl . "Dutch") (no . "Norwegian") (oc . "Occitan") (om . "Oromo") (or . "Oriya") (pa . "Pundjabi") (pl . "Polish") (ps . "Pashto") (pt . "Portuguese") (qu . "Quechua") (rm . "Rhaeto-Romance") (rn . "Kirundi") (ro . "Romanian") (ru . "Russian") (rw . "Kiyarwanda") (sa . "Sanskrit") (sd . "Sindhi") (sg . "Sangho") (sh . "Serbo-Croatian") (si . "Singhalese") (sk . "Slovak") (sl . "Slovenian") (sm . "Samoan") (sn . "Shona") (so . "Somali") (sq . "Albanian") (sr . "Serbian") (ss . "Siswati") (st . "Sesotho") (su . "Sudanese") (sv . "Swedish") (sw . "Swahili") (ta . "Tamil") (te . "Telugu") (tg . "Tajik") (th . "Thai") (ti . "Tigrinya") (tk . "Turkmen") (tl . "Tagalog") (tn . "Setswana") (to . "Tonga") (tr . "Turkish") (ts . "Tsonga") (tt . "Tatar") (tw . "Twi") (ug . "Uigur") (uk . "Ukrainian") (ur . "Urdu") (uz . "Uzbek") (vi . "Vietnamese") (vo . "Volapük") (wo . "Wolof") (xh . "Xhosa") (yi . "Yiddish") (yo . "Yorouba") (za . "Zhuang") (zh . "Chinese") (zu . "Zulu") (-- . "Unknown language (%#1s)"))) (lyskom-language-strings lyskom-menu en '((lyskom . "LysKOM") (read . "Read") (dont-read . "Jump") (write . "Write") (conference . "Conference") (other . "Other") (person . "User") (move . "Go") (info . "About") (send . "Send message") (recievers . "Recievers") (commented . "Commented") (kom-edit-send . "Send") (kom-edit-send-anonymous . "Send anonymously") (kom-edit-quit . "Throw away") (kom-ispell-message . "Check spelling") (kom-edit-add-recipient . "Add recipient") (kom-edit-add-copy . "Add carbon copy") (kom-edit-show-commented . "Review commented") (kom-edit-insert-commented . "Cite commented"))) ;;(defvar lyskom-swascii-commands nil ;; "The swascii-versions of lyskom-commands.") (lyskom-language-var lyskom-onoff-table en '(("on" . on) ("off" . off))) (lyskom-language-var lyskom-filter-predicate-list en '(("=" . nil) ("!=" . t))) (lyskom-language-var lyskom-filter-what en '((author . "Author") (author-no . "Author (number)") (author-re . "Author (regexp)") (subject . "Subject") (subject-re . "Subject (regexp)") (recipient . "Recipient") (recipient-no . "Recipient (number)") (recipient-re . "Recipient (regexp)") (text . "Contents") (text . "Contents (regexp)"))) (lyskom-language-var lyskom-filter-actions en '((skip-text . "Skip") (dontshow . "Don't show") (skip-tree . "Skip comments"))) ;;(defvar lyskom-swascii-filter-actions nil ;; "The swascii-versions of lyskom-filter-actions.") ;;(defvar lyskom-swascii-filter-what nil ;; "The swascii version of lyskom-filter-what") (lyskom-language-var lyskom-text-start en "[0-9]+ +\\(199[0-9]-[0-1][0-9]-[0-3][0-9]\\|today\\|yesterday\\) +[0-2][0-9]:[0-5][0-9] +/[0-9]+ line\\(s\\)?/ ") (defconst lyskom-keybindings-missing nil) (defvar lyskom-en-mode-map nil) (lyskom-language-keymap lyskom-mode-map en lyskom-en-mode-map) (if lyskom-en-mode-map nil (setq lyskom-en-mode-map (make-keymap)) (suppress-keymap lyskom-en-mode-map) (define-prefix-command 'lyskom-en-review-prefix) (define-prefix-command 'lyskom-en-change-prefix) (define-prefix-command 'lyskom-en-next-prefix) (define-prefix-command 'lyskom-en-list-prefix) (define-prefix-command 'lyskom-en-filter-get-prefix) (define-prefix-command 'lyskom-en-S-prefix) (define-prefix-command 'lyskom-en-previous-prefix) (define-key lyskom-en-mode-map "A" 'lyskom-en-change-prefix) (define-key lyskom-en-mode-map "r" 'lyskom-en-review-prefix) (define-key lyskom-en-mode-map "f" 'lyskom-en-filter-get-prefix) (define-key lyskom-en-mode-map "n" 'lyskom-en-next-prefix) (define-key lyskom-en-mode-map "l" 'lyskom-en-list-prefix) (define-key lyskom-en-mode-map "s" 'lyskom-en-S-prefix) (define-key lyskom-en-mode-map "b" 'lyskom-en-previous-prefix) (define-key lyskom-en-mode-map (lyskom-keys [mouse-2]) 'kom-button-click) (define-key lyskom-en-mode-map (lyskom-keys [down-mouse-3]) 'kom-popup-menu) (define-key lyskom-en-mode-map [mouse-3] 'kom-mouse-null) (define-key lyskom-en-mode-map "*" 'kom-button-press) (define-key lyskom-en-mode-map "\C-i" 'kom-next-link) (define-key lyskom-en-mode-map "\M-\C-i" 'kom-previous-link) ;; These should be first in order to be last in the menu of alternatives. (define-key lyskom-en-mode-map "A?" 'lyskom-help) (define-key lyskom-en-mode-map "r?" 'lyskom-help) (define-key lyskom-en-mode-map "f?" 'lyskom-help) (define-key lyskom-en-mode-map "n?" 'lyskom-help) (define-key lyskom-en-mode-map "l?" 'lyskom-help) (define-key lyskom-en-mode-map "s?" 'lyskom-help) (define-key lyskom-en-mode-map "o" 'kom-set-unread) (define-key lyskom-en-mode-map "x" 'kom-extended-command) (define-key lyskom-en-mode-map " " 'kom-next-command) (define-key lyskom-en-mode-map "\n" 'kom-page-next-command) (define-key lyskom-en-mode-map "\r" 'kom-line-next-command) (define-key lyskom-en-mode-map "?" 'describe-mode) (define-key lyskom-en-mode-map "m" 'kom-send-letter) (define-key lyskom-en-mode-map "g" 'kom-go-to-conf) (define-key lyskom-en-mode-map "a" 'kom-write-text) (define-key lyskom-en-mode-map "c" 'kom-write-comment) (define-key lyskom-en-mode-map "C" 'kom-comment-previous) (define-key lyskom-en-mode-map "F" 'kom-write-footnote) (define-key lyskom-en-mode-map "p" 'kom-private-answer) (define-key lyskom-en-mode-map "P" 'kom-private-answer-previous) (define-key lyskom-en-mode-map "j" 'kom-jump) (define-key lyskom-en-mode-map "J" 'kom-super-jump) (define-key lyskom-en-mode-map "lc" 'kom-list-conferences) (define-key lyskom-en-mode-map "ln" 'kom-list-news) (define-key lyskom-en-mode-map "lu" 'kom-list-persons) (define-key lyskom-en-mode-map "lr" 'kom-list-re) (define-key lyskom-en-mode-map "ls" 'kom-membership) (define-key lyskom-en-mode-map "la" 'kom-list-summary) (define-key lyskom-en-mode-map "lf" 'kom-list-filters) (define-key lyskom-en-mode-map "S" 'kom-add-self) (define-key lyskom-en-mode-map "M" 'kom-mark-text) (define-key lyskom-en-mode-map "U" 'kom-unmark-text) (define-key lyskom-en-mode-map "na" 'kom-view-next-new-text) (define-key lyskom-en-mode-map "nc" 'kom-go-to-next-conf) (define-key lyskom-en-mode-map "nl" 'kom-next-kom) (define-key lyskom-en-mode-map "nu" 'kom-next-unread-kom) (define-key lyskom-en-mode-map "bl" 'kom-previous-kom) (define-key lyskom-en-mode-map "q" 'kom-quit) (define-key lyskom-en-mode-map "z" 'kom-bury) (define-key lyskom-en-mode-map "R" 'kom-recover) (define-key lyskom-en-mode-map "t" 'kom-display-time) (define-key lyskom-en-mode-map "fp" 'kom-get-appreciation) (define-key lyskom-en-mode-map "fk" 'kom-get-abuse) (define-key lyskom-en-mode-map "fs" 'kom-filter-subject) (define-key lyskom-en-mode-map "fa" 'kom-filter-author) (define-key lyskom-en-mode-map "fc" 'kom-filter-text) (define-key lyskom-en-mode-map "w" 'kom-who-is-on) (define-key lyskom-en-mode-map "I" 'kom-who-am-i) (define-key lyskom-en-mode-map "W" 'kom-busy-wait) (define-key lyskom-en-mode-map "Ap" 'kom-change-presentation) (define-key lyskom-en-mode-map "Af" 'kom-filter-edit) (define-key lyskom-en-mode-map "Am" 'kom-change-auto-reply) (define-key lyskom-en-mode-map "r " 'kom-view) (define-key lyskom-en-mode-map "r0" 'kom-initial-digit-view) (define-key lyskom-en-mode-map "r1" 'kom-initial-digit-view) (define-key lyskom-en-mode-map "r2" 'kom-initial-digit-view) (define-key lyskom-en-mode-map "r3" 'kom-initial-digit-view) (define-key lyskom-en-mode-map "r4" 'kom-initial-digit-view) (define-key lyskom-en-mode-map "r5" 'kom-initial-digit-view) (define-key lyskom-en-mode-map "r6" 'kom-initial-digit-view) (define-key lyskom-en-mode-map "r7" 'kom-initial-digit-view) (define-key lyskom-en-mode-map "r8" 'kom-initial-digit-view) (define-key lyskom-en-mode-map "r9" 'kom-initial-digit-view) (define-key lyskom-en-mode-map "rc" 'kom-view-commented-text) (define-key lyskom-en-mode-map "rC" 'kom-view-previous-commented-text) (define-key lyskom-en-mode-map "ra?" 'lyskom-help) (define-key lyskom-en-mode-map "rac" 'kom-review-comments) (define-key lyskom-en-mode-map "rar" 'kom-review-tree) (define-key lyskom-en-mode-map "rj" 'kom-review-clear) (define-key lyskom-en-mode-map "rn" 'kom-review-next) (define-key lyskom-en-mode-map "ru" 'kom-review-noconversion) (define-key lyskom-en-mode-map "ro" 'kom-find-root) (define-key lyskom-en-mode-map "rl" 'kom-review-by-to) (define-key lyskom-en-mode-map "rf" 'kom-review-first) (define-key lyskom-en-mode-map "rA" 'kom-review-all) (define-key lyskom-en-mode-map "rM" 'kom-review-more) (define-key lyskom-en-mode-map "rg" 'kom-review-last-normally-read) (define-key lyskom-en-mode-map "B" 'kom-review-backward) (define-key lyskom-en-mode-map "rs" 'kom-review-stack) (define-key lyskom-en-mode-map "rp" 'kom-review-presentation) (define-key lyskom-en-mode-map "rr" 'kom-find-root-review) (define-key lyskom-en-mode-map "rm" 'kom-review-marked-texts) (define-key lyskom-en-mode-map "ram" 'kom-review-all-marked-texts) (define-key lyskom-en-mode-map "ra " 'kom-review-all) (define-key lyskom-en-mode-map "sc" 'kom-status-conf) (define-key lyskom-en-mode-map "su" 'kom-status-person) (define-key lyskom-en-mode-map "ss" 'kom-status-session) ;; Running in buffer (define-key lyskom-en-mode-map "\033p" 'backward-text) (define-key lyskom-en-mode-map "\033n" 'forward-text) (define-key lyskom-en-mode-map "sa" 'kom-save-text) (define-key lyskom-en-mode-map "\C-?" 'scroll-down) ) ;;;============================================================== ;;; Keymap for filter editing ;;; (defvar lyskom-en-filter-edit-map nil) (lyskom-language-keymap lyskom-filter-edit-map en lyskom-en-filter-edit-map) (if lyskom-en-filter-edit-map () (setq lyskom-en-filter-edit-map (make-keymap)) (suppress-keymap lyskom-en-filter-edit-map) (define-key lyskom-en-filter-edit-map "p" 'lyskom-filter-edit-prev-pattern) (define-key lyskom-en-filter-edit-map "P" 'lyskom-filter-edit-prev-entry) (define-key lyskom-en-filter-edit-map "n" 'lyskom-filter-edit-next-pattern) (define-key lyskom-en-filter-edit-map "N" 'lyskom-filter-edit-next-entry) (define-key lyskom-en-filter-edit-map "\C-P" 'lyskom-filter-edit-prev-pattern) (define-key lyskom-en-filter-edit-map "\C-N" 'lyskom-filter-edit-next-pattern) (define-key lyskom-en-filter-edit-map "\C-B" 'lyskom-filter-edit-prev-pattern) (define-key lyskom-en-filter-edit-map "\C-F" 'lyskom-filter-edit-next-pattern) (define-key lyskom-en-filter-edit-map "\M-p" 'lyskom-filter-edit-prev-entry) (define-key lyskom-en-filter-edit-map "\M-n" 'lyskom-filter-edit-next-entry) (define-key lyskom-en-filter-edit-map "d" 'lyskom-filter-edit-delete-pattern) (define-key lyskom-en-filter-edit-map "\M-d" 'lyskom-filter-edit-delete-entry) (define-key lyskom-en-filter-edit-map "D" 'lyskom-filter-edit-delete-pattern) (define-key lyskom-en-filter-edit-map "\C-D" 'lyskom-filter-edit-delete-pattern) (define-key lyskom-en-filter-edit-map "i" 'lyskom-filter-edit-insert-pattern) (define-key lyskom-en-filter-edit-map "I" 'lyskom-filter-edit-insert-pattern) (define-key lyskom-en-filter-edit-map "\M-i" 'lyskom-filter-edit-insert-entry) (define-key lyskom-en-filter-edit-map "<" 'lyskom-filter-edit-beginning-of-list) (define-key lyskom-en-filter-edit-map ">" 'lyskom-filter-edit-end-of-list) (define-key lyskom-en-filter-edit-map "\M-<" 'lyskom-filter-edit-beginning-of-list) (define-key lyskom-en-filter-edit-map "\M->" 'lyskom-filter-edit-end-of-list) (define-key lyskom-en-filter-edit-map "q" 'lyskom-filter-edit-quit) (define-key lyskom-en-filter-edit-map "x" 'lyskom-filter-edit-expunge) (define-key lyskom-en-filter-edit-map "s" 'lyskom-filter-edit-save) (define-key lyskom-en-filter-edit-map "g" 'lyskom-filter-edit-revert) (define-key lyskom-en-filter-edit-map "t" 'lyskom-filter-edit-toggle-permanent) (define-key lyskom-en-filter-edit-map "a" 'lyskom-filter-edit-toggle-action) (define-key lyskom-en-filter-edit-map "?" 'lyskom-filter-edit-brief-help) (define-key lyskom-en-filter-edit-map "h" 'lyskom-filter-edit-brief-help) ) ;;;(if lyskom-prioritize-mode-map ;;; nil ;;; (setq lyskom-prioritize-mode-map (make-keymap)) ;;; (suppress-keymap lyskom-prioritize-mode-map) ;;; (define-key lyskom-prioritize-mode-map "\C-?" 'previous-line) ;;; (define-key lyskom-prioritize-mode-map " " 'next-line) ;;; (define-key lyskom-prioritize-mode-map "\C-k" 'kom-prioritize-kill) ;;; (define-key lyskom-prioritize-mode-map "\C-y" 'kom-prioritize-yank) ;;; (define-key lyskom-prioritize-mode-map "p" 'kom-prioritize-set-priority) ;;; (define-key lyskom-prioritize-mode-map "\C-c\C-c" 'kom-prioritize-quit) ;;; (define-key lyskom-prioritize-mode-map "q" 'kom-prioritize-quit) ;;; (define-key lyskom-prioritize-mode-map "Q" 'kom-prioritize-quit) ;;; (define-key lyskom-prioritize-mode-map "u" 'kom-prioritize-move-up) ;;; (define-key lyskom-prioritize-mode-map "d" 'kom-prioritize-move-down) ;;;) (defvar lyskom-en-prioritize-mode-map nil) (lyskom-language-keymap lyskom-filter-edit-map en lyskom-en-filter-edit-map) (if lyskom-en-prioritize-mode-map nil (setq lyskom-en-prioritize-mode-map (make-keymap)) (suppress-keymap lyskom-en-prioritize-mode-map) (define-key lyskom-en-prioritize-mode-map (lyskom-keys [mouse-2]) 'kom-button-click) (define-key lyskom-en-prioritize-mode-map (lyskom-keys [down-mouse-3]) 'kom-popup-menu) (define-key lyskom-en-prioritize-mode-map [mouse-3] 'kom-mouse-null) (define-key lyskom-en-prioritize-mode-map "*" 'kom-button-press) (define-key lyskom-en-prioritize-mode-map "?" 'kom-prioritize-help) (define-key lyskom-en-prioritize-mode-map "\C-k" 'kom-prioritize-select) (define-key lyskom-en-prioritize-mode-map "\C-y" 'kom-prioritize-yank) (define-key lyskom-en-prioritize-mode-map " " 'kom-prioritize-select) (define-key lyskom-en-prioritize-mode-map "\C-m" 'kom-prioritize-next-line) (define-key lyskom-en-prioritize-mode-map "\C-j" 'kom-prioritize-next-line) (define-key lyskom-en-prioritize-mode-map "\C-?" 'kom-prioritize-previous-line) (define-key lyskom-en-prioritize-mode-map "\M-\C-?" 'kom-prioritize-deselect-all) (define-key lyskom-en-prioritize-mode-map [down] 'kom-prioritize-next-line) (define-key lyskom-en-prioritize-mode-map "\C-n" 'kom-prioritize-next-line) (define-key lyskom-en-prioritize-mode-map [up] 'kom-prioritize-previous-line) (define-key lyskom-en-prioritize-mode-map "\C-p" 'kom-prioritize-previous-line) (define-key lyskom-en-prioritize-mode-map "p" 'kom-prioritize-previous-line) (define-key lyskom-en-prioritize-mode-map [(meta up)] 'kom-prioritize-move-up) (define-key lyskom-en-prioritize-mode-map "\M-p" 'kom-prioritize-move-up) (define-key lyskom-en-prioritize-mode-map "u" 'kom-prioritize-move-up) (define-key lyskom-en-prioritize-mode-map [(meta down)] 'kom-prioritize-move-down) (define-key lyskom-en-prioritize-mode-map "\M-n" 'kom-prioritize-move-down) (define-key lyskom-en-prioritize-mode-map "d" 'kom-prioritize-move-down) (define-key lyskom-en-prioritize-mode-map "\M-<" 'kom-prioritize-beginning) (define-key lyskom-en-prioritize-mode-map "\M->" 'kom-prioritize-end) (define-key lyskom-en-prioritize-mode-map "r" 'kom-prioritize-reprioritize) (define-key lyskom-en-prioritize-mode-map "g" 'kom-prioritize-goto-priority) (define-key lyskom-en-prioritize-mode-map "p" 'kom-prioritize-set-priority) (define-key lyskom-en-prioritize-mode-map "s" 'kom-prioritize-save) (define-key lyskom-en-prioritize-mode-map "q" 'kom-prioritize-quit) (define-key lyskom-en-prioritize-mode-map "\C-c\C-c" 'kom-prioritize-quit) (define-key lyskom-en-prioritize-mode-map "\t" 'kom-next-link) (define-key lyskom-en-prioritize-mode-map "\M-\C-i" 'kom-previous-link) ) (lyskom-language-var lyskom-prioritize-header-lines en 2) (lyskom-language-var lyskom-prioritize-header en " Prio Conference ----------------------------------------------------------------------------- ") ;;;; ============================================================ ;;;; Strings and things for the customize mode ;;;; (defvar lyskom-en-customize-map nil) (lyskom-language-keymap lyskom-customize-map en lyskom-en-customize-map) (if lyskom-en-customize-map nil (setq lyskom-en-customize-map (make-sparse-keymap)) (define-key lyskom-en-customize-map "\t" 'widget-forward) (define-key lyskom-en-customize-map "\M-\t" 'widget-backward) (define-key lyskom-en-customize-map "\C-m" 'widget-button-press) (define-key lyskom-en-customize-map (lyskom-keys [mouse-2]) 'widget-button-click) (define-key lyskom-en-customize-map "\C-c\C-c" 'lyskom-customize-save-and-quit) (define-key lyskom-en-customize-map "\C-c\C-k" 'lyskom-customize-quit) (define-key lyskom-en-customize-map "\C-c\C-s" 'lyskom-customize-save) (define-key lyskom-en-customize-map "\C-c\C-a" 'lyskom-customize-apply) ) (lyskom-language-strings lyskom-custom-strings en '( ;; ;; Widget strings ;; (which-person . "Specify person: ") (which-conf . "Specify a conference: ") (which-conf-or-person . "Specify a person or conference: ") (which-name . "Specify a name: ") (some-person . "Person %#1d") (invalid-value . "Invalid value (%#1S)") (unknown-command . "Unknown command (%#1s)") ;; ;; Help messages ;; (default-help-echo . "Change the value of %#1s.") (change-this-name . "Change the name in this entry.") (show-doc . "Show documentation.") (hide-doc . "Hide documentation.") (select-command . "Select a command.") (select-what-to-execute . "\ Select whether to execute command or keyboard macro.") (select-url-viewer . "Select a web browser.") (select-number . "Select number of times.") (select-audio-file . "Select an audio file.") (select-priority . "Select a priority.") (select-buffer . "Select a buffer name.") (select-buffer-size . "Select maximum buffer size.") ;; ;; Strings that are used in types and so forth ;; (buffer-name . "%#1s-configure") (other-window . "Some other window ") (other-frame . "Some other frame ") (new-frame . "In a new frame ") (lyskom-window . "The LysKOM buffer's window ") (window-on-buffer . "A window displaying the buffer") (on . "On ") (off . "Off") (yes . "Yes") (no . "No ") (max-text-length . "For articles shorter than: ") (turned-off . "Turned off ") (number-of-times . "A few times") (sound-file . "Audio file") (selected-mark . "Mark ") (ask . "Ask every time ") (before . "Before the text") (after . "After the text") (depth-first . "In comment order") (time-order . "I time order") (express-break . "Immediately upon creation ") (break . "After current comment chain") (no-break . "Efter current conference ") (command . "Command") (command-list . "Command list") (some-persons . "For some persons") (name . "Name") (page-none . "Never ") (page-all . "Before every command ") (page-some . "Before the following commands") (ask-every-time . "Ask every time ") (fixed-priority . "Fixed priority") (messages-in-lyskom-buffer . "In the LysKOM buffer ") (discard-messages . "Nowhere - discard them") (in-named-buffer . "In a named buffer ") (everybody-rcpt . "Everybody ") (group-rcpt . "The recipient of the last group message") (sender-rcpt . "The sender of the most recent message ") (viewer-program . "Web browser") (no-viewer . "(ingenting valt)") (default-viewer . "Browse-URL (all)") (netscape-viewer . "Netscape Navigator (all)") (emacs-w3-viewer . "Emacs W3-mode (HTTP, Goper, FTP)") (emacs-general-viewer . "Emacs (FTP, Telnet, Mail)") (emacs-dired-viewer . "Emacs Dired (FTP)") (emacs-mail-viewer . "Emacs Mail-mode (Mail)") (emacs-telnet-viewer . "Emacs Telnet-mode (telnet)") (mosaic-viewer . "NCSA Mosaic (all)") (lynx-viewer . "Lynx (alla)") (dont-check . "Don't ask for confirmation") (check-before-open . "Confirm before writing the text") (check-before-send . "Confirm before sending the text") (no-size-limit . "No limit") (max-size-in-bytes . "Fixed limit (in bytes)") (execute . "Execute") (kbd-macro . "Keyboard macro") (command . "Command") (enter-kbd-macro . "Enter a keybard macro. Finish with %#1s") (long-format . "Show help texts") (short-format . "Hide help texts") ;; ;; Misc doc strings ;; (lyskom . "Configuration of LysKOM") (lyskom-doc . "\\[lyskom-customize-save-and-quit] to save and quit, \\[lyskom-customize-save-and-quit] to save and quit, \\[lyskom-customize-save] to save without quitting, \\[lyskom-customize-quit] to quit without saving. \\[widget-forward] moves to the next setting \\[widget-button-press] changes the value Documentation: [?] Show documentation [!] Hide documentation Lists etc. : [INS] Add a line [DEL] Remove a line [*] Modify") (section . "------------------------------------------------------------------------------\n") (look-and-feel-misc . "Look and feel\n") (window-locations . "Windows\n") (windows-where . "How are windows created:\n") (reading . "Reading\n") (writing . "Writing\n") (urls . "URL Management\n") (personal-messages . "Personal messages\n") (remote-control . "Remote control of LysKOM\n") (hooks . "Hook functions\n") (audio-cues . "Audio cues\n") (audio-cues-when . "Issue audio cues when:\n") (automatic-replies . "Automatic replies\n") (audio-cues-doc . "\ The following group of settings control how LysKOM issues audio cues in various situations. The following options are available for each setting: Off No audio cue is issued A Few Times Emacs will beep one or more times. You have to specify how many times Emacs is to beep. Audio File Emacs will attempt to play the specified audio file. The program used to play the file is specified by another setting.") (sending-doc . "\ The following settings turn on or off certain checks that can be performed before sending an article to the server. The checks are designed to keep you from doing something stupid. Confirm multiple recipients If an article or comment has more than one recipient, LysKOM can ask which of the recipients are relevant. This can either be done before you start writing the article, in which case LysKOM will post a question for each recipient, or before sending the article to the server, in which case you may confirm all the recipients at once. It is also possible to turn this check off entirely. Check membership of commented author When on, LysKOM will check that the author of the comment you are writing is a member of at least one of the recipients of your comment. If not, LysKOM will offer to add the commented authos as a recipient to the comment you are writing. Check for unread comments When this is on, LysKOM will check that you have read all the other comments to the article you are commenting before sending your comment to the server. This is supposed to help you avoid duplicating someone else's comment.") (windows-doc . "\ The following settings control how windows are created in LysKOM. The available options are: Some other window In another window, but in the same frame as LysKOM. If there only is one window in the frame, a new window will be created (and will be removed when you are finished.) Some other frame In a different frame than the one LysKOM is in. If there only is one frame, a new one will be created (and removed when you are finished.) In a new frame A new frame is created (and removed when you are finished.) The LysKOM buffer's window The LysKOM buffer's window will be used. LysKOM will be restored to the window when you're finished. A window displaying the buffer If there is a window anywhere displaying the named buffer, that window will be used. This might be useful if you always have a particular buffer showing, but don't need it when executing some command.") ;; ;; Doc strings for variables ;; (kom-emacs-knows-iso-8859-1-doc . "\ Turned on means that LysKOM expects Emacs to understand ISO-8859-1. There is no point in turning this off.") (kom-bury-buffers-doc . "\ Controls how the LysKOM buffer is handled when moving to another KOM buffer with the Next and Previous LysKOM commands. When turned on the current buffer is buried.") (kom-write-texts-in-window-doc . "\ Controls which window is used to write new texts.") (kom-prioritize-in-window-doc . "\ Controls which window is used to prioritize conferences.") (kom-edit-filters-in-window-doc . "\ Controls which window is used for editing filters.") (kom-customize-in-window-doc . "\ Controls which window is used to configure LysKOM.") (kom-view-commented-in-window-doc . "\ Controls which window is used to show the commented text when commenting.") (kom-list-membership-in-window-doc . "\ Controls in which window your membership list is shown.") (kom-user-prompt-format-doc . "\ The format of the LysKOM prompt. Certain control sequences cause special text to be inserted: %c - Inserts the current default command. %[ - Inserts `[' if the ansaphone is on. %] - Inserts `]' is the ansaphone is on. %m - Inserts information about recorded messages. %s - Inserts the name of the LysKOM system %S - Inserts the server name. %p - Inserts the name of the user currently logged on. %w - Inserts the name of the current conference. %# - Inserts the current session number. % - Inserts a space if it seems necessary. %% - Inserts a percent sign. Here are a few examples: \"%[%c% %m%] - \" The default prompt \"%[%s: %c% %m%] - \" Could display \"LysKOM: Se tiden - \"") (kom-user-prompt-format-executing-doc . "\ The format of the LysKOM prompt when the default command is executing. Certain control sequences cause special text to be inserted: %c - Inserts the current default command. %[ - Inserts `[' if the ansaphone is on. %] - Inserts `]' is the ansaphone is on. %m - Inserts information about recorded messages. %s - Inserts the name of the LysKOM system %S - Inserts the server name. %p - Inserts the name of the user currently logged on. %w - Inserts the name of the current conference. %# - Inserts the current session number. % - Inserts a space if it seems necessary. %% - Inserts a percent sign. Here are a few examples: \"%[%c% %m%] - \" The default prompt \"%[%s: %c% %m%] - \" Could display \"LysKOM: Se tiden - \"") (kom-cite-string-doc . "\ A string that is inserted before each line in a cited text. Normally this is set to something like \"> \". Note that it is not customary to cite commented texts the way it is done in e-mail or Usenet News since the commented text is always available in LysKOM.") (kom-created-texts-are-read-doc . "\ When this is on, self-created texts are autmatically marked as read. Turned off, those texts are presented as any other texts.") (kom-default-mark-doc . "\ The default value used for marking texts. If no value is selected, LysKOM asks for a mark value every time. Values are between 1 and 255 are allowed.") (kom-reading-puts-comments-in-pointers-last-doc . "\ Controls if comment links are listed before or after the body of a text. Normally comment links are listed after the text. Before: 398331 1996-09-24 13:22 /2 lines/ George Berkeley Recipient: Philosophy <1226> Comment in article 398374 by John Locke Subject: ------------------------------------------------------------ An abstract idea is a contradiction in terms. (398331) ----------------------------------- After: 398331 1996-09-24 13:22 /2 lines/ George Berkeley Recipient: Philosophy <1226> Subject: ------------------------------------------------------------ An abstract idea is a contradiction in terms. (398331) ----------------------------------- Comment in article 398374 by John Locke ") (kom-dashed-lines-doc . "\ When this setting is turned on, dashed lines are displayed before and after the text body. When turned off, blank lines are used instead. On: 892343 1996-09-24 19:21 /2 lines/ Tycho Brahe Recipien: Presentation (of new) Members Subject: Tycho Brahe ------------------------------------------------------------ Astronomer and discoverer of stars resident on the island of Ven. (892343) ----------------------------------- Off: 892343 1996-09-24 19:21 /2 lines/ Tycho Brahe Recipien: Presentation (of new) Members Subject: Tycho Brahe Astronomer and discoverer of stars resident on the island of Ven. (892343) Most people have this turned on.") (kom-autowrap-doc . "\ With this setting turned on, LysKOM will attempt to fill any paragraphs containing lines that are wider than the screen. Paragraphs that appear to have been preformatted by the author are exempt from this treatment.") (kom-show-author-at-end-doc . "\ When this is turned on the name of the author will be shown at the end of the article text. The name is also shown before the text as usual. On (with dashed lines on): 892342 1996-09-24 19:21 /2 lines/ Claude Shannon Mottagare: Presentation (of new) Members Ärende: Claude Shannon ------------------------------------------------------------ Information theoretician (892342) /Claude Shannon/------------------------------ Off: 892342 1996-09-24 19:21 /2 lines/ Claude Shannon Recipient: Presentation (of new) Members Subject: Claude Shannon ------------------------------------------------------------ Information theoretician (892342) ----------------------------------- If dashed lines are off the author's name will be shown as in this example, but the dashed lines are natually not displayed.") (kom-print-number-of-unread-on-entrance-doc . "\ Determines whether the number of unread articles is shown when entering a conference: On: Go to next conference... Presentation (of nya) Members - 3 unread Read next article - Off: Go to next conference... Presentation (of nya) Members Read next article - ") (kom-presence-messages-doc . "\ If you want messages in the minibuffer when somebody logs in, logs out or changes name, turn this setting on. Messages are shown in the minibuffer. If you want messages about a limited number of users, specify which ones. To not get any messages at all, just specify an empty list.") (kom-presence-messages-in-buffer-doc . "\ If you want messages in the LysKOM buffer when somebody logs in, logs out or changes name, turn this setting on. Messages are shown in the LysKOM buffer. If you want messages about a limited number of users, specify which ones. To not get any messages at all, just specify an empty list.") (kom-show-where-and-what-doc . "\ If this is on, the list of active users will include the machine and user they are logged in from (if known) and what they are currently doing. On: User Is in conference At Activity -------------------------------------------------------------------------- 6810 George Berkeley Philosophy berkeley@emp1.tcd.ie (Writing a comment.) 7571 John Locke Philosophy eridy@cc.ox.ac.uk (Waiting.) Off: User Is in conference -------------------------------------------------------------------------- 6810 George Berkeley Philosophy 7571 John Locke Philosophy") (kom-idle-hide-doc . "\ The listing of active users normally only shows those users who have been active recently. This setting determines how many minutes a user may be inactive without being excluded from the list of active users.") (kom-show-footnotes-immediately-doc . "\ Footnotes can be shown either as comments or immediately when the article they are footnotes to is displayed. This setting controls which behavior is used.") (kom-follow-comments-outside-membership-doc . "\ LysKOM will normally not follow chains of comments into conference you are not a member of. If you do want to follow comment chains into other conferences, turn this setting on.") (kom-read-depth-first-doc . "\ LysKOM can display articles either in the order they were written or in the order defined by the comment tree. For example, if articles 1003 and 1004 are comments to article 1002, article 1006 is a comment to 1003 and articles 1005 and 1007 are comments to 1004, the comment tree looks something like this: 1002 +-- 1003 --- 1006 | +-- 1004 +-- 1005 | +-- 1007 Reading in order of creation will cause the articles to be displayed in numerical order: 1002, 1003, 1004, 1005, 1006 and finally 1007. Reading in comment order will give the order 1002, 1003, 1006, 1004, 1005 and finally 1007.") (kom-continuous-scrolling-doc . "\ Turned on means that LysKOM will scroll the buffer while new text is being inserted, not just at the end of a command. This works well with faster terminals, but may be worth turning off if the terminal is so slow that scrolling Emacs buffers takes a long time.") (kom-deferred-printing-doc . "\ In order to improve speed, LysKOM will not print certain things, such as the names of users and conferences immeduately, but will delay printing to make time for other tasks. This improves response time in the client considerably, and should only be turned off if it causes problems.") (kom-higher-priority-breaks-doc . "\ When articles are created in conferences that have a higher priority than the one currently being read, LysKOM will attempt to break the normal reading order to show these. This setting controls whether the reading order is broken immediately, after the current comment chain is read or when everything in the current conference has been read.") (kom-login-hook-doc . "\ This hook lists commands to be run when logging in, before any input is accepted from the keyboard.") (kom-do-when-done-doc . "\ This hook lists commands and keyboard macros that are to be executed when all texts have been read.") (kom-page-before-command-doc . "\ The LysKOM buffer can be cleared before all commands, so text that is inserted always appears at the top of the buffer's window. This variable controls before which commands the buffer is to be scrolled.") (kom-permissive-completion-doc . "\ When this is on, TAB will only complete to the names of users that are logged on when the command being invoked is only applicable to people that are logged on. When off, TAB will complete to names of everyone.") (kom-membership-default-priority-doc . "\ This specifies the how the initial priority of a conference is set when you first become a member. If it is a number between 1 and 255, that is the priority assigned. If it is something else, LysKOM will ask for a priority every time you become a member of a conference.") (kom-show-personal-messages-in-buffer-doc . "\ This setting specifies how personal, group and public messages are shown. The messages can be displayed in the LysKOM buffer, simply thrown away or be shown in a named buffer.") (kom-pop-personal-messages-doc . "\ If messages are shown in a named buffer and this setting is also on, then LysKOM will display that buffer whenever a message arrives.") (kom-audio-player-doc . "\ If you want LysKOM to play audio files instead of simply beeping, this setting must specify the name of a program that can play the audio files. The program must takea single argument, the name of the file to play.") (kom-default-message-recipient-doc . "\ This setting controls who will be the default recipient of messages. The default recipient may either be everyone, i.e. a public message; the sender of the most recently received message; or the recipient of the most recently received group message or the sender of the most recently received personal message.") (lyskom-filter-outgoing-messages-doc . "\ If this is on, message that are sent automatically, such as automatic replies and replies to remote control commands will be shown as if you had sent them manually.") (kom-friends-doc . "\ The users named in this list will be displayed using a special face in the LysKOM buffer.") (kom-url-viewer-preferences-doc . "\ This setting controls which WWW browser that will be used to open URLs found in LysKOM. If the first browser in the list cannor handle the type of URL being opened, then the next browser is tried, and so on.") (kom-mosaic-command-doc . "\ This setting specifies the command to use to start NCSA Mosaic.") (kom-netscape-command-doc . "\ This setting specifies the command to use to start Netscape.") (kom-inhibit-typeahead-doc . "\ Key presses are usually buffered while LysKOM is busy, and are executed as soon as possible. With this setting off, LysKOM discard any key presses received while the client was busy.") (kom-max-buffer-size-doc . "\ It is possible to limit the size of the LysKOM buffer by specifying a maximum number of characters in this setting. When the buffer grows beyond this limit, text from the beginning of the buffer is removed.") (kom-ansaphone-record-messages-doc . "\ LysKOM can record messages that arrive when the autoreply feature is on. This setting controls whether messages are recorded or not.") (kom-ansaphone-show-messages-doc . "\ When this setting is on, LysKOM will display incoming messages even if the autoreply feature is turned on.") (kom-ansaphone-default-reply-doc . "\ This is the message sent by the autoreply feature unless a different message has been specified using some other means (and other means are only for careful experts.)") (kom-remote-control-doc . "\ When turned on, it is possible to control the session using remote control commands. Only those users listed below may issue the commands.") (kom-remote-controllers-doc . "\ The users listed here are premitted to issue remove control commands to your LysKOM session.") (kom-self-control-doc . "\ When this is on, the user who is logged on may issue remote control commands. This is an alternative to adding yourself to the list of permitted controllers.") (kom-customize-format-doc . "\ The documentation for the various settings can be visible or hidden when you open the settings buffer. No matter if it starts hidden or visible, the documentation for individual settings can be shown and hidden by using the question mark/exclamation mark to the right of the setting.") (kom-default-language-doc . "\ Default language to use in LysKOM. If you change this setting the new language will not be applied to the current setting. Use the Change language command to do that.") (kom-ispell-dictionary-doc . "\ This specifies the dictionary ispell is to use for spell checking. If set to ispell-dictionary, then the variable ispell-dictionary will be used instead.") (kom-show-namedays-doc . "\ This only works in Swedish. If you're running LysKOM in Swedish, turning this on causes today's names to be shown when you ask for the time.") ;; ;; Tags for variables ;; (kom-emacs-knows-iso-8859-1-tag . "Emacs can display ISO-8859-1:") (kom-bury-buffers-tag . "Bury buffers when changing LysKOM:") (kom-customize-in-window-tag . "LysKOM customization: ") (kom-write-texts-in-window-tag . "Author new articles: ") (kom-prioritize-in-window-tag . "Prioritize conferences: ") (kom-edit-filters-in-window-tag . "Modify filters: ") (kom-view-commented-in-window-tag . "Review comments: ") (kom-list-membership-in-window-tag . "List membership: ") (kom-user-prompt-format-tag . "Prompt format:") (kom-user-prompt-format-executing-tag . "Prompt format when executing:") (kom-higher-priority-breaks-tag . "Read prioritized articles: ") (kom-created-texts-are-read-tag . "Automatically read created texts: ") (kom-default-mark-tag . "Default mark: ") (kom-print-number-of-unread-on-entrance-tag . "Show number of unread when entering a conference: ") (kom-follow-comments-outside-membership-tag . "Follow comment chais outside membership: ") (kom-show-footnotes-immediately-tag . "Show footnotes immediately: ") (kom-membership-default-priority-tag . "Default priority for new memberships: ") (kom-dashed-lines-tag . "Dashed lines around the article body: ") (kom-autowrap-tag . "Fill wide paragraphs before displaying: ") (kom-show-author-at-end-tag . "Show the name of the author after the body: ") (kom-reading-puts-comments-in-pointers-last-tag . "Comment links are shown:") (kom-read-depth-first-tag . "Read order:") (kom-deferred-printing-tag . "Delayed display:") (kom-continuous-scrolling-tag . "Continuous scrolling:") (kom-presence-messages-tag . "Presence messages on or off: ") (kom-presence-messages-in-buffer-tag . "Presence messages in the LysKOM buffer:") (kom-page-before-command-tag . "Clear the screen:") (kom-idle-hide-tag . "Number of minutes of inactivity before session is hidden: ") (kom-show-where-and-what-tag . "Show where sessions are logged on from and what they are doing: ") (kom-login-hook-tag . "Commands executed after logging on:") (kom-do-when-done-tag . "Commands to execute after reading everything:") (kom-permissive-completion-tag . "Fussy name completion:") (kom-show-personal-messages-in-buffer-tag . "Where are messages shown: ") (kom-pop-personal-messages-tag . "Pop up message buffer: ") (kom-default-message-recipient-tag . "Default message recipient:") (kom-audio-player-tag . "Audio player program:") (kom-ding-on-new-letter-tag . "When a letter arrives: ") (kom-ding-on-priority-break-tag . "When a prioritized article arrives:") (kom-ding-on-wait-done-tag . "When done waiting: ") (kom-ding-on-common-messages-tag . "When a public message arrives: ") (kom-ding-on-group-messages-tag . "When a group message arrives: ") (kom-ding-on-personal-messages-tag . "When a personal message arrives: ") (kom-ding-on-no-subject-tag . "When you forget the subject line: ") (lyskom-filter-outgoing-messages-tag . "Show automatic messages:") (kom-friends-tag . "Friends and other special people:") (kom-url-viewer-preferences-tag . "Open URLs using the following program:") (kom-mosaic-command-tag . "Command to start NCSA Mosaic:") (kom-netscape-command-tag . "Command to start Netscape Navigator:") (kom-cite-string-tag . "Quotation indicator: ") (kom-confirm-multiple-recipients-tag . "Confirm multiple recipients: ") (kom-check-commented-author-membership-tag . "Check membership of commented author:") (kom-check-for-new-comments-tag . "Check for unread comments: ") (kom-ansaphone-record-messages-tag . "Save messages when auto reply is on: ") (kom-ansaphone-show-messages-tag . "Display messages when auto reply is on: ") (kom-ansaphone-default-reply-tag . "Auto reply message:") (kom-inhibit-typeahead-tag . "Buffer keypresses:") (kom-max-buffer-size-tag . "Maximum buffer size:") (kom-remote-control-tag . "Remote commands on or off: ") (kom-self-control-tag . "Allow me to use remote commands: ") (kom-remote-controllers-tag . "People allowed to use remove commands:") (kom-customize-format-tag . "Show documentation for all settings:") (kom-default-language-tag . "Default language: ") (kom-show-namedays-tag . "Show today's names:") (kom-ispell-dictionary-tag . "Spelling dictionary:") ) ) ;;;; ============================================================ ;;;; The default Ansaphone message goes here. The more complex ;;;; message specification probably should too, but it's not here ;;;; yet. People who know how to use it are smart enough to do it ;;;; right. (lyskom-language-var kom-ansaphone-default-reply en "I am not reading LysKOM right not. Please write a letter instead.") ;;;; ============================================================ ;;;; Other language-dependent variables ;;;; (lyskom-language-var kom-ispell-dictionary sv "english") ;;;; ============================================================ ;;;; Text buttom menuse go here. This will probably be moved back ;;;; to vars.el.in when the strings have been replaced by ;;;; symbols, but for now they'll stay here. (lyskom-language-var lyskom-button-actions en '((text text-text lyskom-button-view-text (("View article" . lyskom-button-view-text) ("Review unconverted" . lyskom-button-review-noconversion) ("Review tree" . lyskom-button-review-tree) ("Review root article" . lyskom-button-find-root) ("Write commend" . lyskom-button-comment-text) ("Write personal reply" . lyskom-button-private-comment-text) ("Mark article" . lyskom-button-mark-text) ("Unmark article" . lyskom-button-unmark-text)) nil ; ((nil lyskom-print-text footer lyskom-button-comment-text)) ) (conf conf-text lyskom-button-view-conf-presentation (("View presentation" . lyskom-button-view-conf-presentation) ("View conference status" . lyskom-button-view-conf-status) ("Go to conference" . lyskom-button-goto-conf) ("Send group message" . lyskom-button-send-message) ("Join conference" . lyskom-button-add-self) ("Leave conference" . lyskom-button-sub-self)) ((kom-list-news . lyskom-button-goto-conf))) (pers pers-text lyskom-button-view-pers-presentation (("View presentation" . lyskom-button-view-pers-presentation) ("View user status" . lyskom-button-view-pers-status) ("Send letter" . lyskom-button-mail) ("Send personal message" . lyskom-button-send-message)) nil) (url url-text lyskom-button-open-url (("Open" . lyskom-button-open-url) ("Copy" . lyskom-button-copy-url)) nil) (info-node info-node-text lyskom-button-goto-info-node (("Open" . lyskom-button-goto-info-node)) nil) (email email-text lyskom-button-open-email (("Skicka mail" . lyskom-button-open-email) ("Kopiera" . lyskom-button-copy-email)) nil))) ;;;; ================================================================ ;;;; Tell phrases should be configured with the default language used ;;;; at the server and not for person reading if they happens to ;;;; differ. This is of coarse because they are sent to the server for ;;;; everybody else to see. ;;;; Aronsson was here 4 DEC 1990, thus creating version 0.18 ; Created *-tell-* ;;; To coders of the elisp-client: ;;; You not only have to change the text here, you also have to modify ;;; kom-tell-phrases-validation-list in vars.el if you add or remove ;;; one of these. (eval-when-compile (defvar kom-tell-phrases)) (lyskom-language-strings kom-tell-phrases en '((kom-tell-silence . "") ; Why ? (kom-tell-send . "Is trying to post an article.") (kom-tell-login . "Is entering LysKOM.") (kom-tell-read . "Is reading.") (kom-tell-1st-pres . "Is writing the first presentation.") (kom-tell-write-comment . "Is writing a comment.") (kom-tell-write-footnote . "Is writing a footnote.") (kom-tell-write-letter . "Is writing a letter.") (kom-tell-write-reply . "Is writing a personal reply.") (kom-tell-write-text . "Is writing an article.") (kom-tell-conf-pres . "Is writing the presentation for a new conference.") (kom-tell-recover . "Is restarting KOM. Sigh.") (kom-tell-wait . "Is waiting.") (kom-tell-regret . "Decides to throw away the article.") (kom-tell-review . "Is reviewing.") (kom-tell-change-name . "Takes on a new name.") (kom-tell-change-supervisor . "Changes the supervisor of something.") (kom-tell-next-lyskom . "Moves to a different LysKOM."))) (if (and (boundp 'kom-tell-phrases) kom-tell-phrases) (lyskom-language-strings kom-tell-phrases sv (mapcar (function (lambda (x) (cond ((and (consp x) (symbolp (car x)) (stringp (cdr x))) x) ((and (consp x) (symbolp (car x)) (consp (cdr x)) (stringp (car (cdr x)))) (cons (car x) (car (cdr x)))) (t nil)))) kom-tell-phrases))) ;; Placed here because this must NOT be evaluated before ;; kom-tell-phrases is defined: (lyskom-language-var kom-mercial en (lyskom-get-string 'kom-tell-wait 'kom-tell-phrases)) (lyskom-language-strings lyskom-error-texts en '((error-0 . "No error") (error-2 . "Not yet implemented") (error-3 . "No longer implemented") (error-4 . "Wrong password") (error-5 . "String too long") (error-6 . "You have not logged on") (error-7 . "Nobody may enter LysKOM at this time") (error-8 . "You attempted to use conference number 0") (error-9 . "Undefined or secret conference") (error-10 . "Undefined or secret user") (error-11 . "No read or write permission") (error-12 . "Illegal operation") (error-13 . "You are not a member of that conference") (error-14 . "There is no article with that number") (error-15 . "You cannot use global article number 0") (error-16 . "There is no article with that local number") (error-17 . "You cannot use local article number 0") (error-18 . "Name too short, to long or containing illegal characters") (error-19 . "Index out of bounds") (error-20 . "The conference already exists") (error-21 . "The user already exists") (error-22 . "Secret but not read-protected") (error-23 . "You are not allowed to change the erson/conference flag") (error-24 . "Error in the dtabase. Tough luck.") (error-25 . "Illegal misc-field. (Internal error)") (error-26 . "Illegal info type. (Bug in the client)") (error-27 . "Already recipient of this article") (error-28 . "Already comment to this article") (error-29 . "Already footnote to this article") (error-30 . "Not a recipient of this article") (error-31 . "Not a comment to this article") (error-32 . "Not a footnote to this article") (error-33 . "Too many recipients") (error-34 . "Too many commentsp") (error-35 . "Too many footnotes") (error-36 . "Too many marks") (error-37 . "You are not the author of that article") (error-38 . "You cannot connect to the server") (error-39 . "Out of memory") (error-40 . "The server is gone crazy") (error-41 . "The client thinks that the server says that it does not understand the client") (error-42 . "No such session") (error-43 . "Invalid regular expression") (error-44 . "Can't unmark an article that was not marked") (error-45 . "Temorary lossage. Please try again later") (error-46 . "Sending huge messages to the server is not a nice thing to do") (error-47 . "Anonymous texts are not accepted by all recipients"))) (provide 'lyskom-strings) ;;; english-strings ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: komtypes.el,v 44.2.2.2 1999/10/13 12:13:11 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; This file contains primitives for the different data types ;;;; in the lyskom system. All types here have their origin in ;;;; the server. Compare the file clienttypes.el. ;;;; ;;;; Author: ceder ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: komtypes.el,v 44.2.2.2 1999/10/13 12:13:11 byers Exp $\n")) ;;; ================================================================ ;;; conf-no-list ;;; Constructor: (defsubst lyskom-create-conf-no-list (conf-nos) "Create a conf-no-list from all parameters." (cons 'CONF-NO-LIST (vector conf-nos))) ;;; Selector: (defsubst conf-no-list->conf-nos (conf-no-list) "Get conf-nos from conf-no-list." (elt (cdr conf-no-list) 0)) ;;; Modifier: (defsubst set-conf-no-list->conf-nos (conf-no-list newval) "Set conf-nos in conf-no-list to NEWVAL." (aset (cdr conf-no-list) 0 newval)) ;;; Predicate: (defsubst lyskom-conf-no-list-p (object) "Return t if OBJECT is a conf-no-list." (eq (car-safe object) 'CONF-NO-LIST)) ;;; Special functions (defsubst lyskom-conf-no-list-member (conf-no conf-no-list) "Returns non-nil if CONF-NO is a member of CONF-NO-LIST. CONF-NO is a conf-no and CONF-NO-LIST is a conf-no-list." (if (= (length (conf-no-list->conf-nos conf-no-list)) 0) nil (let* ((r 0) (list (conf-no-list->conf-nos conf-no-list)) (len (length list)) (yes nil)) (while (and (not yes) (< r len)) (if (= conf-no (elt list r)) (setq yes t) (setq r (1+ r)))) yes))) ;;; ================================================================ ;;; uconf-stat ;;; Constructor: (defsubst lyskom-create-uconf-stat (conf-no name conf-type highest-local-no nice) "Create an uconf-stat from all parameters." (cons 'UCONF-STAT (vector conf-no name conf-type highest-local-no nice))) ;;; Selectors: (defsubst uconf-stat->conf-no (conf) "Get the conf-no from an uconf-stat" (elt (cdr conf) 0)) (defsubst uconf-stat->name (conf) "Get the name of a conference." (elt (cdr conf) 1)) (defsubst uconf-stat->conf-type (conf) "Get the type of a conference." (elt (cdr conf) 2)) (defsubst uconf-stat->highest-local-no (conf) "Get the highest local number in a conference" (elt (cdr conf) 3)) (defsubst uconf-stat->garb-nice (conf) "Get garb-nice from a conference." (elt (cdr conf) 4)) ;;; Modifiers ;;; You shouldn't need modifiers ;;; Predicate (defsubst lyskom-uconf-stat-p (object) "Return t if OBJECT is a conf-stat." (eq (car-safe object) 'UCONF-STAT)) ;;; ================================================================ ;;; conf-stat ;;; Constructor: (defsubst lyskom-create-conf-stat (conf-no name conf-type creation-time last-written creator presentation supervisor permitted-submitters super-conf msg-of-day garb-nice no-of-members first-local-no no-of-texts) "Create a conf-stat from all parameters." (cons 'CONF-STAT (vector conf-no name conf-type creation-time last-written creator presentation supervisor permitted-submitters super-conf msg-of-day garb-nice no-of-members first-local-no no-of-texts ))) ;;; Selectors: (defsubst conf-stat->conf-no (conf-stat) "Get conf-no from conf-stat." (elt (cdr conf-stat) 0)) (defsubst conf-stat->name (conf-stat) "Get name from conf-stat." (elt (cdr conf-stat) 1)) (defsubst conf-stat->conf-type (conf-stat) "Get conf-type from conf-stat." (elt (cdr conf-stat) 2)) (defsubst conf-stat->creation-time (conf-stat) "Get creation-time from conf-stat." (elt (cdr conf-stat) 3)) (defsubst conf-stat->last-written (conf-stat) "Get last-written from conf-stat." (elt (cdr conf-stat) 4)) (defsubst conf-stat->creator (conf-stat) "Get creator from conf-stat." (elt (cdr conf-stat) 5)) (defsubst conf-stat->presentation (conf-stat) "Get presentation from conf-stat." (elt (cdr conf-stat) 6)) (defsubst conf-stat->supervisor (conf-stat) "Get supervisor from conf-stat." (elt (cdr conf-stat) 7)) (defsubst conf-stat->permitted-submitters (conf-stat) "Get permitted-submitters from conf-stat." (elt (cdr conf-stat) 8)) (defsubst conf-stat->super-conf (conf-stat) "Get super-conf from conf-stat." (elt (cdr conf-stat) 9)) (defsubst conf-stat->msg-of-day (conf-stat) "Get msg-of-day from conf-stat." (elt (cdr conf-stat) 10)) (defsubst conf-stat->garb-nice (conf-stat) "Get garb-nice from conf-stat." (elt (cdr conf-stat) 11)) (defsubst conf-stat->no-of-members (conf-stat) "Get no-of-members from conf-stat." (elt (cdr conf-stat) 12)) (defsubst conf-stat->first-local-no (conf-stat) "Get first-local-no from conf-stat." (elt (cdr conf-stat) 13)) (defsubst conf-stat->no-of-texts (conf-stat) "Get no-of-texts from conf-stat." (elt (cdr conf-stat) 14)) ;;; Modifiers: (defsubst set-conf-stat->conf-no (conf-stat newval) "Set conf-no in conf-stat to NEWVAL." (aset (cdr conf-stat) 0 newval)) (defsubst set-conf-stat->name (conf-stat newval) "Set name in conf-stat to NEWVAL." (aset (cdr conf-stat) 1 newval)) (defsubst set-conf-stat->conf-type (conf-stat newval) "Set conf-type in conf-stat to NEWVAL." (aset (cdr conf-stat) 2 newval)) (defsubst set-conf-stat->creation-time (conf-stat newval) "Set creation-time in conf-stat to NEWVAL." (aset (cdr conf-stat) 3 newval)) (defsubst set-conf-stat->last-written (conf-stat newval) "Set last-written in conf-stat to NEWVAL." (aset (cdr conf-stat) 4 newval)) (defsubst set-conf-stat->creator (conf-stat newval) "Set creator in conf-stat to NEWVAL." (aset (cdr conf-stat) 5 newval)) (defsubst set-conf-stat->presentation (conf-stat newval) "Set presentation in conf-stat to NEWVAL." (aset (cdr conf-stat) 6 newval)) (defsubst set-conf-stat->supervisor (conf-stat newval) "Set supervisor in conf-stat to NEWVAL." (aset (cdr conf-stat) 7 newval)) (defsubst set-conf-stat->permitted-submitters (conf-stat newval) "Set permitted-submitters in conf-stat to NEWVAL." (aset (cdr conf-stat) 8 newval)) (defsubst set-conf-stat->super-conf (conf-stat newval) "Set super-conf in conf-stat to NEWVAL." (aset (cdr conf-stat) 9 newval)) (defsubst set-conf-stat->msg-of-day (conf-stat newval) "Set msg-of-day in conf-stat to NEWVAL." (aset (cdr conf-stat) 10 newval)) (defsubst set-conf-stat->garb-nice (conf-stat newval) "Set garb-nice in conf-stat to NEWVAL." (aset (cdr conf-stat) 11 newval)) (defsubst set-conf-stat->no-of-members (conf-stat newval) "Set no-of-members in conf-stat to NEWVAL." (aset (cdr conf-stat) 12 newval)) (defsubst set-conf-stat->first-local-no (conf-stat newval) "Set first-local-no in conf-stat to NEWVAL." (aset (cdr conf-stat) 13 newval)) (defsubst set-conf-stat->no-of-texts (conf-stat newval) "Set no-of-texts in conf-stat to NEWVAL." (aset (cdr conf-stat) 14 newval)) ;;; Predicate: (defsubst lyskom-conf-stat-p (object) "Return t if OBJECT is a conf-stat." (eq (car-safe object) 'CONF-STAT)) ;;; ================================================================ ;;; Conf-list ;;; Constructor: (defsubst lyskom-create-conf-list (conf-nos conf-types) "Create a conf-list from CONF-NOS and CONF-TYPES. CONF-NOS is a vector of numbers. CONF-TYPES is a vector of conf-type. Both vectors should be of the same length." (cons 'CONF-LIST (cons conf-nos conf-types))) ;;; Selectors: (defsubst conf-list->conf-nos (conf-list) "Get the conf-nos part of CONF-LIST" (car (cdr conf-list))) (defsubst conf-list->conf-types (conf-list) "Get the conf-types part of CONF-LIST" (cdr (cdr conf-list))) ;;; Predicate: (defsubst conf-list-p (object) "Return true if OBJECT is a conf-list" (eq 'CONF-LIST (car-safe object))) ;;; Special functions: (defsubst lyskom-conf-list-length (conf-list) "Return the length of CONF-LIST" (length (conf-list->conf-nos conf-list))) ;;; ================================================================ ;;; pers-stat ;;; Constructor: (defsubst lyskom-create-pers-stat (pers-no username privileges flags last-login user-area total-time-present sessions created-lines created-bytes read-texts no-of-text-fetches created-persons created-confs first-created-text no-of-created-texts no-of-marks no-of-confs) "Create a pers-stat from all parameters." (cons 'PERS-STAT (vector pers-no username privileges flags last-login user-area total-time-present sessions created-lines created-bytes read-texts no-of-text-fetches created-persons created-confs first-created-text no-of-created-texts no-of-marks no-of-confs ))) ;;; Selectors: (defsubst pers-stat->pers-no (pers-stat) "Get pers-no from pers-stat." (elt (cdr pers-stat) 0)) (defsubst pers-stat->username (pers-stat) "Get username from pers-stat." (elt (cdr pers-stat) 1)) (defsubst pers-stat->privileges (pers-stat) "Get privileges from pers-stat." (elt (cdr pers-stat) 2)) (defsubst pers-stat->flags (pers-stat) "Get flags from pers-stat." (elt (cdr pers-stat) 3)) (defsubst pers-stat->last-login (pers-stat) "Get last-login from pers-stat." (elt (cdr pers-stat) 4)) (defsubst pers-stat->user-area (pers-stat) "Get user-area from pers-stat." (elt (cdr pers-stat) 5)) (defsubst pers-stat->total-time-present (pers-stat) "Get total-time-present from pers-stat." (elt (cdr pers-stat) 6)) (defsubst pers-stat->sessions (pers-stat) "Get sessions from pers-stat." (elt (cdr pers-stat) 7)) (defsubst pers-stat->created-lines (pers-stat) "Get created-lines from pers-stat." (elt (cdr pers-stat) 8)) (defsubst pers-stat->created-bytes (pers-stat) "Get created-bytes from pers-stat." (elt (cdr pers-stat) 9)) (defsubst pers-stat->read-texts (pers-stat) "Get read-texts from pers-stat." (elt (cdr pers-stat) 10)) (defsubst pers-stat->no-of-text-fetches (pers-stat) "Get no-of-text-fetches from pers-stat." (elt (cdr pers-stat) 11)) (defsubst pers-stat->created-persons (pers-stat) "Get created-persons from pers-stat." (elt (cdr pers-stat) 12)) (defsubst pers-stat->created-confs (pers-stat) "Get created-confs from pers-stat." (elt (cdr pers-stat) 13)) (defsubst pers-stat->first-created-text (pers-stat) "Get first-created-text from pers-stat." (elt (cdr pers-stat) 14)) (defsubst pers-stat->no-of-created-texts (pers-stat) "Get no-of-created-texts from pers-stat." (elt (cdr pers-stat) 15)) (defsubst pers-stat->no-of-marks (pers-stat) "Get no-of-marks from pers-stat." (elt (cdr pers-stat) 16)) (defsubst pers-stat->no-of-confs (pers-stat) "Get no-of-confs from pers-stat." (elt (cdr pers-stat) 17)) ;;; Modifiers: (defsubst set-pers-stat->pers-no (pers-stat newval) "Set pers-no in pers-stat to NEWVAL." (aset (cdr pers-stat) 0 newval)) (defsubst set-pers-stat->username (pers-stat newval) "Set username in pers-stat to NEWVAL." (aset (cdr pers-stat) 1 newval)) (defsubst set-pers-stat->privileges (pers-stat newval) "Set privileges in pers-stat to NEWVAL." (aset (cdr pers-stat) 2 newval)) (defsubst set-pers-stat->flags (pers-stat newval) "Set flags in pers-stat to NEWVAL." (aset (cdr pers-stat) 3 newval)) (defsubst set-pers-stat->last-login (pers-stat newval) "Set last-login in pers-stat to NEWVAL." (aset (cdr pers-stat) 4 newval)) (defsubst set-pers-stat->user-area (pers-stat newval) "Set user-area in pers-stat to NEWVAL." (aset (cdr pers-stat) 5 newval)) (defsubst set-pers-stat->total-time-present (pers-stat newval) "Set total-time-present in pers-stat to NEWVAL." (aset (cdr pers-stat) 6 newval)) (defsubst set-pers-stat->sessions (pers-stat newval) "Set sessions in pers-stat to NEWVAL." (aset (cdr pers-stat) 7 newval)) (defsubst set-pers-stat->created-lines (pers-stat newval) "Set created-lines in pers-stat to NEWVAL." (aset (cdr pers-stat) 8 newval)) (defsubst set-pers-stat->created-bytes (pers-stat newval) "Set created-bytes in pers-stat to NEWVAL." (aset (cdr pers-stat) 9 newval)) (defsubst set-pers-stat->read-texts (pers-stat newval) "Set read-texts in pers-stat to NEWVAL." (aset (cdr pers-stat) 10 newval)) (defsubst set-pers-stat->no-of-text-fetches (pers-stat newval) "Set no-of-text-fetches in pers-stat to NEWVAL." (aset (cdr pers-stat) 11 newval)) (defsubst set-pers-stat->created-persons (pers-stat newval) "Set created-persons in pers-stat to NEWVAL." (aset (cdr pers-stat) 12 newval)) (defsubst set-pers-stat->created-confs (pers-stat newval) "Set created-confs in pers-stat to NEWVAL." (aset (cdr pers-stat) 13 newval)) (defsubst set-pers-stat->first-created-text (pers-stat newval) "Set first-created-text in pers-stat to NEWVAL." (aset (cdr pers-stat) 14 newval)) (defsubst set-pers-stat->no-of-created-texts (pers-stat newval) "Set no-of-created-texts in pers-stat to NEWVAL." (aset (cdr pers-stat) 15 newval)) (defsubst set-pers-stat->no-of-marks (pers-stat newval) "Set no-of-marks in pers-stat to NEWVAL." (aset (cdr pers-stat) 16 newval)) (defsubst set-pers-stat->no-of-confs (pers-stat newval) "Set no-of-confs in pers-stat to NEWVAL." (aset (cdr pers-stat) 17 newval)) ;;; Predicate: (defsubst lyskom-pers-stat-p (object) "Return t if OBJECT is a pers-stat." (eq (car-safe object) 'PERS-STAT)) ;;; ================================================================ ;;; text-stat ;;; Constructor: (defsubst lyskom-create-text-stat (text-no creation-time author no-of-lines no-of-chars no-of-marks misc-info-list) "Create a text-stat from all parameters." (cons 'TEXT-STAT (vector text-no creation-time author no-of-lines no-of-chars no-of-marks misc-info-list ))) ;;; Selectors: (defsubst text-stat->text-no (text-stat) "Get text-no from text-stat." (elt (cdr text-stat) 0)) (defsubst text-stat->creation-time (text-stat) "Get creation-time from text-stat." (elt (cdr text-stat) 1)) (defsubst text-stat->author (text-stat) "Get author from text-stat." (elt (cdr text-stat) 2)) (defsubst text-stat->no-of-lines (text-stat) "Get no-of-lines from text-stat." (elt (cdr text-stat) 3)) (defsubst text-stat->no-of-chars (text-stat) "Get no-of-chars from text-stat." (elt (cdr text-stat) 4)) (defsubst text-stat->no-of-marks (text-stat) "Get no-of-marks from text-stat." (elt (cdr text-stat) 5)) (defsubst text-stat->misc-info-list (text-stat) "Get misc-info-list from text-stat." (elt (cdr text-stat) 6)) ;;; Modifiers: (defsubst set-text-stat->text-no (text-stat newval) "Set text-no in text-stat to NEWVAL." (aset (cdr text-stat) 0 newval)) (defsubst set-text-stat->creation-time (text-stat newval) "Set creation-time in text-stat to NEWVAL." (aset (cdr text-stat) 1 newval)) (defsubst set-text-stat->author (text-stat newval) "Set author in text-stat to NEWVAL." (aset (cdr text-stat) 2 newval)) (defsubst set-text-stat->no-of-lines (text-stat newval) "Set no-of-lines in text-stat to NEWVAL." (aset (cdr text-stat) 3 newval)) (defsubst set-text-stat->no-of-chars (text-stat newval) "Set no-of-chars in text-stat to NEWVAL." (aset (cdr text-stat) 4 newval)) (defsubst set-text-stat->no-of-marks (text-stat newval) "Set no-of-marks in text-stat to NEWVAL." (aset (cdr text-stat) 5 newval)) (defsubst set-text-stat->misc-info-list (text-stat newval) "Set misc-info-list in text-stat to NEWVAL." (aset (cdr text-stat) 6 newval)) ;;; Predicate: (defsubst lyskom-text-stat-p (object) "Return t if OBJECT is a text-stat." (eq (car-safe object) 'TEXT-STAT)) ;;; ================================================================ ;;; text ;;; Constructor: (defsubst lyskom-create-text (text-no text-mass) "Create a text from all parameters." (cons 'TEXT (vector text-no text-mass ))) ;;; Selectors: (defsubst text->text-no (text) "Get text-no from text." (elt (cdr text) 0)) (defsubst text->text-mass (text) "Get text-mass from text." (elt (cdr text) 1)) ;;; Modifiers: (defsubst set-text->text-no (text newval) "Set text-no in text to NEWVAL." (aset (cdr text) 0 newval)) (defsubst set-text->text-mass (text newval) "Set text-mass in text to NEWVAL." (aset (cdr text) 1 newval)) ;;; Predicate: (defsubst lyskom-text-p (object) "Return t if OBJECT is a text." (eq (car-safe object) 'TEXT)) ;;; ================================================================ ;;; misc-info ;;; Constructors: (defsubst lyskom-create-misc-info (type recipient-no local-no rec-time comm-to comm-in footn-to footn-in sender sent-at) "Create a misc-info from all parameters. TYPE is one of RECPT, CC-RECPT, BCC-RECPT, COMM-TO, COMM-IN, FOOTN-TO or FOOTN-IN." (cons 'MISC-INFO (vector type recipient-no local-no rec-time comm-to comm-in footn-to footn-in sender sent-at ))) (defsubst lyskom-create-empty-misc-info () "Create an empty misc-info." (lyskom-create-misc-info nil nil nil nil nil nil nil nil nil nil)) ;;; Selectors: (defsubst misc-info->type (misc-info) "Get type from misc-info." (elt (cdr misc-info) 0)) (defsubst misc-info->recipient-no (misc-info) "Get recipient-no from misc-info." (elt (cdr misc-info) 1)) (defsubst misc-info->local-no (misc-info) "Get local-no from misc-info." (elt (cdr misc-info) 2)) (defsubst misc-info->rec-time (misc-info) "Get rec-time from misc-info." (elt (cdr misc-info) 3)) (defsubst misc-info->comm-to (misc-info) "Get comm-to from misc-info." (elt (cdr misc-info) 4)) (defsubst misc-info->comm-in (misc-info) "Get comm-in from misc-info." (elt (cdr misc-info) 5)) (defsubst misc-info->footn-to (misc-info) "Get footn-to from misc-info." (elt (cdr misc-info) 6)) (defsubst misc-info->footn-in (misc-info) "Get footn-in from misc-info." (elt (cdr misc-info) 7)) (defsubst misc-info->sender (misc-info) "Get sender from misc-info." (elt (cdr misc-info) 8)) (defsubst misc-info->sent-at (misc-info) "Get sent-at from misc-info." (elt (cdr misc-info) 9)) ;;; Modifiers: (defsubst set-misc-info->type (misc-info newval) "Set type in misc-info to NEWVAL." (aset (cdr misc-info) 0 newval)) (defsubst set-misc-info->recipient-no (misc-info newval) "Set recipient-no in misc-info to NEWVAL." (aset (cdr misc-info) 1 newval)) (defsubst set-misc-info->local-no (misc-info newval) "Set local-no in misc-info to NEWVAL." (aset (cdr misc-info) 2 newval)) (defsubst set-misc-info->rec-time (misc-info newval) "Set rec-time in misc-info to NEWVAL." (aset (cdr misc-info) 3 newval)) (defsubst set-misc-info->comm-to (misc-info newval) "Set comm-to in misc-info to NEWVAL." (aset (cdr misc-info) 4 newval)) (defsubst set-misc-info->comm-in (misc-info newval) "Set comm-in in misc-info to NEWVAL." (aset (cdr misc-info) 5 newval)) (defsubst set-misc-info->footn-to (misc-info newval) "Set footn-to in misc-info to NEWVAL." (aset (cdr misc-info) 6 newval)) (defsubst set-misc-info->footn-in (misc-info newval) "Set footn-in in misc-info to NEWVAL." (aset (cdr misc-info) 7 newval)) (defsubst set-misc-info->sender (misc-info newval) "Set sender in misc-info to NEWVAL." (aset (cdr misc-info) 8 newval)) (defsubst set-misc-info->sent-at (misc-info newval) "Set sent-at in misc-info to NEWVAL." (aset (cdr misc-info) 9 newval)) ;;; Predicate: (defsubst lyskom-misc-info-p (object) "Return t if OBJECT is a misc-info." (eq (car-safe object) 'MISC-INFO)) ;;; ================================================================ ;;; time ;;; Constructor: (defsubst lyskom-create-time (sec min hour mday mon year wday yday isdst) "Create a time from all parameters." (cons 'TIME (vector sec min hour mday mon year wday yday isdst ))) ;;; Selectors: (defsubst time->sec (time) "Get sec from time." (elt (cdr time) 0)) (defsubst time->min (time) "Get min from time." (elt (cdr time) 1)) (defsubst time->hour (time) "Get hour from time." (elt (cdr time) 2)) (defsubst time->mday (time) "Get mday from time." (elt (cdr time) 3)) (defsubst time->mon (time) "Get mon from time." (elt (cdr time) 4)) (defsubst time->year (time) "Get year from time." (elt (cdr time) 5)) (defsubst time->wday (time) "Get wday from time." (elt (cdr time) 6)) (defsubst time->yday (time) "Get yday from time." (elt (cdr time) 7)) (defsubst time->isdst (time) "Get isdst from time." (elt (cdr time) 8)) ;;; Predicate: (defsubst lyskom-time-p (object) "Return t if OBJECT is a time." (eq (car-safe object) 'TIME)) ;;; ================================================================ ;;; privs ;;; Constructor: (defsubst lyskom-create-privs (wheel admin statistic create_pers create_conf change_name flg7 flg8 flg9 flg10 flg11 flg12 flg13 flg14 flg15 flg16) "Create a privs from all parameters." (cons 'PRIVS (vector wheel admin statistic create_pers create_conf change_name flg7 flg8 flg9 flg10 flg11 flg12 flg13 flg14 flg15 flg16 ))) ;;; Selectors: (defsubst privs->wheel (privs) "Get wheel from privs." (elt (cdr privs) 0)) (defsubst privs->admin (privs) "Get admin from privs." (elt (cdr privs) 1)) (defsubst privs->statistic (privs) "Get statistic from privs." (elt (cdr privs) 2)) (defsubst privs->create_pers (privs) "Get create_pers from privs." (elt (cdr privs) 3)) (defsubst privs->create_conf (privs) "Get create_conf from privs." (elt (cdr privs) 4)) (defsubst privs->change_name (privs) "Get change_name from privs." (elt (cdr privs) 5)) (defsubst privs->flg7 (privs) "Get flg7 from privs." (elt (cdr privs) 6)) (defsubst privs->flg8 (privs) "Get flg8 from privs." (elt (cdr privs) 7)) (defsubst privs->flg9 (privs) "Get flg9 from privs." (elt (cdr privs) 8)) (defsubst privs->flg10 (privs) "Get flg10 from privs." (elt (cdr privs) 9)) (defsubst privs->flg11 (privs) "Get flg11 from privs." (elt (cdr privs) 10)) (defsubst privs->flg12 (privs) "Get flg12 from privs." (elt (cdr privs) 11)) (defsubst privs->flg13 (privs) "Get flg13 from privs." (elt (cdr privs) 12)) (defsubst privs->flg14 (privs) "Get flg14 from privs." (elt (cdr privs) 13)) (defsubst privs->flg15 (privs) "Get flg15 from privs." (elt (cdr privs) 14)) (defsubst privs->flg16 (privs) "Get flg16 from privs." (elt (cdr privs) 15)) ;;; Modifiers: (defsubst set-privs->wheel (privs newval) "Set wheel in privs to NEWVAL." (aset (cdr privs) 0 newval)) (defsubst set-privs->admin (privs newval) "Set admin in privs to NEWVAL." (aset (cdr privs) 1 newval)) (defsubst set-privs->statistic (privs newval) "Set statistic in privs to NEWVAL." (aset (cdr privs) 2 newval)) (defsubst set-privs->create_pers (privs newval) "Set create_pers in privs to NEWVAL." (aset (cdr privs) 3 newval)) (defsubst set-privs->create_conf (privs newval) "Set create_conf in privs to NEWVAL." (aset (cdr privs) 4 newval)) (defsubst set-privs->change_name (privs newval) "Set change_name in privs to NEWVAL." (aset (cdr privs) 5 newval)) (defsubst set-privs->flg7 (privs newval) "Set flg7 in privs to NEWVAL." (aset (cdr privs) 6 newval)) (defsubst set-privs->flg8 (privs newval) "Set flg8 in privs to NEWVAL." (aset (cdr privs) 7 newval)) (defsubst set-privs->flg9 (privs newval) "Set flg9 in privs to NEWVAL." (aset (cdr privs) 8 newval)) (defsubst set-privs->flg10 (privs newval) "Set flg10 in privs to NEWVAL." (aset (cdr privs) 9 newval)) (defsubst set-privs->flg11 (privs newval) "Set flg11 in privs to NEWVAL." (aset (cdr privs) 10 newval)) (defsubst set-privs->flg12 (privs newval) "Set flg12 in privs to NEWVAL." (aset (cdr privs) 11 newval)) (defsubst set-privs->flg13 (privs newval) "Set flg13 in privs to NEWVAL." (aset (cdr privs) 12 newval)) (defsubst set-privs->flg14 (privs newval) "Set flg14 in privs to NEWVAL." (aset (cdr privs) 13 newval)) (defsubst set-privs->flg15 (privs newval) "Set flg15 in privs to NEWVAL." (aset (cdr privs) 14 newval)) (defsubst set-privs->flg16 (privs newval) "Set flg16 in privs to NEWVAL." (aset (cdr privs) 15 newval)) ;;; Predicate: (defsubst lyskom-privs-p (object) "Return t if OBJECT is a privs." (eq (car-safe object) 'PRIVS)) ;;; ================================================================ ;;; flags ;;; This is an experiment. Hopefully most of the code can be ;;; automatically generated. (defmacro def-komtype (type &rest args) (let ((typename (symbol-name type)) (n 0) (tmp nil)) ;; Constructor (append (list 'progn (list 'defsubst (intern (concat "lyskom-create-" typename)) args (concat "Create a `" typename "' from arguments.\n" "Args: " (upcase (mapconcat 'symbol-name args " ")) "\n" "Automatically created with def-komtype.") (list 'cons (list 'quote (intern (upcase typename))) (cons 'vector args))) ;; Identifier (list 'defsubst (intern (concat typename "-p")) (list type) (concat "Return `t' if " (upcase typename) " is a " typename ".\n" "Args: " (upcase typename) "\n" "Automatically created with def-komtype.") (list 'and (list 'consp type) (list 'eq (list 'car type) (list 'quote (intern (upcase typename))))))) ;; Selectors/Modifiers (progn (while args (let ((argname (symbol-name (car args)))) ;; Selctor (setq tmp (cons (list 'defsubst (intern (concat typename "->" argname)) (list type) "Automatically created with def-komtype." (list 'aref (list 'cdr type) n)) tmp)) ;; Modifier (setq tmp (cons (list 'defsubst (intern (concat "set-" typename "->" argname)) (list type (car args)) "Automatically created with def-komtype." (list 'aset (list 'cdr type) n (car args))) tmp)) (setq n (1+ n) args (cdr args)))) tmp)))) (def-komtype session-flags invisible user_active_used user_absent reserved3 reserved4 reserved5 reserved6 reserved7) (def-komtype dynamic-session-info session person working-conference idle-time flags what-am-i-doing) (def-komtype static-session-info username hostname ident-user connection-time) ;;; ================================================================ ;;; flags ;;; Constructor: (defsubst lyskom-create-flags (unread_is_secret flg2 flg3 flg4 flg5 flg6 flg7 flg8) "Create a flags from all parameters." (cons 'FLAGS (vector unread_is_secret flg2 flg3 flg4 flg5 flg6 flg7 flg8))) ;;; Selectors: (defsubst flags->unread_is_secret (flags) "Get unread_is_secret from flags." (elt (cdr flags) 0)) (defsubst flags->flg2 (flags) "Get flg2 from flags." (elt (cdr flags) 1)) (defsubst flags->flg3 (flags) "Get flg3 from flags." (elt (cdr flags) 2)) (defsubst flags->flg4 (flags) "Get flg4 from flags." (elt (cdr flags) 3)) (defsubst flags->flg5 (flags) "Get flg5 from flags." (elt (cdr flags) 4)) (defsubst flags->flg6 (flags) "Get flg6 from flags." (elt (cdr flags) 5)) (defsubst flags->flg7 (flags) "Get flg7 from flags." (elt (cdr flags) 6)) (defsubst flags->flg8 (flags) "Get flg8 from flags." (elt (cdr flags) 7)) ;;; Modifiers: (defsubst set-flags->unread_is_secret (flags newval) "Set unread_is_secret in flags to NEWVAL." (aset (cdr flags) 0 newval)) (defsubst set-flags->flg2 (flags newval) "Set flg2 in flags to NEWVAL." (aset (cdr flags) 1 newval)) (defsubst set-flags->flg3 (flags newval) "Set flg3 in flags to NEWVAL." (aset (cdr flags) 2 newval)) (defsubst set-flags->flg4 (flags newval) "Set flg4 in flags to NEWVAL." (aset (cdr flags) 3 newval)) (defsubst set-flags->flg5 (flags newval) "Set flg5 in flags to NEWVAL." (aset (cdr flags) 4 newval)) (defsubst set-flags->flg6 (flags newval) "Set flg6 in flags to NEWVAL." (aset (cdr flags) 5 newval)) (defsubst set-flags->flg7 (flags newval) "Set flg7 in flags to NEWVAL." (aset (cdr flags) 6 newval)) (defsubst set-flags->flg8 (flags newval) "Set flg8 in flags to NEWVAL." (aset (cdr flags) 7 newval)) ;;; Predicate: (defsubst lyskom-flags-p (object) "Return t if OBJECT is a flags." (eq (car-safe object) 'FLAGS)) ;;; ================================================================ ;;; membership ;;; Constructor: (defsubst lyskom-create-membership (last-time-read conf-no priority last-text-read read-texts) "Create a membership from all parameters." (cons 'MEMBERSHIP (vector last-time-read conf-no priority last-text-read read-texts ))) ;;; Selectors: (defsubst membership->last-time-read (membership) "Get last-time-read from membership." (elt (cdr membership) 0)) (defsubst membership->conf-no (membership) "Get conf-no from membership." (elt (cdr membership) 1)) (defsubst membership->priority (membership) "Get priority from membership." (elt (cdr membership) 2)) (defsubst membership->last-text-read (membership) "Get last-text-read from membership." (elt (cdr membership) 3)) (defsubst membership->read-texts (membership) "Get read-texts from membership." (elt (cdr membership) 4)) ;;; Modifiers: (defsubst set-membership->last-time-read (membership newval) "Set last-time-read in membership to NEWVAL." (aset (cdr membership) 0 newval)) (defsubst set-membership->conf-no (membership newval) "Set conf-no in membership to NEWVAL." (aset (cdr membership) 1 newval)) (defsubst set-membership->priority (membership newval) "Set priority in membership to NEWVAL." (aset (cdr membership) 2 newval)) (defsubst set-membership->last-text-read (membership newval) "Set last-text-read in membership to NEWVAL." (aset (cdr membership) 3 newval)) (defsubst set-membership->read-texts (membership newval) "Set read-texts in membership to NEWVAL." (aset (cdr membership) 4 newval)) ;;; Predicate: (defsubst lyskom-membership-p (object) "Return t if OBJECT is a membership." (eq (car-safe object) 'MEMBERSHIP)) ;;; ================================================================ ;;; map ;;; Constructor: (defsubst lyskom-create-map (first-local text-nos) "Create a map from all parameters." (cons 'MAP (vector first-local text-nos ))) ;;; Selectors: (defsubst map->first-local (map) "Get first-local from map." (elt (cdr map) 0)) (defsubst map->text-nos (map) "Get text-nos from map." (elt (cdr map) 1)) ;;; Modifiers: (defsubst set-map->first-local (map newval) "Set first-local in map to NEWVAL." (aset (cdr map) 0 newval)) (defsubst set-map->text-nos (map newval) "Set text-nos in map to NEWVAL." (aset (cdr map) 1 newval)) ;;; Predicate: (defsubst lyskom-map-p (object) "Return t if OBJECT is a map." (eq (car-safe object) 'MAP)) ;;; Concat: (defsubst lyskom-map-concat (&rest maps) "Take any number of MAPS and return a new map which is the sum of the maps. Args: &rest MAPS. The MAPS must be consecutive. No gaps or overlaps are currently allowed." (if (null maps) (lyskom-create-map 1 []) (let* ((first (map->first-local (car maps))) (high (+ first (length (map->text-nos (car maps))))) (maplist (list (map->text-nos (car maps)))) (maps (cdr maps))) (while maps (if (/= (map->first-local (car maps)) high) (signal 'lyskom-internal-error '("lyskom-map-concat"))) (setq maplist (nconc maplist (list (map->text-nos (car maps))))) (setq high (+ high (length (map->text-nos (car maps))))) (setq maps (cdr maps))) (lyskom-create-map first (apply 'vconcat maplist))))) ;;; ================================================================ ;;; mark ;;; Constructor: (defsubst lyskom-create-mark (text-no mark-type) "Create a mark from all parameters." (cons 'MARK (vector text-no mark-type ))) ;;; Selectors: (defsubst mark->text-no (mark) "Get text-no from mark." (elt (cdr mark) 0)) (defsubst mark->mark-type (mark) "Get mark-type from mark." (elt (cdr mark) 1)) ;;; Modifiers: (defsubst set-mark->text-no (mark newval) "Set text-no in mark to NEWVAL." (aset (cdr mark) 0 newval)) (defsubst set-mark->mark-type (mark newval) "Set mark-type in mark to NEWVAL." (aset (cdr mark) 1 newval)) ;;; Predicate: (defsubst lyskom-mark-p (object) "Return t if OBJECT is a mark." (eq (car-safe object) 'MARK)) ;;; ================================================================ ;;; who-info ;;; Constructor: (defsubst lyskom-create-who-info (pers-no working-conf connection doing-what username) "Create a who-info from all parameters." (cons 'WHO-INFO (vector pers-no working-conf connection doing-what username ))) ;;; Selectors: (defsubst who-info->pers-no (who-info) "Get pers-no from who-info." (elt (cdr who-info) 0)) (defsubst who-info->working-conf (who-info) "Get working-conf from who-info." (elt (cdr who-info) 1)) (defsubst who-info->connection (who-info) "Get connection from who-info." (elt (cdr who-info) 2)) (defsubst who-info->doing-what (who-info) "Get doing-what from who-info." (elt (cdr who-info) 3)) (defsubst who-info->username (who-info) "Get username from who-info." (elt (cdr who-info) 4)) ;;; Modifiers: (defsubst set-who-info->pers-no (who-info newval) "Set pers-no in who-info to NEWVAL." (aset (cdr who-info) 0 newval)) (defsubst set-who-info->working-conf (who-info newval) "Set working-conf in who-info to NEWVAL." (aset (cdr who-info) 1 newval)) (defsubst set-who-info->connection (who-info newval) "Set connection in who-info to NEWVAL." (aset (cdr who-info) 2 newval)) (defsubst set-who-info->doing-what (who-info newval) "Set doing-what in who-info to NEWVAL." (aset (cdr who-info) 3 newval)) (defsubst set-who-info->username (who-info newval) "Set username in who-info to NEWVAL." (aset (cdr who-info) 4 newval)) ;;; Predicate: (defsubst lyskom-who-info-p (object) "Return t if OBJECT is a who-info." (eq (car-safe object) 'WHO-INFO)) ;;; ================================================================ ;;; session-info ;;; Constructor: (defsubst lyskom-create-session-info (pers-no working-conf connection doing username idletime connect-time) "Create a session-info from all parameters." (cons 'SESSION-INFO (vector pers-no working-conf connection doing username idletime connect-time ))) ;;; Selectors: (defsubst session-info->pers-no (session-info) "Get pers-no from session-info." (elt (cdr session-info) 0)) (defsubst session-info->working-conf (session-info) "Get working-conf from session-info." (elt (cdr session-info) 1)) (defsubst session-info->connection (session-info) "Get connection from session-info." (elt (cdr session-info) 2)) (defsubst session-info->doing (session-info) "Get doing from session-info." (elt (cdr session-info) 3)) (defsubst session-info->username (session-info) "Get username from session-info." (elt (cdr session-info) 4)) (defsubst session-info->idletime (session-info) "Get idletime from session-info." (elt (cdr session-info) 5)) (defsubst session-info->connect-time (session-info) "Get connect-time from session-info." (elt (cdr session-info) 6)) ;;; Modifiers: (defsubst set-session-info->pers-no (session-info newval) "Set pers-no in session-info to NEWVAL." (aset (cdr session-info) 0 newval)) (defsubst set-session-info->working-conf (session-info newval) "Set working-conf in session-info to NEWVAL." (aset (cdr session-info) 1 newval)) (defsubst set-session-info->connection (session-info newval) "Set connection in session-info to NEWVAL." (aset (cdr session-info) 2 newval)) (defsubst set-session-info->doing (session-info newval) "Set doing in session-info to NEWVAL." (aset (cdr session-info) 3 newval)) (defsubst set-session-info->username (session-info newval) "Set username in session-info to NEWVAL." (aset (cdr session-info) 4 newval)) (defsubst set-session-info->idletime (session-info newval) "Set idletime in session-info to NEWVAL." (aset (cdr session-info) 5 newval)) (defsubst set-session-info->connect-time (session-info newval) "Set connect-time in session-info to NEWVAL." (aset (cdr session-info) 6 newval)) ;;; Predicate: (defsubst lyskom-session-info-p (object) "Return t if OBJECT is a session-info." (eq (car-safe object) 'SESSION-INFO)) ;;; ================================================================ ;;; conf-type. ;;; Constructor: (defsubst lyskom-create-conf-type (rd_prot original secret letterbox &optional anarchy rsv1 rsv2 rsv3) "Create a conf-type object. Args: RD_PROT ORIGINAL SECRET LETTERBOX." (list 'CONF-TYPE rd_prot original secret letterbox anarchy rsv1 rsv2 rsv3 )) ;;;Selectors: (defsubst conf-type->rd_prot (conf-type) "Get rd_prot from conf-type." (elt (cdr conf-type) 0)) (defsubst conf-type->original (conf-type) "Get original from conf-type." (elt (cdr conf-type) 1)) (defsubst conf-type->secret (conf-type) "Get secret from conf-type." (elt (cdr conf-type) 2)) (defsubst conf-type->letterbox (conf-type) "Get letterbox from conf-type." (elt (cdr conf-type) 3)) (defsubst conf-type->anarchy (conf-type) "Get anarchy from conf-type." (elt (cdr conf-type) 4)) (defsubst conf-type->rsv1 (conf-type) "Get reserved bit from conf-type." (elt (cdr conf-type) 5)) (defsubst conf-type->rsv2 (conf-type) "Get reserved bit from conf-type." (elt (cdr conf-type) 5)) (defsubst conf-type->rsv3 (conf-type) "Get reserved bit from conf-type." (elt (cdr conf-type) 5)) ;;; ================================================================ ;;; text-list ;;; Constructor: (defsubst lyskom-create-text-list (texts) "Create a text-list from all parameters." (cons 'TEXT-LIST texts)) ;;; Selector: (defsubst text-list->texts (text-list) "Get texts from text-list." (cdr text-list)) (defsubst text-list->empty (text-list) "Return t if TEXT-LIST is empty." (null (cdr text-list))) (defsubst text-list->length (text-list) "Return the length of TEXT-LIST." (length (cdr text-list))) ;;; Modifier: (defsubst set-text-list->texts (text-list newval) "Set texts in TEXT-LIST to NEWVAL." (setcdr text-list newval)) (defsubst text-list->delq (text-list no) "Remove text NO from TEXT-LIST." (setcdr text-list (delq no (cdr text-list)))) (defsubst text-list->append (text-list texts) "Destructively append TEXTS to the end of TEXT-LIST." (setcdr text-list (nconc (cdr text-list) texts))) ;;; Predicate: (defsubst lyskom-text-list-p (object) "Return t if OBJECT is a text-list." (eq (car-safe object) 'TEXT-LIST)) ;;; ================================================================ ;;; version-info ;;; Constructor: (defsubst lyskom-create-version-info (protocol-version server-software software-version) "Create a version-info from all parameters." (cons 'VERSION-INFO (vector protocol-version server-software software-version))) ;;; Selectors: (defsubst version-info->protocol-version (version-info) "Get protocol version from version-info." (elt (cdr version-info) 0)) (defsubst version-info->server-software (version-info) "Get server software name from version-info." (elt (cdr version-info) 1)) (defsubst version-info->software-version (version-info) "Get server software version from version-info." (elt (cdr version-info) 2)) ;;; ================================================================ ;;; server-info ;;; Constructor: (defsubst lyskom-create-server-info (version conf-pres-conf pers-pres-conf motd-conf kom-news-conf motd-of-lyskom) "Create a server-info from all parameters." (cons 'SERVER-INFO (vector version conf-pres-conf pers-pres-conf motd-conf kom-news-conf motd-of-lyskom ))) ;;; Selectors: (defsubst server-info->version (server-info) "Get version from server-info." (elt (cdr server-info) 0)) (defsubst server-info->conf-pres-conf (server-info) "Get conf-pres-conf from server-info." (elt (cdr server-info) 1)) (defsubst server-info->pers-pres-conf (server-info) "Get pers-pres-conf from server-info." (elt (cdr server-info) 2)) (defsubst server-info->motd-conf (server-info) "Get motd-conf from server-info." (elt (cdr server-info) 3)) (defsubst server-info->kom-news-conf (server-info) "Get kom-news-conf from server-info." (elt (cdr server-info) 4)) (defsubst server-info->motd-of-lyskom (server-info) "Get motd-of-lyskom from server-info." (elt (cdr server-info) 5)) ;;; Modifiers: (defsubst set-server-info->version (server-info newval) "Set version in server-info to NEWVAL." (aset (cdr server-info) 0 newval)) (defsubst set-server-info->conf-pres-conf (server-info newval) "Set conf-pres-conf in server-info to NEWVAL." (aset (cdr server-info) 1 newval)) (defsubst set-server-info->pers-pres-conf (server-info newval) "Set pers-pres-conf in server-info to NEWVAL." (aset (cdr server-info) 2 newval)) (defsubst set-server-info->motd-conf (server-info newval) "Set motd-conf in server-info to NEWVAL." (aset (cdr server-info) 3 newval)) (defsubst set-server-info->kom-news-conf (server-info newval) "Set kom-news-conf in server-info to NEWVAL." (aset (cdr server-info) 4 newval)) (defsubst set-server-info->motd-of-lyskom (server-info newval) "Set motd-of-lyskom in server-info to NEWVAL." (aset (cdr server-info) 5 newval)) ;;; Predicate: (defsubst lyskom-server-info-p (object) "Return t if OBJECT is a server-info." (eq (car-safe object) 'SERVER-INFO)) ;;; ================================================================ ;;; conf-z-info-list ;;; Constructor: (defun lyskom-create-conf-z-info-list (conf-z-infos) "Create a conf-z-info-list from all parameters." (cons 'CONF-Z-INFO-LIST (vector conf-z-infos))) ;;; Selector: (defun conf-z-info-list->conf-z-infos (conf-z-info-list) "Get conf-z-infos from conf-z-info-list." (elt (cdr conf-z-info-list) 0)) ;;; Modifier: (defun set-conf-z-info-list->conf-z-infos (conf-z-info-list newval) "Set conf-z-infos in conf-z-info-list to NEWVAL." (aset (cdr conf-z-info-list) 0 newval)) ;;; Predicate: (defun lyskom-conf-z-info-list-p (object) "Return t if OBJECT is a conf-z-info-list." (eq (car-safe object) 'CONF-Z-INFO-LIST)) ;;; ================================================================ ;;; conf-z-info ;;; Constructor: (defun lyskom-create-conf-z-info (name conf-type conf-no) "Create a conf-z-info from all parameters." (cons 'CONF-Z-INFO (vector name conf-type conf-no))) ;;; Selectors: (defun conf-z-info->name (conf-z-info) "Get name from conf-z-info." (elt (cdr conf-z-info) 0)) (defun conf-z-info->conf-type (conf-z-info) "Get conf-type from conf-z-info." (elt (cdr conf-z-info) 1)) (defun conf-z-info->conf-no (conf-z-info) "Get conf-no from conf-z-info." (elt (cdr conf-z-info) 2)) ;;; Modifiers: (defun set-conf-z-info->name (conf-z-info newval) "Set name in conf-z-info to NEWVAL." (aset (cdr conf-z-info) 0 newval)) (defun set-conf-z-info->conf-type (conf-z-info newval) "Set conf-type in conf-z-info to NEWVAL." (aset (cdr conf-z-info) 1 newval)) (defun set-conf-z-info->conf-no (conf-z-info newval) "Set conf-no in conf-z-info to NEWVAL." (aset (cdr conf-z-info) 2 newval)) ;;; Predicate: (defun lyskom-conf-z-info-p (object) "Return t if OBJECT is a conf-z-info." (eq (car-safe object) 'CONF-Z-INFO)) ;;;; ================================================================ ;;;; This field is just simulation of a field in the conf-stat ;;;; that not yet exist. (defsubst conf-stat->comm-conf (conf-stat) (if (and (conf-type->original (conf-stat->conf-type conf-stat)) (not (zerop (conf-stat->super-conf conf-stat)))) (conf-stat->super-conf conf-stat) (conf-stat->conf-no conf-stat))) ;;; ================================================================ ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: clienttypes.el,v 44.4.2.2 1999/10/13 12:12:52 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: clienttypes.el ;;;; ;;;; This file contains primitives for the different data types ;;;; in the lyskom elisp client. The types in here are only used ;;;; within this lyskom client. ;;;; ;;;; Authors: Linus Tolke and Inge Wallin ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: clienttypes.el,v 44.4.2.2 1999/10/13 12:12:52 byers Exp $\n")) ;;; ================================================================ ;;; read-info ;;; A read-info is used by to tell the client which text to ;;; show next and in which order to step through the conferences ;;; with unread texts. New read-infos are created and deleted ;;; all the time within a session. ;;; ;;; The type is one of the following: ;;; REVIEW - Default review type, created by the kom-review-by-to ;;; and the kom-review-comments ;;; REVIEW-TREE - List of texts created by one of the tree-reading ;;; commands: kom-find-root-review, kom-review-tree ;;; REVIEW-MARK - List of texts created by the review-mark command ;;; COMM-IN - Type containing the list of comments to a text ;;; FOOTN-IN - Type containing the list of footnotes to a text ;;; CONF - Basic type of unread in a conf. ;;; ;;; The types REVIEW-TREE, COMM-IN and FOOTN-IN are created for new for ;;; every text read (recursively) when appropriate. ;;; ;;; The difference between REVIEW and REVIEW-MARK is just that there ;;; generate different prompts and different text from kom-review-stack. ;;; ;;; read-info (defsubst lyskom-create-read-info (type conf-stat priority text-list &optional comm-to forward) "Create a read-info from all parameters." ;; The last nil is for the unfetched-texts pair (first . last) ;; This field is only applicable in read-infos of type CONF where ;; it shows which part of the map for this conference that has not ;; yet been fetched. (cons 'READ-INFO (vector type conf-stat priority text-list comm-to forward nil))) (defsubst read-info->type (read-info) "Get type from read-info." (elt (cdr read-info) 0)) (defsubst read-info->conf-stat (read-info) "Get conf-stat from read-info." (elt (cdr read-info) 1)) (defsubst read-info->priority (read-info) "Get priority from read-info." (elt (cdr read-info) 2)) (defsubst read-info->text-list (read-info) "Get text-list from read-info." (elt (cdr read-info) 3)) (defsubst read-info->comm-to (read-info) "Get comm-to from read-info." (elt (cdr read-info) 4)) (defsubst read-info->forward (read-info) "Get forward from read-info." (elt (cdr read-info) 5)) (defsubst read-info->unfetched-texts (read-info) "Get forward from read-info." (elt (cdr read-info) 6)) (defsubst set-read-info->type (read-info newval) "Set type in read-info to NEWVAL." (aset (cdr read-info) 0 newval)) (defsubst set-read-info->conf-stat (read-info newval) "Set conf-stat in read-info to NEWVAL." (aset (cdr read-info) 1 newval)) (defsubst set-read-info->priority (read-info newval) "Set priority in read-info to NEWVAL." (aset (cdr read-info) 2 newval)) (defsubst set-read-info->text-list (read-info newval) "Set text-list in read-info to NEWVAL." (aset (cdr read-info) 3 newval)) (defsubst set-read-info->comm-to (read-info newval) "Set comm-to in read-info to NEWVAL." (aset (cdr read-info) 4 newval)) (defsubst set-read-info->forward (read-info newval) "Set forward in read-info to NEWVAL." (aset (cdr read-info) 5 newval)) (defsubst set-read-info->unfetched-texts (read-info newval) "Set forward in read-info to NEWVAL." (aset (cdr read-info) 6 newval)) (defsubst lyskom-read-info-p (object) "Return t if OBJECT is a read-info." (eq (car-safe object) 'READ-INFO)) (defsubst read-info-append-text-list (read-info texts) (text-list->append (read-info->text-list read-info) texts)) (defsubst read-info-enter-text-last (read-info text-no) (read-info-append-text-list read-info (list text-no))) ;;; ================================================================ ;;; read-list ;;; Constructor: (defsubst lyskom-create-read-list () "Create an empty read-list." (cons 'READ-LIST nil)) ;;; Predicates: (defsubst read-list-isempty (read-list) "Return t if READ-LIST is empty, otherwise return nil." (null (cdr read-list))) ;;; Selectors: (defsubst read-list->first (read-list) "Return the first entry in READ-LIST, or nil if empty." (car-safe (cdr read-list))) (defsubst read-list->nth (read-list n) "Args: READ-LIST N Return element N in READ-LIST or nil if outside the range. The range of valid values for N is [0, num-entries - 1]." (elt (cdr read-list) n)) (defsubst read-list->all-entries (read-list) "Return a list of all entries in READ-LIST." (cdr read-list)) ;;; Other functions: (defsubst read-list-length (read-list) "Return the number of entries in READ-LIST." (1- (length read-list))) ;;; Modifiers: (defsubst set-read-list-empty (read-list) "Empty READ-LIST destructively." (setcdr read-list nil)) (defsubst set-read-list-del-first (read-list) "Delete the first entry of READ-LIST if there is one." (if (cdr read-list) (setcdr read-list (cdr (cdr read-list))))) (defsubst read-list-enter-first (read-info read-list) "Enter READ-INFO first into READ-LIST." (setcdr read-list (cons read-info (cdr read-list)))) (defun read-list-enter-text (text-no recipient rlist) "Args: TEXT-NO RECIPIENT RLIST. Add the new text TEXT-NO to any RECIPIENT found in RLIST. RECIPIENT is a conf-stat. Returns t if there was a conference to insert this text into." (let ((inserted nil)) (lyskom-traverse read-info (cdr rlist) (cond ((and (eq 'CONF (read-info->type read-info)) (= (conf-stat->conf-no recipient) (conf-stat->conf-no (read-info->conf-stat read-info)))) (read-info-enter-text-last read-info text-no) (setq inserted t)))) inserted)) (defun read-list-delete-text (text-no rlist) "Destructively delete all occurances of TEXT-NO from RLIST. RLIST is a list of read-info. Entries of the type REVIEW, REVIEW-TREE or REVIEW-MARK are not changed except if they were empty in which case they are removed. Returns the modified RLIST. TEXT-NO may be nil, in which case only empty read-infos on RLIST are removed." (let* ((prev rlist) ;"Previous" cons-celll (curr (cdr rlist))) ;Current cons-cell (while curr (if text-no (cond ((let ((type (read-info->type (car curr)))) (or (eq type 'REVIEW) ; Don't change REVIEW et c. (eq type 'REVIEW-TREE) (eq type 'REVIEW-MARK)))) (t ; Do change all other entries. (let ((tl (read-info->text-list (car curr)))) (text-list->delq tl text-no))))) ;; Delete this element from RLIST if the text-list became or was empty. (if (text-list->empty (read-info->text-list (car curr))) (setcdr prev (cdr curr)) (setq prev curr)) (setq curr (cdr curr)))) rlist) (defun read-list-enter-read-info (read-info rlist &optional before) "Destructively insert READ-INFO in RLIST, sorted by priority. RLIST is a list of read-info. Args: READ-INFO RLIST &optional BEFORE. A new item with the same priority as an item that is alreay on the list will nomally be inserted after the old one, but if BEFORE is non-nil it will be inserted before it." (let ((pri (+ (if before 0 -1) (read-info->priority read-info))) (continue t) (conf-stat (read-info->conf-stat read-info)) (type (read-info->type read-info))) (while continue (cond ;; This case was added by davidk 960925. It is not used from ;; everywhere, but at least lyskom-enter-map-in-to-do-list ;; should become more efficient. ((and (eq type 'CONF) (eq (read-info->type (car (cdr rlist))) 'CONF) (eq conf-stat (read-info->conf-stat (car (cdr rlist))))) (read-info-append-text-list (car (cdr rlist)) (text-list->texts (read-info->text-list read-info))) (setq continue nil)) ((null (cdr rlist)) (setcdr rlist (list read-info)) (setq continue nil)) ((>= pri (read-info->priority (car (cdr rlist)))) (setcdr rlist (cons read-info (cdr rlist))) (setq continue nil)) (t (setq rlist (cdr rlist))))))) (defun read-list-delete-read-info (conf-no rlist) "Destructively removes all the entries for the conf CONF-NO in RLIST. RLIST is a list of read-info." (while (cdr rlist) (if (eq (conf-stat->conf-no (read-info->conf-stat (car (cdr rlist)))) conf-no) (setcdr rlist (cdr (cdr rlist))) (setq rlist (cdr rlist))))) (defun read-list-rotate (read-list) "Put the first element of READ-LIST last in the same list. The second element will be the new first element." (if (> (length read-list) 2) (let ((first (cdr read-list)) (last (cdr read-list))) (while (cdr last) (setq last (cdr last))) (setcdr last first) (setcdr read-list (cdr first)) (setcdr first nil))) read-list) ;;; ================================================================ ;;; A simple queue ;;; ;;; This is a simple implementation of a queue. The only thing you ;;; can do with it is stuff things at the back of it and remove ;;; things from the front of it. (...and of course do a few tests) ;;; ;;; Author: Inge Wallin (defun lyskom-queue-create () "Create an empty queue." (cons 'QUEUE (cons nil nil))) (defsubst lyskom-queue-enter (queue element) "Enter last into the queue QUEUE the ELEMENT." (let ((elementcell (cons element nil))) (if (null (car (cdr queue))) ; QUEUE is empty (setcar (cdr queue) (setcdr (cdr queue) elementcell)) (setcdr (cdr (cdr queue)) elementcell) (setcdr (cdr queue) elementcell)))) (defsubst lyskom-queue-p (queue) "Return t if QUEUE is a queue, otherwise return nil." (eq (car-safe queue) 'QUEUE)) (defsubst lyskom-queue-isempty (queue) "Return t if QUEUE is empty, otherwise return nil." (null (car (cdr queue)))) (defsubst lyskom-queue->first (queue) "Return the first element of QUEUE or nil if it is empty." (car-safe (car (cdr queue)))) (defsubst lyskom-queue->all-entries (queue) "Return all elements of QUEUE (nil if it is empty)." (car-safe (cdr queue))) (defsubst lyskom-queue->last (queue) "Return the lastelement of QUEUE or nil if it is empty." (car-safe (cdr (cdr queue)))) (defsubst lyskom-queue-make-empty (queue) "Make the queue QUEUE empty." (setcdr queue (cons nil nil))) (defsubst lyskom-queue-delete-first (queue) "Delete the first element of QUEUE and return it. If QUEUE is empty return nil and do nothing." (if (lyskom-queue-isempty queue) nil (prog1 (lyskom-queue->first queue) (setcar (cdr queue) (cdr (car (cdr queue)))) (if (null (car (cdr queue))) (setcdr (cdr queue) nil))))) ;;; ================================================================ ;;; A simple stack ;;; ;;; This is an implementation of a simple stack. ;;; ;;; Author: Inge Wallin (defun lyskom-stack-create () "Create an empty stack" (cons 'STACK nil)) (defun lyskom-stack-p (stack) "Return t if STACK is a lyskom-stack, otherwise return nil." (eq (car-safe stack) 'STACK)) (defun lyskom-stack-push (stack element) "Push the second arg ELEMENT onto the first arg STACK" (setcdr stack (cons element (cdr stack)))) (defun lyskom-stack-pop (stack) "Remove the topmost element from STACK and return it. If the stack is empty, return nil" (prog1 (car-safe (cdr stack)) (setcdr stack (cdr-safe (cdr stack))))) (defun lyskom-stack->top (stack) "Return the topmost element of STACK or nil if it is empty." (car-safe (cdr stack))) (defun lyskom-stack->length (stack) "Return the number of elements on STACK." (length (cdr stack))) (defun lyskom-stack->nth (stack n) "Return element no (second arg) N of the stack (first arg) STACK. N counts from zero. If the length of STACK is less than N, nil is returned." (nth n (cdr stack))) (defun lyskom-stack->all-entries (stack) "Return a list of all entries in STACK. The element last pushed is first in the list." (cdr stack)) (defsubst lyskom-stack-isempty (stack) "Returns non-nil if the STACK is empty." (not (cdr stack))) ;;; ================================================================ ;;; who-buffer-info ;;; Author: Inge Wallin ;;; Constructor: (defun lyskom-create-who-buffer-info (info start-marker end-marker) "Create a who-buffer-info from all parameters." (cons 'WHO-BUFFER-INFO (vector info start-marker end-marker ))) ;;; Selectors: (defun who-buffer-info->info (who-buffer-info) "Get info from who-buffer-info." (elt (cdr who-buffer-info) 0)) (defun who-buffer-info->start-marker (who-buffer-info) "Get start-marker from who-buffer-info." (elt (cdr who-buffer-info) 1)) (defun who-buffer-info->end-marker (who-buffer-info) "Get end-marker from who-buffer-info." (elt (cdr who-buffer-info) 2)) ;;; Modifiers: (defun set-who-buffer-info->info (who-buffer-info newval) "Set info in who-buffer-info to NEWVAL." (aset (cdr who-buffer-info) 0 newval)) (defun set-who-buffer-info->start-marker (who-buffer-info newval) "Set start-marker in who-buffer-info to NEWVAL." (aset (cdr who-buffer-info) 1 newval)) (defun set-who-buffer-info->end-marker (who-buffer-info newval) "Set end-marker in who-buffer-info to NEWVAL." (aset (cdr who-buffer-info) 2 newval)) ;;; Predicate: (defun lyskom-who-buffer-info-p (object) "Return t if OBJECT is a who-buffer-info." (eq (car-safe object) 'WHO-BUFFER-INFO)) ;;; ================================================================ ;;; format-props (defun make-format-props (arg propl) (cons 'format-props (vector arg propl))) (defsubst format-props-p (arg) (eq 'format-props (car-safe arg))) (defsubst format-props->arg (arg) (elt (cdr arg) 0)) (defsubst format-props->propl (arg) (elt (cdr arg) 1)) ;;; ;;; Help functions ;;; ;;; ================================================================ ;;; format-state (defun make-format-state (format-string start argl result) (cons 'format-state (vector format-string start argl (length argl) result nil nil))) (defsubst format-state-p (arg) (eq 'format-state (car-safe arg))) (defsubst format-state->format-string (arg) (elt (cdr arg) 0)) (defsubst set-format-state->format-string (arg str) (aset (cdr arg) 0 str)) (defsubst format-state->start (arg) (elt (cdr arg) 1)) (defsubst set-format-state->start (arg pos) (aset (cdr arg) 1 pos)) (defsubst format-state->args (arg) (elt (cdr arg) 2)) (defsubst set-format-state->args (arg argl) (aset (cdr arg) 2 argl) (aset (cdr arg) 3 (length argl))) (defsubst format-state->args-length (arg) (elt (cdr arg) 3)) (defsubst format-state->result (arg) (elt (cdr arg) 4)) (defsubst set-format-state->result (arg output-list) (aset (cdr arg) 4 output-list)) (defsubst format-state->delayed-propl (arg) (elt (cdr arg) 5)) (defsubst set-format-state->delayed-propl (arg propl) (aset (cdr arg) 5 propl)) (defsubst format-state->delayed-content (arg) (elt (cdr arg) 6)) (defsubst set-format-state->delayed-content (arg string) (aset (cdr arg) 6 string)) ;;; ================================================================ ;;; ====================================================================== ;;; ;;; collector ;;; ;;; A collector is used when a handler needs to pass information ;;; back to a function using asynchronous calls. You could use ;;; dynamically scoped variables, but that causes problems when ;;; the user quits before all handlers have been called since the ;;; result variable will be out of scope for the remaining handlers. ;;; The best-case scenario will be a crash. The worst-case scenario ;;; is when the handler clobbers another variable with the same name ;;; that has come into scope. ;;; ;;; So, so collect a number of results, do the following: ;;; ;;; (setq (make-collector)) ;;; ( ;;; (initiate- ' )) ;;; (lyskom-wait-queue ') ;;; ( (collector->value )) ;;; ;;; where function is something like this: ;;; ;;; (defun (data-från-servern collector) ;;; (set-collector->value collector ;;; (cons ( data-från-servern) ;;; (collector->value collector)))) ;;; ;;; or shorter, ;;; ;;; (defun (data-från-servern collector) ;;; (collector-push ( data-från-servern))) ;;; ;;; This sidestepping protects the handler from scope changes. ;;; (defun make-collector () "Create a data type for collecting asynchronous results safely" (cons 'COLLECTOR nil)) (defsubst collector->value (collector) "Get the current value of a collector" (cdr collector)) (defsubst set-collector->value (collector value) "Set the calue of a collector" (setcdr collector value)) (defun set-value-of-collector (value collector) "For use with lyskom handlers. In other cases, use set-collector->value" (set-collector->value collector value)) (defun collector-push (value collector) "Push VALUE onto the front of COLLECTOR's value" (setcdr collector (cons value (cdr collector)))) (provide 'lyskom-clienttypes) ;;; clienttypes.el ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: deferred-insert.el,v 44.0.4.2 1999/10/13 12:13:00 byers Exp $ ;;;;; Copyright (C) 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: deferred-insert.el ;;;; ;;;; This file includes functions for deffering insertion of ;;;; information into the LysKOM buffer. ;;;; ;;; ;;; How to defer a peice of text: ;;; ============================= ;;; ;;; 1. Insert some temporary text. Use the variable ;;; `lyskom-defer-indicator' as a placeholder. ;;; ;;; 2. Create a defer-info-structure by calling ;;; `lyskom-create-defer-info' with the following parameters ;;; ;;; SERVER-CALL - the call to get the data (initate-get-*) ;;; CALL-ARG - the argument for the server call. This is ;;; limited to a single argument, which is enough ;;; for get-conf-stat and friends. ;;; HANDLER - the function to be called to insert the ;;; "real" data. ;;; POS - a marker indicating where the insertion ;;; should be placed. ;;; DEL-CHARS - an integer indicating how many characters ;;; from POS on should be replaced by the "real" ;;; text. ;;; FORMAT - a format string for inserting the real ;;; data. This should normally only contain a ;;; single format atom using argument 1 ;;; (i.e. "%#1P"). ;;; DATA - any data that you might want to use in ;;; HANDLER. ;;; ;;; 3. Call `lyskom-defer-insertion' with the defer-info as argument. ;;; ;;; 4. Write a handler function that takes two arguments, the server ;;; reply and the defer-info. This function should replace the ;;; temporary text. A convenient way to do this is to use ;;; `lyskom-replace-deferred'. ;;; ;;; 5. Sit back and watch it work. ;;; ;;; Notes: ;;; ;;; POS must be located before the temporary text. DEL-CHARS should ;;; usually be set to (length lyskom-defer-indicator). Don't count on ;;; it to be 5. ;;; ;;; Steps 1 and 2 are often implemented the other way around, or at ;;; least the POS parameter is determined before any text is ;;; inserted. ;;; ;;; You should only defer text if kom-deferred-printing is non-nil. ;;; ;;; Type: defer-info (defun lyskom-create-defer-info (server-call call-par handler pos del-chars format &optional data) (cons 'DEFER-INFO (vector server-call call-par handler pos del-chars format data lyskom-last-viewed))) (defun lyskom-defer-info-p (obj) (and (consp obj) (eq (car obj) 'DEFER-INFO))) (defun defer-info->server-call (di) (aref (cdr di) 0)) (defun defer-info->call-par (di) (aref (cdr di) 1)) (defun defer-info->handler (di) (aref (cdr di) 2)) (defun defer-info->pos (di) (aref (cdr di) 3)) (defun defer-info->del-chars (di) (aref (cdr di) 4)) (defun defer-info->format (di) (aref (cdr di) 5)) (defun defer-info->data (di) (aref (cdr di) 6)) (defun defer-info->last-viewed (di) (aref (cdr di) 7)) (defun set-defer-info->server-call (di x) (aset (cdr di) 0 x)) (defun set-defer-info->call-par (di x) (aset (cdr di) 1 x)) (defun set-defer-info->handler (di x) (aset (cdr di) 2 x)) (defun set-defer-info->pos (di x) (aset (cdr di) 3 x)) (defun set-defer-info->del-chars (di x) (aset (cdr di) 4 x)) (defun set-defer-info->format (di x) (aset (cdr di) 5 x)) (defun set-defer-info->data (di x) (aset (cdr di) 6 x)) (defun set-defer-info->last-viewed (di x) (aset (cdr di) 7 x)) (defun lyskom-defer-insertion (defer-info) "Defer insertion of something. The insertion will be at (point)." (set-defer-info->last-viewed defer-info lyskom-last-viewed) ;; (goto-char (defer-info->pos defer-info)) (funcall (intern-soft (concat "initiate-" (symbol-name (defer-info->server-call defer-info)))) 'deferred (defer-info->handler defer-info) (defer-info->call-par defer-info) defer-info)) (defun lyskom-replace-deferred (defer-info &rest replacement-data) "Replace some defered text." (save-excursion (goto-char (defer-info->pos defer-info)) (apply 'lyskom-format-insert-at-point (defer-info->format defer-info) replacement-data) (let ((inhibit-read-only t)) (delete-char (defer-info->del-chars defer-info))) (set-marker (defer-info->pos defer-info) nil)) (if lyskom-executing-command nil (let ((window (get-buffer-window lyskom-buffer))) (if window (if (pos-visible-in-window-p (point-max) window) nil ;; This means that this insertion moved point out of the ;; window. The scrolling becomes tricky. One big problem is ;; that we can't use lyskom-last-viewed, because it has been ;; updated to the new prompt. Until that is solved we make ;; sure that we never scroll. ;; ;; The solution is to save lyskom-last-viewed in the defer-info (save-selected-window (select-window window) (lyskom-scroll)) ;; (move-to-window-line -1) ;; (vertical-motion 1) ;; (if (not (pos-visible-in-window-p)) ;; (forward-char -1)) ))))) (defun lyskom-deferred-insert-conf (conf-stat defer-info) "Insert the name of a conference at a previously reserved place." (lyskom-replace-deferred defer-info (if (null conf-stat) (lyskom-format (or (defer-info->data defer-info) (if (= (aref (defer-info->format defer-info) (1- (length (defer-info->format defer-info)))) ?P) (if (= (defer-info->call-par defer-info) 0) 'person-is-anonymous 'person-does-not-exist) 'conference-does-not-exist)) (defer-info->call-par defer-info)) conf-stat) (text-properties-at (defer-info->pos defer-info)))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: utilities.el,v 44.21.2.2 1999/10/13 12:13:35 byers Exp $ ;;;;; Copyright (C) 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: utilities.el ;;;; ;;;; This file contains general lisp utility functions and ;;;; lyskom-specific utility functions (such as date formatting and ;;;; minibuffer reading) ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: utilities.el,v 44.21.2.2 1999/10/13 12:13:35 byers Exp $\n")) ;;; ;;; Need Per Abrahamsens widget and custom packages There should be a ;;; better way of doing this, but I'll be darned if I know how. The ;;; various files need to be loaded in a very specific order. ;;; ;;; Define widget wrappers for all the functions in macros.el ;;; ;;; Lisp utility functions ;;; (defsubst listify-vector (vector) "Turn VECTOR into a list" (append vector nil)) (defun reverse-assoc (key cache) "Same as assoc, but searches on last element in a list" (reverse (assoc key (mapcar (function reverse) cache)))) (defun nfirst (n list) "Return a list of the N first elements of LIST." (if (or (<= n 0) (not list)) nil (cons (car list) (nfirst (1- n) (cdr list))))) ;;; ;;; +++ FIXME: If cl.el can be guaranteed, this is pointless. ;;; (defun lyskom-butlast (x &optional n) "Returns a copy of LIST with the last N elements removed." (if (and n (<= n 0)) x (lyskom-nbutlast (copy-sequence x) n))) (defun lyskom-nbutlast (x &optional n) "Modifies LIST to remove the last N elements." (let ((m (length x))) (or n (setq n 1)) (and (< n m) (progn (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) x)))) (defun skip-first-zeros (list) (while (and list (zerop (car list))) (setq list (cdr list))) list) (defun filter-list (test list) (cond ((null list) '()) ((apply test (car list) nil) (cons (car list) (filter-list test (cdr list)))) (t (filter-list test (cdr list))))) ;;;============================================================ ;;; ;;; Utility functions. ;;; ;;; These should be shared in LysKOM ;;; (lyskom-provide-function copy-tree (l) "Recursively copy the list L" (cond ((atom l) l) (t (cons (copy-tree (car l)) (copy-tree (cdr l)))))) (lyskom-provide-function functionp (obj) "Returns t if OBJ is a function, nil otherwise." (cond ((symbolp obj) (fboundp obj)) ((subrp obj)) ((byte-code-function-p obj)) ((consp obj) (if (eq (car obj) 'lambda) (listp (car (cdr obj))))) (t nil))) (defun regexpp (re) "Return non-nil if RE looks like a valid regexp." (let ((result t)) (save-match-data (condition-case nil (string-match re "") (error (setq result nil)))) result)) (defun mapcar2 (fn seq1 seq2) (let (result) (while (and seq1 seq2) (setq result (cons (funcall fn (car seq1) (car seq2)) result)) (setq seq1 (cdr seq1) seq2 (cdr seq2))) (nreverse result))) (defun lyskom-maxint () (let ((n 1) (l nil)) (while (> n 0) (setq l (cons n l)) (setq n (* 2 n))) (apply '+ l))) (defun lyskom-try-require (feature &optional message &rest args) "Load the feature FEATURE using require. If optional MESSAGE is non-nil, use it as a LysKOM format string taking one string argument to print an error message. Remaining arguments are used as arguments for the format string. Returns t if the feature is loaded or can be loaded, and nil otherwise." (or (featurep 'feature) (condition-case nil (progn (require feature) t) (error (when message (apply 'lyskom-format-insert-before-prompt message (symbol-name feature) args)) nil)))) (defun lyskom-emacs-version () (cond ((string-match "^XEmacs" (emacs-version)) 'xemacs) (t 'emacs))) (defvar lyskom-apo-timeout 0 "Current millisecond timeout value for accept-process-output") (defvar lyskom-apo-timeout-index 0 "Index in lyskom-apo-timeout-vector-max where last timeout is") (defconst lyskom-apo-timeout-vector [0 1000 1000 2000 3000 5000 8000 13000 21000 34000 55000 89000 144000 233000 377000 610000] "Vector of timeout values (usecs) for accept-process-output") (defconst lyskom-apo-timeout-vector-max (1- (length lyskom-apo-timeout-vector)) "Maximum index in lyskom-apo-timeout-vector") (defsubst lyskom-next-apo-timeout () (if (< lyskom-apo-timeout-index lyskom-apo-timeout-vector-max) (setq lyskom-apo-timeout (aref lyskom-apo-timeout-vector (setq lyskom-apo-timeout-index (1+ lyskom-apo-timeout-index)))))) (defsubst lyskom-reset-apo-timeout () (setq lyskom-apo-timeout-index -1) (setq lyskom-apo-timeout 0)) (defsubst lyskom-accept-process-output () "Call accept-process-output with the correct timeout values." (lyskom-next-apo-timeout) (accept-process-output nil 0 lyskom-apo-timeout)) ;;; ;;; LysKOM utility functions ;;; ;;; ;;; WARNING! ;;; ;;; The following variable is *important* if you fuck it up in any ;;; way, the functions used to read conference names won't work. So if ;;; you change it, try to work one character at a time, and when ;;; you're done, run through the mappings of all 256 characters to ;;; make sure they look OK. ;;; (defvar lyskom-default-collate-table "\000\001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037 !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]~\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237 !¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿AAAA[]ACEEEEIIIIÐNOOOO\\×OUUUYYÞßAAAA[]ACEEEEIIIIðNOOOO\\÷OUUUYYþÿ" "String mapping lowercase to uppercase and equivalents to each others.") (defsubst lyskom-unicase-char (c) "Smash case and diacritical marks on c." (aref lyskom-collate-table (char-to-int c))) (defun lyskom-unicase (s) "Smash case and diacritical marks of all chars in s." (lyskom-save-excursion (set-buffer lyskom-buffer) (let ((l (length s)) (s2 (copy-sequence s))) (while (> l 0) (setq l (1- l)) (aset s2 l (lyskom-unicase-char (aref s2 l)))) s2))) (defun lyskom-string-assoc (key list) "Return non-nil if KEY is the same string as the car of an element of LIST. The value is actually the element of LIST whose car equals KEY." (let ((s (downcase key)) (result nil)) (while list (when (string= s (downcase (car (car list)))) (setq result (car list)) (setq list nil)) (setq list (cdr list))) result)) (defun lyskom-set-default (sym val) "Set the value of SYM in the LysKOM buffer to VAL." (save-excursion (set-buffer (or (and (boundp 'lyskom-buffer) (bufferp lyskom-buffer) (buffer-live-p lyskom-buffer) lyskom-buffer) (current-buffer))) (set sym val))) (defun lyskom-default-value (sym) "Get the value of SYM in the LysKOM buffer" (save-excursion (set-buffer (or (and (boundp 'lyskom-buffer) (bufferp lyskom-buffer) (buffer-live-p lyskom-buffer) lyskom-buffer) (current-buffer))) (symbol-value sym))) (defun lyskom-default-value-safe (sym) "Get the value of SYM in the LysKOM buffer" (save-excursion (set-buffer (or (and (boundp 'lyskom-buffer) (bufferp lyskom-buffer) (buffer-live-p lyskom-buffer) lyskom-buffer) (current-buffer))) (and (boundp sym) (symbol-value sym)))) ;;; ====================================================================== ;;; Display device management ;;; ;;; Definition of some useful functions from XEmacs (lyskom-provide-function console-type (&optional console) (or window-system 'tty)) (lyskom-provide-function device-class (&optional device) (condition-case nil (if (x-display-grayscale-p) (if (x-display-color-p) 'color 'grayscale) 'mono) (error 'mono))) (lyskom-provide-function frame-property (frame property &optional default) (or (cdr (assq property (frame-parameters frame))) default)) ;;; XEmacs doesn't seem to have a background-mode frame property (defun lyskom-background-mode () (frame-property (selected-frame) 'background-mode 'light)) ;;; ====================================================================== ;;; LysKOM Hooks ;;; (defun lyskom-run-hook-with-args (hook &rest args) "Run HOOK with the specified arguments ARGS in the LysKOM buffer. See run-hook-with-args for detailed information." (save-excursion (set-buffer (or (and (boundp 'lyskom-buffer) lyskom-buffer) (current-buffer))) (apply 'run-hook-with-args hook args))) (defun lyskom-add-hook (hook function &optional append) "Add to the value of HOOK the function FUNCTION in the LysKOM buffer. If optional APPEND is non-nil, add at the end of HOOK." (save-excursion (set-buffer (or (and (boundp 'lyskom-buffer) lyskom-buffer) (current-buffer))) (add-hook hook function append t))) (defun lyskom-remove-hook (hook function) "From the value of HOOK remove the function FUNCTION in the LysKOM buffer." (save-excursion (set-buffer (or (and (boundp 'lyskom-buffer) lyskom-buffer) (current-buffer))) (remove-hook hook function t))) ;;; ====================================================================== ;;; Printing ;;; ;;; XEmacs princ does not insert text properties. This function is based ;;; on the C code for princ. It only works on strings ;;; (defun lyskom-princ (string &optional stream) "Similar to princ but will only print a string. Does not lose text properties under XEmacs." (let ((old-point nil) (start-point nil) (old-buffer (current-buffer))) (unwind-protect (progn (cond ((bufferp stream) (set-buffer stream)) ((markerp stream) (setq old-point (point)) (set-buffer (marker-buffer stream)) (goto-char stream) (setq start-point (point)))) (insert string)) (cond ((markerp stream) (set-marker stream (point)) (if (>= old-point start-point) (goto-char (+ old-point (- (point) start-point))) (goto-char old-point)))) (set-buffer old-buffer)))) ;;; ====================================================================== ;;; Faces ;;; (defun lyskom-set-face-foreground (face color) (condition-case nil (set-face-foreground face color) (error nil))) (defun lyskom-set-face-background (face color) (condition-case nil (set-face-background face color) (error nil))) (defun lyskom-set-face-scheme (scheme) "Set the LysKOM color and face scheme to SCHEME. Valid schemes are listed in lyskom-face-schemes." (let ((tmp (assoc scheme lyskom-face-schemes))) ;; This test is NOT good, but now it's better... (if (and tmp (or (not (eq (console-type) 'tty)) (not (eq (device-class) 'mono)))) (progn (mapcar (function (lambda (spec) (copy-face (or (elt spec 1) 'default) (elt spec 0)) (if (elt spec 2) (lyskom-set-face-foreground (elt spec 0) (elt spec 2))) (if (elt spec 3) (lyskom-set-face-background (elt spec 0) (elt spec 3))))) (cdr tmp)))))) (defun lyskom-face-resource (face-name attr type) (if (eq (lyskom-emacs-version) 'xemacs) ;; XEmac style (let ((val (x-get-resource (concat face-name ".attribute" attr) (concat "Face.Attribute" attr) type))) (cond ((eq type 'string) val) ((and (eq type 'boolean) val) (if (car val) 'on 'off)) (t val))) ;; Emacs style (let ((val (x-get-resource (concat face-name ".attribute" attr) (concat "Face.Attribute" attr)))) (cond ((eq type 'string) val) ((and val (eq type 'boolean) (member (downcase val) '("on" "true"))) 'on) ((and val (eq type 'boolean)) 'off) (t val))))) (defun lyskom-modify-face (what face) (condition-case nil (funcall (intern (concat "make-face-" (symbol-name what))) face) (error nil))) (defun lyskom-setup-faces () "Initalize the faces in the LysKOM client. This sets the face scheme according to `kom-default-face-scheme', and also reads the proper X resources." (unless kom-default-face-scheme (setq kom-default-face-scheme (condition-case nil (cond ((eq (device-class) 'mono) 'monochrome) ((eq (lyskom-background-mode) 'dark) 'inverse) (t 'default)) (error 'default)))) (lyskom-set-face-scheme kom-default-face-scheme) (if (eq (console-type) 'x) (mapcar (function (lambda (face) (let* ((face-name (symbol-name face)) (fg (lyskom-face-resource face-name "Foreground" 'string)) (bg (lyskom-face-resource face-name "Background" 'string)) (bl (lyskom-face-resource face-name "Bold" 'boolean)) (it (lyskom-face-resource face-name "Italic" 'boolean)) (ul (lyskom-face-resource face-name "Underline" 'boolean))) (if fg (set-face-foreground face fg)) (if bg (set-face-background face bg)) (if (eq bl 'on) (lyskom-modify-face 'bold face)) (if (eq bl 'off) (lyskom-modify-face 'unbold face)) (if (eq it 'on) (lyskom-modify-face 'italic face)) (if (eq it 'off) (lyskom-modify-face 'unitalic face)) (if ul (set-face-underline-p face (eq ul 'on)))))) lyskom-faces))) ;;; ============================================================ ;;; Keymap utilities (defun lyskom-lookup-key (keymap event &optional accept-default) (if (null keymap) (and accept-default (lookup-key global-map event)) (if (not (arrayp event)) (setq event (vector event))) (or (lookup-key keymap event) (lyskom-lookup-key (keymap-parent keymap) event accept-default)))) (defun lyskom-keymap-body (keymap) (setq keymap (cdr keymap)) (cond ((arrayp (car keymap)) (car keymap)) (t keymap))) (defun lyskom-keymap-realbinding (binding) (while (stringp (car-safe binding)) (setq binding (cdr binding))) binding) (defun lyskom-overlay-keymap (basemap overlay keymap &optional prefix) (let ((keys (make-vector (1+ (length prefix)) nil)) (index (length prefix)) (body nil) (r 0)) (while (< r (length prefix)) (aset keys r (aref prefix r)) (setq r (1+ r))) (cond ((not (keymapp keymap))) ((not (keymapp overlay))) ((not (keymapp basemap))) ((setq body (lyskom-keymap-body overlay)) (mapcar (function (lambda (element) (cond ((arrayp element) (let ((len (length element))) (setq r 0) (while (< r len) (aset keys index r) (lyskom-overlay-keys keys (aref element r) basemap overlay keymap) (setq r (1+ r))))) ((consp element) (when (not (eq t (car element))) (aset keys index (car element)) (lyskom-overlay-keys keys (lyskom-keymap-realbinding (cdr element)) basemap overlay keymap))) (t nil)))) body))))) (defun lyskom-overlay-keys (keys binding basemap overlay keymap) (let ((base-binding (lyskom-lookup-key basemap keys nil))) ;; If the binding is a keymap or prefix and ;; the binding in the base is a keymap or prefix ;; then recurse (cond ((and (keymapp binding) (keymapp base-binding)) (lyskom-overlay-keymap basemap binding keymap keys)) ;; If the binding is a keymap or prefix and ;; we are bound in the base ;; then don't recurse ((and (keymapp binding) base-binding) nil) ;; If we are not bound in the base ;; copy the binding ((and binding (null base-binding)) (define-key keymap keys binding))))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: buffers.el,v 44.7.4.2 1999/10/13 12:12:50 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: buffers.el ;;;; Author: David Byers ;;;; ;;;; This file implements special buffer handling used in LysKOM ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: buffers.el,v 44.7.4.2 1999/10/13 12:12:50 byers Exp $\n")) ;;;; ;;;; LYSKOM BUFFER MANAGEMENT ;;;; ;;;; Buffers are arranged in a tree rooted in a LysKOM buffer. There ;;;; is one tree for each session. ;;;; ;;;; Use lyskom-get-buffer-create to create new buffers ;;;; Use lyskom-display-buffer to display most buffers ;;;; Use lyskom-undisplay-buffer to undisplay those buffers ;;;; ;;;; ============================================================ ;;;; Buffer hierarchy management ;;;; ;;;; This code should not be too dependent on LysKOM ;;;; (defvar lyskom-buffer-children nil "List of buffers that are children to this buffer") (defvar lyskom-buffer-inherited-variables nil "List of variables automatically inherited to sub-buffers when they are created.") (defvar lyskom-buffer-parent nil "Parent of buffer") (defvar lyskom-killing-hierarchy nil "Non-nil while killing a buffer hierarchy.") (make-variable-buffer-local 'lyskom-buffer-parent) (lyskom-protect-variable 'lyskom-buffer-parent) (make-variable-buffer-local 'lyskom-buffer-children) (lyskom-protect-variable 'lyskom-buffer-children) (make-variable-buffer-local 'lyskom-buffer-inherited-variables) (lyskom-protect-variable 'lyskom-buffer-inherited-variables) (defun lyskom-set-buffer-parent (buffer parent) "Set the parent buffer of BUFFER to PARENT. If buffer is already a child of some buffer, reparent it." (save-excursion (set-buffer buffer) (if (and lyskom-buffer-parent (buffer-live-p lyskom-buffer-parent)) (lyskom-remove-buffer-child lyskom-buffer-parent buffer)) (setq lyskom-buffer-parent parent) (if parent (lyskom-add-buffer-child parent buffer)))) (defun lyskom-remove-buffer-child (buffer child) "Remove CHILD from BUFFER's list of children. Args: BUFFER CHILD" (save-excursion (set-buffer buffer) (if (boundp 'lyskom-buffer-children) (setq lyskom-buffer-children (delq child lyskom-buffer-children))))) (defun lyskom-add-buffer-child (buffer child) "Add CHILD as a child of BUFFER. Args: BUFFER CHILD" (save-excursion (set-buffer buffer) (setq lyskom-buffer-children (cons child lyskom-buffer-children)))) (defun lyskom-get-buffer-parent (buffer) "Return the parent of BUFFER or nil if it has no parent" (save-excursion (set-buffer buffer) (and (boundp 'lyskom-buffer-parent) lyskom-buffer-parent))) (defun lyskom-get-buffer-children (buffer) "Return the list of children of buffer BUFFER or nil if there are none." (save-excursion (set-buffer buffer) (and (boundp 'lyskom-buffer-children) lyskom-buffer-children))) (defun lyskom-buffer-root-ancestor (buffer) "Return the ultimate ancestor of buffer BUFFER." (let ((buffer-parent buffer)) (while (setq buffer-parent (lyskom-get-buffer-parent buffer)) (setq buffer buffer-parent)) buffer)) (defun lyskom-map-buffer-children (function buffer) "Apply FUNCTION to each child of BUFFER and make a list of the results." (cond ((null buffer) nil) (t (cons (funcall function buffer) (apply 'nconc (mapcar (function (lambda (x) (lyskom-map-buffer-children function x))) (lyskom-get-buffer-children buffer))))))) (defun lyskom-buffer-hierarchy-query-kill-function () "When querying if a buffer is to be killed, ensure that none of the children object" (save-excursion (not (memq nil (mapcar (function (lambda (buffer) (if (buffer-live-p buffer) (progn (set-buffer buffer) (run-hook-with-args-until-failure 'kill-buffer-query-functions)) t))) (lyskom-get-buffer-children (current-buffer))))))) (defun lyskom-buffer-hierarchy-kill-hook () "When killing a buffer, enure that its children also die" (let ((kill-buffer-query-functions nil) (lyskom-killing-hierarchy (or lyskom-killing-hierarchy (current-buffer)))) (lyskom-set-buffer-parent (current-buffer) nil) (let ((buflist (lyskom-get-buffer-children (current-buffer)))) (while buflist (kill-buffer (car buflist)) (setq buflist (cdr buflist)))))) (add-hook 'kill-buffer-hook 'lyskom-buffer-hierarchy-kill-hook) (add-hook 'kill-buffer-query-functions 'lyskom-buffer-hierarchy-query-kill-function) ;;;; ====================================================================== ;;;; ====================================================================== (defvar lyskom-associated-buffer-list nil "List of (CATEGORY . BUFFER-LIST) listing all buffers of various categories") (make-variable-buffer-local 'lyskom-associated-buffer-list) (lyskom-protect-variable 'lyskom-associated-buffer-list) (defvar lyskom-buffer-category nil "Category of this buffer") (make-variable-buffer-local 'lyskom-buffer-category) (lyskom-protect-variable 'lyskom-buffer-category) (def-kom-var lyskom-saved-window-configuration nil "The window configuration to return to when closing the window" protected local) (def-kom-var lyskom-dedicated-frame nil "The frame dedicated to the current buffer" protected local) (def-kom-var lyskom-dedicated-window nil "The window dedicated to the current buffer" protected local) (defvar lyskom-undisplaying-hierarchy nil "The top of the buffer hierarchy being undisplayed.") (defun lyskom-clean-up-buffer-category (cat) (let ((buffers (cdr (assq cat (lyskom-default-value 'lyskom-associated-buffer-list)))) (result nil)) (while buffers (when (buffer-live-p (car buffers)) (setq result (cons (car buffers) result))) (setq buffers (cdr buffers))) (lyskom-set-buffers-of-category cat (nreverse result)))) (defun lyskom-set-buffers-of-category (category buflist) (let ((tmp (assq category (lyskom-default-value 'lyskom-associated-buffer-list)))) (cond (tmp (setcdr tmp buflist)) (t (lyskom-setq-default lyskom-associated-buffer-list (cons (cons category buflist) (lyskom-default-value 'lyskom-associated-buffer-list))))))) (defun lyskom-buffers-of-category (cat) "Return all live buffers of catgory CAT" (lyskom-clean-up-buffer-category cat) (cdr (assq cat (lyskom-default-value 'lyskom-associated-buffer-list)))) (defun lyskom-add-buffer-of-category (buffer category) "Add BUFFER as a buffer of category CATEGORY" (let ((tmp (assq category (lyskom-default-value 'lyskom-associated-buffer-list)))) (cond (tmp (setcdr tmp (cons buffer (cdr tmp)))) (t (lyskom-setq-default 'lyskom-associated-buffer-list (cons (cons category (list buffer)) (lyskom-default-value 'lyskom-associated-buffer-list))))))) (defun lyskom-quit-query () (if (and (boundp 'lyskom-buffer) (local-variable-p 'lyskom-buffer (current-buffer)) (eq lyskom-buffer (current-buffer)) (lyskom-buffers-of-category 'write-texts)) (unwind-protect (progn (display-buffer (car (lyskom-buffers-of-category 'write-texts))) (lyskom-ja-or-nej-p (lyskom-get-string 'quit-in-spite-of-unsent))) nil) t)) (add-hook 'kill-buffer-query-functions 'lyskom-quit-query) (add-hook 'kill-emacs-query-functions 'lyskom-quit-query) (defun lyskom-generate-new-buffer (name) (let ((buf (generate-new-buffer name))) (save-excursion (set-buffer buf) (set-buffer-multibyte nil)) buf)) (defun lyskom-get-buffer-create (category name &optional unique) "Create a new buffer of category CATEGORY with name generated from NAME. If UNIQUE is non-nil, re-use the first existing buffer of category CATEGORY, renaming it and killing its local variables. The created buffer is made a child of the current buffer." (let ((buffers (lyskom-buffers-of-category category)) (buffer nil)) (if (and unique buffers) (progn (setq buffer (car buffers)) (save-excursion (set-buffer buffer) (let ((inhibit-read-only t)) ;;; +++ FIXME: This is that erase-buffer works if there are widgets (setq before-change-functions (delq 'widget-before-change before-change-functions)) (erase-buffer)) (kill-all-local-variables) (if (equal (buffer-name (current-buffer)) name) nil (rename-buffer name t)))) (progn (setq buffer (generate-new-buffer name)) (lyskom-add-buffer-of-category buffer category))) (lyskom-set-buffer-parent buffer (current-buffer)) (lyskom-update-inherited-variables buffer) (save-excursion (set-buffer buffer) (setq lyskom-buffer-category category) (set-buffer-multibyte nil)) buffer)) (defun lyskom-update-inherited-variables (buffer) "Update all inherited variables in this buffer and propagate them to all children" (save-excursion (let ((variables nil) (tmp lyskom-inherited-variables)) (set-buffer buffer) (when lyskom-buffer-parent (set-buffer lyskom-buffer-parent) (setq variables (mapcar 'symbol-value lyskom-inherited-variables)) (set-buffer buffer) (while tmp (make-local-variable (car tmp)) (set (car tmp) (car variables)) (setq tmp (cdr tmp) variables (cdr variables)))) (mapcar 'lyskom-update-inherited-variables lyskom-buffer-children)))) (defun lyskom-display-buffer (buffer) "Display the buffer BUFFER and select the window displaying it. If BUFFER is already visible in some window in any frame, iconified or otherwise, make that window visible. Otherwise display buffer as per which category it is in. Selects the window. Returns the window displaying BUFFER." (set-buffer buffer) (let ((windows (lyskom-get-buffer-window-list buffer nil 0)) (iconified-frame nil) (visible-frame)) ;; ;; Find out if the buffer is visible somewhere ;; (while windows (cond ((eq (frame-visible-p (window-frame (car windows))) 'icon) (setq iconified-frame (car windows))) ((frame-visible-p (window-frame (car windows))) (setq visible-frame (car windows)) (setq windows nil))) (setq windows (cdr windows))) ;; ;; Display it ;; (cond (visible-frame (select-window visible-frame) visible-frame) (iconified-frame (make-frame-visible iconified-frame) (select-window iconified-frame) iconified-frame) (t (let ((category lyskom-buffer-category) (window nil)) (if (null category) (progn (select-window (display-buffer buffer)) (selected-window)) (let* ((sym (intern-soft (concat "kom-" (symbol-name category) "-in-window"))) (open (lyskom-default-value-safe sym)) (saved-window-configuration (save-excursion (set-buffer (or (and (boundp 'lyskom-buffer) lyskom-buffer) (current-buffer))) (current-window-configuration))) (dedicated-frame nil) (dedicated-window nil)) (cond ;; ;; NULL -- Just switch to the buffer ;; ((null open) (switch-to-buffer buffer) (setq window (selected-window))) ;; ;; OTHER, OTHER-WINDOW -- Switch to in another window ;; ((or (eq open 'other) (eq open 'other-window)) (switch-to-buffer-other-window buffer) (setq dedicated-window (selected-window)) (setq window (selected-window))) ;; ;; OTHER-FRAME -- Switch to in another frame ;; Create frame if none exist ;; ((eq open 'other-frame) (if (eq (selected-frame) (next-frame)) (switch-to-buffer-other-frame buffer) (other-frame 1) (switch-to-buffer buffer)) (setq window (selected-window))) ;; ;; NEW-FRAME ;; Create a new frame and display buffer in that frame ;; ((eq open 'new-frame) (switch-to-buffer-other-frame buffer) (setq dedicated-frame (selected-frame)) (setq dedicated-window (selected-window)) (setq window (selected-window)) (setq saved-window-configuration nil)) ;; ;; String or buffer ;; Switch to buffer in window displaying named buffer ;; Prefer windows in selected frame ;; ((and (or (stringp open) (bufferp open)) (lyskom-get-buffer-window-list open nil 'visible)) (let ((tmp (lyskom-get-buffer-window-list open nil 'visible))) (setq window (car tmp)) (while tmp (if (eq (window-frame (car tmp)) (selected-frame)) (progn (setq window (car tmp)) (setq tmp nil)) (setq tmp (cdr tmp)))) (select-window window) (switch-to-buffer buffer))) ;; ;; Otherwise just switch ;; (t (switch-to-buffer buffer) (setq window (selected-window)))) ;; ;; Set up kill-buffer-hooks and similar things ;; (select-window window) (set-buffer buffer) (make-local-variable 'lyskom-dedicated-frame) (setq lyskom-dedicated-frame dedicated-frame) (make-local-variable 'lyskom-dedicated-window) (setq lyskom-dedicated-window dedicated-window) (make-local-variable 'lyskom-saved-window-configuration) (setq lyskom-saved-window-configuration saved-window-configuration) (make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'lyskom-undisplay-buffer-hook nil t) (put 'kill-buffer-hook 'permanent-local t) window))))))) (defun lyskom-undisplay-buffer-hook () (save-excursion (lyskom-undisplay-buffer (current-buffer)))) (defun lyskom-undisplay-buffer (&optional buffer) "Undisplay BUFFER. If buffer is not specified, undisplay the current buffer" (setq buffer (or buffer (current-buffer))) (let ((dedicated-frame (and (boundp 'lyskom-dedicated-frame) lyskom-dedicated-frame)) (dedicated-window (and (boundp 'lyskom-dedicated-window) lyskom-dedicated-window)) (lyskom-undisplaying-hierarchy (or buffer lyskom-undisplaying-hierarchy)) (saved-window-configuration (and (boundp 'lyskom-saved-window-configuration) lyskom-saved-window-configuration))) (cond ;; ;; If buffer has a dedicated frame AND ;; buffer is visible in that frame THEN ;; delete the frame ;; (dedicated-frame (when (memq dedicated-frame (mapcar 'window-frame (lyskom-get-buffer-window-list buffer nil t))) (delete-frame dedicated-frame) (setq dedicated-frame nil))) ((and lyskom-killing-hierarchy (not (eq lyskom-killing-hierarchy buffer))) nil) ((and lyskom-undisplaying-hierarchy (not (eq lyskom-undisplaying-hierarchy buffer))) nil) (dedicated-window (when (and (window-live-p dedicated-window) (eq (get-buffer buffer) (window-buffer dedicated-window))) (cond ((null (delq dedicated-window (window-list (window-frame dedicated-window)))) (bury-buffer buffer)) (t (delete-window dedicated-window))) (setq dedicated-window nil)) (when saved-window-configuration (lyskom-set-partial-window-configuration saved-window-configuration))) (saved-window-configuration (lyskom-set-partial-window-configuration lyskom-saved-window-configuration))))) (defun lyskom-set-partial-window-configuration (configuration) "Set CONFIGURATION as the current window configuration with the exception of point mark and window-start in all windows." (let* ((info nil) (binfo nil)) (save-excursion (setq binfo (mapcar (function (lambda (b) (set-buffer b) (list b (point) (mark t)))) (buffer-list))) (walk-windows (function (lambda (w) (set-buffer (window-buffer w)) (setq info (cons (list w (window-start w) (window-point w) (window-buffer w)) info)))) t t)) (unwind-protect (set-window-configuration configuration) (save-selected-window (let (buffer window saved-point saved-mark saved-start) (while binfo (setq buffer (elt (car info) 0) saved-point (elt (car info) 1) saved-mark (elt (car info) 2)) (when (buffer-live-p buffer) (set-buffer buffer) (goto-char saved-point) (set-mark saved-mark)) (setq binfo (cdr binfo))) (while info (setq window (elt (car info) 0) saved-start (elt (car info) 1) saved-point (elt (car info) 2) buffer (elt (car info) 3)) (when (and (window-live-p window) (eq (window-buffer window) buffer)) (set-window-start window saved-start) (set-window-point window saved-point)) (setq info (cdr info)))))))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: prefetch.el,v 44.10.4.2 1999/10/13 12:13:23 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ;;;; File: prefetch.el ;;;; ;;;; This file contains the functions that make up the prefetch ;;;; system. ;;;; ;;;; Author: Inge Wallin ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: prefetch.el,v 44.10.4.2 1999/10/13 12:13:23 byers Exp $\n")) ;;; ================================================================ ;;; Variables. (def-kom-var lyskom-prefetch-stack nil "A stack where all prefetch requests are entered. New items are entered first and when an item is to be prefetched, it is taken from the front of this list. Each entry is either the atom 'DONE, a cons cell as described below or a lyskom-queue. \('CONFSTAT . number\) - The conf stat of Conference NUMBER. \('PERSSTAT . number\) - The pers stat of person NUMBER. \('TEXTSTAT . number\) - The text stat of text NUMBER. \('TEXTMASS . number\) - The text mass of text NUMBER. \('TEXTAUTH . number\) - The text stat of the text NUMBER and the conf-stat of the author of it. \('TEXT-ALL . number\) - The text stat and mass of text NUMBER, but also all information that will be used when writing this text for the user to see, such as conf-stat for the author, text stats for commented texts, comments, a.s.o. \('TEXTTREE . number\) - The text stat, author, textauth of comments to and texttree of all comments and footnotes. \('CONFSTATFORMAP conf-no first-local\) - The conf-stat of the conference number CONF-NO is fetched and then we continue to fetch the map. \('MAP conf-stat first-local\) - The next part of the map in conference CONF-STAT. The length fetched per revolution is according to the value of lyskom-fetch-map-nos. \('MARKS\) - The whole list of marked texts and then every info about these texts. \('WHOBUFFER\) - The who-is-on-info to construct the who-buffer. \('MEMBERSHIP . pers-no\) - The next part of the membership for person PERS-NO is fetched. How long we already have fetched is kept in the variable lyskom-membership-is-read. If lyskom-membership-is-read is not a number then we are done. For every membership-part we fetch the conf-stats before continuing with the next part. \('MEMBERSHIPISREAD\) - Just sets the lyskom-membership-is-read variable to t. See further documentation in the source code." local) ;;; ;;; The four requests CONFSTAT, PERSSTAT, TEXTSTAT and TEXTMASS are ;;; called simple requests and are handled immediately and removed. ;;; The others are called complex requests. These will each generate ;;; further requests when they return. ;;; ;;; When one of the simple requests are sent to the server, the atom ;;; DONE is swapped for the request. ;;; ;;; When one of the complex requests are sent to the server, a ;;; lyskom-queue is swapped for the request and a pointer to the queue ;;; is sent to the handler. When the call returns the new requests this ;;; call generates will all be put on the queue. This process can be ;;; repeated and a queue might contain other queues and so on. ;;; ;;; When the prefetch code is searching for a new request to process it ;;; always starts searching at the beginning of the variable ;;; lyskom-prefetch-stack. If an empty queue is encountered, it is simply ;;; skipped since this significates a complex request that has already ;;; been sent and is awaiting its result. A non-empty queue is recursively ;;; searched and treated in the same way as the original stack. ;;; (def-kom-var lyskom-prefetch-in-action nil "t when the prefetch-process is started and going." local) (defvar lyskom-inhibit-prefetch nil "Set this to a non-nil value locally to inhibit the prefetch. This is used to prevent the prefetch code to reenter itself.") (def-kom-var lyskom-pending-prefetch 0 "Variable counting the number of unfinished prefetch requests." local) ;;; ================================================================ ;;; Functions callable from the outside (defun lyskom-setup-prefetch () "Sets up the prefetch process in lyskom." (setq lyskom-prefetch-stack (lyskom-stack-create)) (setq lyskom-pending-prefetch 0) (setq lyskom-membership-is-read 0)) ;;;; ================================================================ ;;; +++ lyskom-reset-prefetch to be called on client reset. ;;; must restart everything. ;;; +++ THIS DOES NOT WORK CURRENTLY (defun lyskom-reset-prefetch () "Reset the prefetch system." (lyskom-setup-prefetch)) (defsubst lyskom-membership-is-read () "Return t if the while membership list has been fetched, and nil otherwise." (eq lyskom-membership-is-read 't)) (defun lyskom-prefetch-conf (conf-no &optional queue) "Prefetch the conf-stat for the conference with number CONF-NO. If QUEUE is non-nil, put the request on it, otherwise put it on lyskom-prefetch-stack." (if conf-no (if queue (lyskom-queue-enter queue (cons 'CONFSTAT conf-no)) (lyskom-stack-push lyskom-prefetch-stack (cons 'CONFSTAT conf-no))) (signal 'lyskom-internal-error "No argument to lyskom-prefetch-conf")) (lyskom-continue-prefetch)) (defun lyskom-prefetch-pers (pers-no &optional queue) "Prefetch the pers-stat for person with number PERS-NO. If QUEUE is non-nil, put the request on it, otherwise put it on lyskom-prefetch-stack." (if queue (lyskom-queue-enter queue (cons 'PERSSTAT pers-no)) (lyskom-stack-push lyskom-prefetch-stack (cons 'PERSSTAT pers-no))) (lyskom-continue-prefetch)) (defun lyskom-prefetch-text (text-no &optional queue) "Prefetch the text-stat for the text with number TEXT-NO. If QUEUE is non-nil, put the request on it, otherwise put it on lyskom-prefetch-stack." (if queue (lyskom-queue-enter queue (cons 'TEXTSTAT text-no)) (lyskom-stack-push lyskom-prefetch-stack (cons 'TEXTSTAT text-no))) (lyskom-continue-prefetch)) (defun lyskom-prefetch-textmass (text-no &optional queue) "Prefetch the text mass for the text with number TEXT-NO. If QUEUE is non-nil, put the request on it, otherwise put it on lyskom-prefetch-stack." (if queue (lyskom-queue-enter queue (cons 'TEXTMASS text-no)) (lyskom-stack-push lyskom-prefetch-stack (cons 'TEXTMASS text-no))) (lyskom-continue-prefetch)) (defun lyskom-prefetch-textauth (text-no &optional queue) "Prefetch the text stat and the author of text number TEXT-NO. If QUEUE is non-nil, put the request on it, otherwise put it on lyskom-prefetch-stack." (if queue (lyskom-queue-enter queue (cons 'TEXTAUTH text-no)) (lyskom-stack-push lyskom-prefetch-stack (cons 'TEXTAUTH text-no))) (lyskom-continue-prefetch)) (defun lyskom-prefetch-text-all (text-no &optional queue) "Prefetch all info about the text with number TEXT-NO. If QUEUE is non-nil, put the request on it, otherwise put it on lyskom-prefetch-stack." (if queue (lyskom-queue-enter queue (cons 'TEXT-ALL text-no)) (lyskom-stack-push lyskom-prefetch-stack (cons 'TEXT-ALL text-no))) (lyskom-continue-prefetch)) (defun lyskom-prefetch-texttree (text-no &optional queue only-new) "Prefetch all info about the text with number TEXT-NO and descends recursively. If QUEUE is non-nil, put the request on it, otherwise put it on lyskom-prefetch-stack. If ONLY-NEW is non-nil and the text-stat in question is already prefetched the prefetch is not done." (if (and only-new (cache-get-text-stat text-no)) nil (if queue (lyskom-queue-enter queue (cons 'TEXTTREE text-no)) (lyskom-stack-push lyskom-prefetch-stack (cons 'TEXTTREE text-no)))) (lyskom-continue-prefetch)) (defun lyskom-prefetch-membership (pers-no &optional queue) "+++" ;; h{mtar medlemsskapet i sm} delar ;; och d{refter conf-stat f|r m|tena (if queue (lyskom-queue-enter queue (cons 'MEMBERSHIP pers-no)) (lyskom-stack-push lyskom-prefetch-stack (cons 'MEMBERSHIP pers-no))) (lyskom-continue-prefetch)) (defun lyskom-prefetch-map (conf-no membership &optional queue) "Prefetches a map for conf CONFNO." (lyskom-prefetch-map-from conf-no (1+ (membership->last-text-read membership)) membership queue)) (defun lyskom-prefetch-map-from (conf-no first-local membership &optional queue) "Prefetches a map for conf CONFNO starting att FIRST-LOCAL." (if queue (lyskom-queue-enter queue (list 'CONFSTATFORMAP conf-no first-local membership)) (lyskom-stack-push lyskom-prefetch-stack (list 'CONFSTATFORMAP conf-no first-local membership))) (lyskom-continue-prefetch)) (defun lyskom-prefetch-map-using-conf-stat (conf-stat first-local membership &optional queue) "Prefetches a map for conf CONFSTAT starting att FIRST-LOCAL." (if queue (lyskom-queue-enter queue (list 'MAP conf-stat first-local membership)) (lyskom-stack-push lyskom-prefetch-stack (list 'MAP conf-stat first-local membership))) (lyskom-continue-prefetch)) (defun lyskom-prefetch-all-conf-stats (&optional queue) "+++" nil) (defun lyskom-prefetch-marks (&optional queue) "Prefetches the list of marked texts. Then all texts are fetched." (if queue (lyskom-queue-enter queue (list 'MARKS)) (lyskom-stack-push lyskom-prefetch-stack (list 'MARKS))) (lyskom-continue-prefetch)) (defun lyskom-prefetch-who-is-on (&optional queue) "Prefetches the list of persons on the system." (if queue (lyskom-queue-enter queue (list 'WHOBUFFER)) (lyskom-stack-push lyskom-prefetch-stack (list 'WHOBUFFER))) (lyskom-continue-prefetch)) ;;(defun lyskom-prefetch-all-conf-texts (&optional queue) ;; "Prefetches the texts in all conferences." ;; (if queue ;; (lyskom-queue-enter queue (list 'ALL-CONF-TEXTS)) ;; (lyskom-stack-push lyskom-prefetch-stack (list 'ALL-CONF-TEXTS))) ;; (lyskom-continue-prefetch)) ;;(defun lyskom-prefetch-conf-texts (text-list &optional queue) ;; "Prefetches the texts in all conferences." ;; (if (null (text-list->texts text-list)) ;; nil ;; (if queue ;; (lyskom-queue-enter queue (list 'CONF-TEXTS text-list)) ;; (lyskom-stack-push lyskom-prefetch-stack (list 'CONF-TEXTS text-list)))) ;; (lyskom-continue-prefetch)) (defun lyskom-prefetch-texts (texts &optional queue) "Prefetches a list of texts." (if (null texts) nil (if queue (lyskom-queue-enter queue (list 'TEXTS texts)) (lyskom-stack-push lyskom-prefetch-stack (list 'TEXTS texts)))) (lyskom-continue-prefetch)) ;; (defun lyskom-prefetch-text-list-continue (texts &optional queue) ;; "Prefetches a list of texts." ;; (if (null texts) ;; nil ;; (if queue ;; (lyskom-queue-enter queue (list 'TEXT-LIST-CONT texts)) ;; (lyskom-stack-push lyskom-prefetch-stack ;; (list 'TEXT-LIST-CONT texts)))) ;; (lyskom-continue-prefetch)) ;;; ================================================================ ;;; Functions internal to the prefetch package (defun lyskom-stop-prefetch () "Stop the prefetch process temporarily." (setq lyskom-prefetch-in-action nil)) (defun lyskom-start-prefetch () "Start the whole prefetch process" (setq lyskom-prefetch-in-action t) (lyskom-continue-prefetch)) (defun lyskom-continue-prefetch () "Called after each prefetch is finished and also when the whole prefetch process is started. Used to keep prefetch going." (if (not lyskom-inhibit-prefetch) (let ((lyskom-inhibit-prefetch t)) ; Make sure we don't call this ; recursively (while (and (< lyskom-pending-prefetch lyskom-prefetch-limit) (lyskom-prefetch-one-item) ;; Only increase lyskom-pending-prefetch if a server ;; call was made. ;; ;; The return value from lyskom-prefetch-one-item ;; is whether it has sent a server call, but it ;; should really be if the prefetch-stack has been ;; altered. See the comment in ;; lyskom-prefetch-one-item. (++ lyskom-pending-prefetch)))))) (defun lyskom-skip-finished-in-queue (queue) "Remove all 'DONE entries and queues who's only entry is 'FINISHED." (let ((element nil) (done nil)) (while (not done) (setq element (lyskom-queue->first queue)) (if (or (eq element 'DONE) (and (lyskom-queue-p element) (eq (lyskom-queue->first element) 'FINISHED))) (lyskom-queue-delete-first queue) (setq done t))))) (defun lyskom-prefetch-one-item () "Get the first element of the prefetch data structure and fetch it. Return t if an element was prefetched, otherwise return nil." (let ((result nil) element (prefetch-list (lyskom-stack->all-entries lyskom-prefetch-stack)) (list-stack (lyskom-stack-create)) (done nil)) ; Remove all finished entries at the top of lyskom-prefetch-stack (while (not done) (setq element (lyskom-stack->top lyskom-prefetch-stack)) (if (or (eq element 'DONE) (and (lyskom-queue-p element) (eq (lyskom-queue->first element) 'FINISHED))) (lyskom-stack-pop lyskom-prefetch-stack) (setq done t))) (while (and (not result) prefetch-list) (let ((element (car prefetch-list)) (rest-list (cdr prefetch-list))) (cond ((eq element 'DONE) nil) ((eq element 'FINISHED) nil) ;; A queue ==> check it out first. ((lyskom-queue-p element) (lyskom-skip-finished-in-queue element) (if (lyskom-queue-isempty element) nil (lyskom-stack-push list-stack rest-list) (setq rest-list (lyskom-queue->all-entries element)))) ;; A simple request? ((and (listp element) (memq (car element) '(CONFSTAT PERSSTAT TEXTSTAT TEXTMASS))) (setcar prefetch-list 'DONE) (lyskom-prefetch-one-request element nil) (setq result t)) ;; A complex request? ((and (listp element) (memq (car element) '(TEXTAUTH TEXT-ALL TEXTTREE CONFSTATFORMAP MAP MARKS MEMBERSHIP WHOBUFFER TEXTS))) (let ((queue (lyskom-queue-create))) (setcar prefetch-list queue) (lyskom-prefetch-one-request element queue) (setq result t))) ;; Special requests ((and (listp element) (memq (car element) '(MEMBERSHIPISREAD ALL-CONF-TEXTS))) (if (eq (car element) 'MEMBERSHIPISREAD) (setq lyskom-membership-is-read t) ;; Temporarily disabled (let ((queue (lyskom-queue-create))) (setcar prefetch-list queue) (mapcar (lambda (read-info) (mapcar (lambda (text-no) (lyskom-prefetch-text-all text-no queue)) (text-list->texts (read-info->text-list read-info)))) (read-list->all-entries lyskom-to-do-list)) (lyskom-queue-enter queue 'FINISHED))) ;; This is an ugly hack. If this function returns a non-nil ;; value, lyskom-prefetch-continue will assume that a server ;; call was made and increase lyskom-pending-prefetch. But ;; no server call has been made, so we decrease ;; lyskom-pending-prefetch "in advance". The reason that ;; this sets result to t is that we want the loop in ;; lyskom-continue-prefetch to keep running, as there is no ;; server response that will wake the prefetch up in the ;; future. ;;(-- lyskom-pending-prefetch) ;;(setq result t) ) (t (signal 'lyskom-internal-error '(lyskom-prefetch-one-item ": unknown key")))) (setq prefetch-list rest-list) (if (not (or prefetch-list (lyskom-stack-isempty list-stack))) (setq prefetch-list (lyskom-stack-pop list-stack))))) result)) (defun lyskom-prefetch-one-request (request queue) "Prefetch REQUEST. If the request is complex, put the resulting requests on QUEUE." (cond ((eq (car request) 'CONFSTAT) (initiate-get-conf-stat 'prefetch 'lyskom-prefetch-handler (cdr request))) ((eq (car request) 'PERSSTAT) (initiate-get-pers-stat 'prefetch 'lyskom-prefetch-handler (cdr request))) ((eq (car request) 'TEXTSTAT) (initiate-get-text-stat 'prefetch 'lyskom-prefetch-handler (cdr request))) ((eq (car request) 'TEXTMASS) (initiate-get-text 'prefetch 'lyskom-prefetch-handler (cdr request))) ((eq (car request) 'TEXTAUTH) (initiate-get-text-stat 'prefetch 'lyskom-prefetch-textauth-handler (cdr request) queue)) ((eq (car request) 'TEXT-ALL) (initiate-get-text-stat 'prefetch 'lyskom-prefetch-text-all-handler (cdr request) queue)) ((eq (car request) 'TEXTTREE) (initiate-get-text-stat 'prefetch 'lyskom-prefetch-texttree-handler (cdr request) queue)) ((eq (car request) 'MEMBERSHIP) (if (numberp lyskom-membership-is-read) ; Are we done? (initiate-get-part-of-membership 'prefetch 'lyskom-prefetch-membership-handler (cdr request) lyskom-membership-is-read lyskom-fetch-membership-length (cdr request) queue) ; We are done (lyskom-prefetch-handler))) ((eq (car request) 'CONFSTATFORMAP) (initiate-get-conf-stat 'prefetch 'lyskom-prefetch-confstatformap-handler (nth 1 request) (nth 2 request) (nth 3 request) queue)) ((eq (car request) 'MAP) (initiate-get-map 'prefetch 'lyskom-prefetch-map-handler (conf-stat->conf-no (nth 1 request)) ; conf-stat (nth 2 request) ; first-local lyskom-fetch-map-nos (nth 1 request) ; conf-stat (nth 2 request) ; first-local (nth 3 request) ; membership queue)) ((eq (car request) 'MARKS) (initiate-get-marks 'prefetch 'lyskom-prefetch-marks-handler queue)) ((eq (car request) 'WHOBUFFER) (initiate-who-is-on 'prefetch 'lyskom-prefetch-whobuffer-handler queue)) ((eq (car request) 'TEXTS) (initiate-get-text-stat 'prefetch 'lyskom-prefetch-texts-handler (car (nth 1 request)) (cdr (nth 1 request)) queue)) (t (signal 'lyskom-internal-error (list "lyskom-prefetch-one-request - unknown key:" (car request)))))) ;;; ================================================================ ;;; Functions which handle the results of complex requests. (defun lyskom-prefetch-textauth-handler (text-stat queue) "Prefetch the conf-stat of the author of the text TEXT-STAT. Put the request on QUEUE." (lyskom-stop-prefetch) (if (not text-stat) nil (lyskom-prefetch-conf (text-stat->author text-stat) queue) (lyskom-queue-enter queue 'FINISHED)) (-- lyskom-pending-prefetch) (lyskom-start-prefetch)) (defun lyskom-prefetch-text-all-handler (text-stat queue) "Prefetch all info neccessary to write the text with text-stat TEXT-STAT. Put the requests on QUEUE." (lyskom-stop-prefetch) (lyskom-prefetch-conf (text-stat->author text-stat) queue) (lyskom-prefetch-textmass (text-stat->text-no text-stat) queue) (lyskom-traverse misc (text-stat->misc-info-list text-stat) (let ((type (misc-info->type misc))) (cond ((or (eq type 'RECPT) (eq type 'BCC-RECPT) (eq type 'CC-RECPT)) (lyskom-prefetch-conf (misc-info->recipient-no misc) queue)) ((eq type 'COMM-IN) (lyskom-prefetch-textauth (misc-info->comm-in misc) queue)) ((eq type 'FOOTN-IN) (lyskom-prefetch-textauth (misc-info->footn-in misc) queue)) ((eq type 'COMM-TO) (lyskom-prefetch-textauth (misc-info->comm-to misc) queue)) ((eq type 'FOOTN-TO) (lyskom-prefetch-textauth (misc-info->footn-to misc) queue)) (t nil)))) (lyskom-queue-enter queue 'FINISHED) (-- lyskom-pending-prefetch) (lyskom-start-prefetch)) (defun lyskom-prefetch-texttree-handler (text-stat queue) "Prefetch all info neccessary to write the text with text-stat TEXT-STAT. Then prefetch all info (texttree) of comments. Put the requests on QUEUE." (if (not text-stat) nil ; We did not get anything (lyskom-stop-prefetch) (lyskom-prefetch-conf (text-stat->author text-stat) queue) (lyskom-prefetch-textmass (text-stat->text-no text-stat) queue) (lyskom-traverse misc (text-stat->misc-info-list text-stat) (let ((type (misc-info->type misc))) (cond ((or (eq type 'RECPT) (eq type 'BCC-RECPT) (eq type 'CC-RECPT)) (lyskom-prefetch-conf (misc-info->recipient-no misc) queue)) ((eq type 'COMM-IN) (lyskom-prefetch-texttree (misc-info->comm-in misc) queue t)) ((eq type 'FOOTN-IN) (lyskom-prefetch-texttree (misc-info->footn-in misc) queue t)) ((eq type 'COMM-TO) (lyskom-prefetch-textauth (misc-info->comm-to misc) queue)) ((eq type 'FOOTN-TO) (lyskom-prefetch-textauth (misc-info->footn-to misc) queue)) (t nil)))) (lyskom-queue-enter queue 'FINISHED)) (-- lyskom-pending-prefetch) (lyskom-start-prefetch)) (defun lyskom-prefetch-membership-handler (memberships pers-no queue) "Handle the return of the membership prefetch call." (lyskom-stop-prefetch) (let ((size (length memberships)) (i 0)) (lyskom-add-memberships-to-membership memberships) (while (< i size) (let ((membership (aref memberships i))) (if (lyskom-visible-membership membership) (lyskom-prefetch-map (membership->conf-no membership) membership queue))) (++ i)) (if (and (numberp lyskom-membership-is-read) (< (length memberships) lyskom-fetch-membership-length)) (progn (setq lyskom-membership-is-read 'almost) (lyskom-queue-enter queue (list 'MEMBERSHIPISREAD))) (setq lyskom-membership-is-read (+ lyskom-membership-is-read lyskom-fetch-membership-length)) (lyskom-prefetch-membership pers-no queue) )) (lyskom-queue-enter queue 'FINISHED) (-- lyskom-pending-prefetch) (lyskom-start-prefetch)) (defun lyskom-prefetch-confstatformap-handler (conf-stat first-local membership queue) "Now that we have the conf-stat we can fetch the map." (lyskom-stop-prefetch) (lyskom-prefetch-map-using-conf-stat conf-stat first-local membership queue) (lyskom-queue-enter queue 'FINISHED) (-- lyskom-pending-prefetch) (lyskom-start-prefetch)) (defun lyskom-prefetch-map-handler (map conf-stat first-local membership queue) "Handle the return of the membership prefetch call. Maps are `cached' in lyskom-to-do-list." (lyskom-stop-prefetch) (let ((next-start (+ first-local lyskom-fetch-map-nos)) (last-local (1- (+ (conf-stat->no-of-texts conf-stat) (conf-stat->first-local-no conf-stat))))) (when map ;; An old version of this function tester if the map contained no ;; texts. That is not a correct termination condition. (when (< next-start last-local) (lyskom-prefetch-map-using-conf-stat conf-stat next-start membership queue)) (lyskom-enter-map-in-to-do-list map conf-stat membership))) (lyskom-queue-enter queue 'FINISHED) (-- lyskom-pending-prefetch) (lyskom-start-prefetch) (lyskom-update-prompt) (lyskom-set-mode-line)) (defun lyskom-prefetch-marks-handler (marks queue) "Handle the list of marked texts." (cache-set-marked-texts marks) (lyskom-stop-prefetch) (let ((list (cache-get-marked-texts))) (while list (lyskom-prefetch-text-all (mark->text-no (car list)) queue) (setq list (cdr list)))) (-- lyskom-pending-prefetch) (lyskom-start-prefetch)) (defun lyskom-prefetch-whobuffer-handler (who-is-on queue) "Handle the who-is-on info. The goal here is to get an updated who-buffer." ;+++ should be done later (cache-initiate-who-info-buffer who-is-on lyskom-buffer) (-- lyskom-pending-prefetch) ) (defun lyskom-prefetch-texts-handler (text-stat texts queue) "Prefetch all info neccessary to write the text with text-stat TEXT-STAT. Put the requests on QUEUE." (lyskom-stop-prefetch) (lyskom-prefetch-conf (text-stat->author text-stat) queue) (lyskom-prefetch-textmass (text-stat->text-no text-stat) queue) (lyskom-traverse misc (text-stat->misc-info-list text-stat) (let ((type (misc-info->type misc))) (cond ((or (eq type 'RECPT) (eq type 'BCC-RECPT) (eq type 'CC-RECPT)) (lyskom-prefetch-conf (misc-info->recipient-no misc) queue)) ((eq type 'COMM-IN) (lyskom-prefetch-textauth (misc-info->comm-in misc) queue)) ((eq type 'FOOTN-IN) (lyskom-prefetch-textauth (misc-info->footn-in misc) queue)) ((eq type 'COMM-TO) (lyskom-prefetch-textauth (misc-info->comm-to misc) queue)) ((eq type 'FOOTN-TO) (lyskom-prefetch-textauth (misc-info->footn-to misc) queue)) (t nil)))) (lyskom-queue-enter queue 'FINISHED) ;; The queue is now used up. (lyskom-prefetch-texts texts) (-- lyskom-pending-prefetch) (lyskom-start-prefetch)) (defun lyskom-prefetch-handler (&rest data) "Handler called after each simple prefetch request is done." (-- lyskom-pending-prefetch) (lyskom-continue-prefetch)) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: startup.el,v 44.23.2.2 1999/10/13 12:13:30 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: startup.el ;;;; ;;;; This file contains functions that are called only when lyskom ;;;; is loaded, started or when a new user is logged in during a ;;;; session. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: startup.el,v 44.23.2.2 1999/10/13 12:13:30 byers Exp $\n")) ;;; ================================================================ ;;; Start kom. ;;;###autoload (defun lyskom (&optional host username password session-priority) "Start a LysKOM session. Optional arguments: HOST, USERNAME and PASSWORD. See lyskom-mode for details." (interactive (list (lyskom-read-server-name (lyskom-format 'server-q (or (getenv "KOMSERVER") lyskom-default-server))) nil nil (if current-prefix-arg (prefix-numeric-value current-prefix-arg) nil))) (run-hooks 'lyskom-init-hook) (setq username (or username (getenv "KOMNAME"))) (setq password (or password (getenv "KOMPASSWORD"))) (if (zerop (length host)) (let* ((env-kom (getenv "KOMSERVER")) (canon (rassoc env-kom kom-server-aliases))) (setq host (or (car canon) env-kom lyskom-default-server)))) (let ((port 4894) (init-done nil)) (cond ;Allow "nanny:4892" to use port 4892. ((string-match ":" host) (setq port (string-to-int (substring host (match-end 0)))) (cond ((zerop (match-beginning 0)) (setq host lyskom-default-server)) (t (setq host (substring host 0 (match-beginning 0))))))) (let* ((buffer (get-buffer host)) (name nil) (proc nil) (reused-buffer nil)) (if (and buffer (lyskom-buffer-p buffer) (not (prog1 (j-or-n-p (lyskom-get-string 'start-new-session-same-server)) (message "")))) (progn (switch-to-buffer buffer) (setq reused-buffer t)) (unwind-protect (progn (cond ((and buffer (not (lyskom-buffer-p buffer))) (set-buffer buffer) (setq reused-buffer t) (goto-char (point-max)) (let ((time (decode-time (current-time)))) (setcar (cdr (cdr (cdr (cdr time)))) (1- (car (cdr (cdr (cdr (cdr time))))))) (setcar (cdr (cdr (cdr (cdr (cdr time))))) (- (car (cdr (cdr (cdr (cdr (cdr time)))))) 1900)) (lyskom-insert (format (lyskom-get-string 'new-session-in-buffer) (lyskom-format-time (apply 'lyskom-create-time time)))) (setq name (buffer-name buffer)))) (t (setq buffer (lyskom-generate-new-buffer host)) (setq name (buffer-name buffer)))) (let* ((proxy-host-string (cond ((stringp kom-www-proxy) kom-www-proxy) ((listp kom-www-proxy) (or (cdr (lyskom-string-assoc host kom-www-proxy)) (cdr (assq t kom-www-proxy)) nil)) (t nil))) (proxy-host nil) (proxy-port nil) (match (string-match "\\(.*\\):\\([0-9]+\\)" (or proxy-host-string "")))) (setq proxy-host (or (and match (match-string 1 proxy-host-string)) proxy-host-string) proxy-port (or (and match (string-to-int (match-string 2 proxy-host-string))) 80)) (cond (proxy-host (setq proc (open-network-stream name buffer proxy-host proxy-port)) (set-process-coding-system proc 'no-conversion 'iso-8859-1) (lyskom-process-send-string proc (format "\ connect %s:%d HTTP/1.0\r\n\ \r\n" host port))) (t (setq proc (open-network-stream name buffer host port)) (set-process-coding-system proc 'no-conversion 'iso-8859-1)))) (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) (setq lyskom-server-name host) (setq lyskom-proc proc) (lyskom-setup-faces) (lyskom-insert (lyskom-format 'try-connect lyskom-clientversion host)) (set-process-filter proc 'lyskom-connect-filter) (process-kill-without-query proc nil) (lyskom-process-send-string proc (concat "A" (lyskom-format-objects (concat (user-login-name) "%" (system-name))) "\n")) (while (eq 'lyskom-connect-filter (process-filter proc)) (accept-process-output proc)) ;; Now we have got the correct response. (set-process-sentinel proc 'lyskom-sentinel) (save-excursion (lyskom-init-parse buffer)) ;; +++PREFETCH+++ (lyskom-setup-prefetch) ;; Tell the server who we are (initiate-set-client-version 'background nil "lyskom.el" lyskom-clientversion) (setq lyskom-server-info (blocking-do 'get-server-info)) (setq lyskom-server-version (list (/ (server-info->version lyskom-server-info) 10000) (/ (% (server-info->version lyskom-server-info) 10000) 100) (% (server-info->version lyskom-server-info) 100))) (lyskom-setup-client-for-server-version) (lyskom-format-insert 'connection-done (if (zerop (elt lyskom-server-version 2)) (format "%d.%d" (elt lyskom-server-version 0) (elt lyskom-server-version 1)) (format "%d.%d.%d" (elt lyskom-server-version 0) (elt lyskom-server-version 1) (elt lyskom-server-version 2)))) (if (not (zerop (server-info->motd-of-lyskom lyskom-server-info))) (let ((text (blocking-do 'get-text (server-info->motd-of-lyskom lyskom-server-info)))) (lyskom-insert (if text (text->text-mass text) (lyskom-get-string 'lyskom-motd-was-garbed))) (lyskom-insert "\n"))) ;; Can't use lyskom-end-of-command here. (setq lyskom-executing-command nil) ;; Log in (kom-start-anew t) (if (memq lyskom-buffer lyskom-buffer-list) (while (not (eq lyskom-buffer (car lyskom-buffer-list))) (setq lyskom-buffer-list (nconc (cdr lyskom-buffer-list) (list (car lyskom-buffer-list))))) (setq lyskom-buffer-list (cons lyskom-buffer lyskom-buffer-list))) (setq init-done t)) ;; Something went wrong. Lets cleanup everything. :-> (if init-done nil (if proc (delete-process proc)) (unless reused-buffer (kill-buffer buffer)))))))) (defun lyskom-setup-client-check-version (spec version) (let ((relation (elt spec 0)) (major (elt spec 1)) (minor (elt spec 2)) (revision (elt spec 3))) (cond ((eq relation '=) (and (or (null major) (= major (elt version 0))) (or (null minor) (= minor (elt version 1))) (or (null revision) (= revision (elt version 2))))) ((eq relation '>=) (or (and (= (elt version 0) major) (= (elt version 1) minor) (>= (elt version 2) revision)) (and (= (elt version 0) major) (> (elt version 1) minor)) (and (> (elt version 0) major)))) ((eq relation '<) (or (and (= (elt version 0) major) (= (elt version 1) minor) (< (elt version 2) revision)) (and (= (elt version 0) major) (< (elt version 1) minor)) (and (< (elt version 0) major))))))) (defun lyskom-setup-client-for-server-version () "Set up the supports list and flags for the current server. See variable documentation for lyskom-server-feautres" (let ((result nil) (flags nil)) (mapcar (function (lambda (spec) (let ((spec-version (elt spec 0)) (plist (elt spec 1))) (if (and (lyskom-setup-client-check-version spec-version lyskom-server-version)) (mapcar (function (lambda (x) (cond ((consp x) (setq result (cons x result))) ((symbolp x) (setq flags (cons x flags))) (t (setq result (cons (cons x t) result)))))) plist))))) lyskom-server-features) (mapcar (function (lambda (x) (set x t))) flags) (setq lyskom-server-supports result))) (defun lyskom-connect-filter (proc output) "Receive connection acknowledgement from server." (if lyskom-debug-communications-to-buffer (lyskom-debug-insert proc "-----> " output)) (cond ((string-match "^LysKOM\n" output) (set-process-filter proc 'lyskom-filter)))) ;;; ================================================================ ;;; Start anew (defun kom-start-anew (&optional lyskom-first-time-around) "Start as a new person." (interactive) (lyskom-start-of-command 'kom-start-anew) (lyskom-completing-clear-cache) (let ((old-me lyskom-pers-no) (login-successful nil)) (unwind-protect (progn (if lyskom-first-time-around nil (lyskom-tell-internat 'kom-tell-login)) (setq lyskom-pers-no nil) (while (not lyskom-pers-no) (if (and lyskom-first-time-around lyskom-default-user-name) ;; This is nil if we can't find a unique match. (setq lyskom-pers-no (conf-z-info->conf-no (lyskom-lookup-conf-by-name lyskom-default-user-name '(pers))))) (if lyskom-pers-no nil (let ((name (lyskom-read-conf-name (lyskom-get-string 'what-is-your-name) '(pers none) t "" t))) (setq lyskom-pers-no (or (conf-z-info->conf-no (lyskom-lookup-conf-by-name name '(pers))) (lyskom-create-new-person name))))) ;; Now lyskom-pers-no contains a number of a person. ;; Lets log him in. (if lyskom-pers-no (let ((conf-stat (blocking-do 'get-conf-stat lyskom-pers-no)) (lyskom-inhibit-minibuffer-messages t)) ;; DEBUG (if (null conf-stat) (lyskom-insert "You don't exist. Go away.\n")) (lyskom-insert (concat (conf-stat->name conf-stat) "\n")) (setq lyskom-first-time-around nil) (if (blocking-do 'login lyskom-pers-no (if lyskom-default-password (prog1 lyskom-default-password (setq lyskom-default-password nil) (set-default 'lyskom-default-password nil)) ;; Use password read when creating ;; the person when loggin in new ;; users (or lyskom-is-new-user (silent-read (lyskom-get-string 'password))))) (progn (if lyskom-is-new-user (blocking-do 'add-member (server-info->conf-pres-conf lyskom-server-info) lyskom-pers-no 100 1)) (setq login-successful t)) (lyskom-insert-string 'wrong-password) (setq lyskom-pers-no nil)) (setq lyskom-is-new-user nil)))) ;; Now we are logged in. (lyskom-insert-string 'are-logged-in) (let ((conf-stat (blocking-do 'get-conf-stat lyskom-pers-no))) (if (and conf-stat (/= (conf-stat->msg-of-day conf-stat) 0)) (progn (lyskom-insert-string 'you-have-motd) (let ((lyskom-show-comments ; +++SOJGE (not kom-no-comments-to-motd))) (lyskom-view-text (conf-stat->msg-of-day conf-stat))))) (if (and conf-stat (zerop (conf-stat->presentation conf-stat)) (not (zerop (conf-stat->no-of-texts conf-stat)))) (lyskom-insert-string 'presentation-encouragement))) (if (not lyskom-dont-read-user-area) (lyskom-read-options)) (lyskom-run-hook-with-args 'lyskom-change-conf-hook lyskom-current-conf 0) (setq lyskom-current-conf 0) (lyskom-refetch) ;; (cache-initiate-who-info-buffer (blocking-do 'who-is-on)) (cache-set-marked-texts (blocking-do 'get-marks)) ;; What is this variable? It is never used. It is ust to ;; fill the cache? (let ((lyskom-who-am-i (blocking-do 'who-am-i))) (if lyskom-who-am-i (setq lyskom-session-no lyskom-who-am-i)))) ;; If something failed, make sure we are someone (if login-successful (clear-all-caches) (setq lyskom-pers-no old-me)) (setq lyskom-is-new-user nil) (lyskom-end-of-command))) ;; Run the hook kom-login-hook. We don't want to hang the ;; login, just because something crashed here. (condition-case err (progn (run-hooks 'lyskom-login-hook) (run-hooks 'kom-login-hook)) (error (lyskom-format-insert-before-prompt 'error-in-login-hook (format "%s" err)))) (unless (eq lyskom-language kom-default-language) (when (lyskom-set-language kom-default-language) (lyskom-format-insert-before-prompt 'changing-language-to (lyskom-language-name kom-default-language))))) (defun lyskom-refetch () "Resets and fetches all reading info. This is called at login and after prioritize and set-unread." ;; +++PREFETCH+++ ;; The whole membership! ;; (lyskom-set-membership (blocking-do 'get-membership lyskom-pers-no)) ;; (setq lyskom-membership-is-read t) ;; (setq lyskom-unread-confs (blocking-do 'get-unread-confs lyskom-pers-no)) (setq lyskom-membership nil) (lyskom-reset-prefetch) (lyskom-start-prefetch) (lyskom-prefetch-membership lyskom-pers-no) (setq lyskom-to-do-list (lyskom-create-read-list)) (setq lyskom-reading-list (lyskom-create-read-list))) (defun lyskom-set-membership (membership) "Sets lyskom-membership to a new value. Args: MEMBERSHIP." (setq lyskom-membership (sort (listify-vector membership) 'lyskom-membership-<)) (setq lyskom-membership-is-read t)) (defun lyskom-print-name (conf-stat) "Print the name of the CONF-STAT, with a trailing \n." (lyskom-insert (concat (conf-stat->name conf-stat) "\n"))) (defun lyskom-extract-persons (conf-list) "Extract persons from a conf-list. Return a list of pers-nos of all conferences that are persons. Args: CONF-LIST." (lyskom-do-extract-persons-or-confs conf-list t)) (defun lyskom-extract-confs (conf-list) "Extract conferences from a conf-list. Return a list of conf-nos of all conferences that are persons. Args: CONF-LIST." (lyskom-do-extract-persons-or-confs conf-list nil)) (defun lyskom-do-extract-persons-or-confs (conf-list want-persons) "Extract persons or conferences from CONF-LIST. WANT-PERSONS is t for persons, nil for confs." (let* ((result nil) (i 0) (nos (conf-list->conf-nos conf-list)) (types (conf-list->conf-types conf-list)) (len (length nos))) (while (< i len) (cond ((eq (conf-type->letterbox (elt types i)) want-persons) (setq result (cons (elt nos i) result)))) (++ i)) (nreverse result))) (defun lyskom-create-new-person (name) "A new user named NAME (or an old that mis-spelled his name)." (lyskom-insert (lyskom-format 'first-greeting name)) (lyskom-scroll) (cond ((ja-or-nej-p (lyskom-format 'is-name-correct name)) (let ((password (silent-read (lyskom-get-string 'personal-password)))) (cond ((not (equal password (silent-read (lyskom-get-string 'repeat-password)))) ;; Failed to enter the same password twice (lyskom-insert-string 'repeat-failure) nil) (t ;; Entered the same password twice (let ((new-person (blocking-do 'create-person name password))) (if (null new-person) (lyskom-insert-string 'could-not-create-you) ;; Raise a flag so the user will be added to the ;; presentation conference after login (setq lyskom-is-new-user password)) new-person))))) (t ;; Do not create a new person nil))) ;;(defun lyskom-start-anew-create-handler (pers-no name password) ;; "A new person has been created. Log in as him." ;; (cond ;; ((null pers-no) ;; (lyskom-insert-string 'could-not-create-you) ;; (setq lyskom-executing-command nil) ;; (kom-start-anew)) ;; (t ;; (initiate-login 'main 'lyskom-add-for-new-person ;; pers-no password pers-no lyskom-pers-no) ;; ))) ;;(defun lyskom-add-for-new-person (reply pers-no lyskom-pers-no) ;; "Add a news person as member in the default presentation conference." ;; (initiate-add-member 'main 'lyskom-start-anew-login-2 ;; (server-info->conf-pres-conf lyskom-server-info) ;; pers-no 100 1 ;; pers-no lyskom-pers-no)) (defun lyskom-read-server-name (prompt) "Read the name of a LysKOM server. Copmpletion is done on the servers i kom-server-aliases. If an alias name is entered, the corresponding address is returned." ;; Create a completion table like ;; (("kom.lysator.liu.se" . "kom.lysator.liu.se") ;; ("LysKOM" . "kom.lysator.liu.se")) (let ((known-servers (append (mapcar (function (lambda (pair) (cons (car pair) (car pair)))) kom-server-aliases) (mapcar (function (lambda (pair) (cons (cdr pair) (car pair)))) kom-server-aliases))) (completion-ignore-case t) server) (setq server (completing-read prompt known-servers nil nil)) (or (cdr (assoc server known-servers)) server))) ;;; ================================================================ ;;; The LysKOM mode. ;; The LysKOM mode should not be inherited if we create a new buffer ;; and default-major-mode is nil. (put 'lyskom-mode 'mode-class 'special) (defun lyskom-mode () "\\Mode for LysKOM client. Commands: \\[kom-next-command] Do the default action. This can be to read the next text,select n ext conference with unread texts or whatever the prompt says. \\[kom-go-to-conf] Go to a conference. LysKOM will ask you for a conference and make you a member of it if you are not already. \\[kom-list-conferences] List conferences matching a given string. \\[kom-list-persons] List persons matching a given string. \\[kom-list-news] List the conferences you have unread texts in. \\[kom-go-to-next-conf] Go to the next conference with unread texts. \\[kom-membership] Display a buffer with the list of conferences you are member in. \\[kom-quit] Leave this LysKOM session. \\[kom-who-is-on] Show a list of all the users of lyskom right now. \\[kom-extended-command] Read a command using the minibuffer and execute it. This is another way to give commands. \\[kom-write-text] Start writing a new text. \\[kom-write-comment] Start writing a comment to the last read article. \\[kom-private-answer] Start writing a personal answer to the author of the last read article. \\[kom-send-letter] Start writing a letter to a person or conference. \\[kom-page-next-command] Clear the page and do what \\[kom-next-command] does. \\[kom-line-next-command] Do what \\[kom-next-command] does, but scroll at most 1 line. 0 .. 9 Give a numeric argument to the next command. \\[describe-mode] Display this help text. \\[kom-busy-wait] Put the lyskom-session in wait mode. The next created text with a priotity higher that that of the next conference you are going to will be read directly when it is created. \\[kom-set-unread] Mark a number of texts as unread. \\[kom-jump] Skip (mark as read) all the comments to this article recursively. \\[kom-display-time] Show the current date and time. \\[kom-change-presentation] Change your presentation. \\[kom-view] View the specified text. \\[kom-view-commented-text] View the text that the current text comments or is a footnote to. \\[kom-review-presentation] Show the presentation for a person or a conferencce. \\[kom-review-comments] View all comments to the current text. \\[kom-review-tree] View all comments to the current text and step through the tree in depth-first order. \\[kom-find-root-review] View the complete comment tree. \\[kom-find-root] Show the root text of this comment tree. \\[kom-review-by-to] View the last (first or all) article written by named author in a named conference. \\[kom-mark-text] Create a mark on a text. \\[kom-unmark-text] Remove the mark on a text. \\[kom-review-marked-texts] View all text marked with a certain mark. \\[kom-review-all-marked-texts] View all marked text. \\[kom-view-next-new-text] Read the next text from the list of unread. \\[kom-review-next] Continue the viewing. \\[kom-review-stack] Show the stack of things we are viewing. \\[kom-review-clear] Clear the stack of things we are viewing. \\[kom-review-backward] Toggles the read order of reviewed texts. This can only be done when viewing texts with \\[kom-review-by-to], \\[kom-review-marked-texts] and \\[kom-review-all-marked-texts]. \\[kom-status-conf] Show the status of a conference. \\[kom-status-person] Show the status of a person \\[kom-save-text] Save the text you are looking at to a file. \\[kom-get-abuse] Get an insulting text. \\[kom-get-appreciation] Get an encouraging text. \\[kom-add-self] Become a member of a conference. \\[kom-sub-self] Removes you as a member of a conference. All bindings (this is here due to the fact that inconsistensies while developping this package are frequent): \\{lyskom-mode-map} Entry to this mode runs lyskom-mode-hook. Functions and variables beginning with kom- are intended for the user to see, set or call. Functions and variables beginning with lyskom- are not intended for the user to see, set of call." (interactive) (lyskom-clear-vars) (setq mode-line-buffer-identification (list (concat (lyskom-mode-name-from-host) ": ") 'mode-line-conf-name)) (setq major-mode 'lyskom-mode) (setq mode-name "LysKOM") (setq mode-line-process (lyskom-get-string 'mode-line-working)) (use-local-map lyskom-mode-map) (lyskom-set-menus 'lyskom-mode lyskom-mode-map) (run-hooks 'lyskom-mode-hook) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t)) (defun lyskom-clear-vars () "Set up buffer-local vars." (lyskom-save-variables (lyskom-proc lyskom-pers-no lyskom-membership lyskom-membership-is-read lyskom-last-viewed lyskom-unparsed-buffer lyskom-unparsed-marker lyskom-server-info lyskom-server-name) (kill-all-local-variables)) (lyskom-setup-local-variables) (setq lyskom-do-when-done (cons kom-do-when-done kom-do-when-done)) (setq lyskom-output-queues (make-vector 10 nil)) (setq lyskom-collate-table lyskom-default-collate-table) (let ((i 0)) (while (< i 10) (aset lyskom-output-queues i (lyskom-queue-create)) (setq i (1+ i)))) (setq lyskom-pending-calls nil) (lyskom-set-mode-line (lyskom-get-string 'not-present-anywhere))) ; (let ((proc lyskom-proc) ; (pers-no lyskom-pers-no) ; (membership lyskom-membership) ; (membership-is-read lyskom-membership-is-read) ; (last-viewed lyskom-last-viewed) ; (replies-buffer lyskom-unparsed-buffer) ; (replies-marker lyskom-unparsed-marker) ; (server-info lyskom-server-info) ; (server-name lyskom-server-name) ; ) ; (kill-all-local-variables) ; (make-local-variable 'kom-ansaphone-show-messages) ; (make-local-variable 'kom-ansaphone-record-messages) ; (make-local-variable 'kom-ansaphone-on) ; (make-local-variable 'kom-ansaphone-default-reply) ; (make-local-variable 'kom-friends) ; (make-local-variable 'kom-login-hook) ; (make-local-variable 'kom-membership-default-priority) ; (make-local-variable 'kom-permanent-filter-list) ; (make-local-variable 'kom-user-prompt-format) ; (make-local-variable 'kom-user-prompt-format-executing) ; (make-local-variable 'kom-enabled-prompt-format) ; (make-local-variable 'kom-enabled-prompt-format-executing) ; (make-local-variable 'kom-remote-control) ; (make-local-variable 'kom-remote-controllers) ; (make-local-variable 'kom-session-filter-list) ; (make-local-variable 'lyskom-accept-async-flag) ; (make-local-variable 'lyskom-blocking-return) ; (make-local-variable 'lyskom-buffer) ; (make-local-variable 'lyskom-command-to-do) ; (make-local-variable 'lyskom-conf-cache) ; (make-local-variable 'lyskom-count-var) ; (make-local-variable 'lyskom-current-conf) ; (make-local-variable 'lyskom-current-subject) ; (make-local-variable 'lyskom-current-text) ; (make-local-variable 'lyskom-default-password) ; (make-local-variable 'lyskom-default-user-name) ; (make-local-variable 'lyskom-do-when-done) ; (make-local-variable 'lyskom-dynamic-session-info-flag) ; (make-local-variable 'lyskom-dont-change-prompt) ; (make-local-variable 'lyskom-errno) ; (make-local-variable 'lyskom-executing-command) ; (make-local-variable 'lyskom-filter-list) ; (make-local-variable 'lyskom-idle-time-flag) ; (make-local-variable 'lyskom-is-administrator) ; (make-local-variable 'lyskom-is-parsing) ; (make-local-variable 'lyskom-is-waiting) ; (make-local-variable 'lyskom-is-writing) ; (make-local-variable 'lyskom-language) ; (make-local-variable 'lyskom-last-group-message-recipient) ; (make-local-variable 'lyskom-last-personal-message-sender) ; (make-local-variable 'lyskom-last-viewed) ; (make-local-variable 'lyskom-list-of-edit-buffers) ; (make-local-variable 'lyskom-long-conf-types-flag) ; (make-local-variable 'lyskom-marked-text-cache) ; (make-local-variable 'lyskom-membership) ; (make-local-variable 'lyskom-membership-is-read) ; (make-local-variable 'lyskom-current-prompt) ; (make-local-variable 'lyskom-normally-read-texts) ; (make-local-variable 'lyskom-number-of-pending-calls) ; (make-local-variable 'lyskom-options-done) ; (make-local-variable 'lyskom-other-clients-user-areas) ; (make-local-variable 'lyskom-output-queues) ; (make-local-variable 'lyskom-pending-calls) ; (make-local-variable 'lyskom-pending-prefetch) ; (make-local-variable 'lyskom-pers-cache) ; (make-local-variable 'lyskom-pers-no) ; (make-local-variable 'lyskom-prefetch-conf-tresh) ; (make-local-variable 'lyskom-prefetch-confs) ; (make-local-variable 'lyskom-prefetch-in-action) ; (make-local-variable 'lyskom-prefetch-pending-prefetch) ; (make-local-variable 'lyskom-prefetch-stack) ; (make-local-variable 'lyskom-prefetch-texts) ; (make-local-variable 'lyskom-previous-text) ; (make-local-variable 'lyskom-prioritize-buffer) ; (make-local-variable 'lyskom-proc) ; (make-local-variable 'lyskom-reading-list) ; (make-local-variable 'lyskom-server-info) ; (make-local-variable 'lyskom-server-name) ; (make-local-variable 'lyskom-server-version) ; (make-local-variable 'lyskom-server-supports) ; (make-local-variable 'lyskom-long-conf-types-flag) ; (make-local-variable 'lyskom-set-last-read-flag) ; (make-local-variable 'lyskom-uconf-stats-flag) ; (make-local-variable 'lyskom-z-lookup-flag) ; (make-local-variable 'lyskom-session-no) ; (make-local-variable 'lyskom-session-priority) ; (make-local-variable 'lyskom-text-cache) ; (make-local-variable 'lyskom-text-mass-cache) ; (make-local-variable 'lyskom-to-be-printed-before-prompt) ; (make-local-variable 'lyskom-to-do-list) ; (make-local-variable 'lyskom-unparsed-buffer) ; (make-local-variable 'lyskom-unparsed-marker) ; (make-local-variable 'lyskom-unread-confs) ; (make-local-variable 'lyskom-what-i-am-doing) ; (make-local-variable 'lyskom-who-info-buffer) ; (make-local-variable 'lyskom-who-info-buffer-is-on) ; (make-local-variable 'lyskom-who-info-cache) ; (make-local-variable 'lyskom-collate-table) ; (make-local-variable 'mode-line-conf-name) ; (make-local-variable 'lyskom-mode-map) ; (make-local-variable 'lyskom-edit-mode-map) ; (make-local-variable 'lyskom-filter-edit-map) ; (make-local-variable 'lyskom-prioritize-mode-map) ; (make-local-variable 'lyskom-customize-map) ; (setq lyskom-proc proc) ; (setq lyskom-pers-no pers-no) ; (setq lyskom-membership membership) ; (setq lyskom-last-viewed last-viewed) ; (setq lyskom-membership-is-read membership-is-read) ; (setq lyskom-unparsed-buffer replies-buffer) ; (setq lyskom-unparsed-marker replies-marker) ; (setq lyskom-server-info server-info) ; (setq lyskom-server-name server-name) ; (setq lyskom-do-when-done (cons kom-do-when-done kom-do-when-done)) ; (setq lyskom-output-queues (make-vector 10 nil)) ; (setq lyskom-collate-table lyskom-default-collate-table) ; (let ((i 0)) ; (while (< i 10) ; (aset lyskom-output-queues i (lyskom-queue-create)) ; (++ i))) ; (setq lyskom-list-of-edit-buffers nil) ; (setq lyskom-pending-calls nil) ; (lyskom-set-mode-line (lyskom-get-string 'not-present-anywhere)))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: reading.el,v 44.3.4.2 1999/10/13 12:13:25 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: reading.el ;;;; ;;;; This file contains functions that manage membership and reading ;;;; lists, namely lyskom-membersip lyskom-reading-list and ;;;; lyskom-to-do-list. These are called both from prefetch and from ;;;; startup procedures. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: reading.el,v 44.3.4.2 1999/10/13 12:13:25 byers Exp $\n")) (defun lyskom-enter-map-in-to-do-list (map conf-stat membership) "Takes a MAP and enters all its listed text-nos in the conference CONF-STAT. This works by modifying the lyskom-to-do-list which in some cases also means modifying the lyskom-reading-list. The zero text-nos are skipped." (let ((list (lyskom-list-unread map membership))) (if (null list) nil (read-list-enter-read-info (lyskom-create-read-info 'CONF conf-stat (membership->priority (lyskom-try-get-membership (conf-stat->conf-no conf-stat))) (lyskom-create-text-list list)) lyskom-to-do-list)))) (defun lyskom-add-memberships-to-membership (memberships) "Adds a newly fetched MEMBERSHIP-PART to the list in lyskom-membership. If an item of the membership is already read and entered in the lyskom-membership list then this item is not entered." (let ((list (listify-vector memberships))) (while list (if (memq (membership->conf-no (car list)) (mapcar (function membership->conf-no) lyskom-membership)) nil (setq lyskom-membership (append lyskom-membership (list (car list))))) (setq list (cdr list))))) (defun lyskom-insert-membership (membership membership-list) "Add MEMBERSHIP into MEMBERSHIP-LIST, sorted by priority." (setq lyskom-membership (sort (cons membership lyskom-membership) 'lyskom-membership-<))) (defun lyskom-replace-membership (membership membership-list) "Find the membership for the same conference as MEMBERSHIP, and replaceit with MEMBERSHIP into MEMBERSHIP-LIST." (let ((conf-no (membership->conf-no membership)) (list lyskom-membership)) (while list (if (= conf-no (membership->conf-no (car list))) (progn (setcar list membership) (setq list nil)) (setq list (cdr list))))) (lyskom-run-hook-with-args 'lyskom-replace-membership-hook membership membership-list)) (defun lyskom-remove-membership (conf-no membership-list) "Remove the membership for CONF-NO from MEMBERSHIP-LIST." (let ((list lyskom-membership)) (while list (if (= conf-no (membership->conf-no (car list))) (progn (setcar list nil) (setq list nil)) (setq list (cdr list))))) (setq lyskom-membership (delq nil lyskom-membership)) (lyskom-run-hook-with-args 'lyskom-remove-membership-hook conf-no membership-list)) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: internal.el,v 44.1.2.2 1999/10/13 12:13:10 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: internal.el ;;;; ;;;; Here are internal functions that handles the different kom-queue ;;;; calls. Add a call, apply the handler when a call is done. ;;;; ;;;; Originally written: ceder ;;;; Completely rewritten: Inge Wallin ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: internal.el,v 44.1.2.2 1999/10/13 12:13:10 byers Exp $\n")) ;;;; ================================================================ ;;;; Variables. (defvar lyskom-call-data nil "This is an assoc-list of data for the kom-queues. Each element on the list has the following format: (NAME . KOM-QUEUE) NAME is an atom, the name of the kom-queue. A kom-queue is a way to send questions to the LysKOM server and deal with the replies in a controlled way. KOM-QUEUE is a kom-queue.") (make-variable-buffer-local 'lyskom-call-data) ;;; ================================================================ ;;; Data type kom-queue ;;; ;;; Each kom-queue consists of the following 4 fields: ;;; PENDING - ;;; a list where each element represents a call to a service on ;;; the server, or a call to lyskom-collect, lyskom-use or ;;; lyskom-run. The elements are lists. The first element on each ;;; list is a key to what it represents, as described below. ;;; COLLECT-FLAG - ;;; t means this queue is collecting results for a future ;;; lyskom-use of lyskom-list-use. The results are collected ;;; on collect-queue ;;; COLLECT-QUEUE - ;;; This is where the results described above are collected. ;;; HALTED - ;;; An integer counting the number of times this queue is halted. ;;; A call to lyskom-halt increments this counter, a call to ;;; lyskom-resume decrements it. ;;; ;;; ;;; The items on PENDING is one of the following: ;;; ;;; ('CALL REF-NO PARSER PARSER-DATA HANDLER HANDLER-DATA) ;;; A call that has not yet returned. ;;; ;;; ('PARSED RESULT HANDLER HANDLER-DATA) ;;; A call that has returned, but the result can not be ;;; handled until all previous calls has returned. ;;; ;;; ('COLLECT) ;;; Marks the start of a sequence of results that will be ;;; handled by a multi-handler or multi-list-handler. ;;; ;;; ('COLLECT-IGNORE) ;;; Marks the start of a sequence of results that will be ;;; handled by a multi-handler of multi-list-handler with ;;; errors stripped away. ;;; ;;; ('USE MULTI-HANDLER MULTI-HANDLER-DATA) ;;; Marks the end of a sequence. MULTI-HANDLER is called ;;; when all calls before this element have been handled. ;;; MULTI-HANDLER is a function whose first arguments are ;;; the results from calls between previous COLLECT and ;;; this USE. MULTI-HANDLER-DATA is optional. If it ;;; exists it is a list of more arguments to send to ;;; MULTI-HANDLER. ;;; ;;; ('LIST-USE MULTI-HANDLER MULTI-HANDLER-DATA) ;;; Marks the end of a sequence. MULTI-HANDLER is called ;;; when all calls before this element have been handled. ;;; MULTI-HANDLER is a function whose first argument is a ;;; list of all results from calls between previous ;;; COLLECT and this LIST-USE. MULTI-HANDLER-DATA is ;;; optional. If it exists it is a list of more arguments ;;; to send to MULTI-HANDLER. ;;; ;;; ('RUN FUNCTION FUNCTION-ARGS) ;;; Run FUNCTION when all calls before this have been handled. ;;; (defun kom-queue-create () "Creates a new instance of an empty kom-queue." (vector (lyskom-queue-create) nil (lyskom-queue-create) 0)) (defun kom-queue->pending (queue) "Returns the pending field of the kom-queue QUEUE." (elt queue 0)) (defun kom-queue->collect-flag (queue) "Returns the collect-flag field of the kom-queue QUEUE." (elt queue 1)) (defun kom-queue->collect-queue (queue) "Returns the collect-queue field of the kom-queue QUEUE." (elt queue 2)) (defun set-kom-queue-collect-flag (queue new-val) "Set the collect-flag field of the kom-queue QUEUE to NEW-VAL." (aset queue 1 new-val)) (defun kom-queue-halt (queue) "Halts the kom-queue QUEUE." (aset queue 3 (1+ (elt queue 3)))) (defun kom-queue-resume (queue) "Resume execution on the kom-queue QUEUE." (if (eq (elt queue 3) 0) (signal 'lyskom-internal-error (list "kom-queue-resume called on an unhalted queue: " queue)) (aset queue 3 (1- (elt queue 3))))) (defun kom-queue-is-halted (queue) "Return t if the kom-queue QUEUE is halted at least once." (> (elt queue 3) 0)) ;;; ================================================================ ;;; Entry points to this communication packet. (defun lyskom-collect (kom-queue) "Collect the results of future calls via KOM-QUEUE. The results of the calls will be available to the multi-handler. See lyskom-use and lyskom-list-use." (lyskom-call-add kom-queue 'COLLECT)) (defun lyskom-collect-ignore-err (kom-queue) "Collect the result of future calls via KOM-QUEUE. The result of the calls will be available to the multi-handler with the calls producing errors stripped." (lyskom-call-add kom-queue 'COLLECT-IGNORE)) (defun lyskom-use (kom-queue multi-handler &rest multi-handler-data) "Use the previously collected results from calls to the server. Args: KOM-QUEUE MULTI-HANDLER &rest MULTI-HANDLER-DATA MULTI-HANDLER is a function that is called when all previous results have been handled. MULTI-HANDLER-DATA is a list of additional arguments the multi-handler wants. See also lyskom-list-use." (lyskom-call-add kom-queue 'USE multi-handler multi-handler-data) (lyskom-check-call kom-queue)) (defun lyskom-list-use (kom-queue multi-handler &rest multi-handler-data) "Use the previously collected results from calls to the server. Args: KOM-QUEUE MULTI-HANDLER &rest MULTI-HANDLER-DATA MULTI-HANDLER is a function that is called when all previous results have been handled. The first argument is a list of the results. MULTI-HANDLER-DATA is a list of additional arguments the multi-handler wants. The difference between lyskom-use and lyskom-list-use is the way the MULTI-HANDLER receives the data. lyskom-list-use sends them as a list, lyskom-use as different parameters." (lyskom-call-add kom-queue 'LIST-USE multi-handler multi-handler-data) (lyskom-check-call kom-queue)) (defun lyskom-run (kom-queue function &rest function-args) "Call a function when all calls have been handled. Args: KOM-QUEUE FUNCTION &rest FUNCTION-ARGS Register a FUNCTION that shall be called with FUNCTION-ARGS when all previous calls to the server via KOM-QUEUE have been handled." (lyskom-call-add kom-queue 'RUN function function-args) (lyskom-check-call kom-queue)) (defun lyskom-halt (queue-name) "Prohibit execution of handlers on QUEUE-NAME. The execution will resume when (lyskom-resume KOM-QUEUE) is called." (let ((queue-pair (assoc queue-name lyskom-call-data))) (if (null queue-pair) (setq queue-pair (lyskom-add-new-queue queue-name))) (kom-queue-halt (cdr queue-pair)))) (defun lyskom-resume (kom-queue) "Resume execution of waiting handlers on KOM-QUEUE. See documentation for lyskom-halt." (let ((queue (assoc kom-queue lyskom-call-data))) (cond ((null queue) ;A new kom-queue? (signal 'lyskom-internal-error (list "lyskom-resume called on an unused queue:" kom-queue))) ((kom-queue-is-halted (cdr queue)) ;A halted queue? (kom-queue-resume (cdr queue)) ;Resume execution on the queue. (lyskom-check-call kom-queue)) ;Run any pending handlers. (t ;The queue was not halted. This (signal 'lyskom-internal-error ;is an error. (list "lyskom-resume:" kom-queue "(not halted)")))))) (defun lyskom-call (kom-queue ref-no handler handler-data parser &rest parser-data) "Add information about a call that has not yet returned to kom-queue. Arguments: KOM-QUEUE REF-NO HANDLER HANDLER-DATA PARSER &rest PARSER-DATA." (lyskom-call-add kom-queue 'CALL ref-no parser parser-data handler handler-data)) (defun lyskom-fake-call (kom-queue ref-no handler handler-data) "Add information about a call that will not return from the server, but will be filled in by some other function." (lyskom-call-add kom-queue 'CALL ref-no nil nil handler handler-data)) (defun lyskom-complete-call (kom-queue ref-no result) "Force a call placed on KOM-QUEUE with reference number REF-NO to return RESULT. This should only be used to complete calls placed on the queue using lyskom-fake-call, or the parser might get confused." (let ((call-info (lyskom-locate-ref-no kom-queue ref-no))) (if call-info (progn (lyskom-tr-call-to-parsed call-info result) (lyskom-check-call kom-queue))))) ;;; This is used by z-initiate-get-map, which is not used. ;;; This was a temporary solution. ;;(defun lyskom-kom-queue-collect-p (queue-name) ;; "Return t if the kom-queue QUEUE-NAME has an unmatched 'COLLECT item. ;;It is illegal to call lyskom-collect or lyskom-collect-ignore-err on ;;the kom-queue if and only if this function returns t." ;; (let* ((queue (cdr-safe (assoc queue-name lyskom-call-data))) ;; (pending (lyskom-queue->all-entries (kom-queue->pending queue))) ;; (collect-flg nil) ;; (type nil)) ;; (while (and queue pending) ;; (setq type (car (car pending))) ;; (setq pending (cdr pending)) ;; (cond ;; ((eq type 'COLLECT) ;; (setq collect-flg t)) ;; ((eq type 'COLLECT-IGNORE) ;; (setq collect-flg t)) ;; ((eq type 'USE) ;; (setq collect-flg nil)) ;; ((eq type 'LIST-USE) ;; (setq collect-flg nil)))) ;; collect-flg)) ;;;; ================================================================ ;;;; Internal functions. (defun lyskom-add-new-queue (queue-name) "Add QUEUE-NAME to lyskom-call-data as an empty queue. Return a dotted pair consisting of the QUEUE-NAME and the new queue." (let ((new-queue-list (list (cons queue-name (kom-queue-create))))) (if (null lyskom-call-data) (setq lyskom-call-data new-queue-list) (nconc lyskom-call-data new-queue-list)) (car new-queue-list))) (defun lyskom-set-queue-priority (queue-name priority) (put queue-name 'lyskom-queue-priority priority)) (defun lyskom-queue-priority (queue-name) (or (get queue-name 'lyskom-queue-priority) 0)) (defun lyskom-call-add (queue-name type &rest data) "Add an entry to the kom-queue QUEUE-NAME. The entry is of type TYPE and third argument DATA contains the rest of the necessary data." (let ((queue (assoc queue-name lyskom-call-data))) (if (null queue) (setq queue (lyskom-add-new-queue queue-name))) (lyskom-queue-enter (kom-queue->pending (cdr queue)) (cons type data)))) (defun lyskom-send-packet (kom-queue string) "Send a packet to the server. Add info on lyskom-pending-calls. Update lyskom-ref-no. Args: KOM-QUEUE STRING." ;; Queue it (lyskom-queue-enter (aref lyskom-output-queues (lyskom-queue-priority kom-queue)) (cons lyskom-ref-no string)) (setq lyskom-pending-calls (cons (cons lyskom-ref-no kom-queue) lyskom-pending-calls)) (++ lyskom-ref-no) ;; Send something from the output queues (lyskom-check-output-queues)) (defun lyskom-check-output-queues () "Check for pending calls to the server. Send calls from queues with higher priority first, and make sure that at most lyskom-max-pending-calls are sent to the server at the same time." (catch 'done (let ((i 9)) (while (< lyskom-number-of-pending-calls lyskom-max-pending-calls) (while (lyskom-queue-isempty (aref lyskom-output-queues i)) (-- i) (if (< i 0) (throw 'done nil))) (let ((entry (lyskom-queue-delete-first (aref lyskom-output-queues i)))) (++ lyskom-number-of-pending-calls) (lyskom-process-send-string lyskom-proc (concat (number-to-string (car entry)) (cdr entry) "\n"))))))) (defun lyskom-decrease-pending-calls () "A reply has come. Send a pending call or decrease lyskom-number-of-pending-calls." (-- lyskom-number-of-pending-calls) (if (< lyskom-number-of-pending-calls 0) (setq lyskom-number-of-pending-calls 0)) (lyskom-check-output-queues)) (defun lyskom-process-send-string (process string) "Send PROCESS the contents of STRING. STRING is split in several parts if the operating system can't deal with big strings." (let ((tries 0)) (while (condition-case err (progn (lyskom-process-send-string-2 process string) nil) (file-error (if lyskom-debug-communications-to-buffer (lyskom-debug-insert process "Error: " (format "%s" err)) ;;; (save-excursion ;;; (set-buffer (get-buffer-create ;;; lyskom-debug-communications-to-buffer-buffer)) ;;; (save-excursion ;;; (goto-char (point-max)) ;;; (insert "\n" ;;; (format "%s" process) ;;; (concat "Error: " (format "%s" err)))) ;;; (set-buffer (process-buffer process))) ) (cond ((and (string= "writing to process" (car (cdr err))) (or (string= "message too long" (car (cdr (cdr err)))) (string= "no more processes" (car (cdr (cdr err))))) (> lyskom-max-packet-size 1)) ;; Seems to be impossible to write too long strings to TCP/IP. ;; This happens on a Sequence Balance with packets longer than ;; 2048 bytes. Decrease lyskom-max-packet-size and retry. (setq lyskom-max-packet-size (/ lyskom-max-packet-size 2)) t) ((and (string= "writing to process" (car (cdr err))) (string= "host is unreachable" (car (cdr (cdr err))))) ;; The net is currently shaky. We try again in a while. (lyskom-message "%s" (lyskom-format 'shaky-tcp (make-string (++ tries) ?.))) (sit-for 4) (lyskom-message "%s" (lyskom-get-string 'retrying-tcp)) t) (t ;; It was some unknown file-error. Pass it down. (signal (car err) (cdr err))))))))) (defun lyskom-process-send-string-2 (process string) "Send PROCESS the contents of STRING as input. PROCESS may be a process name. At most lyskom-max-packet-size bytes is sent with each packet. If STRING is longer it is splitted." (cond ((<= (length string) lyskom-max-packet-size) (process-send-string process (progn (if lyskom-debug-communications-to-buffer (lyskom-debug-insert process ">>>>>> " string)) string))) (t (let ((i 0)) (while (< i (length string)) (process-send-string process (let ((string (substring string i (min (length string) (+ i lyskom-max-packet-size))))) (if lyskom-debug-communications-to-buffer (save-excursion (set-buffer (get-buffer-create lyskom-debug-communications-to-buffer-buffer)) (save-excursion (goto-char (point-max)) (insert "\n" (format "%s" process) (concat ">>>>>> " string))) (set-buffer (process-buffer process)))) string)) (setq i (+ i lyskom-max-packet-size))))))) (defun lyskom-check-call (queue-name) "Check lyskom-call-data and call handlers, multi-handlers and functions. Args: QUEUE-NAME. HALTED -> stop CALL -> stop PARSED -> handle -> -> collect-flag? 'COLLECT -> add on temporary resultlist. 'COLLECT-IGNORE -> add on temporary resultlist if not error. no -> delete from lyskom-call-data. COLLECT -> collect-flag? yes -> error! no -> set collect-flag. COLLECT-IGNORE -> collect-flag? yes -> error! no -> set collect-flag. USE -> call handler. Delete previous parts. LIST-USE -> call handler. Delete previous parts. RUN -> call function. Delete. Not allowed inside COLLECT/USE." (let* ((queue (cdr-safe (assoc queue-name lyskom-call-data))) (type nil) (first-pending (lyskom-queue->first (kom-queue->pending queue)))) (while (and queue (not (or (kom-queue-is-halted queue) (lyskom-queue-isempty (kom-queue->pending queue)) (eq (car first-pending) 'CALL)))) (setq type (car first-pending)) (cond ((eq type 'PARSED) (kom-queue-halt queue) (unwind-protect (lyskom-apply-handler first-pending) (kom-queue-resume queue)) (if (or (eq (kom-queue->collect-flag queue) 'COLLECT) (and (eq (kom-queue->collect-flag queue) 'COLLECT-IGNORE) (car (cdr first-pending)))) (lyskom-queue-enter (kom-queue->collect-queue queue) (car (cdr first-pending))))) ((eq type 'COLLECT) (if (kom-queue->collect-flag queue) (signal 'lyskom-internal-error '("lyskom-check-call COLLECT.")) (set-kom-queue-collect-flag queue 'COLLECT) (lyskom-queue-make-empty (kom-queue->collect-queue queue)))) ((eq type 'COLLECT-IGNORE) (if (kom-queue->collect-flag queue) (signal 'lyskom-internal-error '("lyskom-check-call COLLECT-IGNORE.")) (set-kom-queue-collect-flag queue 'COLLECT-IGNORE) (lyskom-queue-make-empty (kom-queue->collect-queue queue)))) ((eq type 'USE) (if (not (kom-queue->collect-flag queue)) (signal 'lyskom-internal-error '("lyskom-check-call USE."))) (kom-queue-halt queue) (unwind-protect (lyskom-apply-multi-handler first-pending (lyskom-queue->all-entries (kom-queue->collect-queue queue))) (kom-queue-resume queue)) (set-kom-queue-collect-flag queue nil)) ((eq type 'LIST-USE) (if (not (kom-queue->collect-flag queue)) (signal 'lyskom-internal-error '("lyskom-check-call LIST-USE."))) (kom-queue-halt queue) (unwind-protect (lyskom-apply-multi-list-handler first-pending (lyskom-queue->all-entries (kom-queue->collect-queue queue))) (kom-queue-resume queue)) (set-kom-queue-collect-flag queue nil)) ((eq type 'RUN) (if (kom-queue->collect-flag queue) (signal 'lyskom-internal-error '("lyskom-check-call RUN."))) (kom-queue-halt queue) (unwind-protect (lyskom-apply-function first-pending) (kom-queue-resume queue))) (t (signal 'lyskom-internal-error (list 'lyskom-check-call "unknown key:" (car first-pending))))) (lyskom-queue-delete-first (kom-queue->pending queue)) (setq first-pending (lyskom-queue->first (kom-queue->pending queue)))))) ;;; Quit is NOT ok to press while the handler is running. inhibit-quit ;;; should be t when these are called. (defun lyskom-apply-handler (pending) "Apply a handler. Args: PENDING. PENDING is an entry of the list as described in documentation for the variable lyskom-call-data. The car on the list must be a PARSED: ('PARSED RESULT HANDLER HANDLER-DATA)" (if (car (cdr (cdr pending))) (apply (car (cdr (cdr pending))) ;Handler (car (cdr pending)) ;Result (car (cdr (cdr (cdr pending))))))) ;Handler-data (defun lyskom-apply-multi-handler (pending result-list) "Apply a handler for a lyskom-collect - lyskom-use construct." (apply (car (cdr pending)) ;Multi-handler (nconc result-list (car (cdr (cdr pending)))))) ;Multi-handler-data (defun lyskom-apply-multi-list-handler (pending result-list) "Apply a handler for a lyskom-collect - lyskom-list-use construct." (apply (car (cdr pending)) ;Multi-handler (cons result-list (car (cdr (cdr pending)))))) ;Multi-handler-data (defun lyskom-apply-function (pending) (setcar pending 'HALTED) (apply (car (cdr pending)) ;Function. (car (cdr (cdr pending))))) ;Function-args. ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: services.el,v 44.8.2.2 1999/10/13 12:13:28 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; This file contains functions for sending requests to the server ;;;; and parsing the result. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: services.el,v 44.8.2.2 1999/10/13 12:13:28 byers Exp $\n")) ;;; ================================================================ ;;; Macro for defining services ;;; (defmacro def-kom-service (name args &rest body) ;;; "Create an initiate call. NAME and ARGS are the name and arguments for the call. ;;; If BODY starts with a string, that is the documentation string. ;;; If BODY consists of (call N PARSER), generate a simple call ;;; for RPC number N, and parse the result with PARSER." ;;; (let ((function-name (intern (concat "initiate-" (symbol-name name)))) ;;; (doc-string nil) ;;; (auto-call nil) ;;; (buffer-save (intern (format "initiate-%s-saved-buffer" name)))) ;;; (when (stringp (car body)) ;;; (setq doc-string (car body)) ;;; (setq body (cdr body))) ;;; ;;; (when (and (listp (car body)) ;;; (eq 'call (car (car body)))) ;;; (setq auto-call (car body)) ;;; (setq body (cdr body))) ;;; ;;; (` (defun (, function-name) (kom-queue handler (,@ args) &rest data) ;;; (, ;;; (or doc-string ;;; (format "Initiate %S on server\nArgs: KOM-QUEUE HANDLER %s &rest DATA" ;;; name (mapconcat ;;; (function ;;; (lambda (x) ;;; (format "%s" (upcase (symbol-name x))))) ;;; args ;;; " ")))) ;;; (let (((, buffer-save) (current-buffer))) ;;; (unwind-protect ;;; (progn ;;; (and (not lyskom-output-queues) (set-buffer lyskom-buffer)) ;;; (,@ (if auto-call ;;; (` ((lyskom-call kom-queue lyskom-ref-no handler data (quote (, (elt auto-call 2)))) ;;; (lyskom-send-packet kom-queue (lyskom-format-objects (, (elt auto-call 1)) (,@ args))))) ;;; body))) ;;; (set-buffer (, buffer-save)))))))) (defmacro lyskom-server-call (&rest body) "Macro to protect initiate-somethings from being called in the wrong buffer." (` (let ((initiate-something-saved-buffer (current-buffer))) (unwind-protect (progn (or lyskom-output-queues (set-buffer lyskom-buffer)) (,@ body)) (set-buffer initiate-something-saved-buffer))))) (put 'lyskom-server-call 'lisp-indent-function 0) ;;; ================================================================ ;;; Requests for services (defun initiate-login (kom-queue handler pers-no password &rest data) "Log in on server. Args: KOM-QUEUE HANDLER PERS-NO PASSWORD &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 0 pers-no password)))) (defun initiate-login-new (kom-queue handler pers-no password status &rest data) "Log in on server. Args: KOM-QUEUE HANDLER PERS-NO PASSWORD STATUS &rest DATA. Status is 0 for visible login and 1 for invisible login." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 62 pers-no password status)))) (defun initiate-logout (kom-queue handler &rest data) "Log out from server. Args: KOM-QUEUE HANDLER &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 1)))) (defun initiate-pepsi (kom-queue handler conf-no &rest data) "Change working conference. Args: KOM-QUEUE HANDLER CONF-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 2 conf-no)))) (defun initiate-change-name (kom-queue handler conf-no new-name &rest data) "Change the name of a conference. Args: KOM-QUEUE HANDLER CONF-NO NEW-NAME &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 3 conf-no new-name)))) (defun initiate-change-what-i-am-doing (kom-queue handler what &rest data) "Tell server what you are doing. Args: KOM-QUEUE HANDLER WHAT &rest DATA. WHAT is a string." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 4 what)))) (defun initiate-create-person (kom-queue handler name password &rest data) "Create a new person. Args: KOM-QUEUE HANDLER NAME PASSWORD &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-num) (lyskom-send-packet kom-queue (lyskom-format-objects 5 name password)))) ;;; Call 6 is get-person-stat-old, and is obsoleted by call 49. (defun initiate-set-priv-bits (kom-queue handler pers-no priv-bits &rest data) "Set priv-bits of a person. Args: KOM-QUEUE HANDLER PERS-NO PRIV-BITS &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 7 pers-no priv-bits)))) (defun initiate-set-passwd (kom-queue handler pers-no old-pw new-pw &rest data) "Set the password of a person. Args: KOM-QUEUE HANDLER PERS-NO OLD-PW NEW-PW &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 8 pers-no old-pw new-pw)))) ;;; ;;; This function has a ridiculous name! It ought to be called ;;; get-membership. Unfortunately this name is already taken ;;; by another call. ;;; (defun initiate-query-read-texts (kom-queue handler pers-no conf-no &rest data) "Get a membership struct describing the membership of PERS-NO in CONF-NO. Args: KOM-QUEUE HANDLER PERS-NO CONF-NO &rest DATA" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-membership) (lyskom-send-packet kom-queue (lyskom-format-objects 9 pers-no conf-no)))) (defun initiate-create-conf (kom-queue handler conf-name conf-type &rest data) "Add a member to a conference. Args: KOM-QUEUE HANDLER CONF-NAME CONF-TYPE &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-num) (lyskom-send-packet kom-queue (lyskom-format-objects 10 conf-name conf-type)))) (defun initiate-delete-conf (kom-queue handler conf-no &rest data) "Delete a conference. Args: KOM-QUEUE HANDLER CONF-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 11 conf-no)))) (defun initiate-lookup-name (kom-queue handler name &rest data) "See what conferences match NAME. Args: KOM-QUEUE HANDLER NAME &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-conf-list) (lyskom-send-packet kom-queue (lyskom-format-objects 12 name)))) ;;; Call 13 is get-conf-stat-old, which is obsoleted by 50. (defun initiate-add-member (kom-queue handler conf-no pers-no priority where &rest data) "Add a member to a conference. Args: KOM-QUEUE HANDLER CONF-NO PERS-NO PRIORITY WHERE &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 14 conf-no pers-no priority where)))) (defun initiate-sub-member (kom-queue handler conf-no pers-no &rest data) "Subtract a member from a conference. Args: KOM-QUEUE HANDLER CONF-NO PERS-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 15 conf-no pers-no)))) (defun initiate-set-presentation (kom-queue handler conf-no text-no &rest data) "Set presentation of a conference. Args: KOM-QUEUE HANDLER CONF-NO TEXT-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 16 conf-no text-no)))) (defun initiate-set-conf-motd (kom-queue handler conf-no text-no &rest data) "Set motd of a conference. Args: KOM-QUEUE HANDLER CONF-NO TEXT-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 17 conf-no text-no)))) (defun initiate-set-user-area (kom-queue handler pers-no text-no &rest data) "Set user-area of a person. Args: KOM-QUEUE HANDLER PERS-NO TEXT-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 57 pers-no text-no)))) (defun initiate-set-supervisor (kom-queue handler conf-no admin &rest data) "Set supervisor of a conference. Args: KOM-QUEUE HANDLER CONF-NO ADMIN &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 18 conf-no admin)))) (defun initiate-set-permitted-submitters (kom-queue handler conf-no perm-sub &rest data) "Set permitted submitters of a conference. Args: KOM-QUEUE HANDLER CONF-NO PERM-SUB &rest DATA. PERM-SUB is a conference number. All members in that conference might write texts in CONF-NO. If PERM-SUB is zero everyone is allowed to write texts in CONF-NO." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 19 conf-no perm-sub)))) (defun initiate-set-super-conf (kom-queue handler conf-no super-conf &rest data) "Set superconference of a conference. Args: KOM-QUEUE HANDLER CONF-NO SUPER-CONF &rest DATA. Unauthorized attempts to write texts to CONF-NO will bounce to SUPER-CONF." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 20 conf-no super-conf)))) (defun initiate-set-conf-type (kom-queue handler conf-no conf-type &rest data) "Set type of a conference. Args: KOM-QUEUE HANDLER CONF-NO CONF-TYPE &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 21 conf-no conf-type)))) (defun initiate-set-garb-nice (kom-queue handler conf-no garb-nice &rest data) "Set garb-nice of a conference. Args: KOM-QUEUE HANDLER CONF-NO GARB-NICE &rest DATA. Texts in CONF-NO will live approximately GARB-NICE days." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 22 conf-no garb-nice)))) (defun initiate-get-marks (kom-queue handler &rest data) "Get all marked texts. Args: KOM-QUEUE HANDLER &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-mark-list) (lyskom-send-packet kom-queue (lyskom-format-objects 23)))) (defun initiate-mark-text (kom-queue handler text-no mark-type &rest data) "Mark a text. Args: KOM-QUEUE HANDLER TEXT-NO MARK-TYPE &rest DATA. MARK-TYPE is currently a number, but this should maybe be changed (internally in the elisp-klient) to something similar to a conf-type (with several bits that are 't' or 'nil' that is)." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 24 text-no mark-type)))) (defun initiate-find-next-text-no (kom-queue handler text-no &rest data) "Find the text following the text TEXT-NO" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-num) (lyskom-send-packet kom-queue (lyskom-format-objects 60 text-no)))) (defun initiate-find-previous-text-no (kom-queue handler text-no &rest data) "Find the text preceding the text TEXT-NO" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-num) (lyskom-send-packet kom-queue (lyskom-format-objects 61 text-no)))) (defun initiate-get-text (kom-queue handler text-no &rest data) "Get text from LysKOM server. Args: KOM-QUEUE HANDLER TEXT-NO &rest DATA." (lyskom-server-call (let ((text (cache-get-text text-no))) (cond ((null text) ;Cached info? (lyskom-call kom-queue ;No, ask the server. lyskom-ref-no handler data 'lyskom-parse-text text-no) ;(princ text-no (get-buffer-create "text"))+++ ;(terpri (get-buffer-create "text")) (lyskom-send-packet kom-queue (lyskom-format-objects 25 text-no 0 lyskom-max-int))) (t ;Cached info. (lyskom-call-add kom-queue 'PARSED text handler data) (lyskom-check-call kom-queue)))))) (defun initiate-get-text-stat (kom-queue handler text-no &rest data) "Get text-stat from LysKOM server. Args: KOM-QUEUE HANDLER TEXT-NO &rest DATA." (lyskom-server-call (let ((text-stat (cache-get-text-stat text-no))) (cond ((null text-stat) ;Cached info? (lyskom-call kom-queue ;No, ask the server. lyskom-ref-no handler data 'lyskom-parse-text-stat text-no) ;(princ text-no (get-buffer-create "text-stat"))+++ ;(terpri (get-buffer-create "text-stat")) (lyskom-send-packet kom-queue (lyskom-format-objects 26 text-no))) (t ;Cached info. (lyskom-call-add kom-queue 'PARSED text-stat handler data) (lyskom-check-call kom-queue)))))) (defun initiate-mark-as-read (kom-queue handler conf-no text-list &rest data) "Mark all texts in TEXT-LIST as read in CONF-NO. Args: CONF-NO TEXT-LIST." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 27 conf-no (cons 'LIST text-list))))) (defun initiate-create-text (kom-queue handler message misc-list &rest data) "Create a new text. Args: KOM-QUEUE HANDLER MESSAGE MISC-LIST &rest DATA. MESSAGE is a string. MISC-LIST should be created by lyskom-create-misc-list." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-num) (lyskom-send-packet kom-queue (lyskom-format-objects 28 message misc-list)))) (defun initiate-create-anonymous-text (kom-queue handler message misc-list &rest data) "Create a new anonymous text. Args: KOM-QUEUE HANDLER MESSAGE MISC-LIST &rest DATA. MESSAGE is a string. MISC-LIST should be created by lyskom-create-misc-list." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-num) (lyskom-send-packet kom-queue (lyskom-format-objects 59 message misc-list)))) (defun initiate-delete-text (kom-queue handler text-no &rest data) "Delete a text. Args: KOM-QUEUE HANDLER TEXT-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 29 text-no)))) (defun initiate-add-recipient (kom-queue handler text-no conf-no type &rest data) "Add a recipient to a text. Args: KOM-QUEUE HANDLER TEXT-NO CONF-NO TYPE &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 30 text-no conf-no (cond ((eq type 'recpt) 0) ((eq type 'cc-recpt) 1) ((eq type 'bcc-recpt) (if lyskom-bcc-flag 15 1))))))) (defun initiate-sub-recipient (kom-queue handler text-no conf-no &rest data) "Subtract a recipient from a text. Args: KOM-QUEUE HANDLER TEXT-NO CONF-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 31 text-no conf-no)))) (defun initiate-add-comment (kom-queue handler comment-text-no text-no &rest data) "Add a comment to a text. Args: KOM-QUEUE HANDLER COMMENT-TEXT-NO TEXT-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 32 comment-text-no text-no)))) (defun initiate-sub-comment (kom-queue handler comment-text-no text-no &rest data) "Subtract a comment from a text. Args: KOM-QUEUE HANDLER COMMENT-TEXT-NO TEXT-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 33 comment-text-no text-no)))) (defun initiate-get-map (kom-queue handler conf-no first-local no-of-texts &rest data-list) "Get mapping from local to global text-nos for CONF-NO from server. Args: KOM-QUEUE HANDLER CONF-NO FIRST-LOCAL NO-OF-TEXTS DATA-LIST. Use initiate-get-map instead. This function has severe performance losses with big maps." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data-list 'lyskom-parse-map) (lyskom-send-packet kom-queue (lyskom-format-objects 34 conf-no first-local no-of-texts)))) (defun z-initiate-get-map (kom-queue handler conf-no first-local no-of-texts &rest data) "Get mapping from local to global text-nos for CONF-NO from server. Args: KOM-QUEUE HANDLER CONF-NO FIRST-LOCAL NO-OF-TEXTS &rest DATA. This function will automatically split fetching of big maps to small chunks of lyskom-fetch-map-nos texts/chunk if KOM-QUEUE is not already used to collect a result. This currently gives a big performance gain. Unfortunately it is impossible (or at least very hard) to do the same thing when a collect is in progress. This will of course be fixed in protocol B." (lyskom-server-call (cond ((kom-queue->collect-flag (cdr-safe (assq kom-queue lyskom-call-data))) ;; Use oldstyle single big map. Sorry. (apply 'initiate-get-map kom-queue handler conf-no first-local no-of-texts data)) (t ;; You win. (initiate-get-map kom-queue 'lyskom-receive-partial-map conf-no first-local lyskom-fetch-map-nos (+ lyskom-fetch-map-nos first-local) (- no-of-texts lyskom-fetch-map-nos) conf-no nil kom-queue data handler))))) (defun lyskom-receive-partial-map (map first-local no-of-texts conf-no map-so-far kom-queue data-list handler) "Receive a partial map and start fetching a new chunk." (lyskom-server-call (let ((map-list (nconc map-so-far (list map)))) (if (<= no-of-texts 0) (apply handler (apply 'lyskom-map-concat map-list) data-list) (initiate-get-map kom-queue 'lyskom-receive-partial-map conf-no first-local lyskom-fetch-map-nos (+ lyskom-fetch-map-nos first-local) (- no-of-texts lyskom-fetch-map-nos) conf-no map-list kom-queue data-list handler))))) (defun initiate-get-time (kom-queue handler &rest data) "Get time from server. Args: KOM-QUEUE HANDLER &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-time) (lyskom-send-packet kom-queue (lyskom-format-objects 35)))) (defun initiate-get-server-info (kom-queue handler &rest data) "Get info about the server" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-server-info) (lyskom-send-packet kom-queue (lyskom-format-objects 36)))) (defun initiate-add-footnote (kom-queue handler footnote-text-no text-no &rest data) "Add a footnote to a text. Args: KOM-QUEUE HANDLER FOOTNOTE-TEXT-NO TEXT-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 37 footnote-text-no text-no)))) (defun initiate-sub-footnote (kom-queue handler footnote-text-no text-no &rest data) "Subtract a footnote from a text. Args: KOM-QUEUE HANDLER FOOTNOTE-TEXT-NO TEXT-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 38 footnote-text-no text-no)))) ;;; Call 39, who-is-on-old, is obsoleted by call 51. (defun initiate-set-unread (kom-queue handler conf-no no-of-unread &rest data) "Set number of unread texts in a certain conference. Args: KOM-QUEUE HANDLER CONF-NO NO-OF-UNREAD &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 40 conf-no no-of-unread)))) (defun initiate-set-motd-of-lyskom (kom-queue handler text-no &rest data) "Set message of the day of LysKOM. Args: KOM-QUEUE HANDLER TEXT-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 41 text-no)))) (defun initiate-enable (kom-queue handler level &rest data) "Set security level. Args: KOM-QUEUE HANDLER LEVEL &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 42 level)))) ;;; Call 43 is sync. Starting with version 1.9 of lyskomd it is a ;;; privileged operation, so there is no harm in having the function ;;; easily available any more. (defun initiate-sync (kom-queue handler &rest data) "Sync the LysKOM datbase. This is a prioritized call." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 43)))) ;;; Call 44 is shutdown. Use 'kill -HUP' instead. (defun initiate-shutdown (kom-queue handler parameter &rest data) "Shutdown the server. Args: KOM-QUEUE HANDLER PARAMETER &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 44 parameter)))) (defun initiate-broadcast (kom-queue handler message &rest data) "Send a broadcast message to all logged in users. Args: KOM-QUEUE HANDLER MESSAGE &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 45 message)))) (defun initiate-get-membership (kom-queue handler pers-no &rest data) "Get membership-list for PERS-NO from server. Args: KOM-QUEUE HANDLER PERS-NO &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-membership-list) (lyskom-send-packet kom-queue (lyskom-format-objects 46 pers-no 0 lyskom-max-int ;all confs. 1)))) ;want read texts. (defun initiate-get-part-of-membership (kom-queue handler pers-no first length &rest data) "Get membership-list for PERS-NO from server. Args: KOM-QUEUE HANDLER PERS-NO FIRST-IN-LIST LENGHT &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-membership-list) (lyskom-send-packet kom-queue (lyskom-format-objects 46 pers-no first length ;all confs. 1)))) (defun initiate-get-created-texts (kom-queue handler pers-no first-local no-of-texts &rest data) "Get a part of the list of created texts for a person. Args: KOM-QUEUE HANDLER PERS-NO FIRST-LOCAL NO-OF-TEXTS &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-map) (lyskom-send-packet kom-queue (lyskom-format-objects 47 pers-no first-local no-of-texts)))) (defun initiate-get-members (kom-queue handler conf-no first-local no-of-members &rest data) "Get a part of the list of members in a conference. Args: KOM-QUEUE HANDLER CONF-NO FIRST-LOCAL NO-OF-MEMBERS &rest DATA. Returns a conf-no-list." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-conf-no-list) (lyskom-send-packet kom-queue (lyskom-format-objects 48 conf-no first-local no-of-members)))) (defun initiate-get-pers-stat (kom-queue handler pers-no &rest data) "Get status for person PERS-NO. Args: KOM-QUEUE HANDLER PERS-NO &rest DATA." (lyskom-server-call (let ((pers-stat (cache-get-pers-stat pers-no))) (cond ((null pers-stat) ;Cached info? (lyskom-call kom-queue ;No, ask the server. lyskom-ref-no handler data 'lyskom-parse-pers-stat pers-no) ;(princ pers-no (get-buffer-create "pers-stat")) +++ ;(terpri (get-buffer-create "pers-stat")) (lyskom-send-packet kom-queue (lyskom-format-objects 49 pers-no))) (t ;Cached info. (lyskom-call-add kom-queue 'PARSED pers-stat handler data) (lyskom-check-call kom-queue)))))) (defun initiate-get-conf-stat (kom-queue handler conf-no &rest data) "Get conf-stat from LysKOM server. Args: KOM-QUEUE HANDLER CONF-NO &rest DATA." (lyskom-server-call (let ((conf-stat (cache-get-conf-stat conf-no))) (cond ((zerop conf-no) ;No real user. (lyskom-call-add kom-queue 'PARSED nil handler data) (lyskom-check-call kom-queue)) ((null conf-stat) ;Cached info? (lyskom-call kom-queue ;No, ask the server. lyskom-ref-no handler data 'lyskom-parse-conf-stat conf-no) ;(princ conf-no (get-buffer-create "conf-stat")) +++ ;(terpri (get-buffer-create "conf-stat")) (lyskom-send-packet kom-queue (lyskom-format-objects 50 conf-no))) (t ;Cached info. (lyskom-call-add kom-queue 'PARSED conf-stat handler data) (lyskom-check-call kom-queue)))))) ;This might call the handler. (defun initiate-get-uconf-stat (kom-queue handler conf-no &rest data) "Get an uconf-sstat from LysKOM server. Args: KOM-QUEUE HANDLER CONF-NO &rest DATA." (lyskom-server-call (let ((conf-stat (cache-get-uconf-stat conf-no))) (cond ((zerop conf-no) (lyskom-call-add kom-queue 'PARSED nil handler data) (lyskom-check-call kom-queue)) ((null conf-stat) (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-uconf-stat conf-no) (lyskom-send-packet kom-queue (lyskom-format-objects 78 conf-no))) (t (lyskom-call-add kom-queue 'PARSED conf-stat handler data) (lyskom-check-call kom-queue)))))) ;; who-is-on is obsoleted by who-is-on-dynamic (83) i protocol version 9 (defun initiate-who-is-on (kom-queue handler &rest data) "Ask server who is on. Args: KOM-QUEUE HANDLER &rest DATA" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-who-info-list) (lyskom-send-packet kom-queue (lyskom-format-objects 51)))) (defun initiate-get-unread-confs (kom-queue handler pers-no &rest data) "Return a list of confs that may have unread texts. Args: KOM-QUEUE HANDLER PERS-NO &rest DATA. PERS-NO is the number of the person whos confs we are checking." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-conf-no-list) (lyskom-send-packet kom-queue (lyskom-format-objects 52 pers-no)))) (defun initiate-send-message (kom-queue handler recipient message &rest data) "Send a message to one or all logged in users. Args: KOM-QUEUE HANDLER RECIPIENT MESSAGE &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 53 recipient message)))) (defun initiate-get-session-info (kom-queue handler session-no &rest data) "Ask server for info about a session. Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-session-info) (lyskom-send-packet kom-queue (lyskom-format-objects 54 session-no)))) (defun initiate-disconnect (kom-queue handler session-no &rest data) "Disconnect a session. Args: KOM-QUEUE HANDLER SESSION &rest DATA" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 55 session-no)))) (defun initiate-who-am-i (kom-queue handler &rest data) "Ask the server which connection we are using. Args: KOM-QUEUE HANDLER &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-num) (lyskom-send-packet kom-queue (lyskom-format-objects 56)))) (defun initiate-set-client-version (kom-queue handler name version &rest data) "Tell the server to set the client name and version of this session." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 69 name version)))) (defun initiate-get-client-name (kom-queue handler session &rest data) "Tell the server to set the highest unread article in conference CONF-NO to TEXT-NO Args: KOM-QUEUE HANDLER CONF-NO TEXT-NO &rest DATA" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-string) (lyskom-send-packet kom-queue (lyskom-format-objects 70 session)))) (defun initiate-get-client-version (kom-queue handler session &rest data) "Tell the server to set the highest unread article in conference CONF-NO to TEXT-NO Args: KOM-QUEUE HANDLER CONF-NO TEXT-NO &rest DATA" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-string) (lyskom-send-packet kom-queue (lyskom-format-objects 71 session)))) (defun initiate-re-z-lookup (kom-queue handler regexp want-persons want-confs &rest data) "Perform a regexp lookup. Args: KOM-QUEUE HANDLER REGEXP WANT-PERSONS WANT-CONFS &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-conf-z-info-list) (lyskom-send-packet kom-queue (lyskom-format-objects 74 regexp want-persons want-confs)))) (defun initiate-get-version-info (kom-queue handler &rest data) "Perform a get-version-info vall. Args: KOM-QUEUE HANDLER &rest DATA" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-version-info) (lyskom-send-packet kom-queue (lyskom-format-objects 75)))) (defun initiate-lookup-z-name (kom-queue handler name want-persons want-confs &rest data) "Perform a z-lookup. Args: KOM-QUEUE HANDLER NAME WANT-PERSONS WANT-CONFS &rest DATA" (lyskom-server-call (if lyskom-z-lookup-flag (progn (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-conf-z-info-list) (lyskom-send-packet kom-queue (lyskom-format-objects 76 name want-persons want-confs))) (let ((ref-no lyskom-ref-no)) (lyskom-fake-call kom-queue ref-no handler data) (++ lyskom-ref-no) (initiate-lookup-name 'compat 'initiate-compat-lookup-z-name-2 name kom-queue ref-no want-persons want-confs))))) (defun initiate-compat-lookup-z-name-2 (result kom-queue ref-no want-persons want-confs) (lyskom-server-call (if (null result) (lyskom-complete-call kom-queue ref-no nil)) (let ((conf-nos (listify-vector (conf-list->conf-nos result))) (conf-types (listify-vector (conf-list->conf-types result)))) (lyskom-collect 'follow) (while conf-nos (if (or (and want-persons (conf-type->letterbox (car conf-types))) (and want-confs (not (conf-type->letterbox (car conf-types))))) (initiate-get-conf-stat 'follow nil (car conf-nos))) (setq conf-nos (cdr conf-nos)) (setq conf-types (cdr conf-types))) (lyskom-list-use 'follow 'initiate-compat-lookup-z-name-3 kom-queue ref-no)))) (defun initiate-compat-lookup-z-name-3 (conf-list kom-queue ref-no) (lyskom-server-call (lyskom-complete-call kom-queue ref-no (lyskom-create-conf-z-info-list (mapcar (function (lambda (conf-stat) (lyskom-create-conf-z-info (conf-stat->name conf-stat) (conf-stat->conf-type conf-stat) (conf-stat->conf-no conf-stat)))) conf-list))))) (defun initiate-set-last-read (kom-queue handler conf-no text-no &rest data) "Tell the server to set the highest unread article in conference CONF-NO to TEXT-NO Args: KOM-QUEUE HANDLER CONF-NO TEXT-NO &rest DATA" (lyskom-server-call (if lyskom-set-last-read-flag (progn (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 77 conf-no text-no))) (initiate-get-conf-stat kom-queue 'initiate-set-last-read-2 conf-no kom-queue handler conf-no text-no data)))) (defun initiate-set-last-read-2 (conf-stat kom-queue handler conf-no text-no data) (lyskom-server-call (let ((no-of-unread (- (1- (+ (conf-stat->first-local-no conf-stat) (conf-stat->no-of-texts conf-stat))) text-no))) (if (< no-of-unread 0) (setq no-of-unread 0)) (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 40 conf-no no-of-unread))))) (defun initiate-accept-async (kom-queue handler list &rest data) "Request asynchronous messages in LIST Args: KOM-QUEUE HANDLER LIST &rest DATA" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 80 (cons 'LIST list))))) (defun initiate-query-async (kom-queue handler &rest data) "Request information on which async messages are being sent. Args: KOM-QUEUE HANDLER &rest DATA" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-number-array) (lyskom-send-packet kom-queue (lyskom-format-objects 81)))) (defun initiate-user-active (kom-queue handler &rest data) "Notify the server that the user is active Args: KOM-QUEUE HANDLER &rest DATA." (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-void) (lyskom-send-packet kom-queue (lyskom-format-objects 82)))) (defun initiate-who-is-on-dynamic (kom-queue handler want-visible want-invisible active-last &rest data) "Ask server who is on. Args: KOM-QUEUE HANDLER WANT-VISIBLE WANT-INVISIBLE ACTIVE_LAST &rest DATA" (lyskom-server-call (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-dynamic-session-info-list) (lyskom-send-packet kom-queue (lyskom-format-objects 83 want-visible want-invisible active-last)))) (defun initiate-get-static-session-info (kom-queue handler session-no &rest data) "Ask server for info about a session. Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA" (lyskom-server-call (let ((info (cache-get-static-session-info session-no))) (cond ((null info) ; Not cached (lyskom-call kom-queue lyskom-ref-no handler data 'lyskom-parse-static-session-info session-no) (lyskom-send-packet kom-queue (lyskom-format-objects 84 session-no))) (t ; Cached (lyskom-call-add kom-queue 'PARSED info handler data) (lyskom-check-call kom-queue)))))) ;This might call the handler. ;;; ================================================================ ;; Blocking reading from server: (defvar lyskom-blocking-return nil "Return from blocking-do.") (defun blocking-return (retval) "Sets blocking variable." (setq lyskom-blocking-return retval)) (defun blocking-do (command &rest data) "Does the COMMAND agains the lyskom-server and returns the result. COMMAND is one lyskom-command \(like the initiate-* but the initiate- is stripped. DATA is the args to command. The cache is consulted when command is get-conf-stat, get-pers-stat or get-text-stat." ;; Here we could check if lyskom-blocking-return is non-nil, in ;; which case there is a bug in the code (save-excursion (set-buffer (or lyskom-buffer (process-buffer lyskom-proc))) ;; If this happens, we're in trouble (if lyskom-is-parsing (lyskom-really-serious-bug)) (let ((lyskom-blocking-return 'not-yet-gotten)) (apply (intern-soft (concat "initiate-" (symbol-name command))) 'blocking 'blocking-return data) (while (and (eq lyskom-blocking-return 'not-yet-gotten) (memq (process-status lyskom-proc) '(open run)) ;; The following test should probably be removed (not lyskom-quit-flag)) (lyskom-accept-process-output)) (if (or lyskom-quit-flag quit-flag) (signal 'quit nil)) (setq lyskom-quit-flag nil) lyskom-blocking-return))) (defun lyskom-wait-queue (queue) "Waits until all data on QUEUE has been processed" (save-excursion (set-buffer (or lyskom-buffer (process-buffer lyskom-proc))) (let ((lyskom-blocking-return 'not-yet-gotten)) (lyskom-run queue 'blocking-return (list t)) (while (and (eq lyskom-blocking-return 'not-yet-gotten) (not lyskom-quit-flag)) (lyskom-accept-process-output)) (if (or lyskom-quit-flag quit-flag) (progn (lyskom-insert-before-prompt (lyskom-get-string 'interrupted)) (signal 'quit nil))) (setq lyskom-quit-flag nil) lyskom-blocking-return))) (defvar lyskom-multiple-blocking-return nil "Return from blocking-do-multiple") (defun lyskom-blocking-do-multiple (call-list) (save-excursion (set-buffer (or lyskom-buffer (process-buffer lyskom-proc))) ;; If this happens, we're in trouble (if lyskom-is-parsing (lyskom-really-serious-bug)) (let ((lyskom-multiple-blocking-return 'not-yet-gotten)) (lyskom-collect 'blocking) (while call-list (apply (intern-soft (concat "initiate-" (symbol-name (car (car call-list))))) 'blocking nil (cdr (car call-list))) (setq call-list (cdr call-list))) (lyskom-use 'blocking 'lyskom-blocking-do-multiple-1) (while (and (eq lyskom-multiple-blocking-return 'not-yet-gotten) (memq (process-status lyskom-proc) '(open run)) (not lyskom-quit-flag)) (lyskom-accept-process-output)) (if lyskom-quit-flag (progn (setq lyskom-quit-flag nil) (lyskom-insert-before-prompt (lyskom-get-string 'interrupted)) (signal 'quit nil))) lyskom-multiple-blocking-return))) (defun lyskom-blocking-do-multiple-1 (&rest data) (setq lyskom-multiple-blocking-return data)) (provide 'lyskom-services) ;;; services.el ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: command.el,v 44.11.2.2 1999/10/13 12:12:52 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: command.el ;;;; ;;;; This file contains stuff regarding commands. ;;;; (eval-when-compile (require 'lyskom-vars "vars") (require 'lyskom-services "services") (require 'lyskom-language "language") (require 'lyskom-clienttypes "clienttypes")) ;;; ====================================================================== ;;; LysKOM user commands ;;; The new, blocking commands have a very similar structure ;;; ;;; (defun kom-cmd (args) ;;; "Documentation" ;;; (interactive "...") ;;; (lyskom-start-of-command 'kom-cmd) ;;; (unwind-protect ;;; (progn ...) ;;; (lyskom-end-of-command))) ;;; ;;; This can now be written as ;;; ;;; (def-kom-command kom-cmd (args) ;;; "Documentation" ;;; (interactive "...") ;;; ...) (defmacro def-kom-command (cmd args doc interactive-decl &rest forms) (let ((bufsym (intern (format "%S-start-buffer" cmd)))) (` (defun (, cmd) (, args) (, doc) (, interactive-decl) (lyskom-start-of-command (quote (, cmd))) (let (((, bufsym) (current-buffer))) (unwind-protect (condition-case nil (progn (,@ forms)) (quit (ding) (lyskom-insert-before-prompt (lyskom-get-string 'interrupted)))) (lyskom-save-excursion (when (buffer-live-p (, bufsym)) (set-buffer (, bufsym))) (lyskom-end-of-command)))))))) ;; ;; def-kom-emacs-command works like def-kom-command, but the template ;; is different. Commands defined this way will run as regular Emacs ;; commands when invoked outside of a LysKOM buffer. ;; ;; The variable -running-as-kom-command is non-nil when running ;; as a LysKOM command and nil otherwise. ;; ;; Note: this function catches *all* errors in lyskom-start-of-command ;; which may not be what you want, so be careful. ;; ;; ;; (defun kom-cmd (args) ;; "Documentation" ;; (interactive "...") ;; (let ((kom-cmd-running-as-kom-command nil)) ;; (condition-case nil ;; (progn (lyskom-start-of-command 'kom-cmd) ;; (setq kom-cmd-running-as-kom-command t)) ;; (error nil)) ;; (unwind-protect ;; (condition-case nil ;; (progn ...) ;; (quit (ding) ;; (lyskom-insert-before-prompt ;; (lyskom-get-string 'interrupted)))) ;; (and kom-cmd-running-as-kom-command (lyskom-end-of-command))))) ;; (defmacro def-kom-emacs-command (cmd args doc interactive-decl &rest forms) (let ((rsym (intern (concat (format "%S-running-as-kom-command" cmd)))) (bufsym (intern (format "%S-start-buffer" cmd)))) (` (defun (, cmd) (, args) (, doc) (, interactive-decl) (let (((, rsym) nil)) (condition-case nil (progn (lyskom-start-of-command (quote (, cmd))) (setq (, rsym) t)) (error nil)) (let (((, bufsym) (current-buffer))) (unwind-protect (condition-case nil (progn (,@ forms)) (quit (ding) (lyskom-insert-before-prompt (lyskom-get-string 'interrupted)))) (and (, rsym) (lyskom-save-excursion (when (buffer-live-p (, bufsym)) (set-buffer (, bufsym))) (lyskom-end-of-command)))))))))) (put 'def-kom-command 'edebug-form-spec '(&define name lambda-list [&optional stringp] ; Match the doc string, if present. ("interactive" interactive) def-body)) (put 'def-kom-emacs-command 'edebug-form-spec '(&define name lambda-list [&optional stringp] ; Match the doc string, if present. ("interactive" interactive) def-body)) ;;;; ================================================================ ;;;; User-level commands and functions. (defsubst lyskom-command-name (command) "Get the command name for the command COMMAND" (condition-case nil (lyskom-get-string command 'lyskom-command) (error nil))) (defun lyskom-ok-command (alternative administrator) "Returns non-nil if it is ok to do such a command right now." (if administrator (not (memq (cdr alternative) lyskom-admin-removed-commands)) (not (memq (cdr alternative) lyskom-noadmin-removed-commands)))) (defun kom-extended-command () "Read a LysKOM function name and call the function." (interactive) (let ((fnc (lyskom-read-extended-command current-prefix-arg))) (cond (fnc (call-interactively fnc)) (t (kom-next-command)))) ) (defun lyskom-read-extended-command (&optional prefix-arg) "Reads and returns a command" (let* ((completion-ignore-case t) (minibuffer-setup-hook minibuffer-setup-hook) (alternatives (mapcar (function (lambda (pair) (cons (cdr pair) (car pair)))) (lyskom-get-strings lyskom-commands 'lyskom-command))) (name nil) (prefix-text (cond ((eq prefix-arg '-) "- ") ((equal prefix-arg '(4)) "C-u ") ((integerp prefix-arg) (format "%d " prefix-arg)) ((and (consp prefix-arg) (integerp (car prefix-arg))) (format "%d " (car prefix-arg))) (t nil))) (prompt (if prefix-text (concat prefix-text (lyskom-get-string 'extended-command)) (lyskom-get-string 'extended-command)))) ;; (add-hook 'minibuffer-setup-hook ;; (function ;; (lambda () ;; (let ((table (make-char-table 'case-table))) ;; (set-char-table-parent table (current-case-table)) ;; (aset table ?\} 345) ;; (set-case-table table))))) (lyskom-with-lyskom-minibuffer (setq name (completing-read prompt alternatives ;; lyskom-is-administrator is buffer-local and ;; must be evalled before the call to ;; completing-read ;; Yes, this is not beautiful (list 'lambda '(alternative) (list 'lyskom-ok-command 'alternative lyskom-is-administrator)) t nil 'lyskom-command-history))) (cdr (lyskom-string-assoc name alternatives)))) (defun lyskom-start-of-command (function &optional may-interrupt) "This function is run at the beginning of every LysKOM command. It moves the cursor one line down, and +++ later it will tell the server that the previous text has been read. Argument FUNCTION is a string the string will be written in the buffer on start of the command. If it is a symbol it searches for the corresponding command name in lyskom-commands and writes this in the message buffer. If optional argument MAY-INTERRUPT is present and non-nil, don't signal an error if this call is interrupting another command. Special: if lyskom-is-waiting then we are allowed to break if we set lyskom-is-waiting nil. This function checks if lyskom-doing-default-command and lyskom-first-time-around are bound. The text entered in the buffer is chosen according to this" (if (not lyskom-proc) (lyskom-error "%s" (lyskom-get-string 'dead-session))) (if (and lyskom-is-waiting (listp lyskom-is-waiting)) (progn (setq lyskom-is-waiting nil) (lyskom-end-of-command))) (setq lyskom-is-waiting nil) (if (and lyskom-executing-command (not may-interrupt)) (lyskom-error "%s" (lyskom-get-string 'wait-for-prompt))) (if (not (and (boundp 'lyskom-doing-default-command) lyskom-doing-default-command)) (cond (lyskom-first-time-around) ((stringp function) (lyskom-insert function)) ((and function (symbolp function)) (let ((name (lyskom-command-name function))) (if name (lyskom-insert name))))) (save-excursion (if lyskom-current-prompt (let ((inhibit-read-only t)) (goto-char (point-max)) (beginning-of-line) (delete-region (point) (point-max))))) (lyskom-insert (lyskom-modify-prompt (cond ((stringp lyskom-current-prompt) lyskom-current-prompt) ((symbolp lyskom-current-prompt) (lyskom-get-string lyskom-current-prompt)) (t (format "%S" lyskom-current-prompt))) t))) (setq mode-line-process (lyskom-get-string 'mode-line-working)) (if (pos-visible-in-window-p (point-max)) (save-excursion (goto-char (point-max)) (lyskom-set-last-viewed))) (setq lyskom-executing-command t) (setq lyskom-current-command function) (setq lyskom-current-prompt nil) (lyskom-insert "\n") (if (and (eq (window-buffer (selected-window)) (current-buffer)) ;; (= (point) (point-max)) ) (progn (if (pos-visible-in-window-p (1- (point-max))) (goto-char (point-max))) (sit-for 0))) ; (lyskom-scroll) (run-hooks 'lyskom-before-command-hook) (if kom-page-before-command ;Nice with dumb terminals. (if (or (not (listp kom-page-before-command)) (memq function kom-page-before-command)) (recenter 1)))) (defun lyskom-end-of-command () "Print prompt, maybe scroll, prefetch info." (lyskom-save-excursion (message "") (while (and lyskom-to-be-printed-before-prompt (lyskom-queue->first lyskom-to-be-printed-before-prompt)) (if (not (bolp)) (lyskom-insert "\n")) (lyskom-insert (car (lyskom-queue->first lyskom-to-be-printed-before-prompt))) (lyskom-queue-delete-first lyskom-to-be-printed-before-prompt)) (setq lyskom-executing-command nil) (setq lyskom-current-command nil) (setq lyskom-current-prompt nil) ; Already set in s-o-c really (lyskom-scroll) (setq mode-line-process (lyskom-get-string 'mode-line-waiting)) (if (pos-visible-in-window-p (point-max) (selected-window)) (lyskom-set-last-viewed)) (lyskom-prefetch-and-print-prompt) (run-hooks 'lyskom-after-command-hook) (if lyskom-idle-time-flag (save-excursion (set-buffer lyskom-buffer) (initiate-user-active 'background nil))) (if kom-inhibit-typeahead (discard-input)) ;; lyskom-pending-commands should probably be a queue or a stack. (when lyskom-pending-commands (let ((command (car lyskom-pending-commands))) (setq lyskom-pending-commands (cdr lyskom-pending-commands)) (if (symbolp command) (call-interactively command) (eval command)))) (when lyskom-slow-mode (buffer-enable-undo)))) (provide 'lyskom-command) ;;; command.el ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: parse.el,v 44.12.2.2 1999/10/13 12:13:21 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: parse.el ;;;; ;;;; This file contains functions which parse replies from the ;;;; server. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: parse.el,v 44.12.2.2 1999/10/13 12:13:21 byers Exp $\n")) ;;; ================================================================ ;;; Errors that are handled of use while parsing (put 'lyskom-parse-incomplete 'error-conditions '(error lyskom-error lyskom-parse-incomplete)) (put 'lyskom-parse-incomplete 'error-message "LysKOM internal error: Parse incomplete.") ;;; ================================================================ ;;; Low-level parsing. (defun lyskom-string-skip-whitespace (string) "Return STRING omitting any leading whitespace." (let ((start (string-match "[^ \t\n\r]" string))) (cond ((null start) "") (t (substring string start))))) (defun lyskom-parse-skip-rest-of-token () "Skip to the next whitespace" (let ((c (lyskom-parse-char))) (while (not (or (= c ?\ ) (= c ?\n))) (setq c (lyskom-parse-char))))) (defun lyskom-parse-nonwhite-char () "Get next character, skipping whitespace, from lyskom-unparsed-buffer and increase lyskom-parse-pos. Signal lyskom-parse-incomplete if the buffer lyskom-unparsed-buffer is exhausted." (let ((char (lyskom-parse-char))) (while (or (= char ?\ ) (= char ?\n)) (setq char (lyskom-parse-char))) char)) (defun lyskom-parse-char () "Get next character from lyskom-unparsed-buffer and increase lyskom-parse-pos. Signal lyskom-parse-incomplete if the buffer lyskom-unparsed-buffer is exhausted." (cond ((< lyskom-parse-pos (point-max)) (prog1 (char-after lyskom-parse-pos) (++ lyskom-parse-pos))) (t (signal 'lyskom-parse-incomplete nil)))) (defun lyskom-expect-char (char) "Read past next non-white character, which must be equal to CHAR. Return nil, or signal lyskom-protocol-error if the first non-white character was not equal to CHAR." (if (/= char (lyskom-parse-nonwhite-char)) (signal 'lyskom-protocol-error (list "Expecting " char " but got " (char-after (1- lyskom-parse-pos)))) nil)) (defun lyskom-char-p (char) "Check if next token is CHAR (a character)." (string-match (format "\\`%c[ \t\n\r]" char) (lyskom-string-to-parse))) (defun lyskom-string-to-parse () "Return unparsed data as a string." (lyskom-string-skip-whitespace (buffer-substring lyskom-parse-pos (point-max)))) (defun lyskom-parse-num () "Parse the next token as a number. Signal lyskom-parse-incomplete if the number is not followed by whitespace. Signal lyskom-protocol-error if the next token is not a number." (goto-char lyskom-parse-pos) (cond ((looking-at "[ \n]*[0-9]+") (if (char-after (match-end 0)) (progn (setq lyskom-parse-pos (goto-char (match-end 0))) (string-to-int (match-string 0))) (signal 'lyskom-parse-incomplete nil))) ((looking-at "[ \n]*\\'") (goto-char (point-max)) (signal 'lyskom-parse-incomplete nil)) (t (signal 'lyskom-protocol-error (list "Expected number, got " (lyskom-string-to-parse))))) ) (defun lyskom-parse-string () "Parse next token as a string. Signal lyskom-parse-incomplete if the string is not complete. Signal lyskom-protocol-error if the next token is not a string." ;; Kludge to deal with leading spaces. (lyskom-parse-nonwhite-char) (setq lyskom-parse-pos (1- lyskom-parse-pos)) ;; End kludge. (let ((to-parse (lyskom-string-to-parse))) (cond ((string-match "\\`[0-9]*\\(\\|H\\)\\'" to-parse) (signal 'lyskom-parse-incomplete nil)) ((null (string-match "\\`[0-9]+H" to-parse)) (signal 'lyskom-protocol-error (list to-parse))) ;Not a legal string. (t (let ((end (match-end 0)) (len (string-to-int to-parse))) (setq lyskom-parse-pos (+ lyskom-parse-pos end)) (cond ((< (point-max) (+ lyskom-parse-pos len)) (setq lyskom-string-bytes-missing (- (+ lyskom-parse-pos len) (point-max))) (signal 'lyskom-parse-incomplete nil)) (t (prog1 (buffer-substring lyskom-parse-pos (+ lyskom-parse-pos len)) (setq lyskom-parse-pos (+ lyskom-parse-pos len)))))))))) (defun lyskom-parse-1-or-0 () "Parse next nonwhite char and return t if it was 1, nil if it was 0. Signal lyskom-protocol-error if it was neither 1 nor 0. Signal lyskom-parse-incomplete if there is no nonwhite char to parse." (let ((char (lyskom-parse-nonwhite-char))) (cond ((= char ?0) nil) ((= char ?1) t) (t (signal 'lyskom-protocol-error (list 'lyskom-parse-1-or-0 char lyskom-parse-pos (buffer-string))))))) (defun lyskom-parse-bitstring (default) "Parse a generic bit string" (let ((result nil) (char (lyskom-parse-nonwhite-char)) (continue t)) (while (and continue default) (cond ((eq char ?0) (setq result (cons nil result) default (cdr default) char (lyskom-parse-char))) ((eq char ?1) (setq result (cons t result) default (cdr default) char (lyskom-parse-char))) ((or (= char ?\ ) (= char ?\n)) ;; This occurs when the received string is shorter than ;; expected. (setq continue nil)) (t (signal 'lyskom-protocol-error (list 'lyskom-parse-bitstring char lyskom-parse-pos (buffer-string)))))) (if (not (or (eq char ?\ ) (eq char ?\n))) ;; This occurs when the received string is longer than ;; expected. (progn (lyskom-parse-skip-rest-of-token) (nreverse result)) (nconc (nreverse result) (copy-sequence default))))) (defun lyskom-parse-time () "Parse a time from server. Args: none." (lyskom-create-time (lyskom-parse-num) ;sec (lyskom-parse-num) ;min (lyskom-parse-num) ;hour (lyskom-parse-num) ;mday (lyskom-parse-num) ;mon (lyskom-parse-num) ;year (lyskom-parse-num) ;wday (lyskom-parse-num) ;yday (lyskom-parse-num))) ;isdst ;;; ================================================================ ;;; Skip tokens. (Used e g to skip unknown asynchronous messages.) (defun lyskom-skip-tokens (to-skip) "Skip next TO-SKIP tokens" (while (not (zerop to-skip)) (lyskom-skip-one-token) (-- to-skip))) (defun lyskom-skip-one-token () (let ((to-parse (lyskom-string-to-parse))) (cond ((string-match "\\`{" to-parse) ;Array/list? (lyskom-skip-array)) ((string-match "\\`*" to-parse) ;Empty array/list? (lyskom-parse-nonwhite-char)) ;Simply skip it. ((string-match "\\`[0-9]+H" to-parse) ;Hollerith string? (lyskom-parse-string)) ((string-match "\\`[0-9]+[ \t\n\r]" to-parse) ;Number? (lyskom-parse-num)) ((string-match "\\`[0-9]\\'" to-parse) ;Incomplete number? (signal 'lyskom-parse-incomplete nil)) (t (signal 'lyskom-protocol-error (list to-parse)))))) (defun lyskom-skip-array () (let ((to-parse (lyskom-string-to-parse))) (cond ((string-match "\\`}" to-parse)) (t (lyskom-skip-one-token) (lyskom-skip-array))))) ;;; ================================================================ ;;; Medium level parsing. Parse arrays, misc-info-lists ;;; and other complex LysKOM types. (defun lyskom-parse-vector (len parser) "Parse a vector with LEN elements. Each element is parsed by PARSER, a function that takes no arguments." (cond ((zerop len) (if (lyskom-char-p ?*) (lyskom-expect-char ?*) (lyskom-expect-char ?\{) (lyskom-expect-char ?\}))) ((lyskom-char-p ?*) (lyskom-expect-char ?*)) (t (lyskom-expect-char ?{) (prog1 (lyskom-fill-vector (make-vector len nil) parser) (lyskom-expect-char ?}))))) (defun lyskom-fill-vector (vector parser) "Fill a vector. Args: VECTOR PARSER. Fills in all elements in VECTOR. PARSER is called for each element and the result is assigned to the element." (let ((index 0) (len (length vector))) (while (< index len) (aset vector index (funcall parser)) (setq index (1+ index)))) vector) (defun lyskom-parse-conf-type () "Parse a conf-type. No args." (apply 'lyskom-create-conf-type (lyskom-parse-bitstring '(nil nil nil nil t nil nil nil)))) (defun lyskom-parse-privs () "Parse privileges. No args." (apply 'lyskom-create-privs (lyskom-parse-bitstring '(nil nil nil t t t nil nil nil nil nil nil nil nil nil nil)))) (defun lyskom-parse-flags () "Parse Personal_flags. No args." (apply 'lyskom-create-flags (lyskom-parse-bitstring '(nil nil nil nil nil nil nil nil)))) (defun lyskom-parse-misc-info-list () "Parse a misc-info-list." (let ((n (lyskom-parse-num)) ;Number of misc-items to parse. (char (lyskom-parse-nonwhite-char))) (cond ((= char ?*) ;Empty list. nil) ((= char ?{) ;Start of list. (prog1 (lyskom-parse-misc-info-list-sub n) (lyskom-expect-char ?}))) (t ;Error. (signal 'lyskom-protocol-error (list 'lyskom-parse-misc-info-list "Expected * or {, got " char)))))) (defun lyskom-parse-misc-info-list-sub (n) "Parse a misc-info list with N items." (let* ((result (list 'dummy)) (last result) (next-key (lyskom-parse-num)) (res)) (while (> n 0) (cond ((eq next-key 0) ;recpt (setq res (lyskom-parse-misc-recipient 'RECPT last n))) ((eq next-key 1) ;cc-recpt (setq res (lyskom-parse-misc-recipient 'CC-RECPT last n))) ((eq next-key 2) ;comm-to (setq res (lyskom-parse-misc-comm-to last n))) ((eq next-key 3) ;comm-in (setq res (lyskom-parse-misc-comm-in last n))) ((eq next-key 4) ;footn-to (setq res (lyskom-parse-misc-footn-to last n))) ((eq next-key 5) ;footn-in (setq res (lyskom-parse-misc-footn-in last n))) ((eq next-key 15) ;bcc-recpt (setq res (lyskom-parse-misc-recipient 'BCC-RECPT last n))) (t ;error! (signal 'lyskom-protocol-error (list 'lyskom-parse-misc-info-list-sub "Unknown misc-type " next-key)))) (setq n (car res)) (setq next-key (cdr res)) (setq last (cdr last))) (cdr result))) ;Don't return the dummy element. (defun lyskom-parse-misc-recipient (type last n) "Parse a recipient. Args: TYPE LAST N. TYPE is either RECPT, CC-RECPT or BCC-RECPT. LAST is a pointer to the last element on a misc-info-list. N is number of misc-items left to parse. Returns (cons n next-key)." (setcdr last (cons (lyskom-create-empty-misc-info) nil)) (let ((info (car (cdr last))) (next-key nil)) (set-misc-info->type info type) (set-misc-info->recipient-no info (lyskom-parse-num)) (setq n (1- n)) ;; A loc-no should follow. (if (/= 6 (lyskom-next-num n nil)) (signal 'lyskom-protocol-error '("No loc-no after recipient."))) (set-misc-info->local-no info (lyskom-parse-num)) (setq n (1- n)) ;; A rec-time might follow. (if (= 7 (setq next-key (lyskom-next-num n nil))) (progn (set-misc-info->rec-time info (lyskom-parse-time)) (setq n (1- n)) (setq next-key nil))) ;; A sent-by might follow. (if (= 8 (setq next-key (lyskom-next-num n next-key))) (progn (set-misc-info->sender info (lyskom-parse-num)) (setq n (1- n)) (setq next-key nil))) ;; A sent-at might follow. (if (= 9 (setq next-key (lyskom-next-num n next-key))) (progn (set-misc-info->sent-at info (lyskom-parse-time)) (setq n (1- n)) (setq next-key nil))) ;; Return n and next-key. (cons n (lyskom-next-num n next-key)))) (defun lyskom-parse-misc-comm-to (last n) "Parse a comm-to. Args: LAST N. LAST is a pointer to the last element on a misc-info-list. N is number of misc-items left to parse. Returns (cons n next-key)." (setcdr last (cons (lyskom-create-empty-misc-info) nil)) (let ((info (car (cdr last))) (next-key nil)) (set-misc-info->type info 'COMM-TO) (set-misc-info->comm-to info (lyskom-parse-num)) (setq n (1- n)) ;; A sent-by might follow. (if (= 8 (setq next-key (lyskom-next-num n nil))) (progn (set-misc-info->sender info (lyskom-parse-num)) (setq n (1- n)) (setq next-key nil))) ;; A sent-at might follow. (if (= 9 (setq next-key (lyskom-next-num n next-key))) (progn (set-misc-info->sent-at info (lyskom-parse-time)) (setq n (1- n)) (setq next-key nil))) ;; Return n and next-key. (cons n (lyskom-next-num n next-key)))) (defun lyskom-parse-misc-footn-to (last n) "Parse a footn-to. Args: LAST N. LAST is a pointer to the last element on a misc-info-list. N is number of misc-items left to parse. Returns (cons n next-key)." (setcdr last (cons (lyskom-create-empty-misc-info) nil)) (let ((info (car (cdr last))) (next-key nil)) (set-misc-info->type info 'FOOTN-TO) (set-misc-info->footn-to info (lyskom-parse-num)) (setq n (1- n)) ;; A sent-at might follow. (if (= 9 (setq next-key (lyskom-next-num n nil))) (progn (set-misc-info->sent-at info (lyskom-parse-time)) (setq n (1- n)) (setq next-key nil))) ;; Return n and next-key. (cons n (lyskom-next-num n next-key)))) (defun lyskom-parse-misc-comm-in (last n) "Parse a comm-in. Args: LAST N. LAST is a pointer to the last element on a misc-info-list. N is number of misc-items left to parse. Returns (cons n next-key)." (setcdr last (cons (lyskom-create-empty-misc-info) nil)) (let ((info (car (cdr last)))) (set-misc-info->type info 'COMM-IN) (set-misc-info->comm-in info (lyskom-parse-num)) (setq n (1- n)) ;; Return n and next-key. (cons n (lyskom-next-num n nil)))) (defun lyskom-parse-misc-footn-in (last n) "Parse a footn-in. Args: LAST N. LAST is a pointer to the last element on a misc-info-list. N is number of misc-items left to parse. Returns (cons n next-key)." (setcdr last (cons (lyskom-create-empty-misc-info) nil)) (let ((info (car (cdr last)))) (set-misc-info->type info 'FOOTN-IN) (set-misc-info->footn-in info (lyskom-parse-num)) (setq n (1- n)) ;; Return n and next-key. (cons n (lyskom-next-num n nil)))) (defun lyskom-next-num (items-to-parse pre-fetched) "Parse next number if PRE-FETCHED is nil and ITEMS-TO-PARSE is greater than 0. Args: ITEMS-TO-PARSE PRE-FETCHED. Returns -1 if ITEMS-TO-PARSE is 0." (cond ((zerop items-to-parse) -1) (pre-fetched) (t (lyskom-parse-num)))) ;;; ================================================================ ;;; High level parsing. Parsing of entire datatypes. (defun lyskom-parse-number-array () "Parse an array of integers." (lyskom-parse-vector (lyskom-parse-num) 'lyskom-parse-num)) (defun lyskom-parse-membership () "Parse a membership." (lyskom-create-membership (lyskom-parse-time) ;last-time-read (lyskom-parse-num) ;conf-no (lyskom-parse-num) ;priority (lyskom-parse-num) ;last-text-read (lyskom-parse-vector ;read-texts (lyskom-parse-num) 'lyskom-parse-num))) (defun lyskom-parse-version-info () "Parse info about the server and protocol." (lyskom-create-version-info (lyskom-parse-num) (lyskom-parse-string) (lyskom-parse-string))) (defun lyskom-parse-server-info () "Parse info about the server." (lyskom-create-server-info (lyskom-parse-num) (lyskom-parse-num) (lyskom-parse-num) (lyskom-parse-num) (lyskom-parse-num) (lyskom-parse-num))) (defun lyskom-parse-map () "Parse a text-list (also known as map)." (lyskom-create-map (lyskom-parse-num) ;first-local (lyskom-parse-vector ;text-nos (lyskom-parse-num) 'lyskom-parse-num))) (defun lyskom-parse-who-info () "Parse a who-info." (lyskom-create-who-info (lyskom-parse-num) ;pers-no (lyskom-parse-num) ;working-conf (lyskom-parse-num) ;connection (lyskom-parse-string) ;doing-what (lyskom-parse-string))) ;userid@host (defun lyskom-parse-session-info () "Parse a session-info." (lyskom-create-session-info (lyskom-parse-num) ;pers-no (lyskom-parse-num) ;working-conf (lyskom-parse-num) ;connection (lyskom-parse-string) ;doing (lyskom-parse-string) ;userid@host (lyskom-parse-num) ;idletime (lyskom-parse-time))) ;connect-time ;; prot-A.txt says that this should allow more or less flags than ;; specified, but I can't figure out how. /davidk (defun lyskom-parse-session-flags () "Parse session-flags." (apply 'lyskom-create-session-flags (lyskom-parse-bitstring '(nil nil nil nil nil nil nil nil)))) (defun lyskom-parse-dynamic-session-info () "Parse a dynamic-session-info." (lyskom-create-dynamic-session-info (lyskom-parse-num) ;session-no (lyskom-parse-num) ;pers-no (lyskom-parse-num) ;working-conf (lyskom-parse-num) ;idle-time (lyskom-parse-session-flags) ;session-flags (lyskom-parse-string))) ;doing ;;; High level parsing. Parsing of complete replies. (defun lyskom-parse-void () "Parse result from functions that only return an OK/FAILURE." t) ;Needn't do anything. (defun lyskom-parse-conf-list () "Parse result from functions that return a conf-list." (let* ((list-len (lyskom-parse-num))) (lyskom-create-conf-list (lyskom-parse-vector list-len 'lyskom-parse-num) (lyskom-parse-vector list-len 'lyskom-parse-conf-type)))) (defun lyskom-parse-conf-no-list () "Parse result from functions that return a conf-no-list." (lyskom-create-conf-no-list (lyskom-parse-vector (lyskom-parse-num) 'lyskom-parse-num))) (defun lyskom-parse-mark-list () "Parser result from functions that returns a mark-list." (lyskom-parse-vector (lyskom-parse-num) 'lyskom-parse-mark)) (defun lyskom-parse-mark () "Parse a marked text." (lyskom-create-mark (lyskom-parse-num) ;Text-no (lyskom-parse-num))) ;Mark-type ;;;================================================================ ;;; Parsing of datatypes with cache (defun lyskom-parse-static-session-info (session) "Parse a static-session-info and add it to the cache." (let ((info (lyskom-create-static-session-info (lyskom-parse-string) ;username (lyskom-parse-string) ;hostname (lyskom-parse-string) ;ident-user (lyskom-parse-time)))) ;connection-time (lyskom-save-excursion (set-buffer lyskom-buffer) (cache-add-static-session-info session info)) info)) (defun lyskom-parse-conf-stat (conf-no) "Parse a conf-stat, add add it in the cache. Retuns the conf-stat. Args: CONF-NO." (let ((conf-stat (lyskom-create-conf-stat conf-no ;conf-no (supplied by ; initiate-get-conf-stat) (lyskom-parse-string) ;name (lyskom-parse-conf-type) ;conf-type (lyskom-parse-time) ;creation-time (lyskom-parse-time) ;last-written (lyskom-parse-num) ;creator (lyskom-parse-num) ;presentation (lyskom-parse-num) ;supervisor (lyskom-parse-num) ;permitted-submitters (lyskom-parse-num) ;super-conf (lyskom-parse-num) ;msg-of-day (lyskom-parse-num) ;garb-nice (lyskom-parse-num) ;no-of-members (lyskom-parse-num) ;first-local-no (lyskom-parse-num)))) ;no-of-texts (lyskom-save-excursion (set-buffer lyskom-buffer) (cache-add-conf-stat conf-stat)) conf-stat)) (defun lyskom-parse-uconf-stat (conf-no) "Parse a uconf-stat, and add it to the cache. Returns the conf-stat. Args CONF-NO." (let ((conf-stat (lyskom-create-uconf-stat conf-no (lyskom-parse-string) (lyskom-parse-conf-type) (lyskom-parse-num) (lyskom-parse-num)))) (lyskom-save-excursion (set-buffer lyskom-buffer) (cache-add-uconf-stat conf-stat)) conf-stat)) (defun lyskom-parse-pers-stat (pers-no) "Parse a pers-stat, add add it in the cache. Retuns the pers-stat. Args: PERS-NO." (let ((pers-stat (lyskom-create-pers-stat pers-no ;pers-no (lyskom-parse-string) ;username (lyskom-parse-privs) ;privileges (lyskom-parse-flags) ;flags (lyskom-parse-time) ;last-login (lyskom-parse-num) ;user-area (lyskom-parse-num) ;total-time-present (lyskom-parse-num) ;sessions (lyskom-parse-num) ;created-lines (lyskom-parse-num) ;created-bytes (lyskom-parse-num) ;read-texts (lyskom-parse-num) ;no-of-text-fetches (lyskom-parse-num) ;created-persons (lyskom-parse-num) ;created-confs (lyskom-parse-num) ;first-created-text (lyskom-parse-num) ;no-of-created-texts (lyskom-parse-num) ;no-of-marks (lyskom-parse-num)))) ;no-of-confs (lyskom-save-excursion (set-buffer lyskom-buffer) (cache-add-pers-stat pers-stat)) pers-stat)) (defun lyskom-parse-text-stat (text-no) "Parse a text-stat and add it in the cache. Args: TEXT-NO. Value: text-stat." (let ((text-stat (lyskom-create-text-stat text-no (lyskom-parse-time) ;creation-time (lyskom-parse-num) ;author (lyskom-parse-num) ;no-of-lines (lyskom-parse-num) ;no-of-chars (lyskom-parse-num) ;no-of-marks (lyskom-parse-misc-info-list)))) ;misc-info-list (lyskom-save-excursion (set-buffer lyskom-buffer) (cache-add-text-stat text-stat)) text-stat)) (defun lyskom-parse-text (text-no) "Parse a text and add it to the cache. Args: TEXT-NO. Result: text-stat." (let ((text (lyskom-create-text text-no (lyskom-parse-string)))) ;The text. (lyskom-save-excursion (set-buffer lyskom-buffer) (cache-add-text text)) text)) (defun lyskom-parse-conf-z-info-list () "Parse result from functions that return a conf-z-info-list." (let* ((list-len (lyskom-parse-num))) (lyskom-create-conf-z-info-list (lyskom-parse-vector list-len 'lyskom-parse-conf-z-info)))) (defun lyskom-parse-conf-z-info () "Parse a conf-z-info." (lyskom-create-conf-z-info (lyskom-parse-string) ;name (lyskom-parse-conf-type) ;conf-type (lyskom-parse-num))) ;conf-no ;;; ================================================================ ;;; Parsing of complex datatypes without cache. (defun lyskom-parse-membership-list () "Parse a membership-list. Returns a vector." (lyskom-parse-vector (lyskom-parse-num) 'lyskom-parse-membership)) (defun lyskom-parse-who-info-list () "Parse a who-info-list. Returns a vector." (lyskom-parse-vector (lyskom-parse-num) 'lyskom-parse-who-info)) (defun lyskom-parse-dynamic-session-info-list () "Parse a who-info-list. Returns a vector." (lyskom-parse-vector (lyskom-parse-num) 'lyskom-parse-dynamic-session-info)) (defun lyskom-init-parse (buffer) "Does all initialization of the parsing routines. i.e creates the buffer, sets all markers and pointers." (setq lyskom-is-parsing nil) (setq lyskom-unparsed-buffer (lyskom-generate-new-buffer (concat (if lyskom-debug-communications-to-buffer "" " ") (buffer-name) "-replies"))) (setq lyskom-unparsed-marker (lyskom-save-excursion (let ((proc lyskom-proc)) (set-buffer lyskom-unparsed-buffer) (make-local-variable 'lyskom-proc) (make-local-variable 'lyskom-string-bytes-missing) (setq lyskom-proc proc) (make-local-variable 'lyskom-buffer) (setq lyskom-buffer buffer) (goto-char (point-max)) (point-marker))))) ;;; ================================================================ ;;; Functions that call the other parsing functions. (defun lyskom-parse-success (ref-no buffer) "Parse the results of a successful call and call the handler." (lyskom-save-excursion (set-buffer buffer) (let* ((kom-queue (cdr (assq ref-no lyskom-pending-calls))) (call-info (lyskom-locate-ref-no kom-queue ref-no))) (set-buffer lyskom-unparsed-buffer) (if call-info (apply-parser call-info)) (set-buffer buffer) (lyskom-decrease-pending-calls) (setq lyskom-pending-calls (lyskom-assoc-dremove ref-no lyskom-pending-calls)) (lyskom-check-call kom-queue)))) (defun lyskom-locate-ref-no (kom-queue ref-no) (let ((pending (lyskom-queue->all-entries (kom-queue->pending (cdr (assoc kom-queue lyskom-call-data))))) (result nil)) (while (and (null result) (not (null pending))) (cond ((and (eq (car (car pending)) 'CALL) (eq (car (cdr (car pending))) ref-no)) (setq result (car pending))) (t (setq pending (cdr pending))))) result)) (defun lyskom-assoc-dremove (elt list) "Args: ELT LIST. Return a copy of LIST, but exclude any elements whose car is equal to ELT." (let* ((head (cons nil list)) (tail head)) (while (not (null (cdr tail))) (cond ((equal elt (car (car (cdr tail)))) (setcdr tail (cdr (cdr tail)))) (t (setq tail (cdr tail))))) (cdr head))) (defun apply-parser (call-info) "Try to parse a reply from the server. CALL-INFO looks like this: (See lyskom-call-data). ('CALL REF-NO PARSER PARSER-DATA HANDLER HANDLER-DATA) PARSER is called, and if it succeeds CALL-INFO is destructively changed to ('PARSED RESULT HANDLER HANDLER-DATA)" (let ((result (apply (car (cdr (cdr call-info))) ;Parser (car (cdr (cdr (cdr call-info))))))) ;Parser-data ;; If some part of the reply has not yet arrived ;; the parser will signal lyskom-parse-incomplete ;; and execution will not continue here. ;; The parse is complete. Change the call-info. (lyskom-tr-call-to-parsed call-info result))) (defun lyskom-tr-call-to-parsed (call-info result) "Transform a CALL to a PARSED." (setcar call-info 'PARSED) (setcar (cdr call-info) result) (setcdr (cdr call-info) (cdr (cdr (cdr (cdr call-info)))))) (defun lyskom-parse-error (ref-no buffer) "Parse the result of an unsuccessful call and call the handler." (lyskom-save-excursion (set-buffer buffer) (let* ((kom-queue (cdr (assq ref-no lyskom-pending-calls))) (call-info (lyskom-locate-ref-no kom-queue ref-no)) errno) (set-buffer lyskom-unparsed-buffer) (setq errno (lyskom-parse-num)) (lyskom-parse-num) ;Skip ref_no. (set-buffer buffer) (setq lyskom-errno errno) (setq lyskom-pending-calls (lyskom-assoc-dremove ref-no lyskom-pending-calls)) (lyskom-decrease-pending-calls) (if call-info (lyskom-tr-call-to-parsed call-info nil) (lyskom-message "Bug i lyskom-parse-error")) (lyskom-check-call kom-queue)))) (defun lyskom-parse-unparsed () "Parse all complete replies in lyskom-unparsed-buffer. All parsing is to take place in this buffer but calling the functions: lyskom-parse-success, lyskom-parse-error and lyskom-parse-async calls functions and variables that are connected with the lyskom-buffer." (let ((lyskom-buffer (current-buffer)) (match-data (match-data))) ;; Was the server saving? (if lyskom-is-saving (progn (setq mode-line-process (lyskom-get-string (if lyskom-executing-command 'mode-line-working 'mode-line-waiting)) lyskom-is-saving nil) ;; Removed check for kom-presence-messages (if (and (not (lyskom-is-in-minibuffer))) (message "")))) (lyskom-save-excursion (set-buffer lyskom-unparsed-buffer) (setq lyskom-string-bytes-missing 0) (while (not (zerop (1- (point-max)))) ;Parse while replies. (let* ((lyskom-parse-pos 1) (key (lyskom-parse-nonwhite-char))) (condition-case err (let ((inhibit-quit t)) ; Used to be nil, but that can ; cause hard-to-repair ; problems (cond ((= key ?=) ;The call succeeded. (lyskom-parse-success (lyskom-parse-num) lyskom-buffer)) ((= key ?%) ;The call was not successful. (lyskom-parse-error (lyskom-parse-num) lyskom-buffer)) ((= key ?:) ;An asynchronous message. (lyskom-parse-async (lyskom-parse-num) lyskom-buffer))) (delete-region (point-min) lyskom-parse-pos)) ;; One reply is now parsed. (lyskom-protocol-error (delete-region (point-min) (min (point-max) (1+ lyskom-parse-pos))) (signal 'lyskom-protocol-error err))) (goto-char (point-min)) (if (looking-at "[ \n]+") (delete-region (match-beginning 0) (match-end 0))) ))) (store-match-data match-data))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: cache.el,v 44.3.2.2 1999/10/13 12:12:51 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: cache.el ;;;; ;;;; This file contains all functions which have to do with ;;;; caching various data types in the LysKOM client. ;;;; ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: cache.el,v 44.3.2.2 1999/10/13 12:12:51 byers Exp $\n")) ;;; ================================================================ ;;; UConf-stat cache (defun cache-get-uconf-stat (conf-no) "Get uconf-stat for conference CONF-NO, or nil if nothing is cached. If full conf-stat is cached, construct an uconf-stat from that data and cache it." (or (cache-assoc conf-no lyskom-uconf-cache) (cache-construct-uconf-stat (cache-get-conf-stat conf-no)))) (defun cache-construct-uconf-stat (conf) "If conf is non-nil, create an uconf-stat from conf and cache it. Return the new uconf-stat or nil" (let ((tmp nil)) (and conf (cache-add-uconf-stat (setq tmp (lyskom-create-uconf-stat (conf-stat->conf-no conf) (conf-stat->name conf) (conf-stat->conf-type conf) (+ (conf-stat->first-local-no conf) (conf-stat->no-of-texts conf)) (conf-stat->garb-nice conf))))) tmp)) (defun cache-add-uconf-stat (uconf-stat) "Insert a UCONF-STAT in the cache." (cache-add (uconf-stat->conf-no uconf-stat) uconf-stat 'lyskom-uconf-cache)) (defun cache-del-uconf-stat (conf-no) "Delete a conf-stat from the cache. Args: CONF-NO." (cache-del conf-no 'lyskom-uconf-cache) (cache-del conf-no 'lyskom-conf-cache)) ;;; ================================================================ ;;; Conf-stat cache. (defun cache-get-conf-stat (conf-no) "Get conf-stat for conference CONF-NO, or nil if nothing is cached." (cache-assoc conf-no lyskom-conf-cache)) (defun cache-add-conf-stat (conf-stat) "Insert a CONF-STAT in the cache." (cache-add (conf-stat->conf-no conf-stat) conf-stat 'lyskom-conf-cache)) (defun cache-del-conf-stat (conf-no) "Delete a conf-stat from the cache. Args: CONF-NO." (cache-del conf-no 'lyskom-conf-cache) (cache-del conf-no 'lyskom-uconf-cache)) ;;; ================================================================ ;;; Pers-stat cache. (defun cache-get-pers-stat (pers-no) "Get pers-stat for person PERS-NO, or nil if nothing is cached." (cache-assoc pers-no lyskom-pers-cache)) (defun cache-add-pers-stat (pers-stat) "Insert a PERS-STAT in the cache." (cache-add (pers-stat->pers-no pers-stat) pers-stat 'lyskom-pers-cache)) (defun cache-del-pers-stat (pers-no) "Delete a pers-stat from the cache. Args: PERS-NO." (cache-del pers-no 'lyskom-pers-cache)) ;;; ================================================================ ;;; Text-stat cache. (defun cache-get-text-stat (text-no) "Get text-stat for texton TEXT-NO, or nil if nothing is cached." (cache-assoc text-no lyskom-text-cache)) (defun cache-add-text-stat (text-stat) "Insert a TEXT-STAT in the cache." (cache-add (text-stat->text-no text-stat) text-stat 'lyskom-text-cache)) (defun cache-del-text-stat (text-no) "Delete a text-stat from the cache. Args: TEXT-NO." (cache-del text-no 'lyskom-text-cache)) ;;; ================================================================ ;;; Text cache (the text strings). (defun cache-get-text (text-no) "Get text for textno TEXT-NO, or nil if nothing is cached." (let ((tx (cache-assoc text-no lyskom-text-mass-cache))) (cond ((lyskom-text-p tx) tx)))) (defun cache-add-text (text) "Insert a TEXT in the cache." (cache-add (text->text-no text) text 'lyskom-text-mass-cache)) (defun cache-del-text (text-no) "Delete a text from the cache. Args: TEXT-NO." (cache-del text-no 'lyskom-text-mass-cache)) ;;; ================================================================ ;;; Marked texts cache. (defun cache-get-marked-texts () "Return the a list of marks for all marked texts." lyskom-marked-text-cache) (defun cache-set-marked-texts (mark-array) "Sets the marks for all marked texts. A mark-list is an array, but we want a list in the cache, so this remakes it into a list." (setq lyskom-marked-text-cache (listify-vector mark-array))) (defun cache-text-is-marked (text-no) "Return the mark if the text text-no is marked by the current user, otherwise return nil" (let ((marks lyskom-marked-text-cache) (mark nil)) (while (and (not (null marks)) (null mark)) (if (equal text-no (mark->text-no (car marks))) (setq mark (car marks)) (setq marks (cdr marks)))) mark)) (defun cache-add-marked-text (text-no mark-type) "Insert a mark into the cache. If it is already there, replace it." (let ((marks lyskom-marked-text-cache) (found nil) (mark (lyskom-create-mark text-no mark-type))) (while (and (not found) (not (null marks))) (if (and (car marks) (equal text-no (mark->text-no (car marks)))) (progn (setcar marks mark) (setq found t)) (setq marks (cdr marks)))) (if (not found) (setq lyskom-marked-text-cache (cons mark lyskom-marked-text-cache))))) (defun cache-del-marked-text (text-no) "Remove the mark from the cache of marked texts if it is there. +++BUG: A mark is replaced with a nil and not removed." (let ((marks lyskom-marked-text-cache) (found nil)) (while (and (not found) (not (null marks))) (if (equal text-no (mark->text-no (car marks))) (progn (setcar marks nil) (setq found t)) (setq marks (cdr marks)))))) ;;; ================================================================ ;;; Static-session-info cache (defun cache-get-static-session-info (session) "Get static-session-info for session SESSION, or nil if nothing is cached." (let ((tx (cache-assoc session lyskom-static-session-info-cache))) (cond ((static-session-info-p tx) tx)))) (defun cache-add-static-session-info (session info) "Insert INFO in the cache." (cache-add session info 'lyskom-static-session-info-cache)) (defun cache-del-static-session-info (session) "Delete a text from the cache. Args: SESSION." (cache-del session 'lyskom-static-session-info-cache)) ;;; ================================================================ ;;; who-info cache (defun cache-initiate-who-info-buffer (who-info-arr kombuf) "Sets the cache of who-info items." (setq lyskom-who-info-cache (list 'WHO-INFO-LIST)) (lyskom-save-excursion (setq lyskom-who-info-buffer (lyskom-get-buffer-create 'WHO-INFO (concat (buffer-name) "-who") t)) (set-buffer lyskom-who-info-buffer) (make-local-variable 'kom-buffer) (setq lyskom-buffer kombuf) (local-set-key [mouse-2] 'kom-mouse-2) (erase-buffer)) (mapcar 'cache-add-who-info (sort (listify-vector who-info-arr) (function (lambda (who1 who2) (< (who-info->connection who1) (who-info->connection who2))))))) (defun cache-add-who-info (who-info) "Adds another entry to the lyskom-who-info-cache. Updating the buffer." (if lyskom-who-info-buffer-is-on (progn (lyskom-collect 'who-buffer) (initiate-get-conf-stat 'who-buffer nil (who-info->pers-no who-info)) (initiate-get-conf-stat 'who-buffer nil (who-info->working-conf who-info)) (lyskom-use 'who-buffer 'lyskom-set-who-info-buffer-2 who-info)))) (defun cache-add-session-info (session-info) "Adds another entry to the lyskom-who-info-cache. Updating the buffer. ARG: session-info" (if (null session-info) nil ;+++ Annan felhantering (lyskom-halt 'who-buffer) (lyskom-collect 'who-buffer-2) (initiate-get-conf-stat 'who-buffer-2 nil (session-info->pers-no session-info)) (initiate-get-conf-stat 'who-buffer-2 nil (session-info->working-conf session-info)) (lyskom-use 'who-buffer-2 'lyskom-set-session-info session-info) (lyskom-run 'who-buffer-2 'lyskom-resume 'who-buffer))) (defun cache-del-who-info (session-no) "Delete the session SESSION-NO from the lyskom-who-info-cache. Updating buffer." (if lyskom-who-info-buffer-is-on (let ((where (cache-assoc session-no lyskom-who-info-cache))) (if where (progn (lyskom-save-excursion (set-buffer lyskom-who-info-buffer) (delete-region (marker-position (who-buffer-info->start-marker where)) (marker-position (who-buffer-info->end-marker where)))) (set-marker (who-buffer-info->start-marker where) nil) (set-marker (who-buffer-info->end-marker where) nil) (cache-del session-no 'lyskom-who-info-cache)))))) (defun lyskom-set-who-info-buffer-2 (pers-conf-stat conf-conf-stat who-info) "Inserts a who-buffer-info into lyskom-who-info-cache" ;; ;We can use lyskom-insert (not beautiful) ;; ;we insert everything at the end of the buffer. ;; ;defensive programming and it will work: ;; (if (and lyskom-who-info-buffer-is-on ;; lyskom-who-info-buffer) ;; (let ((sesno lyskom-session-no) ;; min max ;; (where (cache-assoc (who-info->connection who-info) ;; lyskom-who-info-cache))) ;; (lyskom-save-excursion ;; (set-buffer lyskom-who-info-buffer) ;; (save-restriction ;; (if where ;; (progn ;; (narrow-to-region (marker-position ;; (who-buffer-info->start-marker where)) ;; (1- (marker-position ;; (who-buffer-info->end-marker where)))) ;; (delete-region (point-min) (point-max))) ;; (goto-char (point-max)) ;; (insert " ") ;; (narrow-to-region (point-min) (1- (point-max)))) ;; (setq min (point-max-marker)) ;; (lyskom-print-who-info pers-conf-stat conf-conf-stat who-info sesno ;; (function ;; (lambda (string) ;; (insert string)))) ;; (setq max (point-max-marker)) ;; (goto-char (point-max))) ;; (delete-char 1)) ;; (cache-add (who-info->connection who-info) ;; (lyskom-create-who-buffer-info who-info min max) ;; 'lyskom-who-info-cache) ;; (run-hooks 'lyskom-who-info-has-changed-hook))) ) (defun lyskom-set-session-info (pers-conf-stat conf-conf-stat session-info) "Inserts a session-info into lyskom-who-info-cache" ;;; (lyskom-set-who-info-buffer-2 pers-conf-stat conf-conf-stat ;;; (lyskom-create-who-info ;;; (session-info->pers-no session-info) ;;; (session-info->working-conf session-info) ;;; (session-info->connection session-info) ;;; (session-info->doing session-info) ;;; (session-info->username session-info))) ) ;;; ================================================================ ;;; Generic cache routines (defvar lyskom-caches nil "A list of all the caches in use. This is used to clear all caches with `clear-all-caches'") (defun cache-create (cache) (set cache nil) (setq lyskom-caches (cons cache lyskom-caches))) (defun cache-assoc (key cache) "Get data for item with key KEY from CACHE. CACHE is an assoc-list in this implementation." (cdr-safe (assoc key cache))) (defun cache-add (key data cache) "Add DATA to CACHE under the key KEY. Args: KEY DATA CACHE. CACHE is a (the only one) quoted variable pointing to the cache (an alist). The variable might be changed." (if (null (symbol-value cache)) (cache-create cache)) (let ((oldval (assoc key (symbol-value cache)))) (cond ((null oldval) (set cache (cons (cons key data) (symbol-value cache)))) (t (setcdr oldval data))))) (defun cache-del (key cache) "Delete item with key KEY from CACHE. CACHE is the name of the variable that points to the cache." (let ((oldval (assoc key (symbol-value cache)))) (if oldval (setcdr oldval nil)))) ;A pair (key . nil) will remain. ;Fix this bug someday. +++ (defun cache-clear (cache) (set cache nil) (setq lyskom-caches (delete cache lyskom-caches))) ;; (defsubst cache-hash (key cache) ;; "Return a hash value for use in the cache." ;; (mod key (length (aref cache 2)))) ;; ;; (defun cache-create (cache &optional size) ;; (set cache (vector 'CACHE-HASH (or size 1000) ;; (make-vector (or size 1000) nil))) ;; (if (not (memq cache lyskom-caches)) ;; (setq lyskom-caches (cons cache lyskom-caches))) ;; (symbol-value cache)) ;; ;; (defun cache-rehash (cache-symbol) ;; (let* ((cache (symbol-value cache-symbol)) ;; (newsize (/ (aref cache 1) 5)) ;; (oldsize (length (aref cache 2))) ;; (i 0)) ;; (cache-create cache-symbol newsize) ;; (while (< i oldsize) ;; (let ((entries (aref cache i))) ;; (while entries ;; (cache-add cache-symbol (car (car entries)) (cdr (car entries))) ;; (setq entries (cdr entries)))) ;; (setq i (1+ i))) ;; (symbol-value cache-symbol))) ;; ;; (defun cache-assoc (key cache) ;; "Get data for item with key KEY from CACHE. ;; CACHE is an assoc-list in this implementation." ;; (if cache ;; (cdr-safe (assq key (aref (aref cache 2) ;; (cache-hash key cache)))))) ;; ;; ;; ;; (defun cache-add (key data cache-symbol) ;; "Add DATA to CACHE under the key KEY. ;; Args: KEY DATA CACHE. ;; CACHE is a (the only one) quoted variable pointing to the cache (an alist). ;; The variable might be changed." ;; (let ((cache (symbol-value cache-symbol))) ;; (if (null cache) ;; (setq cache (cache-create cache-symbol)) ;; (if (> (aset cache 1 (1+ (aref cache 1))) ;; (* (length (aref cache 2)) 20)) ;; (setq cache (cache-rehash cache-symbol)))) ;; (let ((hash (cache-hash key cache))) ;; (aset (aref cache 2) hash ;; (cons (cons key data) (aref (aref cache 2) hash)))))) ;; ;; (defun cache-del (key cache-symbol) ;; "Delete item with key KEY from CACHE. ;; CACHE is the name of the variable that points to the cache." ;; (let ((cache (symbol-value cache-symbol))) ;; (if cache ;; (let* ((hash (cache-hash key cache)) ;; (entries (aref (aref cache 2) hash)) ;; (ass (assq key entries))) ;; (if ass ;; (progn (aset cache 1 (1- (aref cache 1))) ;; (aset (aref cache 2) hash ;; (delq ass entries)))))))) ;; ;; (defun cache-clear (cache) ;; (set cache nil) ;; (setq lyskom-caches (delete cache lyskom-caches))) (defun clear-all-caches () (mapcar (function (lambda (cache) (set cache nil))) lyskom-caches) (setq lyskom-caches nil)) ;;; ================================================================ ;;; lyskom-tell-server (this is also a sort of cache) (def-kom-var lyskom-what-i-am-doing nil "What the client thinks the server thinks the user is doing." local) (defun lyskom-tell-server (string) "Tell the server what the user is doing. Args: STRING." (save-excursion (when lyskom-buffer (set-buffer lyskom-buffer)) (cond ((equal string lyskom-what-i-am-doing)) (t (setq lyskom-what-i-am-doing string) (initiate-change-what-i-am-doing 'background nil string))))) ;;;;; -*-coding: raw-text; unibyte: t; -*- ;;;;; ;;;;; $Id: view-mode.el,v 44.3.4.2 1999/10/13 12:13:39 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: view-mode.el ;;;; ;;;; LysKOM view mode, a simple move for viewing buffers. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: view-mode.el,v 44.3.4.2 1999/10/13 12:13:39 byers Exp $\n")) (defvar lyskom-view-mode-map nil "Keymap for LysKOM view mode") (eval-when-compile (defvar view-mode-map nil)) (lyskom-external-function view-major-mode) (defun lyskom-view-base-mode () (cond ((fboundp 'view-major-mode) (view-major-mode)) ((assq 'view-mode minor-mode-alist) (let* ((keymap (copy-keymap lyskom-view-mode-map))) (make-variable-buffer-local 'minor-mode-map-alist) (set-keymap-parent keymap view-mode-map) (setq minor-mode-map-alist (cons (cons 'view-mode keymap) minor-mode-map-alist)) (view-mode))) (t (view-mode)))) (if lyskom-view-mode-map nil (setq lyskom-view-mode-map (make-sparse-keymap)) (define-key lyskom-view-mode-map "*" 'kom-button-press) (define-key lyskom-view-mode-map "\t" 'kom-next-link) (define-key lyskom-view-mode-map [(meta tab)] 'kom-previous-link) (define-key lyskom-view-mode-map (lyskom-keys [mouse-2]) 'kom-button-click) (define-key lyskom-view-mode-map (lyskom-keys [down-mouse-3]) 'kom-popup-menu) (define-key lyskom-view-mode-map "q" 'lyskom-view-mode-quit)) (defun lyskom-view-mode-quit () (interactive) (let ((buf (current-buffer))) (lyskom-undisplay-buffer buf) (kill-buffer buf))) (define-derived-mode lyskom-view-mode lyskom-view-base-mode "LysKOM View" "Major mode for viewing buffers") ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: commands1.el,v 44.28.2.2 1999/10/13 12:12:54 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: commands1.el ;;;; ;;;; This file contains the code for some of the high level commands. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: commands1.el,v 44.28.2.2 1999/10/13 12:12:54 byers Exp $\n")) ;;; ================================================================ ;;; F} uppmuntran - Get appreciation ;;; Author: Inge Wallin (def-kom-command kom-get-appreciation () "Give the user a little light in the dark" (interactive) (lyskom-insert-string 'appreciation)) ;;; ================================================================ ;;; F} Sk{ll - Get abuse ;;; Author: Inge Wallin (def-kom-command kom-get-abuse () "Give the user a little verbal abuse." (interactive) (lyskom-insert-string 'abuse)) ;;; ================================================================ ;;; Utpl}na - Delete a person or a conference ;;; Author: Inge Wallin (def-kom-command kom-delete-conf () "Delete a person or a conference." (interactive) (let ((conf-stat (lyskom-read-conf-stat (lyskom-get-string 'what-conf-to-delete) '(all) nil nil t))) (if conf-stat (if (lyskom-ja-or-nej-p (lyskom-format 'confirm-delete-pers-or-conf (if (conf-type->letterbox (conf-stat->conf-type conf-stat)) (lyskom-get-string 'the-pers) (lyskom-get-string 'the-conf)) (conf-stat->name conf-stat))) (if (blocking-do 'delete-conf (conf-stat->conf-no conf-stat)) (progn (lyskom-format-insert 'conf-is-deleted (conf-stat->name conf-stat)) (when (= (conf-stat->conf-no conf-stat) lyskom-pers-no) (lyskom-insert (lyskom-get-string 'you-have-deleted-yourself)) (setq lyskom-pers-no nil lyskom-membership nil lyskom-to-do-list (lyskom-create-read-list) lyskom-reading-list (lyskom-create-read-list) lyskom-pending-commands (cons 'kom-start-anew lyskom-pending-commands)))) (lyskom-format-insert 'you-could-not-delete conf-stat)) (lyskom-insert-string 'deletion-not-confirmed)) (lyskom-insert-string 'somebody-else-deleted-that-conf)))) ;;; ================================================================ ;;; Radera (text) - Delete a text ;;; Author: Inge Wallin (def-kom-command kom-delete-text (text-no-arg) "Delete a text. Argument: TEXT-NO" (interactive "P") (let ((text-no (cond ((null text-no-arg) 0) ((integerp text-no-arg) text-no-arg) ((listp text-no-arg) (car text-no-arg)) (t 0)))) (if (zerop text-no) (setq text-no (lyskom-read-number (lyskom-get-string 'what-text-to-delete) lyskom-current-text))) (lyskom-format-insert 'deleting-text text-no) (lyskom-report-command-answer (blocking-do 'delete-text text-no)))) ;;; ================================================================ ;;; ]terse presentation - Review the presentation ;;; for a person or a conference ;;; Author: Inge Wallin (defun kom-review-presentation (&optional who) "Review the presentation for a person or a conference." (interactive) (lyskom-start-of-command 'kom-review-presentation) (let ((end-of-command-taken-care-of)) (unwind-protect (let ((conf-stat (if who (blocking-do 'get-conf-stat who) (lyskom-read-conf-stat (lyskom-get-string 'presentation-for-whom) '(all) nil "" t)))) (if (null conf-stat) (lyskom-insert-string 'somebody-deleted-that-conf) (lyskom-format-insert 'review-presentation-of conf-stat) (if (/= (conf-stat->presentation conf-stat) 0) (lyskom-view-text (conf-stat->presentation conf-stat)) (lyskom-format-insert 'has-no-presentation conf-stat)))) (if end-of-command-taken-care-of nil (lyskom-end-of-command))))) ;;; ================================================================ ;;; ]terse det kommenterade - View commented text ;;; Author: Inge Wallin ;;; Modified by: David K}gedal (def-kom-command kom-view-commented-text () "View the commented text. If the current text is comment to (footnote to) several text then the first text is shown and a REVIEW list is built to shown the other ones." (interactive) (if lyskom-current-text (progn (lyskom-tell-internat 'kom-tell-read) (lyskom-view-commented-text (blocking-do 'get-text-stat lyskom-current-text))) (lyskom-insert-string 'have-to-read))) (def-kom-command kom-view-previous-commented-text () "View the text the previous text commented. If the previously viewed text is a comment to (footnote to) several texts then the first text is shown and a REVIEW list is built to show the other ones." (interactive) (if lyskom-previous-text (progn (lyskom-tell-internat 'kom-tell-read) (lyskom-view-commented-text (blocking-do 'get-text-stat lyskom-previous-text))) (lyskom-insert-string 'confusion-what-to-view))) (defun lyskom-view-commented-text (text-stat) "Handles the return from the initiate-get-text-stat, displays and builds list." (let* ((misc-info-list (and text-stat (text-stat->misc-info-list text-stat))) (misc-infos (and misc-info-list (append (lyskom-misc-infos-from-list 'COMM-TO misc-info-list) (lyskom-misc-infos-from-list 'FOOTN-TO misc-info-list)))) (text-nos (and misc-infos (mapcar (function (lambda (misc-info) (if (equal (misc-info->type misc-info) 'COMM-TO) (misc-info->comm-to misc-info) (misc-info->footn-to misc-info)))) misc-infos)))) (if text-nos (progn (lyskom-format-insert 'review-text-no (car text-nos)) (if (cdr text-nos) (read-list-enter-read-info (lyskom-create-read-info 'REVIEW nil (lyskom-get-current-priority) (lyskom-create-text-list (cdr text-nos)) lyskom-current-text) lyskom-reading-list t)) (lyskom-view-text (car text-nos))) (lyskom-insert-string 'no-comment-to)))) (defun lyskom-misc-infos-from-list (type list) "Get all the misc-infos from the misc-info-list LIST with the same type as TYPE. If no such misc-info, return NIL" (cond ((null list) nil) ((equal type (misc-info->type (car list))) (cons (car list) (lyskom-misc-infos-from-list type (cdr list)))) (t (lyskom-misc-infos-from-list type (cdr list))))) ;;; ================================================================ ;;; Brev - Send letter ;;; Author: Inge Wallin ;;; Rewritten using read-conf-no by Linus Tolke (4=>1) (def-kom-command kom-send-letter (&optional pers-no) "Send a personal letter to a person or a conference." (interactive) (condition-case nil (progn (lyskom-tell-internat 'kom-tell-write-letter) ;; If there was a motd, which is now removed we have to ;; refetch the conf-stat to know that. (let* ((tono (or pers-no (lyskom-read-conf-no (lyskom-get-string 'who-letter-to) '(all) nil nil t))) (conf-stat (blocking-do 'get-conf-stat tono))) (cache-del-conf-stat tono) (if (if (zerop (conf-stat->msg-of-day conf-stat)) t (progn (recenter 1) (lyskom-format-insert 'has-motd conf-stat) (lyskom-view-text (conf-stat->msg-of-day conf-stat)) (if (lyskom-j-or-n-p (lyskom-get-string 'motd-persist-q)) t nil))) (if (= tono lyskom-pers-no) (lyskom-edit-text lyskom-proc (lyskom-create-misc-list 'recpt tono) "" "") (lyskom-edit-text lyskom-proc (lyskom-create-misc-list 'recpt tono 'recpt lyskom-pers-no) "" ""))))) (quit (signal 'quit "Quitting in letter")))) ;;; ================================================================ ;;; Bli medlem i m|te - Become a member of a conference ;;; Addera medlem - Add somebody else as a member ;;; Author: ??? ;;; Rewritten by: David K}gedal ;; Add another person (def-kom-command kom-add-member () "Add a person as a member of a conference. Ask for the name of the person, the conference to add him/her to." (interactive) (let* ((who (lyskom-read-conf-stat (lyskom-get-string 'who-to-add) '(pers) nil nil t)) (whereto (lyskom-read-conf-stat (lyskom-get-string 'where-to-add) '(all) nil nil t)) (pers-stat (blocking-do 'get-pers-stat (conf-stat->conf-no who)))) (lyskom-add-member-answer (lyskom-try-add-member whereto who pers-stat) whereto who))) ;; Add self (def-kom-command kom-add-self (&optional conf) "Add this person as a member of a conference." (interactive) (let ((whereto (if conf (blocking-do 'get-conf-stat conf) (lyskom-read-conf-stat (lyskom-get-string 'where-to-add-self) '(all) nil "" t))) (who (blocking-do 'get-conf-stat lyskom-pers-no)) (pers-stat (blocking-do 'get-pers-stat lyskom-pers-no))) (lyskom-add-member-answer (lyskom-try-add-member whereto who pers-stat) whereto who))) ;;; NOTE: This function is also called from lyskom-go-to-conf-handler ;;; and from lyskom-create-conf-handler. (defun lyskom-add-member-by-no (conf-no pers-no &optional thendo &rest data) "Fetch info to be able to add a person to a conf. Get the conf-stat CONF-NO for the conference and the conf-stat and pers-stat for person PERS-NO and send them into lyskom-try-add-member." (blocking-do-multiple ((whereto (get-conf-stat conf-no)) (who (get-conf-stat pers-no)) (pers-stat (get-pers-stat pers-no))) (let ((result (lyskom-try-add-member whereto who pers-stat))) (lyskom-add-member-answer result whereto who) (if thendo (apply thendo data)) result))) (defun lyskom-try-add-member (conf-conf-stat pers-conf-stat pers-stat) "Add a member to a conference. Args: CONF-CONF-STAT PERS-CONF-STAT PERS-STAT CONF-CONF-STAT: the conf-stat of the conference the person is being added to PERS-CONF-STAT: the conf-stat of the person being added. PERS-STAT: the pers-stat of the person being added. Returns t if it was possible, otherwise nil." (if (or (null conf-conf-stat) (null pers-conf-stat)) nil ; We have some problem here. (let ((priority (if (/= lyskom-pers-no (conf-stat->conf-no pers-conf-stat)) 100 ; When adding someone else (if (and (numberp kom-membership-default-priority) (< kom-membership-default-priority 256) (> kom-membership-default-priority 0)) kom-membership-default-priority (lyskom-read-num-range 0 255 (lyskom-get-string 'priority-q))))) (where (if (/= lyskom-pers-no (conf-stat->conf-no pers-conf-stat)) 1 ; When adding someone else (cond ((and (numberp kom-membership-default-placement) (>= kom-membership-default-placement 0)) kom-membership-default-placement) ((eq kom-membership-default-placement 'first) 0) ((eq kom-membership-default-placement 'last) (length lyskom-membership)) (t (lyskom-read-num-range 0 (pers-stat->no-of-confs pers-stat) (lyskom-format 'where-on-list-q (length lyskom-membership)))))))) (if (= (conf-stat->conf-no pers-conf-stat) lyskom-pers-no) (lyskom-format-insert 'member-in-conf conf-conf-stat) (lyskom-format-insert 'add-member-in pers-conf-stat conf-conf-stat)) (blocking-do 'add-member (conf-stat->conf-no conf-conf-stat) (conf-stat->conf-no pers-conf-stat) priority where)))) (defun lyskom-add-member-answer (answer conf-conf-stat pers-conf-stat) "Handle the result from an attempt to add a member to a conference." (if (null answer) (progn (lyskom-insert-string 'nope) (if (conf-type->rd_prot (conf-stat->conf-type conf-conf-stat)) ;; The conference is protected. Tell the user to contact (let ((supervisorconf (blocking-do 'get-conf-stat (conf-stat->supervisor conf-conf-stat)))) (if supervisorconf (lyskom-format-insert 'is-read-protected-contact-supervisor conf-conf-stat supervisorconf) (lyskom-format-insert 'cant-find-supervisor conf-conf-stat))) (lyskom-format-insert 'error-code (lyskom-get-error-text lyskom-errno) lyskom-errno))) (lyskom-insert-string 'done) ;;+++Borde {ndra i cachen i st{llet. (cache-del-pers-stat (conf-stat->conf-no pers-conf-stat)) ;;+++Borde {ndra i cachen i st{llet. (cache-del-conf-stat (conf-stat->conf-no conf-conf-stat)) (if (= (conf-stat->conf-no pers-conf-stat) lyskom-pers-no) (progn ; Adding myself (lyskom-add-membership (blocking-do 'query-read-texts lyskom-pers-no (conf-stat->conf-no conf-conf-stat)) (conf-stat->conf-no conf-conf-stat)))))) (defun lyskom-add-membership (membership conf-no) "Adds MEMBERSHIP to the sorted list of memberships. Args: MEMBERSHIP CONF-STAT THENDO DATA Also adds to lyskom-to-do-list." (if membership (progn (lyskom-insert-membership membership lyskom-membership) (lyskom-prefetch-map conf-no membership) (lyskom-run-hook-with-args 'lyskom-add-membership-hook membership)) (lyskom-insert-string 'conf-does-not-exist))) ;;; ================================================================ ;;; Uttr{d - Subtract yourself as a member from a conference ;;; Uteslut medlem - Subtract somebody else as a member ;;; Author: David Byers ;;; Based on code by Inge Wallin ;; Subtract another person (def-kom-command kom-sub-member () "Subtract a person as a member from a conference. Ask for the name of the person." (interactive) (lyskom-sub-member (lyskom-read-conf-stat (lyskom-get-string 'who-to-exclude) '(pers) nil "" t) (lyskom-read-conf-stat (lyskom-get-string 'where-from-exclude) '(all) nil "" t))) (def-kom-command kom-sub-self (&optional conf) "Subtract this person as a member from a conference." (interactive) (lyskom-sub-member (blocking-do 'get-conf-stat lyskom-pers-no) (if conf (blocking-do 'get-conf-stat conf) (lyskom-read-conf-stat (lyskom-get-string 'leave-what-conf) '(all) nil (let ((ccn (if (or (zerop lyskom-current-conf)) "" (conf-stat->name (blocking-do 'get-conf-stat lyskom-current-conf))))) (if ccn (cons ccn 0) "")) t)))) (defun lyskom-sub-member (pers conf) "Remove the person indicated by PERS as a member of CONF." (let ((reply nil) (self (= (conf-stat->conf-no pers) lyskom-pers-no))) (cond ((null pers) (lyskom-insert-string 'error-fetching-person)) ((null conf) (lyskom-insert-string 'error-fetching-conf)) (t (if self (lyskom-format-insert 'unsubscribe-to conf) (lyskom-format-insert 'exclude-from pers conf)) (setq reply (blocking-do 'sub-member (conf-stat->conf-no conf) (conf-stat->conf-no pers))) (if self (lyskom-remove-membership (conf-stat->conf-no conf) lyskom-membership)) (if (not reply) (lyskom-format-insert 'unsubscribe-failed (if self (lyskom-get-string 'You) (conf-stat->name pers)) (conf-stat->name conf)) (lyskom-insert-string 'done) (if (and self (= (conf-stat->conf-no conf) lyskom-current-conf)) (progn (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 (conf-stat->conf-no conf) lyskom-to-do-list)))))) ;;; ================================================================ ;;; Skapa m|te - Create a conference ;;; Author: ??? (def-kom-command kom-create-conf (&optional name) "Create a conference." (interactive) (let* ((conf-name (or name (lyskom-read-string (lyskom-get-string 'name-of-conf)))) (open (j-or-n-p (lyskom-get-string 'anyone-member) t)) (secret (if (not open) (j-or-n-p (lyskom-get-string 'secret-conf) t))) (orig (j-or-n-p (lyskom-get-string 'comments-allowed) t)) (anarchy (j-or-n-p (lyskom-get-string 'anonymous-allowed) t)) (conf-no (blocking-do 'create-conf conf-name (lyskom-create-conf-type (not open) (not orig) secret nil anarchy nil nil nil)))) (if (null conf-no) (progn (lyskom-format-insert 'could-not-create-conf conf-name) (lyskom-format-insert 'error-code (lyskom-get-error-text lyskom-errno) lyskom-errno)) (progn (let ((conf-stat (blocking-do 'get-conf-stat conf-no))) (lyskom-format-insert 'created-conf-no-name (or conf-stat conf-no) (or conf-stat conf-name) (if conf-stat (lyskom-default-button 'conf conf-stat) nil))) (lyskom-scroll) (lyskom-add-member-by-no conf-no lyskom-pers-no (if secret nil ; Don't write a presentation 'lyskom-create-conf-handler-2) conf-no conf-name))))) (defun lyskom-create-conf-handler-2 (conf-no conf-name) "Starts editing a presentation for the newly created conference. This does lyskom-end-of-command" (lyskom-tell-internat 'kom-tell-conf-pres) (let ((conf (blocking-do 'get-conf-stat conf-no))) (if conf (lyskom-dispatch-edit-text lyskom-proc (lyskom-create-misc-list 'recpt (server-info->conf-pres-conf lyskom-server-info)) conf-name "" 'lyskom-set-presentation conf-no)))) (defun lyskom-set-presentation (text-no conf-no) "Set presentation of a conference. Args: text-no conf-no." (initiate-set-presentation 'background nil conf-no text-no) (cache-del-conf-stat conf-no)) ;+++Borde {ndra i cachen i st{llet. ;+++ Kan tas bort n{r det existerar ;asynkrona meddelanden som talar om att ;n}got {r {ndrat. (defun lyskom-set-conf-motd (text-no conf-no) "Set motd of a conference. Args: text-no conf-no." (initiate-set-conf-motd 'background nil conf-no text-no) (cache-del-conf-stat conf-no)) ;+++Borde {ndra i cachen i st{llet. ;+++ Kan tas bort n{r det existerar ;asynkrona meddelanden som talar om att ;n}got {r {ndrat. ;;; ================================================================ ;;; Kommentera - write comment ;;; Author: ??? (defun kom-write-comment (&optional text-no) "Write a comment to a text. If optional arg TEXT-NO is present write a comment to that text instead." (interactive (list (cond ((null current-prefix-arg) lyskom-current-text) ((integerp current-prefix-arg) current-prefix-arg) ((listp current-prefix-arg) (lyskom-read-number (lyskom-get-string 'what-comment-no))) (t (signal 'lyskom-internal-error '(kom-write-comment)))))) (lyskom-start-of-command (concat (lyskom-command-name 'kom-write-comment) (if text-no (lyskom-format " (%#1n)" text-no) ""))) (unwind-protect (if text-no (lyskom-write-comment-soon (blocking-do 'get-text-stat text-no) (blocking-do 'get-text text-no) text-no 'comment) (lyskom-insert-string 'confusion-what-to-comment)) (lyskom-end-of-command))) (def-kom-command kom-write-footnote (&optional text-no) "Write a footnote to a text. If optional arg TEXT-NO is present write a footnote to that text instead." (interactive) (let ((text-stat nil)) (setq text-no (cond ((and (null current-prefix-arg) lyskom-current-text (setq text-stat (blocking-do 'get-text-stat lyskom-current-text)) (eq (text-stat->author text-stat) lyskom-pers-no)) (setq text-no lyskom-current-text)) ((and (null current-prefix-arg) lyskom-last-written (setq text-stat (blocking-do 'get-text-stat lyskom-last-written))) (lyskom-read-number (lyskom-get-string 'what-footnote-no) lyskom-last-written)) ((integerp current-prefix-arg) current-prefix-arg) ((listp current-prefix-arg) (lyskom-read-number (lyskom-get-string 'what-footnote-no))) (t (signal 'lyskom-internal-error '(kom-write-footnote))))) (if text-no (lyskom-write-comment-soon (blocking-do 'get-text-stat text-no) (blocking-do 'get-text text-no) text-no 'footnote) (lyskom-insert-string 'confusion-what-to-footnote)))) (def-kom-command kom-comment-previous () "Write a comment to previously viewed text." (interactive) (if lyskom-previous-text (lyskom-write-comment-soon (blocking-do 'get-text-stat lyskom-previous-text) (blocking-do 'get-text lyskom-previous-text) lyskom-previous-text 'comment) (lyskom-insert-string 'confusion-what-to-comment))) (defun lyskom-write-comment-soon (text-stat text text-no type) "Write a comment to the text with TEXT-STAT, TEXT and, TEXT-NO. TYPE is either 'comment or 'footnote." (cond ;; Text not found? ((or (null text-stat) (null text)) (lyskom-format-insert 'cant-read-textno text-no)) ;; Give header. ((string-match "\n" (text->text-mass text)) (lyskom-write-comment text-stat (substring (text->text-mass text) 0 (match-beginning 0)) type)) ;; The commented text had no header. (t (lyskom-write-comment text-stat "" type)))) (defun lyskom-write-comment (text-stat subject type) "Write a comment to the text associated with TEXT-STAT. The default subject is SUBJECT. TYPE is either 'comment or 'footnote." (if (null text-stat) (progn (lyskom-insert-string 'confusion-what-to-comment)) (let ((ccrep nil) (bccrep nil)) (lyskom-tell-internat (if (eq type 'comment) 'kom-tell-write-comment 'kom-tell-write-footnote)) (let (data) (mapcar (function (lambda (misc-info) (cond ((eq 'RECPT (misc-info->type misc-info)) (setq data (cons (blocking-do 'get-conf-stat (misc-info->recipient-no misc-info)) data))) ((and (eq type 'footnote) (eq 'CC-RECPT (misc-info->type misc-info))) (setq ccrep (cons (misc-info->recipient-no misc-info) ccrep)) (setq data (cons (blocking-do 'get-conf-stat (misc-info->recipient-no misc-info)) data))) ((and (eq type 'footnote) (eq 'BCC-RECPT (misc-info->type misc-info))) (setq bccrep (cons (misc-info->recipient-no misc-info) bccrep)) (setq data (cons (blocking-do 'get-conf-stat (misc-info->recipient-no misc-info)) data)))))) (text-stat->misc-info-list text-stat)) (lyskom-comment-recipients data lyskom-proc text-stat subject type ccrep bccrep))))) (defun lyskom-comment-recipients (data lyskom-proc text-stat subject type ccrep bccrep) "Compute recipients to a comment to a text. Args: DATA, LYSKOM-PROC TEXT-STAT SUBJECT TYPE CCREP BCCREP. DATA is a list of all the recipients that should receive this text. If DATA contains more than one conference the user is asked (using y-or-n-p) if all conferences really should receive the text. The call is continued to the lyskom-edit-text. TYPE is info whether this is going to be a comment of footnote. CCREP is a list of all recipients that are going to be cc-recipients. BCCREP is a list of all recipient that are going to be bcc-recipients." (condition-case nil ;; Catch any quits (progn ;; Filter multiple recipients through y-or-n-p. (if (and (eq kom-confirm-multiple-recipients 'before) (> (length data) 1) (not (and (= (length data) 2) (or (= lyskom-pers-no (conf-stat->conf-no (car data))) (= lyskom-pers-no (conf-stat->conf-no (car (cdr data)))))))) (let ((new-data nil)) (while data (if (lyskom-j-or-n-p (lyskom-format 'comment-keep-recpt-p (conf-stat->name (car data)))) (setq new-data (cons (car data) new-data))) (setq data (cdr data))) (setq data (nreverse new-data)))) (let* ((member nil) (recver (lyskom-create-misc-list (cond ((eq type 'comment) 'comm-to) ((eq type 'footnote) 'footn-to) (t (signal 'lyskom-internal-error (list "Unknown comment type" type)))) (text-stat->text-no text-stat))) (recpts nil)) (while data (let ((conf-stat (car data))) (if (memq (conf-stat->comm-conf conf-stat) recpts) nil (setq recver (append recver (list (cons (cond ((memq (conf-stat->conf-no conf-stat) ccrep) 'cc-recpt) ((memq (conf-stat->conf-no conf-stat) bccrep) 'bcc-recpt) (t 'recpt)) (conf-stat->comm-conf conf-stat))))) (if (lyskom-get-membership (conf-stat->conf-no conf-stat)) (setq member t)) (setq recpts (cons (conf-stat->comm-conf conf-stat) recpts)))) (setq data (cdr data))) ;; Add the user to the list of recipients if he isn't a member in ;; any of the recipients. (if (not member) (setq recver (append recver (list (cons 'recpt lyskom-pers-no))))) (lyskom-edit-text lyskom-proc recver subject ""))) (quit (signal 'quit "quit in lyskom-comment-recipients")))) ;;; ================================================================ ;;; Personligt svar - personal answer ;;; Author: ??? ;;; Rewritten using blocking-do by: Linus Tolke (def-kom-command kom-private-answer (&optional text-no) "Write a private answer to the current text. If optional arg TEXT-NO is present write a private answer to that text instead." (interactive (list (cond ((null current-prefix-arg) lyskom-current-text) ((integerp current-prefix-arg) current-prefix-arg) ((listp current-prefix-arg) (lyskom-read-number (lyskom-get-string 'what-private-no))) (t (signal 'lyskom-internal-error '(kom-private-answer)))))) (if text-no (lyskom-private-answer-soon (blocking-do 'get-text-stat text-no) (blocking-do 'get-text text-no) text-no) (lyskom-insert-string 'confusion-who-to-reply-to))) (defun lyskom-private-answer-soon (text-stat text text-no) "Write a private answer to TEXT-STAT, TEXT." (if (and text-stat text) (if (string-match "\n" (text->text-mass text)) (lyskom-private-answer text-stat (substring (text->text-mass text) 0 (match-beginning 0))) (lyskom-private-answer text-stat "")) (lyskom-format-insert 'no-such-text-no text-no))) (defun lyskom-private-answer (text-stat subject) "Write a private answer. Args: TEXT-STAT SUBJECT." (if (null text-stat) (progn (lyskom-insert-string 'confusion-what-to-answer-to)) (progn (lyskom-tell-internat 'kom-tell-write-reply) (lyskom-edit-text lyskom-proc (lyskom-create-misc-list 'comm-to (text-stat->text-no text-stat) 'recpt (text-stat->author text-stat) 'recpt lyskom-pers-no) subject "")))) ;;; ================================================================ ;;; Personligt svar p} f|reg}ende - kom-private-answer-previous ;;; Author: ceder ;;; Rewritten using blocking-do by: Linus Tolke (def-kom-command kom-private-answer-previous () "Write a private answer to previously viewed text." (interactive) (if lyskom-previous-text (lyskom-private-answer-soon-prev (blocking-do 'get-text-stat lyskom-previous-text) (blocking-do 'get-text lyskom-previous-text)) (lyskom-insert-string 'confusion-who-to-reply-to))) (defun lyskom-private-answer-soon-prev (text-stat text) "Write a private answer to TEXT-STAT, TEXT." (if (string-match "\n" (text->text-mass text)) (lyskom-private-answer text-stat (substring (text->text-mass text) 0 (match-beginning 0))) (lyskom-private-answer text-stat ""))) ;;; ================================================================ ;;; Sluta - quit ;;; Author: ??? (defun kom-quit (&optional arg) "Quit session. Kill process and buffer-local variables. If optional argument is non-nil then dont ask for confirmation." (interactive "P") (lyskom-start-of-command 'kom-quit t) (let ((do-end-of-command t)) (unwind-protect (setq do-end-of-command (cond ((and (lyskom-buffers-of-category 'write-texts) (display-buffer (car (lyskom-buffers-of-category 'write-texts))) (not (lyskom-ja-or-nej-p (lyskom-get-string 'quit-in-spite-of-unsent)))) t) ((or arg (lyskom-ja-or-nej-p (lyskom-get-string 'really-quit))) (lyskom-quit) nil) (t t))) (if do-end-of-command (lyskom-end-of-command))))) (defun lyskom-quit () "Quit a session. Kill process and buffer-local variables. Don't ask for confirmation." (initiate-logout 'main nil) (setq lyskom-sessions-with-unread (delq lyskom-buffer lyskom-sessions-with-unread)) (setq lyskom-sessions-with-unread-letters (delq lyskom-buffer lyskom-sessions-with-unread-letters)) (set-process-sentinel lyskom-proc nil) (delete-process lyskom-proc) (setq lyskom-proc nil) (lyskom-insert-string 'session-ended) (lyskom-scroll) (setq mode-line-process (lyskom-get-string 'mode-line-down)) (run-hooks 'kom-quit-hook)) ;;; ================================================================ ;;; [ndra presentation - Change presentation ;;; S{tta lapp p} d|rren - Change conf-motd ;;; Author: Inge Wallin ;;; Changed by Linus Tolke (def-kom-command kom-change-presentation () "Change presentation for a person or a conference." (interactive) (lyskom-change-pres-or-motd-2 (let ((no (lyskom-read-conf-no (lyskom-get-string 'what-to-change-pres-you) '(all) t nil t))) (if (zerop no) (setq no lyskom-pers-no)) (blocking-do 'get-conf-stat no)) 'pres)) (def-kom-command kom-change-conf-motd () "Change motd for a person or a conference." (interactive) (lyskom-change-pres-or-motd-2 (let ((no (lyskom-read-conf-no (lyskom-get-string 'who-to-put-motd-for) '(all) t nil t))) (if (zerop no) (setq no lyskom-pers-no)) (blocking-do 'get-conf-stat no)) 'motd)) (defun lyskom-get-recipients-from-misc-list (misc-list) "Return a misc-info-list containing only the recipients." (let* ((info (car misc-list)) (type (misc-info->type info))) (cond ((null misc-list) '()) ((or (eq type 'RECPT) (eq type 'CC-RECPT) (eq type 'BCC-RECPT)) (append (list (intern (downcase (symbol-name type))) (misc-info->recipient-no info)) (lyskom-get-recipients-from-misc-list (cdr misc-list)))) (t (lyskom-get-recipients-from-misc-list (cdr misc-list)))))) (defun lyskom-change-pres-or-motd-2 (conf-stat type) "Change the presentation or motd of CONF-STAT. TYPE is either 'pres or 'motd, depending on what should be changed." (cond ((null conf-stat) ;+++ annan felhantering (lyskom-insert-string 'cant-get-conf-stat)) ((or lyskom-is-administrator (lyskom-get-membership (conf-stat->supervisor conf-stat)) (= lyskom-pers-no (conf-stat->conf-no conf-stat))) (lyskom-dispatch-edit-text lyskom-proc (apply 'lyskom-create-misc-list (if (and (eq type 'pres) (not (zerop (conf-stat->presentation conf-stat)))) (append (lyskom-get-recipients-from-misc-list (text-stat->misc-info-list (blocking-do 'get-text-stat (conf-stat->presentation conf-stat)))) (list 'comm-to (conf-stat->presentation conf-stat))) (list 'recpt (cond ((eq type 'motd) (server-info->motd-conf lyskom-server-info)) ((eq type 'pres) (if (conf-type->letterbox (conf-stat->conf-type conf-stat)) (server-info->pers-pres-conf lyskom-server-info) (server-info->conf-pres-conf lyskom-server-info))))))) (conf-stat->name conf-stat) (let ((text-mass (blocking-do 'get-text (cond ((eq type 'pres) (conf-stat->presentation conf-stat)) ((eq type 'motd) (conf-stat->msg-of-day conf-stat)))))) (if (and text-mass (string-match "\n" (text->text-mass text-mass))) (substring (text->text-mass text-mass) (match-end 0)) (if (and (eq type 'pres) (conf-type->letterbox (conf-stat->conf-type conf-stat))) (lyskom-get-string 'presentation-form) ""))) (cond ((eq type 'pres) 'lyskom-set-presentation) ((eq type 'motd) 'lyskom-set-conf-motd)) (conf-stat->conf-no conf-stat))) (t (lyskom-format-insert 'not-supervisor-for conf-stat)))) ;;; ================================================================ ;;; Ta bort lapp p} d|rren - delete conf-motd ;;; Author: Linus Tolke (& Inge Wallin) (def-kom-command kom-unset-conf-motd () "Removes motd for a person or a conference." (interactive) (let ((conf-stat (or (lyskom-read-conf-stat (lyskom-get-string 'who-to-remove-motd-for) '(all) t nil t) (blocking-do 'get-conf-stat lyskom-pers-no)))) (cond ((null conf-stat) (lyskom-insert-string 'cant-get-conf-stat)) ((or lyskom-is-administrator (lyskom-get-membership (conf-stat->supervisor conf-stat))) ;; This works like a dispatch. No error handling. (lyskom-set-conf-motd 0 (conf-stat->conf-no conf-stat))) (t (lyskom-format-insert 'not-supervisor-for conf-stat))))) ;;; ================================================================ ;;; G} till M|te - Go to a conference. ;;; Author: ??? (def-kom-command kom-go-to-conf (&optional conf-no) "Select a certain conference. The user is prompted for the name of the conference. If s/he was already reading a conference that conference will be put back on lyskom-to-do-list." (interactive) (let ((conf (if conf-no (blocking-do 'get-conf-stat conf-no) (lyskom-read-conf-stat (lyskom-get-string 'go-to-conf-p) '(all) nil "" t)))) (lyskom-go-to-conf conf))) (defun lyskom-go-to-conf (conf) "Go to the conference in CONF. CONF can be conf-no of conf-stat. Allowed conferences are conferences and the mailboxes you are member of." (if (numberp conf) (setq conf (blocking-do 'get-conf-stat conf))) (let ((membership (lyskom-get-membership (conf-stat->conf-no conf)))) (lyskom-format-insert 'go-to-conf conf) ;; FIXME: DEBUG+++ (let ((lyskom-inhibit-prefetch t)) (cond (membership (lyskom-do-go-to-conf conf membership)) ((conf-type->letterbox (conf-stat->conf-type conf)) (lyskom-format-insert 'cant-go-to-his-mailbox conf)) (t (progn (lyskom-format-insert 'not-member-of-conf conf) (lyskom-scroll) (if (lyskom-j-or-n-p (lyskom-get-string 'want-become-member)) (if (lyskom-add-member-by-no (conf-stat->conf-no conf) lyskom-pers-no) (lyskom-do-go-to-conf conf (lyskom-get-membership (conf-stat->conf-no conf))) (lyskom-insert-string 'nope)) (lyskom-insert-string 'no-ok)))))) ;; DEBUG+++ (lyskom-continue-prefetch) )) ;; Dead function /davidk 960217 ;;(defun lyskom-fixup-and-go-to-conf (conf-no) ;; "Prefetches and after lyskom-member-in-conf and then goes to CONF-NO." ;; (lyskom-do-go-to-conf (blocking-do 'get-conf-stat conf-no) ;; (lyskom-member-p conf-no))) (defun lyskom-do-go-to-conf (conf-stat membership) "Go to a conference. Args: CONF-STAT MEMBERSHIP. Put a read-info of type CONF first on lyskom-reading-list. Args: CONF-STAT MEMBERSHIP" (let ((priority (lyskom-get-current-priority))) (lyskom-maybe-move-unread nil) (if conf-stat (lyskom-set-mode-line conf-stat)) (let ((r 0) (len (read-list-length lyskom-to-do-list)) (found nil)) (while (and (not found) (< r len)) (if (and (read-info->conf-stat (read-list->nth lyskom-to-do-list r)) (= (conf-stat->conf-no conf-stat) (conf-stat->conf-no (read-info->conf-stat (read-list->nth lyskom-to-do-list r))))) (setq found t) (++ r))) (cond (found (let ((read-info (read-list->nth lyskom-to-do-list r))) (read-list-enter-first read-info lyskom-reading-list) (read-list-delete-read-info (conf-stat->conf-no conf-stat) lyskom-to-do-list) (read-list-enter-first read-info lyskom-to-do-list) (set-read-info->priority read-info priority) (lyskom-enter-conf conf-stat read-info))) (t (lyskom-go-to-empty-conf conf-stat)))))) (defun lyskom-go-to-empty-conf (conf-stat) "Go to a conference with no unseen messages. Args: CONF-STAT." (blocking-do 'pepsi (conf-stat->conf-no conf-stat)) (lyskom-run-hook-with-args 'lyskom-change-conf-hook lyskom-current-conf (conf-stat->conf-no conf-stat)) (setq lyskom-current-conf (conf-stat->conf-no conf-stat)) (lyskom-format-insert 'conf-all-read conf-stat)) ;;(def-kom-var kom-iåm-conf-no 6 ;; "*Conf-no of IÅM." ;;local) ;;(defun kom-change-to-iåm-hook (old new) ;; (cond ((eq new kom-iåm-conf-no) ;; (make-local-variable kom-iåm-saved-variables) ;; (setq kom-iåm-saved-variables ;; (list kom-check-commented-author-membership ;; kom-check-for-new-comments ;; kom-confirm-multiple-recipients)) ;; (setq kom-check-commented-author-membership nil ;; kom-check-for-new-comments nil ;; kom-confirm-multiple-recipients nil)) ;; (t (when kom-iåm-saved-variables ;; (setq kom-check-commented-author-membership ;; (elt kom-iåm-saved-variables 0) ;; kom-check-for-new-comments ;; (elt kom-iåm-saved-variables 1) ;; kom-confirm-multiple-recipients ;; (elt kom-iåm-saved-variables 2)))))) (defun lyskom-get-current-priority () "Return the current priority level." (or (read-info->priority (read-list->first lyskom-reading-list)) (read-info->priority (read-list->first lyskom-to-do-list)) -1)) ;;; ================================================================ ;;; Skriva inl{gg - write text ;;; Author: ??? (def-kom-command kom-write-text () "write a text." (interactive) ; (lyskom-start-of-command 'kom-write-text) (if (zerop lyskom-current-conf) (progn (lyskom-insert-string 'no-in-conf) (lyskom-end-of-command)) (lyskom-tell-internat 'kom-tell-write-text) (lyskom-edit-text lyskom-proc (lyskom-create-misc-list 'recpt lyskom-current-conf) "" ""))) ;;; ================================================================ ;;; Lista Personer - List persons ;;; Author: ceder ;;; Rewritten: linus (def-kom-command kom-list-persons (match) "List all persons whose name matches MATCH (a string)." (interactive (list (lyskom-read-string (lyskom-get-string 'search-for-pers)))) (mapcar (function (lambda (no) (lyskom-list-pers-print no))) (lyskom-extract-persons (blocking-do 'lookup-name match)))) (defun lyskom-list-pers-print (conf-no) "Print name of the person CONF-NO for kom-list-persons." (lyskom-format-insert "%[%#1@%4#2:p %#3P%]\n" (lyskom-default-button 'pers conf-no) conf-no conf-no)) ;;; ================================================================ ;;; Lista M|ten - List conferences ;;; Author: ceder ;;; Rewritten: linus (def-kom-command kom-list-conferences (match) "List all conferences whose name matches MATCH (a string). Those that you are not a member in will be marked with an asterisk." (interactive (list (lyskom-read-string (lyskom-get-string 'search-for-conf)))) (mapcar (function (lambda (no) (lyskom-list-conf-print no))) (lyskom-extract-confs (blocking-do 'lookup-name match)))) (defun lyskom-list-conf-print (conf-no) "Print a line of info about CONF-NO. If you are not member in the conference it will be flagged with an asterisk." (lyskom-format-insert "%[%#1@%4#2:m %#3c %#4M%]\n" (lyskom-default-button 'conf conf-no) conf-no (if (lyskom-get-membership conf-no) 32 ?*) conf-no)) ;;; ================================================================ ;;; Lista med regexpar - List regexp (def-kom-command kom-list-re (regexp) "List all persons and conferences whose name matches REGEXP." (interactive (list (lyskom-read-string (lyskom-get-string 'search-re)))) (lyskom-format-insert 'matching-regexp regexp) (let ((conf-list (blocking-do 're-z-lookup regexp 1 1))) (mapcar (function (lambda (czi) (lyskom-format-insert "%[%#1@%4#2:m %#3c %#4:M%]\n" (lyskom-default-button 'conf (conf-z-info->conf-no czi)) (conf-z-info->conf-no czi) (if (conf-type->letterbox (conf-z-info->conf-type czi)) ?P ?M) (conf-z-info->name czi)))) (conf-z-info-list->conf-z-infos conf-list)))) ;;; ================================================================ ;;; [ndra namn - Change name ;;; Author: Inge Wallin ;;; Changed by: Peter Eriksson(?) ;;; Changed again: Inge Wallin ;;; Rewritten: linus (def-kom-command kom-change-name () "Change the name of a person or conference." (interactive) (let ((conf-stat (lyskom-read-conf-stat (lyskom-get-string 'name-to-be-changed) '(all) nil nil t))) (if (null conf-stat) (lyskom-insert-string 'no-such-conf-or-pers) (let (name) (lyskom-format-insert 'about-to-change-name-from conf-stat) (lyskom-scroll) (lyskom-tell-internat 'kom-tell-change-name) (setq name (lyskom-read-string (lyskom-get-string 'new-name) (conf-stat->name conf-stat))) (if (blocking-do 'change-name (conf-stat->conf-no conf-stat) name) (lyskom-format-insert 'change-name-done name (lyskom-default-button 'conf conf-stat)) (lyskom-format-insert 'change-name-nope name (lyskom-get-error-text lyskom-errno) lyskom-errno)))))) ;;; ================================================================ ;;; [ndra organisat|r - Change supervisor ;;; Author: Inge Wallin ;;; Rewritten: linus (def-kom-command kom-change-supervisor () "Change the supervisor of a person or conference." (interactive) (let ((supervisee (lyskom-read-conf-stat (lyskom-get-string 'who-to-change-supervisor-for) '(all) nil nil t))) (if (null supervisee) (lyskom-insert-string 'no-such-conf-or-pers) (lyskom-tell-internat 'kom-tell-change-supervisor) (let ((supervisor (lyskom-read-conf-stat (lyskom-get-string 'new-supervisor) '(all) nil nil t))) (lyskom-format-insert 'change-supervisor-from-to supervisee supervisor) (if (blocking-do 'set-supervisor (conf-stat->conf-no supervisee) (conf-stat->conf-no supervisor)) (progn (lyskom-insert-string 'done) (cache-del-conf-stat (conf-stat->conf-no supervisee))) (lyskom-format-insert 'change-supervisor-nope supervisee)))))) ;;; ================================================================ ;;; Markera och Avmarkera - Mark and Unmark a text ;;; Author: Inge Wallin ;;; [ndrad av: Linus Tolke (def-kom-command kom-mark-text (text-no-arg) "Mark a text. If the argument TEXT-NO-ARG is non-nil, the user has used a prefix command argument. If kom-defaul-mark is a number it is used as the mark. If it is nil the user is prompted for the mark to use." (interactive "P") (lyskom-mark-text text-no-arg (lyskom-get-string 'text-to-mark) 1)) (def-kom-command kom-unmark-text (text-no-arg) "Unmark a text. If the argument TEXT-NO-ARG is non-nil, the user has used a prefix command argument." (interactive "P") (lyskom-mark-text text-no-arg (lyskom-get-string 'text-to-unmark) 0)) (defun lyskom-mark-text (text-no-arg prompt mark) "Get the number of the text that is to be marked and do the marking. Arguments: TEXT-NO-ARG: an argument as it is gotten from (interactive P) PROMPT: A string that is used when prompting for a number. MARK: A number that is used as the mark." (let ((text-no (cond ((integerp text-no-arg) text-no-arg) ((and text-no-arg (listp text-no-arg)) (car text-no-arg)) (t lyskom-current-text)))) (if prompt (setq text-no (lyskom-read-number prompt text-no))) (if (not (eq mark 0)) (setq mark (or kom-default-mark (lyskom-read-num-range 1 255 (lyskom-get-string 'what-mark) t)))) (if (equal mark 0) (lyskom-format-insert 'unmarking-textno text-no) (lyskom-format-insert 'marking-textno text-no)) (if (blocking-do 'mark-text text-no mark) (progn (lyskom-insert-string 'done) (if (= mark 0) (cache-del-marked-text text-no) (cache-add-marked-text text-no mark))) (lyskom-insert-string 'nope)) ;+++ lyskom-errno? (cache-del-text-stat text-no))) ;;; ================================================================ ;;; ]terse alla markerade - Review marked texts ;;; Author: Inge Wallin (def-kom-command kom-review-marked-texts () "Review marked texts with a certain mark." (interactive) (lyskom-review-marked-texts (lyskom-read-num-range 1 255 (lyskom-get-string 'what-mark-to-view) t))) (def-kom-command kom-review-all-marked-texts () "Review all marked texts" (interactive) (lyskom-review-marked-texts 0)) (defun lyskom-review-marked-texts (mark-no) "Review all marked texts with the mark equal to MARK-NO. If MARK-NO == 0, review all marked texts." (let ((mark-list (cache-get-marked-texts)) (text-list nil)) (while (not (null mark-list)) (let ((mark (car mark-list))) (if (and mark (or (eq mark-no 0) (eq mark-no (mark->mark-type mark)))) (setq text-list (cons (mark->text-no mark) text-list)))) (setq mark-list (cdr mark-list))) (if (equal (length text-list) 0) (lyskom-insert (if (eq mark-no 0) (lyskom-get-string 'no-marked-texts) (lyskom-format 'no-marked-texts-mark mark-no))) (let ((read-info (lyskom-create-read-info 'REVIEW-MARK nil (lyskom-get-current-priority) (lyskom-create-text-list text-list) nil t))) (read-list-enter-read-info read-info lyskom-reading-list t) (read-list-enter-read-info read-info lyskom-to-do-list t))))) ;;; ================================================================ ;;; [ndra L|senord - Change password ;;; Author: Inge Wallin (def-kom-command kom-change-password () "Change the password for a person." (interactive) (let ((pers-no (lyskom-read-conf-no (lyskom-get-string 'whos-passwd) '(pers) t "" t)) (old-pw (silent-read (lyskom-get-string 'old-passwd))) (new-pw1 (silent-read (lyskom-get-string 'new-passwd))) (new-pw2 (silent-read (lyskom-get-string 'new-passwd-again)))) (if (string= new-pw1 new-pw2) (progn (lyskom-insert-string 'changing-passwd) (lyskom-report-command-answer (blocking-do 'set-passwd (if (zerop pers-no) lyskom-pers-no pers-no) old-pw new-pw1))) (lyskom-insert-string 'retype-dont-match)))) ;;; ================================================================ ;;; (Se) Tiden - display time and date. (defconst lyskom-times '(((nil 12 24 nil nil nil) . xmaseve) ((nil 12 25 nil nil nil) . xmasday) ((nil 1 1 nil nil nil) . newyearday) ((nil 12 31 23 nil nil) . newyearevelate) ((nil 12 31 nil nil nil) . newyeareve) ((nil 4 30 nil nil nil) . cgdag) ((nil 6 6 nil nil nil) . sixjune) ((nil 8 15 nil nil nil) . holdnose) ((nil 3 29 nil nil nil) . lysbday) )) (defun lyskom-format-time (time) "Return TIME as a formatted string." (lyskom-format 'time-format-exact (+ (time->year time) 1900) (1+ (time->mon time)) (time->mday time) (time->hour time) (time->min time) (time->sec time) (elt (lyskom-get-string 'weekdays) (time->wday time)))) (def-kom-command kom-display-time () "Ask server about time and date." (interactive) (let ((time (blocking-do 'get-time)) (lyskom-last-text-format-flags nil)) (lyskom-format-insert 'time-is (lyskom-format-time time) ;; Kult: (if (and (= (time->hour time) (+ (/ (time->sec time) 10) (* (% (time->sec time) 10) 10))) (= (/ (time->min time) 10) (% (time->min time) 10))) (lyskom-get-string 'palindrome) "")) ;; Mera kult (mapcar (function (lambda (el) (let ((when (car el)) (event (cdr el))) (if (and (or (null (elt when 0)) (= (+ (time->year time) 1900) (elt when 0))) (or (null (elt when 1)) (= (1+ (time->mon time)) (elt when 1))) (or (null (elt when 2)) (= (time->mday time) (elt when 2))) (or (null (elt when 3)) (= (time->hour time) (elt when 3))) (or (null (elt when 4)) (= (time->min time) (elt when 4))) (or (null (elt when 5)) (= (time->sec time) (elt when 5)))) (condition-case nil (progn (lyskom-insert " ") (lyskom-format-insert "%#1t" (lyskom-format event (+ (time->year time) 1900) (1+ (time->mon time)) (time->mday time) (time->hour time) (time->min time) (time->sec time)))) (error nil)))))) lyskom-times) ;;; ;;; +++ FIXME specialhack för svenska. Borde det generaliseras? ;;; (when (and (eq lyskom-language 'sv) kom-show-namedays) (let ((tmp (lyskom-nameday time))) (when tmp (lyskom-insert "\n") (lyskom-insert tmp))))) (lyskom-insert "\n")) ;(def-kom-command kom-display-calendar () ; "Nothing yet" ; (interactive) ; (let* ((time (blocking-do 'get-time)) ; (nameday (lyskom-nameday time)) ; (special (lyskom-special-date time))) ; )) (defvar lyskom-nameday-alist '((1 . ((1 . ()) (2 . ("Svea" "Sverker")) (3 . ("Alfred" "Alfrida")) (4 . ("Rut" "Ritva")) (5 . ("Hanna" "Hannele")) (6 . ("Baltsar" "Kasper")) (7 . ("August" "Augusta")) (8 . ("Erland" "Erhard")) (9 . ("Gunnar" "Gunder")) (10 . ("Sigurd" "Sigmund")) (11 . ("Hugo" "Hagar")) (12 . ("Frideborg" "Fridolf")) (13 . ("Knut")) (14 . ("Felix" "Felicia")) (15 . ("Laura" "Liv")) (16 . ("Hjalmar" "Hervor")) (17 . ("Anton" "Tony")) (18 . ("Hilda" "Hildur")) (19 . ("Henrik" "Henry")) (20 . ("Fabian" "Sebastian")) (21 . ("Agnes" "Agneta")) (22 . ("Vincent" "Veine")) (23 . ("Emilia" "Emilie")) (24 . ("Erika" "Eira")) (25 . ("Paul" "Pål")) (26 . ("Bodil" "Boel")) (27 . ("Göte" "Göta")) (28 . ("Karl" "Karla")) (29 . ("Valter" "Vilma")) (30 . ("Gunhild" "Gunilla")) (31 . ("Ivar" "Joar")))) (2 . ((1 . ("Max" "Magda")) (2 . ("Marja" "Mia")) (3 . ("Disa" "Hjördis")) (4 . ("Ansgar" "Anselm")) (5 . ("Lisa" "Elise")) (6 . ("Dorotea" "Dora")) (7 . ("Rikard" "Dick")) (8 . ("Berta" "Berthold")) (9 . ("Fanny" "Betty")) (10 . ("Egon" "Egil")) (11 . ("Yngve" "Ingolf")) (12 . ("Evelina" "Evy")) (13 . ("Agne" "Agnar")) (14 . ("Valentin" "Tina")) (15 . ("Sigfrid" "Sigbritt")) (16 . ("Julia" "Jill")) (17 . ("Alexandra" "Sandra")) (18 . ("Frida" "Fritz")) (19 . ("Gabriella" "Ella")) (20 . ("Rasmus" "Ruben")) (21 . ("Hilding" "Hulda")) (22 . ("Marina" "Marlene")) (23 . ("Torsten" "Torun")) (24 . ("Mattias" "Mats")) (25 . ("Sigvard" "Sivert")) (26 . ("Torgny" "Torkel")) (27 . ("Lage" "Laila")) (28 . ("Maria" "Maja")))) (3 . ((1 . ("Albin" "Inez")) (2 . ("Ernst" "Erna")) (3 . ("Gunborg" "Gunvor")) (4 . ("Adrian" "Ada")) (5 . ("Tora" "Tor")) (6 . ("Ebba" "Ebbe")) (7 . ("Isidor" "Doris")) (8 . ("Siv" "Saga")) (9 . ("Torbjörn" "Ambjörn")) (10 . ("Edla" "Ethel")) (11 . ("Edvin" "Elon")) (12 . ("Viktoria" "Viktor")) (13 . ("Greger" "Iris")) (14 . ("Matilda" "Maud")) (15 . ("Kristofer" "Christel")) (16 . ("Herbert" "Gilbert")) (17 . ("Gertrud" "Görel")) (18 . ("Edvard" "Eddie")) (19 . ("Josef" "Josefina")) (20 . ("Joakim" "Kim")) (21 . ("Bengt" "Benny")) (22 . ("Viking" "Vilgot")) (23 . ("Gerda" "Gert")) (24 . ("Gabriel" "Rafael")) (25 . ("Mary" "Marion")) (26 . ("Emanuel" "Manne")) (27 . ("Ralf" "Raymond")) (28 . ("Elma" "Elmer")) (29 . ("Jonas" "Jens")) (30 . ("Holger" "Reidar")) (31 . ("Ester" "Estrid")))) (4 . ((1 . ("Harald" "Halvar")) (2 . ("Gunnel" "Gun")) (3 . ("Ferdinand" "Florence")) (4 . ("Irene" "Irja")) (5 . ("Nanna" "Nanny")) (6 . ("Vilhelm" "Willy")) (7 . ("Irma" "Mimmi")) (8 . ("Vanja" "Ronja")) (9 . ("Otto" "Ottilia")) (10 . ("Ingvar" "Ingvor")) (11 . ("Ulf" "Ylva")) (12 . ("Julius" "Gillis")) (13 . ("Artur" "Douglas")) (14 . ("Tiburtius" "Tim")) (15 . ("Olivia" "Oliver")) (16 . ("Patrik" "Patricia")) (17 . ("Elias" "Elis")) (18 . ("Valdemar" "Volmar")) (19 . ("Olaus" "Ola")) (20 . ("Amalia" "Amelie")) (21 . ("Annika" "Anneli")) (22 . ("Allan" "Alida")) (23 . ("Georg" "Göran")) (24 . ("Vega" "Viveka")) (25 . ("Markus" "Mark")) (26 . ("Teresia" "Terese")) (27 . ("Engelbrekt" "Enok")) (28 . ("Ture""Tyko")) (29 . ("Kennet" "Kent")) (30 . ("Mariana" "Marianne")))) (5 . ((1 . ("Valborg" "Maj")) (2 . ("Filip" "Filippa")) (3 . ("John" "Jack")) (4 . ("Monika" "Mona")) (5 . ("Vivianne" "Vivan")) (6 . ("Marit" "Rita")) (7 . ("Lilian" "Lilly")) (8 . ("Åke" "Ove")) (9 . ("Jonatan" "Gideon")) (10 . ("Elvira" "Elvy")) (11 . ("Märta" "Märit")) (12 . ("Charlotta" "Lotta")) (13 . ("Linnea" "Nina")) (14 . ("Lillemor" "Lill")) (15 . ("Sofia" "Sonja")) (16 . ("Hilma" "Hilmer")) (17 . ("Nore" "Nora")) (18 . ("Erik" "Jerker")) (19 . ("Majken" "Majvor")) (20 . ("Karolina" "Lina")) (21 . ("Konstantin" "Conny")) (22 . ("Henning" "Hemming")) (23 . ("Desiree" "Renee")) (24 . ("Ivan" "Yvonne")) (25 . ("Urban" "Ursula")) (26 . ("Vilhelmina" "Helmy")) (27 . ("Blenda" "Beda")) (28 . ("Ingeborg" "Borghild")) (29 . ("Jean" "Jeanette")) (30 . ("Fritiof" "Frej")) (31 . ("Isabella" "Isa")))) (6 . ((1 . ("Rune" "Runa")) (2 . ("Rutger" "Roger")) (3 . ("Ingemar" "Gudmar")) (4 . ("Solveig" "Solbritt")) (5 . ("Bo" "Boris")) (6 . ("Gustav" "Gösta")) (7 . ("Robert" "Robin")) (8 . ("Eivor" "Elaine")) (9 . ("Petra" "Petronella")) (10 . ("Kerstin" "Karsten")) (11 . ("Bertil" "Berit")) (12 . ("Eskil" "Esbjörn")) (13 . ("Aina" "Eila")) (14 . ("Håkan" "Heidi")) (15 . ("Margit" "Mait")) (16 . ("Axel" "Axelina")) (17 . ("Torborg" "Torvald")) (18 . ("Björn" "Bjarne")) (19 . ("Germund" "Jerry")) (20 . ("Linda" "Linn")) (21 . ("Alf" "Alva")) (22 . ("Paulina" "Paula")) (23 . ("Adolf" "Adela")) (24 . ("Johan" "Jan")) (25 . ("David" "Salomon")) (26 . ("Gunni" "Jim")) (27 . ("Selma" "Herta")) (28 . ("Leo" "Leopold")) (29 . ("Petrus" "Peter")) (30 . ("Elof" "Leif")))) (7 . ((1 . ("Aron" "Mirjam")) (2 . ("Rosa" "Rosita")) (3 . ("Aurora" "Adina")) (4 . ("Ulrika" "Ulla")) (5 . ("Melker" "Agaton")) (6 . ("Ronald" "Ronny")) (7 . ("Klas" "Kaj")) (8 . ("Kjell" "Tjelvar")) (9 . ("Jörgen" "Örjan")) (10 . ("Anund" "Gunda")) (11 . ("Eleonora" "Ellinor")) (12 . ("Herman" "Hermine")) (13 . ("Joel" "Judit")) (14 . ("Folke" "Odd")) (15 . ("Ragnhild" "Ragnvald")) (16 . ("Reinhold" "Reine")) (17 . ("Alexis" "Alice")) (18 . ("Fredrik" "Fred")) (19 . ("Sara" "Sally")) (20 . ("Margareta" "Greta")) (21 . ("Johanna" "Jane")) (22 . ("Magdalena" "Madeleine")) (23 . ("Emma" "Emmy")) (24 . ("Kristina" "Stina")) (25 . ("Jakob" "James")) (26 . ("Jesper" "Jessika")) (27 . ("Marta" "Moa")) (28 . ("Botvid" "Seved")) (29 . ("Olof" "Olle")) (30 . ("Algot" "Margot")) (31 . ("Elin" "Elna")))) (8 . ((1 . ("Per" "Pernilla")) (2 . ("Karin" "Kajsa")) (3 . ("Tage" "Tanja")) (4 . ("Arne" "Arnold")) (5 . ("Ulrik" "Alrik")) (6 . ("Sixten" "Sölve")) (7 . ("Dennis" "Donald")) (8 . ("Silvia" "Sylvia")) (9 . ("Roland" "Roine")) (10 . ("Lars" "Lorentz")) (11 . ("Susanna" "Sanna")) (12 . ("Klara" "Clary")) (13 . ("Hillevi" "Gullvi")) (14 . ("William" "Bill")) (15 . ("Stella" "Stefan")) (16 . ("Brynolf" "Sigyn")) (17 . ("Verner" "Veronika")) (18 . ("Helena" "Lena")) (19 . ("Magnus" "Måns")) (20 . ("Bernhard" "Bernt")) (21 . ("Jon" "Jonna")) (22 . ("Henrietta" "Henny")) (23 . ("Signe" "Signhild")) (24 . ("Bartolomeus" "Bert")) (25 . ("Lovisa" "Louise")) (26 . ("Östen" "Ejvind")) (27 . ("Rolf" "Rudolf")) (28 . ("Gurli" "Gull")) (29 . ("Hans" "Hampus")) (30 . ("Albert" "Albertina")) (31 . ("Arvid" "Vidar")))) (9 . ((1 . ("Samuel" "Sam")) (2 . ("Justus" "Justina")) (3 . ("Alfhild" "Alfons")) (4 . ("Gisela" "Glenn")) (5 . ("Harry" "Harriet")) (6 . ("Sakarias" "Esaias")) (7 . ("Regina" "Roy")) (8 . ("Alma" "Ally")) (9 . ("Anita" "Anja")) (10 . ("Tord" "Tove")) (11 . ("Dagny" "Daniela")) (12 . ("Tyra" "Åsa")) (13 . ("Sture" "Styrbjörn")) (14 . ("Ida" "Ellida")) (15 . ("Sigrid" "Siri")) (16 . ("Dag" "Daga")) (17 . ("Hildegard" "Magnhild")) (18 . ("Alvar" "Orvar")) (19 . ("Fredrika" "Carita")) (20 . ("Agda" "Agata")) (21 . ("Ellen" "Elly")) (22 . ("Maurits" "Morgan")) (23 . ("Tekla" "Tea")) (24 . ("Gerhard" "Gert")) (25 . ("Kåre" "Tryggve")) (26 . ("Einar" "Enar")) (27 . ("Dagmar" "Rigmor")) (28 . ("Lennart" "Leonard")) (29 . ("Mikael" "Mikaela")) (30 . ("Helge" "Helny")))) (10 . ((1 . ("Ragnar" "Ragna")) (2 . ("Ludvig" "Louis")) (3 . ("Evald" "Osvald")) (4 . ("Frans" "Frank")) (5 . ("Bror" "Bruno")) (6 . ("Jenny" "Jennifer")) (7 . ("Birgitta" "Britta")) (8 . ("Nils" "Nelly")) (9 . ("Ingrid" "Inger")) (10 . ("Helmer" "Hadar")) (11 . ("Erling" "Jarl")) (12 . ("Valfrid" "Ernfrid")) (13 . ("Birgit" "Britt")) (14 . ("Manfred" "Helfrid")) (15 . ("Hedvig" "Hedda")) (16 . ("Fingal" "Finn")) (17 . ("Antonia" "Annette")) (18 . ("Lukas" "Matteus")) (19 . ("Tore" "Torleif")) (20 . ("Sibylla" "Camilla")) (21 . ("Birger" "Börje")) (22 . ("Marika" "Marita")) (23 . ("Sören" "Severin")) (24 . ("Evert" "Eilert")) (25 . ("Inga" "Ingvald")) (26 . ("Amanda" "My")) (27 . ("Sabina" "Ina")) (28 . ("Simon" "Simone")) (29 . ("Viola" "Vivi")) (30 . ("Elsa" "Elsie")) (31 . ("Edit" "Edgar")))) (11 . ((1 . ("Andre" "Andrea")) (2 . ("Tobias" "Toini")) (3 . ("Hubert" "Diana")) (4 . ("Uno" "Unn")) (5 . ("Eugen" "Eugenia")) (6 . ("Gustav""Adolf")) (7 . ("Ingegerd" "Ingela")) (8 . ("Vendela" "Vanda")) (9 . ("Teodor" "Ted")) (10 . ("Martin" "Martina")) (11 . ("Mårten")) (12 . ("Konrad" "Kurt")) (13 . ("Kristian" "Krister")) (14 . ("Emil" "Mildred")) (15 . ("Katja" "Nadja")) (16 . ("Edmund" "Gudmund")) (17 . ("Naemi" "Nancy")) (18 . ("Pierre" "Percy")) (19 . ("Elisabet" "Lisbeth")) (20 . ("Pontus" "Pia")) (21 . ("Helga" "Olga")) (22 . ("Cecilia" "Cornelia")) (23 . ("Klemens" "Clarence")) (24 . ("Gudrun" "Runar")) (25 . ("Katarina" "Carina")) (26 . ("Linus" "Love")) (27 . ("Astrid" "Asta")) (28 . ("Malte" "Malkolm")) (29 . ("Sune" "Synnöve")) (30 . ("Anders" "Andreas")))) (12 . ((1 . ("Oskar" "Ossian")) (2 . ("Beata" "Beatrice")) (3 . ("Lydia" "Carola")) (4 . ("Barbro" "Barbara")) (5 . ("Sven" "Svante")) (6 . ("Nikolaus" "Niklas")) (7 . ("Angelika" "Angela")) (8 . ("Virginia" "Vera")) (9 . ("Anna" "Annie")) (10 . ("Malin" "Malena")) (11 . ("Daniel" "Dan")) (12 . ("Alexander" "Alex")) (13 . ("Lucia")) (14 . ("Sten" "Stig")) (15 . ("Gottfrid" "Gotthard")) (16 . ("Assar" "Astor")) (17 . ("Inge" "Ingemund")) (18 . ("Abraham" "Efraim")) (19 . ("Isak" "Rebecka")) (20 . ("Israel" "Moses")) (21 . ("Tomas" "Tom")) (22 . ("Natanael" "Natalia")) (23 . ("Adam")) (24 . ("Eva")) (26 . ("Stefan" "Staffan")) (27 . ("Johannes" "Hannes")) (29 . ("Abel" "Set")) (30 . ("Gunlög" "Åslög")) (31 . ("Sylvester")))))) (defun lyskom-nameday (&optional now) (let* ((time (or now (blocking-do 'get-time))) (mlist (cdr (assq (1+ (time->mon time)) lyskom-nameday-alist))) (dlist (cdr (assq (time->mday time) mlist)))) (cond ((eq 1 (length dlist)) (lyskom-format "%#1s har namnsdag i dag." (car dlist))) ((eq 2 (length dlist)) (lyskom-format "%#1s och %#2s har namnsdag i dag." (elt dlist 0) (elt dlist 1))) (t (format "%s och %s har namnsdag i dag." (mapconcat 'identity (lyskom-butlast dlist 1) ", ") (elt dlist (1- (length dlist)))))))) ;;; ================================================================ ;;; Vilka ({r inloggade) - Who is on? ;;; Author: ??? ;;; Rewritten by: David K}gedal (put 'lyskom-no-users 'error-conditions '(error lyskom-error lyskom-no-users)) (def-kom-command kom-who-is-on (&optional arg) "Display a list of all connected users. The prefix arg controls the idle limit of the sessions showed. If the prefix is negativ, invisible sessions are also shown. If the prefix is 0, all visible sessions are shown." (interactive "P") (condition-case nil (if lyskom-dynamic-session-info-flag (lyskom-who-is-on-9 arg) (lyskom-who-is-on-8)) (lyskom-no-users (lyskom-insert (lyskom-get-string 'null-who-info))))) (defun lyskom-who-is-on-8 () "Display a list of all connected users. Uses Protocol A version 8 calls" (let* ((who-info-list (blocking-do 'who-is-on)) (who-list (sort (listify-vector who-info-list) (function (lambda (who1 who2) (< (who-info->connection who1) (who-info->connection who2)))))) (total-users (length who-list)) (session-width (1+ (length (int-to-string (who-info->connection (nth (1- total-users) who-list)))))) (format-string-1 (lyskom-info-line-format-string session-width "P" "M")) (format-string-2 (lyskom-info-line-format-string session-width "s" "s")) (lyskom-default-conf-string 'not-present-anywhere) (lyskom-default-pers-string 'secret-person)) (lyskom-format-insert format-string-2 "" (lyskom-get-string 'lyskom-name) (lyskom-get-string 'is-in-conf)) (if kom-show-where-and-what (lyskom-format-insert format-string-2 "" (lyskom-get-string 'from-machine) (lyskom-get-string 'is-doing))) (lyskom-insert (concat (make-string (- (lyskom-window-width) 2) ?-) "\n")) (while who-list (let* ((who-info (car who-list)) (session-no (int-to-string (who-info->connection who-info))) (my-session (if (= lyskom-session-no (who-info->connection who-info)) "*" " "))) (lyskom-format-insert format-string-1 (concat session-no my-session) (who-info->pers-no who-info) (or (who-info->working-conf who-info) (lyskom-get-string 'not-present-anywhere))) (if kom-show-where-and-what (lyskom-format-insert format-string-2 "" (lyskom-return-username who-info) (concat "(" (who-info->doing-what who-info) ")")))) (setq who-list (cdr who-list))) (lyskom-insert (concat (make-string (- (lyskom-window-width) 2) ?-) "\n")) (lyskom-insert (lyskom-format 'total-visible-users total-users)))) (defun lyskom-who-is-on-9 (arg) "Display a list of all connected users. Uses Protocol A version 9 calls" (let* ((wants-invisibles (or (and (numberp arg) (< arg 0)) (and (symbolp arg) (eq '- arg)))) (idle-hide (if (numberp arg) (abs arg) (cond ((eq '- arg) 0) ((numberp kom-idle-hide) kom-idle-hide) (kom-idle-hide 30) (t 0)))) (who-info-list (blocking-do 'who-is-on-dynamic 't wants-invisibles (* idle-hide 60))) (who-list (sort (listify-vector who-info-list) (function (lambda (who1 who2) (< (dynamic-session-info->session who1) (dynamic-session-info->session who2)))))) (total-users (length who-list)) (session-width (if (null who-list) (signal 'lyskom-no-users nil) (1+ (length (int-to-string (dynamic-session-info->session (nth (1- total-users) who-list))))))) (format-string-1 (lyskom-info-line-format-string session-width "P" "M")) (format-string-2 (lyskom-info-line-format-string session-width "D" "s")) (lyskom-default-conf-string 'not-present-anywhere) (lyskom-default-pers-string 'secret-person)) (if (zerop idle-hide) (lyskom-insert (lyskom-get-string 'who-is-active-all)) (lyskom-format-insert 'who-is-active-last-minutes idle-hide)) (if wants-invisibles (lyskom-insert (lyskom-get-string 'showing-invisibles))) (lyskom-format-insert format-string-2 "" (lyskom-get-string 'lyskom-name) (lyskom-get-string 'is-in-conf)) (if kom-show-where-and-what (lyskom-format-insert format-string-2 "" (lyskom-get-string 'from-machine) (lyskom-get-string 'is-doing))) (lyskom-insert (concat (make-string (- (lyskom-window-width) 2) ?-) "\n")) (while who-list (let* ((who-info (car who-list)) (session-no (dynamic-session-info->session who-info)) (session-no-s (int-to-string session-no)) (my-session (if (= lyskom-session-no session-no) "*" " "))) (lyskom-format-insert format-string-1 (concat session-no-s my-session) (dynamic-session-info->person who-info) (or (dynamic-session-info->working-conference who-info) (lyskom-get-string 'not-present-anywhere))) (if kom-show-where-and-what (let* (static defer-info username) (cond (kom-deferred-printing (setq static (cache-get-static-session-info session-no)) (if static (setq username (lyskom-combine-username (static-session-info->username static) (static-session-info->ident-user static) (static-session-info->hostname static))) (setq defer-info (lyskom-create-defer-info 'get-static-session-info session-no 'lyskom-insert-deferred-session-info (make-marker) (length lyskom-defer-indicator) "%#1s")) (setq username defer-info))) (t (setq static (blocking-do 'get-static-session-info session-no)) (setq username (lyskom-combine-username (static-session-info->username static) (static-session-info->ident-user static) (static-session-info->hostname static))))) (lyskom-format-insert format-string-2 "" username (concat "(" (dynamic-session-info->what-am-i-doing who-info) ")")))) (setq who-list (cdr who-list)))) (lyskom-insert (concat (make-string (- (lyskom-window-width) 2) ?-) "\n")) (lyskom-insert (lyskom-format (cond ((and wants-invisibles (zerop idle-hide)) 'total-users) (wants-invisibles 'total-active-users) ((zerop idle-hide) 'total-visible-users) (t 'total-visible-active-users)) total-users)))) (defun lyskom-insert-deferred-session-info (session-info defer-info) (if session-info (lyskom-replace-deferred defer-info (lyskom-combine-username (static-session-info->username session-info) (static-session-info->ident-user session-info) (static-session-info->hostname session-info))) (lyskom-replace-deferred defer-info ""))) ;;; ===================================================================== ;;; Lista klienter - List clients ;;; Author: David Kågedal ;;; Modified: Daivd Byers (def-kom-command kom-list-clients (prefix) "Display a list of all connected users." (interactive "P") (let* ((want-invisible (if prefix t nil)) (who-info-list (blocking-do 'who-is-on-dynamic t want-invisible nil)) (who-list (sort (listify-vector who-info-list) (function (lambda (who1 who2) (< (dynamic-session-info->session who1) (dynamic-session-info->session who2)))))) (total-users (length who-list)) (s-width (1+ (length (int-to-string (dynamic-session-info->session (nth (1- total-users) who-list)))))) (format-string (lyskom-info-line-format-string s-width "P" (if kom-deferred-printing "D" "s")))) (lyskom-format-insert format-string "" (lyskom-get-string 'lyskom-name) (lyskom-get-string 'lyskom-client)) (lyskom-insert (concat (make-string (- (lyskom-window-width) 2) ?-) "\n")) (while who-list (let* ((who-info (car who-list)) (session-no (int-to-string (dynamic-session-info->session who-info))) (my-session (if (= lyskom-session-no (dynamic-session-info->session who-info)) "*" " ")) (client (if kom-deferred-printing (lyskom-create-defer-info 'get-client-name (dynamic-session-info->session who-info) 'lyskom-deferred-client-1 nil nil nil ; Filled in later (dynamic-session-info->session who-info)) (blocking-do-multiple ((name (get-client-name (dynamic-session-info->session who-info))) (version (get-client-version (dynamic-session-info->session who-info)))) (concat name " " version))))) (lyskom-format-insert format-string (concat session-no my-session) (dynamic-session-info->person who-info) client)) (setq who-list (cdr who-list))) (lyskom-insert (concat (make-string (- (lyskom-window-width) 2) ?-) "\n")) (lyskom-insert (lyskom-format (if want-invisible 'total-users 'total-visible-users) total-users)))) (defun lyskom-deferred-client-1 (name defer-info) (initiate-get-client-version 'deferred 'lyskom-deferred-client-2 (defer-info->data defer-info) defer-info name)) (defun lyskom-deferred-client-2 (version defer-info name) (lyskom-replace-deferred defer-info (if (zerop (length name)) "-" (concat name " " version)))) (defun lyskom-info-line-format-string (prefixlen type1 type2) "Return a format string suitable for inserting who-info lines etc." (let* ((plen (or prefixlen 7)) (adj1 (+ plen 2)) (adj2 (+ adj1 1))) (concat "%" (int-to-string plen) "#1s" "%=-" (int-to-string (/ (* 37 (- (lyskom-window-width) adj1)) 73)) "#2" type1 " %=-" (int-to-string (/ (* 37 (- (lyskom-window-width) adj2)) 73)) "#3" type2 "\n"))) (defun lyskom-window-width () "Returns the width of the lyskom-window or the screen-width if not displayed." (let ((win (get-buffer-window (current-buffer)))) (cond (win (window-width win)) (t (frame-width))))) (defun lyskom-return-username (who-info) "Takes the username from the WHO-INFO and returns it on a better format." (let* ((username (who-info->username who-info)) (type (or (string-match "\\([^%@.]+\\)%\\(.+\\)@\\([^%@.]+\\)" username) (string-match "\\([^%@.]+\\)@\\([^%@.]+\\)" username)))) (if type (let ((name (substring username 0 (match-end 1))) (sent (if (match-beginning 3) (substring username (match-beginning 2) (match-end 2)))) (gott (if (match-beginning 3) (substring username (match-beginning 3) (match-end 3)) (substring username (match-beginning 2) (match-end 2)))) (rest (substring username (match-end 0)))) (if (or (not sent) (string= (downcase sent) (downcase gott)) (string= (downcase sent) (downcase (concat gott rest)))) (concat name "@" gott rest) (concat name "@" sent " (" gott rest ")"))) username))) (defun lyskom-combine-username (username identname hostname) "Return a description of from where a user is logged in." ;; Ignore ident info for now (if (string-match "\\(.*\\)%\\(.*\\)" username) (let ((user (substring username (match-beginning 1) (match-end 1))) (uhost (substring username (match-beginning 2) (match-end 2)))) (if (string= uhost hostname) (concat user "@" hostname) (concat username "@" hostname))) (concat username "@" hostname))) ;;; ================================================================ ;;; Status (för) Session - Status (for a) session ;;; ;;; Author: David Byers (def-kom-command kom-status-session (&optional arg) "Show status for all sessions a person has. Asks for person name. Optional argument ARG should be a list of sessions to get information about or a single session number." (interactive "P") (let ((sessions (or (cond ((listp arg) arg) ((numberp arg) (list arg))) (lyskom-read-session-no (lyskom-get-string 'status-for-session)))) who-info) (cond ((null sessions) (lyskom-insert-string 'no-such-session-r)) ((and (numberp (car sessions)) (<= (car sessions) 0)) (lyskom-format-insert (lyskom-get-string 'person-not-logged-in-r) (- (car sessions)))) (t (if lyskom-dynamic-session-info-flag (progn (setq who-info (listify-vector (blocking-do 'who-is-on-dynamic t t 0))) (mapcar (function (lambda (x) (lyskom-status-session-9 x who-info))) sessions)) (setq who-info (listify-vector (blocking-do 'who-is-on))) (mapcar (function (lambda (x) (lyskom-status-session-8 x who-info))) sessions)))))) (defun lyskom-status-session-8 (sid who-info-list) "Show session status for session SID. WHO-INFO is a list of WHO-INFOS that are potential sessions." (while who-info-list (if (eq sid (who-info->connection (car who-info-list))) (let* ((info (car who-info-list)) (client (if kom-deferred-printing (lyskom-create-defer-info 'get-client-name (who-info->connection info) 'lyskom-deferred-client-1 nil nil nil (who-info->connection info)) (blocking-do-multiple ((name (get-client-name (who-info->connection info))) (version (get-client-version (who-info->connection info)))) (concat name " " version))))) (lyskom-format-insert (lyskom-get-string 'session-status) (who-info->connection info) (who-info->pers-no info) (lyskom-return-username info) (if (not (eq (who-info->working-conf info) 0)) (who-info->working-conf info) (lyskom-get-string 'not-present-anywhere)) (let ((string (if (string-match "^\\(.*[^.]\\)\\.*$" (who-info->doing-what info)) (match-string 1 (who-info->doing-what info)) (who-info->doing-what info)))) (if (string= string "") (lyskom-get-string 'unknown-doing-what) string)) client (if (not (eq (who-info->working-conf info) 0)) (lyskom-get-string 'doing-where-conn) (lyskom-get-string 'doing-nowhere-conn))))) (setq who-info-list (cdr who-info-list)))) (defun lyskom-status-session-9 (sid who-info-list) "Show session status for session SID. WHO-INFO is a list of WHO-INFOS that are potential sessions." (let ((static (blocking-do 'get-static-session-info sid))) (while who-info-list (if (eq sid (dynamic-session-info->session (car who-info-list))) (let* ((info (car who-info-list)) (client (if kom-deferred-printing (lyskom-create-defer-info 'get-client-name (dynamic-session-info->session info) 'lyskom-deferred-client-1 nil nil nil (dynamic-session-info->session info)) (blocking-do-multiple ((name (get-client-name (dynamic-session-info->session info))) (version (get-client-version (dynamic-session-info->session info)))) (concat name " " version))))) (lyskom-format-insert (lyskom-get-string 'session-status-9) (dynamic-session-info->session info) (dynamic-session-info->person info) (lyskom-combine-username (static-session-info->username static) (static-session-info->ident-user static) (static-session-info->hostname static)) (if (not (eq (dynamic-session-info->working-conference info) 0)) (dynamic-session-info->working-conference info) (lyskom-get-string 'not-present-anywhere)) (let ((string (if (string-match "^\\(.*[^.]\\)\\.*$" (dynamic-session-info->what-am-i-doing info)) (match-string 1 (dynamic-session-info->what-am-i-doing info)) (dynamic-session-info->what-am-i-doing info)))) (if (string= string "") (lyskom-get-string 'unknown-doing-what) string)) client (if (not (eq (dynamic-session-info->working-conference info) 0)) (lyskom-get-string 'doing-where-conn) (lyskom-get-string 'doing-nowhere-conn)) (lyskom-format-time (static-session-info->connection-time static)) (cond ((eq (/ (dynamic-session-info->idle-time info) 60) 0) (lyskom-get-string 'session-is-active)) ((not (session-flags->user_active_used (dynamic-session-info->flags info))) "\n") (t (lyskom-format (lyskom-get-string 'session-status-inactive) (lyskom-format-secs (dynamic-session-info->idle-time info)))))) (if (session-flags->invisible (dynamic-session-info->flags info)) (lyskom-insert (lyskom-get-string 'session-is-invisible))))) (setq who-info-list (cdr who-info-list))))) (defun lyskom-format-secs-aux (string num x1 x2 one many) (cond ((<= num 0) string) ((= num 1) (if (string= "" string) (concat string (lyskom-get-string one)) (concat string (if (and (= x1 0) (= x2 0)) (format " %s " (lyskom-get-string 'and)) ", ") (lyskom-get-string one)))) (t (if (string= "" string) (concat string (format "%d %s" num (lyskom-get-string many))) (concat string (if (and (= x1 0) (= x2 0)) (format " %s " (lyskom-get-string 'and)) ", ") (format "%d %s" num (lyskom-get-string many))))))) (defun lyskom-format-secs (time) "Format the number of seconds in TIME as a human-readable string." (let (;; (secs (% time 60)) (mins (% (/ time 60) 60)) (hrs (% (/ time 3600) 24)) (days (/ time 86400)) (string "")) (setq string (lyskom-format-secs-aux string days hrs mins 'one-day 'days)) (setq string (lyskom-format-secs-aux string hrs mins 0 'one-hour 'hours)) (setq string (lyskom-format-secs-aux string mins 0 0 'one-minute 'minutes)))) ;;; ================================================================ ;;; Hoppa - Jump over comments ;;; Author: Linus Tolke Y ;; Hoppa |ver alla inl{gg som {r kommentarer till detta inl{gg (recursivt) (defun kom-jump (&optional text-no) "Jumps all comments to the current text. Descends recursively in comment tree. The three is truncated if we encounter an older text. If optional arg TEXT-NO is present then jump all comments to that text instead." (interactive (list (cond ((null current-prefix-arg) lyskom-current-text) ((integerp current-prefix-arg) current-prefix-arg) ((and (listp current-prefix-arg) (integerp (car current-prefix-arg)) (null (cdr current-prefix-arg))) (car current-prefix-arg)) (t (signal 'lyskom-internal-error '(kom-jump)))))) (if text-no (progn (lyskom-start-of-command 'kom-jump) (initiate-get-text-stat 'main 'lyskom-jump text-no t) (lyskom-run 'main 'lyskom-end-of-command)) (lyskom-start-of-command 'kom-jump) (lyskom-insert-string 'have-to-read) (lyskom-end-of-command))) (defun lyskom-jump (text-stat mark-as-read &optional sync) "Jump past TEXT-STAT and all comments to it. Remove TEXT-STAT from all internal tables in the client. If MARK-AS-READ is non-nil, also mark TEXT-STAT and all comments (and footnotes) to it as read in the server." (cond (text-stat ;+++ annan errorhantering. ;; Should check that we are a member of at least one of ;; the recipients, and stop otherwise. (if mark-as-read (lyskom-mark-as-read text-stat)) (lyskom-is-read (text-stat->text-no text-stat)) (lyskom-traverse misc (text-stat->misc-info-list text-stat) (cond ((and (or (eq (misc-info->type misc) 'COMM-IN) (eq (misc-info->type misc) 'FOOTN-IN)) (> (if (eq (misc-info->type misc) 'COMM-IN) (misc-info->comm-in misc) (misc-info->footn-in misc)) (text-stat->text-no text-stat))) (let ((comment (if (eq (misc-info->type misc) 'COMM-IN) (misc-info->comm-in misc) (misc-info->footn-in misc)))) (if sync (lyskom-jump (blocking-do 'get-text-stat comment) mark-as-read sync) (initiate-get-text-stat 'main 'lyskom-jump comment mark-as-read))))))))) ;;; ================================================================ ;;; Addera mottagare - Add recipient ;;; Subtrahera mottagare - Subtract recipient ;;; Author: David Byers & David K}gedal ;;; Based on code by Inge Wallin (def-kom-command kom-add-recipient (text-no-arg) "Add a recipient to a text. If the argument TEXT-NO-ARG is non-nil, the user has used a prefix command argument." (interactive "P") (let ((conf (blocking-do 'get-conf-stat lyskom-last-added-rcpt))) (lyskom-add-sub-recipient text-no-arg (lyskom-get-string 'text-to-add-recipient) 'add-rcpt conf))) (def-kom-command kom-add-copy (text-no-arg) "Add a cc recipient to a text. If the argument TEXT-NO-ARG is non-nil, the user has used a prefix command argument." (interactive "P") (let ((conf (blocking-do 'get-conf-stat lyskom-last-added-ccrcpt))) (lyskom-add-sub-recipient text-no-arg (lyskom-get-string 'text-to-add-copy) 'add-copy conf))) (def-kom-command kom-add-bcc (text-no-arg) "Add a cc recipient to a text. If the argument TEXT-NO-ARG is non-nil, the user has used a prefix command argument." (interactive "P") (let ((conf (blocking-do 'get-conf-stat lyskom-last-added-bccrcpt))) (lyskom-add-sub-recipient text-no-arg (lyskom-get-string 'text-to-add-bcc) 'add-bcc conf))) (def-kom-command kom-sub-recipient (text-no-arg) "Subtract a recipient from a text. If the argument TEXT-NO-ARG is non-nil, the user has used a prefix command argument." (interactive "P") (let ((conf (blocking-do 'get-conf-stat lyskom-current-conf))) (lyskom-add-sub-recipient text-no-arg (lyskom-get-string 'text-to-delete-recipient) 'sub conf))) (def-kom-command kom-move-text (text-no-arg) "Subtract a recipient from a text and add another. If the argument TEXT-NO-ARG is non-nil, the user has used a prefix command argument." (interactive "P") (blocking-do-multiple ((default-from (get-conf-stat lyskom-current-conf)) (default-to (get-conf-stat lyskom-last-added-rcpt))) (lyskom-add-sub-recipient text-no-arg (lyskom-get-string 'text-to-move) 'move default-to default-from))) (defun lyskom-add-sub-recipient (text-no-arg prompt action conf &optional conf2) (let* ((text-no (lyskom-read-number prompt (or text-no-arg lyskom-current-text))) (text-stat (blocking-do 'get-text-stat text-no)) (was-read (lyskom-text-read-p text-stat)) ;; Only for moving (conf-to-move-from (if (eq action 'move) (lyskom-read-conf-stat (lyskom-get-string 'who-to-move-from-q) '(all) nil (if conf2 (conf-stat->name conf2) "") t))) (conf-to-add-to (lyskom-read-conf-stat (lyskom-get-string (cond ((eq action 'add-rcpt) 'who-to-add-q) ((eq action 'add-copy) 'who-to-add-copy-q) ((eq action 'sub) 'who-to-sub-q) ((eq action 'move) 'who-to-move-to-q) (t (lyskom-error "internal error")))) '(all) nil (if conf (conf-stat->name conf) "") t)) (result nil)) (setq result (cond ((eq action 'add-rcpt) (lyskom-format-insert 'adding-name-as-recipient conf-to-add-to text-stat) (setq lyskom-last-added-rcpt (conf-stat->conf-no conf-to-add-to)) (blocking-do 'add-recipient text-no (conf-stat->conf-no conf-to-add-to) 'recpt)) ((eq action 'add-copy) (lyskom-format-insert 'adding-name-as-copy conf-to-add-to text-stat) (setq lyskom-last-added-ccrcpt (conf-stat->conf-no conf-to-add-to)) (blocking-do 'add-recipient text-no (conf-stat->conf-no conf-to-add-to) 'cc-recpt)) ((eq action 'add-bcc) (lyskom-format-insert 'adding-name-as-copy conf-to-add-to text-stat) (setq lyskom-last-added-bccrcpt (conf-stat->conf-no conf-to-add-to)) (blocking-do 'add-recipient text-no (conf-stat->conf-no conf-to-add-to) 'bcc-recpt)) ((eq action 'sub) (lyskom-format-insert 'remove-name-as-recipient conf-to-add-to text-stat) (blocking-do 'sub-recipient text-no (conf-stat->conf-no conf-to-add-to))) ((eq action 'move) (lyskom-format-insert 'moving-name conf-to-move-from conf-to-add-to text-stat) (setq lyskom-last-added-rcpt (conf-stat->conf-no conf-to-add-to)) (blocking-do-multiple ((add (add-recipient text-no (conf-stat->conf-no conf-to-add-to) 'recpt)) (sub (sub-recipient text-no (conf-stat->conf-no conf-to-move-from)))) (and add sub))) (t (lyskom-error "internal error")))) (cache-del-text-stat text-no) (if was-read (lyskom-mark-as-read (blocking-do 'get-text-stat text-no))) (lyskom-report-command-answer result))) ;;; ================================================================ ;;; Addera kommentar - Add comment ;;; Subtrahera kommentar - Subtract comment ;;; Author: David Byers ;;; Heavily based on code by Lars Willf|r (def-kom-command kom-add-comment (text-no-arg) "Add a text as a comment to another text." (interactive "P") (lyskom-add-sub-comment text-no-arg (lyskom-get-string 'text-to-add-comment-to) t)) (def-kom-command kom-sub-comment (text-no-arg) "Remove a comment from a text." (interactive "P") (lyskom-add-sub-comment text-no-arg (lyskom-get-string 'text-to-delete-comment-from) nil)) (defun lyskom-add-sub-comment (text-no-arg prompt do-add) "Get the number of the text that is going to have a comment added to it or subtracted from it Arguments: TEXT-NO-ARG: an argument as it is gotten from (interactive P) PROMPT: A string that is used when prompting for a number. DO-ADD: NIL if a comment should be subtracted. Otherwise a comment is added" (let* ((text-no (lyskom-read-number prompt (or text-no-arg lyskom-current-text))) (comment-text-no (lyskom-read-number (lyskom-get-string (if do-add 'text-to-add-q 'text-to-remove-q)) (if (eq text-no lyskom-current-text) nil lyskom-current-text)))) (lyskom-format-insert (if do-add 'add-comment-to 'sub-comment-to) comment-text-no text-no) (cache-del-text-stat text-no) (cache-del-text-stat comment-text-no) (lyskom-report-command-answer (blocking-do (if do-add 'add-comment 'sub-comment) comment-text-no text-no)))) ;;; ================================================================ ;;; Local Variables: ;;; eval: (put 'lyskom-traverse 'lisp-indent-hook 2) ;;; end: ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: commands2.el,v 44.20.2.2 1999/10/13 12:12:56 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: commands2.el ;;;; ;;;; This file contains the code for some high level commands. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: commands2.el,v 44.20.2.2 1999/10/13 12:12:56 byers Exp $\n")) ;;; ================================================================ ;;; Lista medlemsskap - List membership ;;; Author: Linus Tolke ;;; Rewritten by ceder ;; This functions is left in its "asynchronous way". (def-kom-command kom-membership () "Show memberships last visited, priority, unread and name." (interactive) (let ((buffer (lyskom-get-buffer-create 'list-membership (concat (buffer-name (current-buffer)) "-membership") t))) (save-window-excursion (set-buffer buffer) (lyskom-view-mode) (lyskom-add-hook 'lyskom-new-membership-list-hook 'lyskom-update-membership-when-changed t) (setq truncate-lines t) (let ((inhibit-read-only t)) (erase-buffer) (insert (lyskom-get-string 'your-memberships)) (insert (lyskom-get-string 'memberships-header)))) (save-selected-window (lyskom-display-buffer buffer)) (lyskom-update-membership-buffer))) (defun lyskom-update-membership-buffer () (let ((buf (car (lyskom-buffers-of-category 'list-membership)))) (when (buffer-live-p buf) (let ((inhibit-read-only t)) (save-excursion (set-buffer buf) (erase-buffer)) (lyskom-traverse x lyskom-membership (initiate-get-conf-stat 'memberhsip 'lyskom-memb-received-1 (membership->conf-no x) x buf)))))) (defun lyskom-update-membership-when-changed () (let ((buffer (car (lyskom-buffers-of-category 'list-membership)))) (if (buffer-live-p buffer) (save-excursion (set-buffer buffer) (lyskom-update-membership-buffer)) (lyskom-remove-hook 'lyskom-new-membership-list-hook 'lyskom-update-membership-when-changed)))) (defun lyskom-memb-received-1 (conf-stat membership buffer) "Part of kom-membership. Get maps for the conference CONF-STAT. MEMBERSHIP is the users membership in that conference. Call lyskom-memb-received with the resulting MAP, CONF-STAT, MEMBERSHIP and BUFFER. Args: CONF-STAT MEMBERSHIP BUFFER." (if (/= (conf-stat->conf-no conf-stat) (membership->conf-no membership)) (signal 'lyskom-internal-error '("lyskom-memb-received-1"))) (let* ((first-wanted (1+ (membership->last-text-read membership))) (last-existing (+ (conf-stat->first-local-no conf-stat) (conf-stat->no-of-texts conf-stat) -1))) (if (> first-wanted last-existing) (lyskom-run 'membership 'lyskom-memb-received nil conf-stat membership buffer) (if (> (- last-existing first-wanted) 50) (lyskom-run 'membership 'lyskom-memb-received (- last-existing first-wanted) conf-stat membership buffer) (initiate-get-map 'membership 'lyskom-memb-received (membership->conf-no membership) first-wanted (+ 1 last-existing (- first-wanted)) conf-stat membership buffer))))) (defun lyskom-memb-received (map conf-stat membership buffer) "Args: MAP CONF-STAT MEMBERSHIP BUFFER. Prints membership in a conferences. MAP may be nil if there are no new texts." (save-window-excursion (set-buffer buffer) (goto-char (point-max)) (let ((lyskom-executing-command 'kom-membership) (lyskom-current-command 'kom-membership) (inhibit-read-only t)) (lyskom-format-insert 'memberships-line (lyskom-return-date-and-time (membership->last-time-read membership)) (membership->priority membership) (cond ((null map) 0) ((numberp map) map) ((listp map) (length (lyskom-list-unread map membership))) (t (signal 'lyskom-internal-error '("Erroneous map in lyskom-memb-received")))) conf-stat)))) ;;; ================================================================ ;;; Status (f|r) M|te - Status for a conference ;;; Author: ceder (with some help by Linus) ;;; much enhanced by Inge Wallin (lyskom-status-conf-2 and beyond) (def-kom-command kom-status-conf (&optional conf-no) "Prints conference status. If argument CONF-NO is existing and non-nil then this conference is used. otherwise: the conference is read with lyskom-completing-read." (interactive) (let ((conf-no (or conf-no (lyskom-read-conf-no (lyskom-get-string 'conf-for-status) '(all) nil nil t))) conf-stat) (cache-del-conf-stat conf-no) (setq conf-stat (blocking-do 'get-conf-stat conf-no)) (if (null conf-stat) (lyskom-insert-string 'no-such-conf) (let* ((type (conf-stat->conf-type conf-stat)) (box (conf-type->letterbox type)) (ori (conf-type->original type)) (pro (conf-type->rd_prot type)) (sec (conf-type->secret type))) (lyskom-format-insert 'status-record conf-stat conf-stat (cond ((or box ori pro sec) (concat "(" (if box (lyskom-get-string 'Mailbox) "") (if (and box (or sec ori pro)) ", " "") (if sec (lyskom-get-string 'Protected) "") (if (and sec (or ori pro)) ", " "") (if ori (lyskom-get-string 'no-comments) "") (if (and ori pro) ", " "") (if pro (lyskom-get-string 'closed) "") ")")) (t "")))) (let ((creator (conf-stat->creator conf-stat))) (lyskom-format-insert 'created-by creator creator (if (and (lyskom-conf-stat-p creator) (> (length (conf-stat->name creator)) (- (lyskom-window-width) 46))) "\n" ""))) (lyskom-format-insert 'created-at (lyskom-return-date-and-time (conf-stat->creation-time conf-stat))) (lyskom-format-insert 'members (conf-stat->no-of-members conf-stat)) (lyskom-format-insert 'garb-nice (conf-stat->garb-nice conf-stat)) (lyskom-format-insert 'lowest-local-no (conf-stat->first-local-no conf-stat)) (lyskom-format-insert 'highest-local-no (1- (+ (conf-stat->no-of-texts conf-stat) (conf-stat->first-local-no conf-stat)))) (lyskom-format-insert 'last-text-time (lyskom-return-date-and-time (conf-stat->last-written conf-stat))) (lyskom-format-insert 'no-of-motd (conf-stat->msg-of-day conf-stat)) (let ((superconf (conf-stat->super-conf conf-stat))) (lyskom-format-insert 'superconf-is-no-name superconf superconf (if (and (lyskom-conf-stat-p superconf) (> (length (conf-stat->name superconf)) (- (lyskom-window-width) 46))) "\n" ""))) (let ((permitted-submitters (conf-stat->permitted-submitters conf-stat))) (lyskom-format-insert 'permitted-submitters-no-name permitted-submitters (if (zerop permitted-submitters) (lyskom-get-string 'Everybody) permitted-submitters) "")) (let ((supervisor (conf-stat->supervisor conf-stat))) (lyskom-format-insert 'supervisor-is-no-name supervisor supervisor "")) (lyskom-format-insert 'presentation-no (conf-stat->presentation conf-stat)) (if (zerop (conf-stat->msg-of-day conf-stat)) nil (lyskom-format-insert 'conf-has-motd conf-stat) (lyskom-view-text (conf-stat->msg-of-day conf-stat))) ;; Show all members of CONF-STAT if the user so wishes." (lyskom-scroll) (if (lyskom-j-or-n-p (lyskom-get-string 'show-members-list-also-q)) (let ((member-list (blocking-do 'get-members (conf-stat->conf-no conf-stat) 0 lyskom-max-int))) (lyskom-format-insert 'conf-has-these-members conf-stat) (if (lyskom-j-or-n-p (lyskom-get-string 'show-membership-info-q)) (progn (lyskom-insert-string 'member-list-header) (lyskom-traverse member (conf-no-list->conf-nos member-list) (let ((membership (blocking-do 'query-read-texts member (conf-stat->conf-no conf-stat)))) ;; Print a row describing the membership of MEMBER ;; (described by MEMBERSHIP) in CONF-STAT. (if (or (null membership)) (lyskom-insert-string 'secret-membership) (lyskom-insert (format "%17s" (lyskom-return-date-and-time (membership->last-time-read membership)))) (let ((unread (- (+ (conf-stat->first-local-no conf-stat) (conf-stat->no-of-texts conf-stat)) (membership->last-text-read membership) (length (membership->read-texts membership)) 1))) (lyskom-format-insert 'conf-membership-line (if (zerop unread) " " (format "%7d " unread)) member)))))) ;; Don't show membership info (lyskom-insert "\n") (lyskom-traverse member (conf-no-list->conf-nos member-list) (lyskom-format-insert " %#1P\n" member)))))))) ;;; ================================================================ ;;; Status (f|r) Person - status for a person ;;; Author: ceder ;;; Heavily enhanced: Inge Wallin (lyskom-status-pers-3 and beyond) (def-kom-command kom-status-person (&optional pers-no) "Prints status for a person." (interactive) (let ((pers-no (or pers-no (lyskom-read-conf-no (lyskom-get-string 'pers-for-status) '(pers) nil "" t))) conf-stat pers-stat) (cache-del-conf-stat pers-no) (cache-del-pers-stat pers-no) (setq pers-stat (blocking-do 'get-pers-stat pers-no)) (setq conf-stat (blocking-do 'get-conf-stat pers-no)) ;; "Print status about PERS-STAT. The name is in CONF-STAT" (if (or (null pers-stat) (null conf-stat)) (lyskom-insert-string 'no-such-pers) (lyskom-format-insert 'pers-status-record conf-stat conf-stat) (lyskom-format-insert 'created-time (lyskom-return-date-and-time (conf-stat->creation-time conf-stat))) (lyskom-format-insert 'created-confs (pers-stat->created-confs pers-stat)) (lyskom-format-insert 'created-persons (pers-stat->created-persons pers-stat)) (lyskom-format-insert 'created-texts (1- (+ (pers-stat->no-of-created-texts pers-stat) (pers-stat->first-created-text pers-stat)))) (lyskom-format-insert 'created-lines (pers-stat->created-lines pers-stat)) (lyskom-format-insert 'created-chars (pers-stat->created-bytes pers-stat)) (lyskom-format-insert 'no-of-sessions (pers-stat->sessions pers-stat)) (if (zerop (pers-stat->total-time-present pers-stat)) nil (lyskom-format-insert 'present-time-d-h-m-s (/ (pers-stat->total-time-present pers-stat) (* 24 3600)) (% (/ (pers-stat->total-time-present pers-stat) 3600) 24) (% (/ (pers-stat->total-time-present pers-stat) 60) 60) (% (pers-stat->total-time-present pers-stat) 60))) (lyskom-format-insert 'last-log-in (lyskom-return-date-and-time (pers-stat->last-login pers-stat))) (lyskom-format-insert 'user-name (pers-stat->username pers-stat)) (lyskom-format-insert 'read-texts (pers-stat->read-texts pers-stat)) (if (= (pers-stat->pers-no pers-stat) lyskom-pers-no) (lyskom-format-insert 'marked-texts (pers-stat->no-of-marks pers-stat))) (lyskom-format-insert 'time-for-last-letter (lyskom-return-date-and-time (conf-stat->last-written conf-stat))) (let ((superconf (conf-stat->super-conf conf-stat))) (lyskom-format-insert 'superconf superconf superconf "")) (if (not (zerop (conf-stat->supervisor conf-stat))) (let ((supervisor (conf-stat->supervisor conf-stat))) (lyskom-format-insert 'supervisor supervisor supervisor ""))) (lyskom-format-insert 'member-of-confs (pers-stat->no-of-confs pers-stat)) (lyskom-format-insert 'presentation (conf-stat->presentation conf-stat)) (if (not (zerop (conf-stat->msg-of-day conf-stat))) (progn (lyskom-format-insert 'has-motd conf-stat) (lyskom-view-text (conf-stat->msg-of-day conf-stat)))) ;; "Show all conferences CONF-STAT is a member of if the user so wishes." (lyskom-scroll) (if (null (lyskom-j-or-n-p (lyskom-get-string 'show-membership-list-also-q))) nil (let ((membership-list (blocking-do 'get-membership (conf-stat->conf-no conf-stat))) (lyskom-count-var 0)) (if (null membership-list) (lyskom-format-insert 'not-allowed-see-confs conf-stat) (lyskom-format-insert 'is-member-of conf-stat) (lyskom-insert-string 'membership-list-header) (setq lyskom-count-var 0) (lyskom-traverse membership membership-list (let ((cs (cache-get-conf-stat (membership->conf-no membership)))) (and cs (lyskom-time-greater (membership->last-time-read membership) (conf-stat->last-written conf-stat)) (cache-del-conf-stat (membership->conf-no membership)))) ;; "Print a row describing the membership of ;; MEMBER-CONF-STAT (let ((member-conf-stat (blocking-do 'get-conf-stat (membership->conf-no membership)))) (if (or (null member-conf-stat) (null membership)) (lyskom-insert-string 'secret-membership) (lyskom-insert (format "%17s" (lyskom-return-date-and-time (membership->last-time-read membership)))) (let ((unread (- (+ (conf-stat->first-local-no member-conf-stat) (conf-stat->no-of-texts member-conf-stat)) (membership->last-text-read membership) (length (membership->read-texts membership)) 1))) (lyskom-format-insert 'pers-membership-line (if (zerop unread) " " (format "%6d " unread)) (if (= (conf-stat->conf-no conf-stat) (conf-stat->supervisor member-conf-stat)) (lyskom-get-string 'is-supervisor-mark) " ") member-conf-stat) (setq lyskom-count-var (+ lyskom-count-var unread))))))) ;; "Print the total number of unread texts for the person CONF-STAT." (lyskom-format-insert 'his-total-unread conf-stat lyskom-count-var)))))) ;;; ================================================================ ;;; Skicka meddelande - Send message ;;; Author: Inge Wallin ;;; Rewritten to use lyskom-read-conf-no by Linus Tolke ;;; Modified to use default recipient by David Byers (def-kom-command kom-send-message (&optional who message) "Send a message to one of the users in KOM right now." (interactive) (let ((target (or who (lyskom-read-conf-no (format (lyskom-get-string 'who-to-send-message-to) (lyskom-get-string 'everybody)) (if kom-permissive-completion '(all) '(login conf)) ;; Initial string: t (cond ((eq kom-default-message-recipient 'everybody) nil) ((and (eq kom-default-message-recipient 'group) lyskom-last-group-message-recipient) (cons lyskom-last-group-message-recipient 0)) ((or (and (eq kom-default-message-recipient 'group) (null lyskom-last-group-message-recipient)) (and (eq kom-default-message-recipient 'sender) lyskom-last-personal-message-sender)) (cons lyskom-last-personal-message-sender 0)) (t (if lyskom-last-personal-message-sender (cons lyskom-last-personal-message-sender 0) ""))) t)))) (if (zerop target) (lyskom-insert (lyskom-get-string 'message-all-info)) (lyskom-format-insert 'message-recipient-info target)) (lyskom-send-message target message))) (def-kom-command kom-send-alarm (&optional message) "Send a message to all of the users in KOM right now." (interactive) (lyskom-send-message 0 message)) (defvar lyskom-message-recipient) (defvar lyskom-message-string) (defun lyskom-send-message-minibuffer-setup-hook () (unwind-protect (run-hooks 'lyskom-send-message-setup-hook) (remove-hook 'minibuffer-setup-hook 'lyskom-send-message-minibuffer-setup-hook))) (defun lyskom-send-message-minibuffer-exit-hook () (unwind-protect (run-hooks 'lyskom-send-message-exit-hook) (remove-hook 'minibuffer-exit-hook 'lyskom-send-message-minibuffer-exit-hook))) (defun lyskom-send-message (pers-no message &optional dontshow) "Send a message to the person with the number PERS-NO. PERS-NO == 0 means send the message to everybody. MESSAGE is the message to send. If DONTSHOW is non-nil, don't display the sent message." (let* ((lyskom-message-string nil) (reply nil) (lyskom-message-recipient nil) (lyskom-last-text-format-flags nil)) (add-hook 'minibuffer-setup-hook 'lyskom-send-message-minibuffer-setup-hook) (add-hook 'minibuffer-exit-hook 'lyskom-send-message-minibuffer-exit-hook) (setq lyskom-message-string (or message (lyskom-read-string (lyskom-get-string 'message-prompt) nil 'lyskom-message-history))) (setq lyskom-message-recipient (if (zerop pers-no) nil (blocking-do 'get-conf-stat pers-no))) (run-hooks 'lyskom-send-message-hook) (if lyskom-message-string (progn (setq reply (blocking-do 'send-message pers-no lyskom-message-string)) (if reply (if (not dontshow) (lyskom-handle-as-personal-message (if lyskom-message-recipient (lyskom-format 'message-sent-to-user lyskom-message-string lyskom-message-recipient) (lyskom-format 'message-sent-to-all lyskom-message-string)) lyskom-pers-no lyskom-filter-outgoing-messages)) (lyskom-format-insert-before-prompt 'message-nope (or lyskom-message-recipient (lyskom-get-string 'everybody)) lyskom-message-string))) (lyskom-insert-string 'interrupted)) ;+++ lyskom-errno )) (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)))))) (lyskom-external-function lyskom-resize-minibuffer-mode) (lyskom-external-function resize-minibuffer-setup) (defun lyskom-send-message-turn-off-resize-on-exit () (resize-minibuffer-mode -1) (remove-hook 'lyskom-send-message-exit-hook 'lyskom-send-message-turn-off-resize-on-exit)) (defun lyskom-send-message-resize-minibuffer () "Temporarily turn on resizing of minibuffer" (let ((tmp nil)) (if (not resize-minibuffer-mode) (progn (if (not (memq 'resize-minibuffer-setup minibuffer-setup-hook)) (setq tmp t)) (resize-minibuffer-mode 0) (if tmp (resize-minibuffer-setup)) (add-hook 'lyskom-send-message-exit-hook 'lyskom-send-message-turn-off-resize-on-exit))))) (defun lyskom-send-message-auto-fill () "Temporarily turn on auto fill in minibuffer" (setq fill-column 78) ;+++ Ta bort? (auto-fill-mode 1)) ;;; ================================================================ ;;; Endast l{sa senaste - Set unread articles in a conf. ;;; (Skip or re-read articles). ;;; Author: Linus Tolke ;;; Rehacked: David K}gedal (def-kom-command kom-set-unread (&optional arg conf-no) "Set number of unread articles in current conference." (interactive "P") (setq conf-no (or conf-no lyskom-current-conf)) (if (and (zerop lyskom-current-conf) (null conf-no)) (progn (lyskom-insert-string 'not-present-anywhere) (lyskom-insert-string "\n")) (let ((conf-stat (blocking-do 'get-conf-stat conf-no))) (if (null conf-stat) ;+++ annan errorhantering (lyskom-insert "Error!\n") ;+++ Hrrrmmmmffff???? (let* ((narg (prefix-numeric-value arg)) (n (if (and arg (<= 0 narg) (<= narg (conf-stat->no-of-texts conf-stat))) narg (lyskom-read-num-range 0 (conf-stat->no-of-texts conf-stat) (lyskom-format 'only-last (conf-stat->no-of-texts conf-stat) (conf-stat->name conf-stat))))) (result (blocking-do 'set-unread conf-no n)) (membership (blocking-do 'query-read-texts lyskom-pers-no conf-no)) ) (ignore result) (lyskom-replace-membership membership lyskom-membership) (if (= conf-no lyskom-current-conf) (set-read-list-empty lyskom-reading-list)) (read-list-delete-read-info conf-no lyskom-to-do-list) (lyskom-prefetch-map conf-no membership) ))))) ;;; ================================================================ ;;; Lista Nyheter - List News ;;; Author: Linus Tolke ;;; Rehacked: Inge Wallin (defvar lyskom-special-conf-name "\\`Inl.gg .t mig\\'" "Regexp to match conf names that are special.") (def-kom-command kom-list-news (&optional num) "Print the number of unread articles to the user." (interactive "P") (unless kom-allow-incompleteness (sit-for 0) (lyskom-prefetch-all-confs)) (let ((num-arg (cond ((numberp num) num) ((and (listp num) (numberp (car num))) (car num)) (t nil))) (sum 0)) (mapcar (function (lambda (info) (let ((un (length (cdr (read-info->text-list info)))) (name (conf-stat->name (read-info->conf-stat info))) (conf-stat (read-info->conf-stat info))) (cond ((eq (read-info->type info) 'CONF) (if (or (not num-arg) (>= (-- num-arg) 0)) (lyskom-insert (if (and (boundp 'lyskom-special-conf-name) (stringp lyskom-special-conf-name) (string-match lyskom-special-conf-name name)) (if (/= un 1) (lyskom-format 'you-have-unreads-special un conf-stat) (lyskom-format 'you-have-an-unread-special conf-stat)) (if (/= un 1) (lyskom-format 'you-have-unreads un conf-stat) (lyskom-format 'you-have-an-unread conf-stat))))) (setq sum (+ sum un))))))) (read-list->all-entries lyskom-to-do-list)) (if (= 0 sum) (lyskom-insert-string 'you-have-read-everything) (lyskom-insert (if (/= sum 1) (lyskom-format 'total-unreads sum) (format (lyskom-get-string 'total-unread))))))) ;;; ================================================================ ;;; V{nta - Idle wait (defun kom-busy-wait (arg) "Sets the kom-session in wait-mode. The wait-mode is interrupted when a text in a conference with higher priority than that of the next text to be read. If you want another priority to break that the ones higher that the next text to be read, give the priority as a prefix argument. When a text is received the new text is displayed." (interactive "P") (lyskom-start-of-command 'kom-busy-wait) (unwind-protect (let ((waitfor (or (cond ((integerp arg) arg) ((listp arg) (car arg))) (read-info->priority (read-list->first lyskom-to-do-list)) -2))) (lyskom-tell-server kom-mercial) (if (not (read-list-isempty lyskom-reading-list)) (set-read-list-empty lyskom-reading-list)) (if (= waitfor -2) (lyskom-insert-string 'waiting-for-anything) (lyskom-format-insert 'waiting-higher-than waitfor)) (lyskom-scroll) (setq lyskom-is-waiting (list '> '(or (read-info->priority (read-list->first lyskom-reading-list)) (read-info->priority (read-list->first lyskom-to-do-list)) 257) waitfor)) (while lyskom-is-waiting ;; This is a bit trial-and-error stuff at the momemt. ;; o How to make personal messages appear *fast* ;; o How to enable C-g with a quick response (sit-for 0) (accept-process-output nil 1) (sit-for 0) (if lyskom-quit-flag (signal 'quit nil)))) (lyskom-end-of-command)) ;; We are done waiting (lyskom-beep kom-ding-on-wait-done) (if (read-list-isempty lyskom-reading-list) (kom-go-to-next-conf)) (kom-next-command)) (defun lyskom-time-greater (time1 time2) "Returns t if TIME2 is before TIME1 chronologically." (cond ((< (time->year time2) (time->year time1))) ((< (time->mon time2) (time->mon time1))) ((< (time->mday time2) (time->mday time1))) ((< (time->hour time2) (time->hour time1))) ((< (time->min time2) (time->min time1))) ((< (time->sec time2) (time->sec time1))) (t nil))) ;;; ================================================================ ;;; Lista {rende - list summary ;;; Author: Linus Tolke (def-kom-command kom-list-summary () "List a summary of the unread in the current conf. The summary contains the date, number of lines, author and subject of the text on one line." (interactive) (if (read-list-isempty lyskom-reading-list) (lyskom-insert-string 'have-to-be-in-conf-with-unread) (lyskom-list-summary (text-list->texts (read-info->text-list (let ((len (read-list-length lyskom-reading-list)) (r 0)) (while (< r len) (let ((type (read-info->type (read-list->nth lyskom-reading-list r)))) (if (or (eq type 'CONF) (eq type 'REVIEW-MARK) (eq type 'REVIEW)) (setq len 0) (++ r)))) (read-list->nth lyskom-reading-list r))))))) ;; This function is commented out untile we might implement marks in a ;; new way. But it works as it is. ;;(def-kom-command kom-list-marks (&optional mark) ;; "List a summary of marked texts with mark MARK." ;; (interactive (list (or (and current-prefix-arg ;; (prefix-numeric-value current-prefix-arg)) ;; (lyskom-read-num-range ;; 1 255 ;; (lyskom-get-string 'what-mark-to-list))))) ;; (let ((texts (delq nil ;; (mapcar (function ;; (lambda (x) (and (= (elt (cdr x) 1) mark) ;; (elt (cdr x) 0)))) ;; (blocking-do 'get-marks))))) ;; (lyskom-list-summary texts) ;; (lyskom-format-insert 'you-have-marks (length texts) mark))) (defun lyskom-list-summary (texts) "List a summary of the texts in TEXTS. The summary contains the date, number of lines, author and subject of the text on one line." (let ((time (blocking-do 'get-time)) (author-width (/ (- (lyskom-window-width) 22) 3))) ;; Start fetching all text-stats and text to list them. (lyskom-format-insert (concat "%-8#1s%-6#2s%-4#3s %-" (int-to-string author-width) "#4s %#5s\n") (lyskom-get-string 'Texts) (lyskom-get-string 'Date) (lyskom-get-string 'Lines) (lyskom-get-string 'Author) (lyskom-get-string 'Subject)) (lyskom-traverse text-no texts (let ((text-stat (blocking-do 'get-text-stat text-no)) (text (blocking-do 'get-text text-no)) ;; We could do som optimization here. ;; We really don't need the whole text. ) (lyskom-print-summary-line text-stat text text-no (time->year time) (time->yday time)) (sit-for 0))))) (defun lyskom-print-summary-line (text-stat text text-no year day) "Handle the info, fetch the author and print it. Args: TEXT-STAT TEXT TEXT-NO YEAR DAY. The year and day is there to be able to choose format on the day. Format is 23:29 if the text is written today. Otherwise 04-01." (if (not (and text-stat text)) ;+++ B{ttre felhantering. (lyskom-format-insert 'could-not-read text-no) (let* ((lines (text-stat->no-of-lines text-stat)) (txt (text->text-mass text)) (eos (string-match (regexp-quote "\n") txt)) (subject (substring txt 0 eos)) ;; length of the number %%%%%% :8 ;; length for time is: 6 (time (text-stat->creation-time text-stat)) (time (if (and (= year (time->year time)) (= day (time->yday time))) (format "%02d:%02d" (time->hour time) (time->min time)) (format "%02d-%02d" (1+ (time->mon time)) (time->mday time)))) ;; length for lines is: 4 ;; We split the rest between author and subject (namelen (/ (- (lyskom-window-width) 22) 3)) (subjlen (/ (* (- (lyskom-window-width) 22) 2) 3)) (format-string (concat "%=-8#1n%#2s%4#3d %=-" (int-to-string namelen) "#4P %[%#5@%=-" (int-to-string subjlen) "#6r%]\n"))) (lyskom-format-insert format-string text-no time lines (text-stat->author text-stat) (lyskom-default-button 'text text-no) subject)))) ;;; ============================================================ ;;; kom-who-am-i - Vem är jag ;;; ;;; Author: David Byers (def-kom-command kom-who-am-i () "Show my name" (interactive) (if (and lyskom-current-conf (not (zerop lyskom-current-conf))) (lyskom-format-insert 'who-i-am-present lyskom-pers-no lyskom-current-conf) (lyskom-format-insert 'who-i-am-not-present lyskom-pers-no)) (lyskom-format-insert 'who-i-am-server lyskom-server-name (if (zerop (% (server-info->version lyskom-server-info) 100)) (format "%d.%d" (/ (server-info->version lyskom-server-info) 10000) (/ (% (server-info->version lyskom-server-info) 10000) 100)) (format "%d.%d.%d" (/ (server-info->version lyskom-server-info) 10000) (/ (% (server-info->version lyskom-server-info) 10000) 100) (% (server-info->version lyskom-server-info) 100)))) (lyskom-format-insert 'who-i-am-client lyskom-clientversion) (lyskom-format-insert 'who-i-am-emacs (emacs-version))) ;;; ================================================================ ;;; kom-display-who-buffer - Visa vilka-listan ;;; Author: Linus Tolke (def-kom-command kom-display-who-buffer () "Make the who-buffer appear on the screen as a temp buffer." (interactive) (let ((win (selected-window)) (who (display-buffer lyskom-who-info-buffer))) (unwind-protect (progn (select-window who) (if (numberp kom-who-buffer-size-when-displaying) (enlarge-window (- kom-who-buffer-size-when-displaying (window-height who))))) (select-window win)))) ;;; ================================================================ ;;; Hj{lp vid del av kommando - Help function ;;; Author: Linus Tolke (defun lyskom-help () "Prints a short list of alternatives when you don't know what you can do." (interactive) (let* ((tohere (cond ((stringp (this-command-keys)) (substring (this-command-keys) 0 -1)) (t ;This is the case in the lucid-emacs. (let* ((tck (this-command-keys)) (newvec (make-vector (1- (length tck)) nil)) (r 0)) (while (< r (length newvec)) (aset newvec r (aref tck r)) (++ r)) newvec)))) (binding (key-binding tohere)) (keymap (cond ((and (symbolp binding) (fboundp binding)) (symbol-function binding)) (t binding))) (keylis (lyskom-help-get-keylist keymap)) (text (format "\n%s: \n%s\n" (mapconcat 'single-key-description tohere " ") (mapconcat (function (lambda (arg) (format "%s - %s" (if (fboundp 'key-description) (if (not (vectorp (car arg))) (key-description (vector (car arg))) (key-description (car arg))) (cond ((symbolp (car arg)) (format "%s" (car arg))) ((characterp (car arg)) (format "%c" (car arg))) (t (format "%S" (car arg))))) (or (lyskom-command-name (cdr arg)) (and (keymapp (cdr arg)) (lyskom-get-string 'multiple-choice)) (cdr arg))))) keylis "\n"))) ;; next-char ) (if (eq major-mode 'lyskom-mode) (progn (lyskom-insert text) (lyskom-end-of-command)) (with-output-to-temp-buffer "*Help*" (princ text))))) (defun lyskom-help-get-keylist (keymap) (cond ((fboundp 'map-keymap) (and keymap (let (list) (map-keymap (function (lambda (event function) (setq list (cons (cons event function) list)))) keymap t) (nreverse list)))) ((vectorp keymap) (let ((lis nil) (r 0)) (while (< r (length keymap)) (if (aref keymap r) (setq lis (cons (cons r (aref keymap r)) lis))) (++ r)) (nreverse lis))) (t (cdr keymap)))) ; (setq next-char (read-char)) ; (cond ; ((commandp (key-binding (concat tohere (char-to-string next-char)))) ; (command-execute (concat tohere (char-to-string next-char)))) ; (t (lyskom-message "%s" (lyskom-get-string 'does-not-exist)))) ;;; ================================================================ ;;; Skapa bugg-rapport - Compile bugg-report ;;; Author: Linus Tolke (defun kom-bug-report () "This command should make it easier to include the correct info in a buggreport" (interactive) (let* ((curbuf (current-buffer)) (old-buf (if (boundp 'debugger-old-buffer) (symbol-value 'debugger-old-buffer) (current-buffer))) (repname "*lyskom-bugreport*")) (lyskom-message "%s" (lyskom-get-string 'buggreport-compilestart)) (set-buffer old-buf) (cond ((condition-case nil (eq old-buf (process-buffer lyskom-proc)) (error nil))) ((condition-case nil (save-excursion (set-buffer (process-buffer lyskom-proc)) (set-buffer lyskom-unparsed-buffer) (eq old-buf (current-buffer))) (error nil)) (set-buffer (process-buffer lyskom-proc))) (t (error "I dont know what buffer you are running lyskom in (%s)?" old-buf))) (with-output-to-temp-buffer repname (princ (lyskom-get-string 'buggreport-description)) (princ (lyskom-get-string 'buggreport-internals)) (princ (lyskom-get-string 'buggreport-command-keys)) (terpri) (princ (key-description (recent-keys))) (terpri) (princ (lyskom-get-string 'buggreport-version)) (print lyskom-clientversion) (princ (lyskom-get-string 'buggreport-emacs-version)) (print (emacs-version)) (princ (lyskom-get-string 'buggreport-system-id)) (print system-type) (princ (lyskom-get-string 'buggreport-ctl-arrow-doc)) (print (condition-case nil (documentation-property 'ctl-arrow 'variable-documentation) (error))) (princ (lyskom-get-string 'buggreport-unparsed)) (print (save-excursion (set-buffer lyskom-unparsed-buffer) (goto-char (point-min)) (forward-line 10) (buffer-substring (point-min) (point)))) (if (and (boundp 'debugger-old-buffer) (symbol-value 'debugger-old-buffer)) (princ (lyskom-format 'buggreport-backtrace (save-excursion (set-buffer curbuf) (buffer-substring (point-min) (point-max)))))) (if lyskom-debug-communications-to-buffer (progn (princ (lyskom-get-string 'buggreport-communications)) (print (save-excursion (set-buffer lyskom-debug-communications-to-buffer-buffer) (buffer-substring (point-min) (point-max)))))) (princ (lyskom-get-string 'buggreport-all-kom-variables)) (mapatoms (function (lambda (symbol) (and (boundp symbol) (string-match "^\\(kom-\\|lyskom-\\)" (symbol-name symbol)) (not (string-match "-cache$\\|^kom-dict$\\|^lyskom-strings$\ \\|-map$\\|^lyskom-commands$" (symbol-name symbol))) (progn (terpri) (princ (symbol-name symbol)) (princ ":") (print (symbol-value symbol)))))))) (save-excursion (set-buffer repname) (goto-char (point-min)) (replace-regexp "byte-code(\".*\"" (lyskom-get-string 'buggreport-instead-of-byte-comp))) (lyskom-message "%s" (lyskom-get-string 'buggreport-compileend)))) (fset 'kom-compile-bug-report (symbol-function 'kom-bug-report)) ;;; ================================================================ ;;; [ndra livsl{ngd - Set lifespan of texts in a conference ;;; Author: Inge Wallin (def-kom-command kom-set-garb-nice () "Set the garb-nice value for a conference." (interactive) (let ((conf-stat (lyskom-read-conf-stat (lyskom-get-string 'conf-to-set-garb-nice-q) '(all) nil nil t))) (if (not conf-stat) (lyskom-insert-string 'somebody-deleted-that-conf) (let ((garb-nice (lyskom-read-number (lyskom-get-string 'new-garb-nice-q)))) (lyskom-format-insert 'garb-nice-for-is conf-stat garb-nice) (if (not (blocking-do 'set-garb-nice (conf-stat->conf-no conf-stat) garb-nice)) (lyskom-insert-string 'nope) ;+++lyskom-errno (lyskom-insert-string 'done) (cache-del-conf-stat (conf-stat->conf-no conf-stat))))))) ;;; ================================================================ ;;; S{tt till}tna f|rfattare - set-permitted-submitters ;;; Author: Linus Tolke (def-kom-command kom-set-permitted-submitters () "Set the permitted submitters of a conference." (interactive) (let ((conf-stat (lyskom-read-conf-stat (lyskom-get-string 'conf-to-set-permitted-submitters-q) '(all) nil nil t))) (if (not conf-stat) (lyskom-insert-string 'somebody-deleted-that-conf) (let ((new-conf (lyskom-read-conf-stat (lyskom-format 'new-permitted-submitters-q (conf-stat->name conf-stat)) '(all) t nil t))) (if (eq new-conf nil) (lyskom-format-insert 'permitted-submitters-removed-for-conf conf-stat) (lyskom-format-insert 'submitters-conf-for-is conf-stat new-conf)) (if (not (blocking-do 'set-permitted-submitters (conf-stat->conf-no conf-stat) (if (eq new-conf nil) ;Allowing all to write there 0 (conf-stat->conf-no new-conf)))) (lyskom-insert-string 'nope) ;+++ lyskom-errno (lyskom-insert-string 'done) (cache-del-conf-stat (conf-stat->conf-no conf-stat))))))) ;;; ================================================================ ;;; [ndra superm|te - Set super conference ;;; Author: Inge Wallin (def-kom-command kom-set-super-conf () "Set the super conference for a conference." (interactive) (let ((conf-stat (lyskom-read-conf-stat (lyskom-get-string 'conf-to-set-super-conf-q) '(all) nil nil t))) (if (not conf-stat) (lyskom-insert-string 'somebody-deleted-that-conf) (let ((new-conf (lyskom-read-conf-stat (lyskom-format 'new-super-conf-q (conf-stat->name conf-stat)) '(all) nil nil t))) ;; Set the super conference for conf-stat to new-conf. (lyskom-format-insert 'super-conf-for-is conf-stat new-conf) (if (not (blocking-do 'set-super-conf (conf-stat->conf-no conf-stat) (conf-stat->conf-no new-conf))) (lyskom-insert-string 'nope) ;+++ lyskom-errno (lyskom-insert-string 'done) (cache-del-conf-stat (conf-stat->conf-no conf-stat))))))) ;;; ================================================================ ;;; Spara databasen - Save database ;;; (def-kom-command kom-sync-database () "Save the LysKOM database." (interactive) (if (or (> (elt lyskom-server-version 0) 1) (and (= (elt lyskom-server-version 0) 1) (> (elt lyskom-server-version 1) 8))) (if (lyskom-ja-or-nej-p (lyskom-get-string 'really-sync)) (progn (lyskom-insert-string 'syncing-server) (lyskom-report-command-answer (blocking-do 'sync)))) (setq lyskom-errno 12) (lyskom-report-command-answer nil))) ;;; ================================================================ ;;; St{ng av servern - Shutdown ;;; Author: Inge Wallin (def-kom-command kom-shutdown-server () "Shutdown the LysKOM server." (interactive) (if (lyskom-ja-or-nej-p (lyskom-get-string 'really-shutdown)) (progn (lyskom-insert-string 'closing-server) (lyskom-report-command-answer (blocking-do 'shutdown 0))))) ;;; ================================================================ ;;; \verg} till adm.mod - Enable administrator capabilities ;;; \verg} till normalmod - Disable administrator capabilities ;;; Author: Inge Wallin (def-kom-command kom-enable-adm-caps () "Enable the LysKOM adminstrator commands for the current user." (interactive) (lyskom-enable-adm-caps (blocking-do 'enable 255) (lyskom-get-string 'administrator) t)) (def-kom-command kom-disable-adm-caps () "Disable the LysKOM adminstrator commands for the current user." (interactive) (lyskom-enable-adm-caps (blocking-do 'enable 0) (lyskom-get-string 'no-longer-administrator) nil)) (defun lyskom-enable-adm-caps (answer string is-administrator) "Tell the user if the call succeded." (if answer (progn (lyskom-format-insert 'you-are-now string) (setq lyskom-is-administrator is-administrator)) (lyskom-insert-string 'nope))) ;+++ lyskom-errno ;;; ================================================================ ;;; S{tt loginmeddelande - Set message of the day ;;; Author: Inge Wallin (def-kom-command kom-set-motd () "Set the message of the day for LysKOM." (interactive) (if (server-info->motd-of-lyskom lyskom-server-info) (initiate-get-text 'main 'lyskom-set-motd (server-info->motd-of-lyskom lyskom-server-info)) (lyskom-set-motd nil))) (defun lyskom-set-motd (old-motd-text) "Set the message of the day for LysKOM. Use OLD-MOTD-TEXT as the default text if non-nil." (lyskom-edit-text lyskom-proc (lyskom-create-misc-list) (if (and old-motd-text (string-match "\n" (text->text-mass old-motd-text))) (substring (text->text-mass old-motd-text) 0 (1- (match-end 0))) "") (if (and old-motd-text (string-match "\n" (text->text-mass old-motd-text))) (substring (text->text-mass old-motd-text) (match-end 0)) "") 'lyskom-set-motd-2)) ;; Should really fix lyskom-edit text instead of the ugly IGNORE (defun lyskom-set-motd-2 (text-no ignore) "Set motd of LysKOM to the newly created text TEXT-NO." (lyskom-insert-before-prompt (lyskom-format 'setting-motd text-no)) (initiate-set-motd-of-lyskom 'background 'lyskom-set-motd-3 text-no text-no)) (defun lyskom-set-motd-3 (result text-no) "Handle the return from the initiate-set-motd-of-lyskom call." (if result (progn (lyskom-insert-before-prompt (lyskom-get-string (if (zerop text-no) 'removed-motd 'set-motd-success))) (set-server-info->motd-of-lyskom lyskom-server-info text-no)) (lyskom-insert-before-prompt (lyskom-get-string 'set-motd-failed)))) ;;; ================================================================ ;;; Ta bort loginmeddelande - Remove message of the day ;;; Author: Inge Wallin (def-kom-command kom-remove-motd () "Remove the message of the day for LysKOM." (interactive) (lyskom-insert-string 'removing-motd) (initiate-set-motd-of-lyskom 'background 'lyskom-set-motd-3 0 0)) ;;; ================================================================ ;;; Kasta ut - force logout ;;; Author: Inge Wallin (def-kom-command kom-force-logout () "Force another user to log out." (interactive) (let ((session (car-safe (lyskom-read-session-no (lyskom-get-string 'who-to-throw-out) nil nil t)))) (if session (progn (lyskom-format-insert 'throwing-out session) (lyskom-report-command-answer (blocking-do 'disconnect session)))))) ;;; ================================================================ ;;; Skjut upp l{sning - postpone ;;; Author: Per Cederqvist (def-kom-command kom-postpone (today) "Postpone the reading of all but the last TODAY articles in the current conference to another session." (interactive (list (cond ((null current-prefix-arg) (lyskom-read-number (lyskom-get-string 'postpone-prompt) 17)) (t (prefix-numeric-value current-prefix-arg))))) (let ((len (read-list-length lyskom-reading-list)) (finished nil)) (while (and (not finished) (> len 0)) (let ((type (read-info->type (read-list->first lyskom-reading-list)))) (cond ((or (eq type 'REVIEW) (eq type 'REVIEW-TREE) (eq type 'REVIEW-MARK)) (read-list-rotate lyskom-reading-list)) ((or (eq type 'COMM-IN) (eq type 'FOOTN-IN)) (set-read-list-del-first lyskom-reading-list)) ((eq type 'CONF) (let* ((rlist (read-info->text-list (read-list->first lyskom-reading-list))) (cell (nthcdr (max (- (length rlist) today) 1) rlist))) (setcdr rlist cell)) (setq finished t)) (t (signal 'lyskom-internal-error '("lyskom-remove-comment-chains"))))) (-- len))) ;; Delete the 'CONF entry if we selected 0 entries. (cond ((zerop today) (read-list-delete-text nil lyskom-reading-list) (read-list-delete-text nil lyskom-to-do-list)))) ;;; ================================================================ ;;; S{tt l{sniv} - Sess session priority ;;; Author: David K}gedal (def-kom-command kom-set-session-priority (priority) "Set the priority level of the current session. This sets the variable kom-session-priority and refetches all membership info." (interactive "P") (let ((pri (or priority (lyskom-read-num-range 0 255 (lyskom-get-string 'set-session-priority) t 100)))) (setq lyskom-session-priority pri) (lyskom-refetch))) ;;; ================================================================ ;;; Begrav lyskom-sessionen - kom-bury ;;; Author: Linus Tolke (defun kom-bury () "Puts the kom-session in the background." (interactive) (let ((session-name (buffer-name (current-buffer))) (buffer (current-buffer))) ;;; (if lyskom-debug-communications-to-buffer ;;; (bury-buffer lyskom-debug-communications-to-buffer-buffer)) (if lyskom-who-info-buffer (bury-buffer lyskom-who-info-buffer)) (bury-buffer) (while (and (string-match (regexp-quote session-name) (buffer-name (current-buffer))) (not (eq buffer (current-buffer)))) (bury-buffer)))) (defun lyskom-buffer-p (buf) ;; Returns non-nil if BUF is an active LysKOM buffer (if (and buf (bufferp buf) (buffer-name buf)) (save-excursion (set-buffer buf) (and (eq major-mode 'lyskom-mode) (boundp 'lyskom-proc) lyskom-proc (processp lyskom-proc) (memq (process-status lyskom-proc) '(run open)))))) ;;;(defun lyskom-update-lyskom-buffer-list () ;;; (mapcar (function ;;; (lambda (buf) ;;; (if (and (lyskom-buffer-p buf) ;;; (not (memq buf lyskom-buffer-list))) ;;; ;; This is a LysKOM buffer that we haven't seen yet -- ;;; ;; If it is the current buffer, add it at the start ;;; ;; of lyskom-buffer-list, otherwise add it to the end ;;; (if (eq buf (current-buffer)) ;;; (setq lyskom-buffer-list (cons buf ;;; lyskom-buffer-list)) ;;; (setq lyskom-buffer-list ;;; (nconc lyskom-buffer-list (list buf))))))) ;;; (buffer-list)) ;;; (mapcar (function ;;; (lambda (buf) ;;; (if buf ;;; (setq lyskom-buffer-list ;;; (delete buf lyskom-buffer-list))))) ;;; (mapcar (function ;;; (lambda (buf) ;;; (if (lyskom-buffer-p buf) nil buf))) ;;; lyskom-buffer-list))) (defun lyskom-next-kom () "Internal version of kom-next-kom" (if lyskom-buffer-list (progn (if (lyskom-buffer-p (car lyskom-buffer-list)) ;; If there is an "active" lyskom buffer, send it to the ;; back of the list. (progn ;; If the "active" lyskom buffer is the current buffer, ;; and kom-bury-buffers is non-nil, bury it. (if (and kom-bury-buffers (eq (car lyskom-buffer-list) (current-buffer))) (kom-bury)) (setq lyskom-buffer-list (nconc (cdr lyskom-buffer-list) (list (car lyskom-buffer-list))))) ;; The "active" lyskom buffer is dead, so we remove it from ;; some lists. (setq lyskom-sessions-with-unread (delq (car lyskom-buffer-list) lyskom-sessions-with-unread)) (setq lyskom-sessions-with-unread-letters (delq (car lyskom-buffer-list) lyskom-sessions-with-unread-letters)) (setq lyskom-buffer-list (cdr lyskom-buffer-list))) ;; Don't switch to dead sessions. (if (lyskom-buffer-p (car lyskom-buffer-list)) (switch-to-buffer (car lyskom-buffer-list)) (lyskom-next-kom))) (error "No active LysKOM buffers"))) (defun lyskom-previous-kom () "Internal version of kom-previous-kom" (if (> (length lyskom-buffer-list) 1) (let (lastbuf (last-but-one lyskom-buffer-list)) (while (cdr (cdr last-but-one)) (setq last-but-one (cdr last-but-one))) (setq lastbuf (car (cdr last-but-one))) (if (lyskom-buffer-p (car lyskom-buffer-list)) ;; If there is an "active" lyskom buffer, send it to the ;; back of the list. (progn ;; If the "active" lyskom buffer is the current buffer, ;; and kom-bury-buffers is non-nil, bury it. (if (and kom-bury-buffers (eq (car lyskom-buffer-list) (current-buffer))) (kom-bury)) (setq lyskom-buffer-list (cons lastbuf lyskom-buffer-list)) (rplacd last-but-one nil)) ;; The "active" lyskom buffer is dead, so we remove it from ;; some lists. (setq lyskom-sessions-with-unread (delq (cdr last-but-one) lyskom-sessions-with-unread)) (setq lyskom-sessions-with-unread-letters (delq (cdr last-but-one) lyskom-sessions-with-unread-letters)) (rplacd last-but-one nil)) (if (lyskom-buffer-p (car last-but-one)) (switch-to-buffer lastbuf) (lyskom-previous-kom))) (if (null lyskom-buffer-list) (error (lyskom-get-string 'no-lyskom-session))))) (def-kom-emacs-command kom-next-kom () "Pop up the next lyskom-session." (interactive) (let ((start-buffer (current-buffer))) (if (lyskom-buffer-p (current-buffer)) (lyskom-tell-internat 'kom-tell-next-lyskom)) (lyskom-next-kom) (when (eq (current-buffer) start-buffer) (if kom-next-kom-running-as-kom-command (lyskom-insert-before-prompt (lyskom-get-string 'no-other-lyskom-r)) (error (lyskom-get-string 'no-lyskom-session)))))) (def-kom-emacs-command kom-previous-kom () "Pop up the previous lyskom-session." (interactive) (let ((start-buffer (current-buffer))) (if (lyskom-buffer-p (current-buffer)) (lyskom-tell-internat 'kom-tell-next-lyskom)) (lyskom-previous-kom) (when (eq (current-buffer) start-buffer) (if kom-previous-kom-running-as-kom-command (lyskom-insert-before-prompt (lyskom-get-string 'no-other-lyskom-r)) (error 'no-lyskom-session))))) (def-kom-emacs-command kom-next-unread-kom () "Pop up the next LysKOM session with unread texts in." (interactive) (let ((start-buffer (current-buffer))) (if (not (lyskom-buffer-p (current-buffer))) (lyskom-next-kom)) (let ((thisbuf (current-buffer))) (lyskom-next-kom) (while (and (not (eq thisbuf (current-buffer))) (not (memq lyskom-buffer lyskom-sessions-with-unread))) (lyskom-next-kom))) (when (eq start-buffer (current-buffer)) (if kom-next-unread-kom-running-as-kom-command (lyskom-insert-before-prompt (lyskom-get-string 'no-unread-lyskom-r)) (error (lyskom-get-string 'no-unread-lyskom)))))) ;;;============================================================ ;;; Visa user-arean (kom-show-user-area) ;;; ;;; Author: David Byers (defun kom-show-user-area () "Get and display the user area of the current person" (interactive) (lyskom-start-of-command 'kom-show-user-area) (let ((pers-stat (blocking-do 'get-pers-stat lyskom-pers-no))) (lyskom-view-text (pers-stat->user-area pers-stat) nil nil nil nil nil) (lyskom-run 'main 'lyskom-end-of-command))) ;;;============================================================ ;;; Ändra mötestyp (kom-change-conf-type) ;;; ;;; Author: Tomas Abrahamsson & David Byers (def-kom-command kom-change-conf-type () "Change type of a conference" (interactive) (let* ((conf-stat (lyskom-read-conf-stat (lyskom-get-string 'what-conf-to-change) '(conf pers) nil "" t)) (type (conf-stat->conf-type conf-stat)) (box (conf-type->letterbox type)) (ori (conf-type->original type)) (pro (conf-type->rd_prot type)) (sec (conf-type->secret type))) (lyskom-format-insert 'change-type-prompt conf-stat conf-stat (cond ((or box ori pro sec) (concat "(" (if box (lyskom-get-string 'Mailbox) "") (if (and box (or sec ori pro)) ", " "") (if sec (lyskom-get-string 'Protected) "") (if (and sec (or ori pro)) ", " "") (if ori (lyskom-get-string 'no-comments) "") (if (and ori pro) ", " "") (if pro (lyskom-get-string 'closed) "") ")")) (t ""))) (let* ((open (lyskom-j-or-n-p (lyskom-get-string 'anyone-member))) (secret (if (not open) (lyskom-j-or-n-p (lyskom-get-string 'secret-conf)))) (orig (lyskom-j-or-n-p (lyskom-get-string 'comments-allowed))) (anarchy (lyskom-j-or-n-p (lyskom-get-string 'anonymous-allowed)))) (cache-del-conf-stat (conf-stat->conf-no conf-stat)) (if (not (blocking-do 'set-conf-type (conf-stat->conf-no conf-stat) (lyskom-create-conf-type (not open) (not orig) secret (conf-type->letterbox (conf-stat->conf-type conf-stat)) anarchy (conf-type->rsv1 (conf-stat->conf-type conf-stat)) (conf-type->rsv2 (conf-stat->conf-type conf-stat)) (conf-type->rsv3 (conf-stat->conf-type conf-stat))))) (progn (lyskom-insert-string 'nope) (lyskom-format-insert 'error-code (lyskom-get-error-text lyskom-errno) lyskom-errno)))))) ;;; ============================================================ ;;; Ändra språk ;;; (def-kom-command kom-change-language () "Change the current language in LysKOM" (interactive) (let* ((completion-ignore-case t) (table (lyskom-available-language-list)) (language (completing-read (lyskom-get-string 'which-language) table nil t nil 'lyskom-language-history))) (when (lyskom-string-assoc language table) (lyskom-set-language (cdr (lyskom-string-assoc language table)))))) (defun lyskom-available-language-list () "Return an alist suitable for completing read of available language names." (let ((tmp (mapcar (function (lambda (el) (cons (car el) (eval (cdr el))))) (get 'lyskom-language-codes 'lyskom-language-var))) (codes (mapcar 'car lyskom-languages)) (result nil)) (mapcar (function (lambda (code) (mapcar (function (lambda (codelist) (when (assq code codelist) (setq result (cons (cons (cdr (assq code codelist)) code) result))))) tmp))) codes) result)) ;;; ============================================================ ;;; Beräkna (def-kom-command kom-calculate (&optional exprx) "Calculate optional arg EXPRX, or prompt the user for an expression." (interactive) (when (lyskom-try-require 'calc (lyskom-get-string 'need-library)) (let* ((expr (or exprx (lyskom-with-lyskom-minibuffer (read-from-minibuffer (lyskom-get-string 'calc-expression) nil nil nil 'lyskom-expression-history)))) (result (calc-eval expr))) (cond ((stringp result) (lyskom-format-insert-before-prompt "%#1s = \n %#2s\n" expr result)) (t (lyskom-format-insert-before-prompt "%#1s = \n%#2s^ %#3s\n" expr (make-string (car result) ?\ ) (car (cdr result)))))))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: review.el,v 44.9.2.2 1999/10/13 12:13:27 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: review.el ;;;; ;;;; This file contains functions to review articles in different ways. ;;;; Both the review commands themselves, the functions called by them ;;;; and the underlying functions are here. ;;;; ;;;; Most, if not all, of these functions are written by Linus Tolke. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: review.el,v 44.9.2.2 1999/10/13 12:13:27 byers Exp $\n")) (put 'lyskom-cant-review-error 'error-conditions '(error lyskom-error lyskom-review-error)) (put 'lyskom-review-error 'error-message "Review error") ;;; ====================================================================== ;;; State-saving variables ;;; (defvar lyskom-last-review-by nil) (defvar lyskom-last-review-to nil) (defvar lyskom-last-review-num nil) (defvar lyskom-last-review-pmark nil) (defvar lyskom-last-review-cmark nil) (defvar lyskom-last-review-saved-result-list nil) (defvar lyskom-last-review-saved-by-list nil) (defvar lyskom-last-review-saved-to-list nil) (defvar lyskom-last-review-saved-result-size 0) (defvar lyskom-last-review-saved-smallest nil) (defvar lyskom-last-review-saved-largest nil) (defvar lyskom-have-review nil) (defun lyskom-intersection (a b) "Returns as a list the intersection of list A and list B. The order of the list a is kept." (if (or a b) (let ((list nil)) (while a (if (memq (car a) b) (setq list (cons (car a) list))) (setq a (cdr a))) (nreverse list)))) (defun lyskom-remove-zeroes (a) "Returns a copy of list where all zeroes are removed." (delq 0 (copy-sequence a))) ;;; ================================================================ ;;; ]terse av, till - Review by X to Conference Y. ;;; Author: David Byers (def-kom-command kom-review-all () "Review every articles of an author written to a conference." (interactive) (lyskom-tell-internat 'kom-tell-review) (lyskom-review-by-to 0)) (def-kom-command kom-review-more (&optional count) "Review more articlies using the same critera as the last review." (interactive "P") (if (not lyskom-have-review) (lyskom-format-insert 'no-review-done) (let* ((count (lyskom-read-number (lyskom-get-string 'review-how-many-more) (abs lyskom-last-review-num))) (info (progn (if (and (listp count) (integerp (car count)) (null (cdr count))) (setq count (car count))) (cond ((zerop count) (setq count nil) (lyskom-get-string 'review-rest)) ((> count 0) (lyskom-format (lyskom-get-string 'review-more) count))))) (by lyskom-last-review-by) (to lyskom-last-review-to)) (lyskom-format-insert 'review-more-info-by-to info (if (zerop by) (lyskom-get-string 'anybody) by) (if (zerop to) (lyskom-get-string 'all-confs) to)) (condition-case arg (let ((list (lyskom-get-texts-by-to by to count t))) (setq lyskom-last-review-num (if (< lyskom-last-review-num 0) (- count) count)) (if list (read-list-enter-read-info (lyskom-create-read-info 'REVIEW nil (lyskom-get-current-priority) (lyskom-create-text-list list) nil t) lyskom-reading-list t) (lyskom-insert-string 'no-such-text))) (lyskom-review-error (if arg nil (lyskom-insert-string 'no-such-text))))))) (def-kom-command kom-review-first (&optional count) "Reviews all articles of author that is written to conference recipient. If return is given instead of an author then all authors to that conference is shown. If return is given instead of conference then all conferences for that person is chosen. If a negative numeric argument is given then only the last COUNT articles are chosen. If the argument is positive then the first -COUNT articles are chosen. If the argument is zero the all articles are chosen. No argument is equivalent to COUNT 1. The defaults for this command is the conference that you are in." (interactive "P") (lyskom-tell-internat 'kom-tell-review) (lyskom-review-by-to (- (or count (lyskom-read-number (lyskom-get-string 'review-how-many) 1))))) (def-kom-command kom-review-by-to (&optional count) "Reviews all articles of author that is written to conference recipient. If return is given instead of an author then all authors to that conference is shown. If return is given instead of conference then all conferences for that person is chosen. If a positive numeric argument is given then only the last COUNT articles are chosen. If the argument is negative then the first -COUNT articles are chosen. If the argument is zero the all articles are chosen. No argument is equivalent to COUNT 1. The defaults for this command is the conference that you are in." (interactive "P") (lyskom-review-by-to (or count (lyskom-read-number (lyskom-get-string 'review-how-many) 1)))) (defun lyskom-review-by-to (count) "Common function for kom-review-by-to and kom-review-first" (let* ((info (progn (if (and (listp count) (integerp (car count)) (null (cdr count))) (setq count (car count))) (cond ((zerop count) (setq count nil) (lyskom-get-string 'everything)) ((> count 0) (lyskom-format 'latest-n count)) ((< count 0) (lyskom-format 'first-n (- count)))))) (by (lyskom-read-conf-no (lyskom-format 'review-info (lyskom-format 'info-by-whom info)) '(pers) t nil t)) (to (lyskom-read-conf-no (lyskom-format 'review-info (lyskom-format 'info-to-conf info)) '(all) t ;; If person is not given we must give ;; conf -- Not anymore! ;; (not (zerop by)) (if (zerop lyskom-current-conf) "" (cons (conf-stat->name (blocking-do 'get-conf-stat lyskom-current-conf)) 0)) t))) (if (not (zerop to)) (cache-del-conf-stat to)) (if (not (zerop by)) (cache-del-pers-stat by)) (lyskom-format-insert 'review-info-by-to info (if (zerop by) (lyskom-get-string 'anybody) by) (if (zerop to) (lyskom-get-string 'all-confs) to)) (setq lyskom-last-review-by by) (setq lyskom-last-review-to to) (setq lyskom-last-review-num count) (setq lyskom-last-review-pmark nil) (setq lyskom-last-review-cmark nil) (setq lyskom-last-review-saved-result-list nil) (setq lyskom-last-review-saved-by-list nil) (setq lyskom-last-review-saved-to-list nil) (setq lyskom-last-review-saved-result-size 0) (setq lyskom-last-review-saved-smallest nil) (setq lyskom-last-review-saved-largest nil) (setq lyskom-have-review t) (condition-case arg (let ((list (lyskom-get-texts-by-to by to count))) (if list (read-list-enter-read-info (lyskom-create-read-info 'REVIEW nil (lyskom-get-current-priority) (lyskom-create-text-list list) nil t) lyskom-reading-list t) (lyskom-insert-string 'no-such-text))) (lyskom-review-error (if arg nil (lyskom-insert-string 'no-such-text)))))) ;;; ================================================================ ;;; lyskom-get-texts-by-to ;;; Author: David Byers ;;; ;;; Call lyskom-get-texts-by, lyskom-get-texts-to or ;;; lyskom-get-texts-by-and-to to get NUM texts by person ;;; BY to conference TO. ;;; (defun lyskom-get-texts-by-to (by to num &optional again) "Get NUM texts written by person number BY in conference number TO Args: BY TO NUM" (cond ((and (zerop by) (zerop to)) (lyskom-get-texts-globally num again)) ((zerop to) (lyskom-get-texts-by by num again)) ((zerop by) (lyskom-get-texts-to to num again)) ((and (eq by lyskom-pers-no) (not (eq to by)) (let ((conf (blocking-do 'get-conf-stat to))) (and (conf-type->letterbox (conf-stat->conf-type conf)) (null (map->text-nos (blocking-do 'get-map (conf-stat->conf-no conf) (conf-stat->first-local-no conf) 1)))))) (lyskom-get-texts-by-generic by num (function (lambda (x to) (let ((found nil)) (lyskom-traverse misc (text-stat->misc-info-list x) (setq found (or found (and (or (eq (misc-info->type misc) 'RECPT) (eq (misc-info->type misc) 'CC-RECPT) (eq (misc-info->type misc) 'BCC-RECPT)) (eq (misc-info->recipient-no misc) to))))) found))) (list to) again)) (t (lyskom-get-texts-by-and-to by to num again)))) ;;; ============================================================ ;;; lyskom-check-review-access ;;; Author: David Byers ;;; ;;; Check that we can access the conference map. If we can't some ;;; review functions are just not much fun ;;; (defun lyskom-check-review-access (conf pers) "Check that we can review texts to CONF by PERS. CONF is a conf-stat or t if we know we can access that conference. PERS is a pers-stat or t if we know we can access that person. This function signals an error if review is impossible" (cond ((null conf) (lyskom-format-insert 'review-conf-gone) (signal 'lyskom-cant-review-error t)) ((null pers) (lyskom-format-insert 'review-pers-gone) (signal 'lyskom-cant-review-error t)) ((lyskom-conf-stat-p conf) (cond ((= 0 (conf-stat->no-of-texts conf)) (lyskom-format-insert 'review-cant-read-empty) (signal 'lyskom-cant-review-error t)) ((null (map->text-nos (blocking-do 'get-map (conf-stat->conf-no conf) (conf-stat->first-local-no conf) 1))) (if (conf-type->letterbox (conf-stat->conf-type conf)) (lyskom-format-insert 'review-cant-read-letterbox) (lyskom-format-insert 'review-cant-read-conf)) (signal 'lyskom-cant-review-error t)))))) ;;; ============================================================ ;;; lyskom-get-texts-globally ;;; Author: Per Cederquist, David Byers ;;; (defun lyskom-get-texts-globally (num &optional again) "Get the last NUM texts created in LysKOM. If AGAIN is non-nil, keep going from where we were before." (cond ((and again (null num)) (setq num lyskom-last-review-num)) ((and again (< lyskom-last-review-num 0)) (setq num (- num))) ((null num) (lyskom-format-insert 'cant-review-everything) (signal 'lyskom-cant-review-error t))) (let ((result nil) (textno (cond (again lyskom-last-review-cmark) ((< num 0) 1) (t (lyskom-maxint)))) (op (if (< num 0) 'find-next-text-no 'find-previous-text-no))) (while (and (not (eq textno 0)) (not (null textno)) (< (length result) (abs num))) (setq textno (blocking-do op textno)) (if textno (setq result (cons textno result)))) (setq lyskom-last-review-cmark textno) (if (< num 0) (nreverse result) result))) ;;; ================================================================ ;;; lyskom-get-texts-by-and-to ;;; Author: David Byers ;;; ;;; Note: We can't assume that the conference's map of texts is ;;; sorted. If we could, it would be possible to simplify this ;;; function considerably without making it slower. ;;; ;;; Problem: Construct part of the intersection between the user's ;;; created texts (the by-list) and the texts in a conference (the ;;; to-list) without bogging down the client, server or network and ;;; do it quickly! ;;; ;;; Idea: Construct the intersection incrementally without doing more ;;; work comparing things than we would if we had the full maps to ;;; start with. ;;; ;;; Solution: Get one segment of the by-list (call the nth segment ;;; by_n) and to-list (call the nth segment to_n) at a time until we ;;; are done or until both are exhausted. ;;; ;;; In each iteration do the following: Calculate the intersection ;;; between to_n with each of the previous by_i leaving r_n: ;;; r_n = \prod_{i=1}^{n-1} by_i \cap to_n ;;; where \prod denotes list concatenation. Next calculate the ;;; intersection of by_n with each to_i 0first-created-text persstat))) (phigh (1- (+ plow (pers-stat->no-of-created-texts persstat)))) (pmark (cond (again lyskom-last-review-pmark) ((and num (< num 0)) plow) (t phigh))) (clow (or cstart (conf-stat->first-local-no confstat))) (chigh (1- (+ clow (conf-stat->no-of-texts confstat)))) (cmark (cond (again lyskom-last-review-cmark) ((and num (< num 0)) clow) (t chigh))) (smallest (if again lyskom-last-review-saved-smallest nil)) (largest (if again lyskom-last-review-saved-largest nil)) (abort-loop nil)) (if (null num) (setq num (1+ phigh))) (while (and (or (and (<= pmark phigh) (>= pmark plow)) (and (<= cmark chigh) (>= cmark clow))) (> (abs num) result-size) (not abort-loop)) (setq by (and (<= pmark phigh) (>= pmark plow) (lyskom-remove-zeroes (listify-vector (map->text-nos (blocking-do 'get-created-texts (pers-stat->pers-no persstat) (if (< num 0) pmark (max 0 (- pmark (1- increment)))) increment))))) to (and (<= cmark chigh) (>= cmark clow) (lyskom-remove-zeroes (listify-vector (map->text-nos (blocking-do 'get-map (conf-stat->conf-no confstat) (if (< num 0) cmark (max 0 (- cmark (1- increment)))) increment)))))) (if (> num 0) (if (and smallest by (> smallest (car by))) (setq abort-loop t)) (if (and largest by (< largest (car (nthcdr (1- (length by)) by)))) (setq abort-loop t))) ;; ;; Add intersection between new TO and old BYs ;; to the results list. ;; (setq result-list (cons (apply 'nconc (mapcar (function (lambda (x) (lyskom-intersection to x))) by-list)) result-list)) ;; ;; Add new BY and TO to the by-list and to-list ;; (setq by-list (cons by by-list) to-list (cons to to-list)) ;; ;; Add intersections between new BY and all TOs ;; (setq result-list (mapcar2 (function (lambda (x y) (lyskom-intersection y (nconc x by)))) result-list to-list)) (setq result-size (apply '+ (mapcar 'length result-list))) ;; ;; Adjust the marks ;; (if (> num 0) (setq pmark (- pmark increment) cmark (- cmark increment)) (setq pmark (+ pmark increment) cmark (+ cmark increment))) ;; ;; If we have exhausted the conference, calculate smallest and ;; largest ;; (if (and (null smallest) (null largest) (or (> cmark chigh) (< cmark clow))) (setq smallest (apply 'min (mapcar (function (lambda (x) (if x (apply 'min x) (lyskom-maxint)))) to-list)) largest (apply 'max (mapcar (function (lambda (x) (if x (apply 'max x) -1))) to-list)))) ;; ;; This is the end of the while loop ;; ) (setq lyskom-last-review-pmark pmark) (setq lyskom-last-review-cmark cmark) (setq lyskom-last-review-saved-by-list by-list) (setq lyskom-last-review-saved-to-list to-list) (setq lyskom-last-review-saved-smallest smallest) (setq lyskom-last-review-saved-largest largest) ;; ;; Extract results ;; (setq result-list (apply 'nconc (if (< num 0) (nreverse result-list) result-list))) ;; ;; Save discarded results and return retained results ;; (if (> num 0) (progn (setq lyskom-last-review-saved-result-list (nfirst (- (length result-list) num) result-list)) (setq lyskom-last-review-saved-result-size (length lyskom-last-review-saved-result-list)) (setq lyskom-last-review-saved-result-list (cons lyskom-last-review-saved-result-list (make-list (- (length by-list) 1) nil))) (nthcdr (- (length result-list) num) result-list)) (progn (setq lyskom-last-review-saved-result-list (nthcdr (- num) result-list)) (setq lyskom-last-review-saved-result-size (length lyskom-last-review-saved-result-list)) (setq lyskom-last-review-saved-result-list (cons lyskom-last-review-saved-result-list (make-list (- (length by-list) 1) nil))) (nfirst (- num) result-list)))))) ;;; =============================================================== ;;; lyskom-get-texts-by, lyskom-get-texts-to ;;; Author: David Byers ;;; ;;; These functions get data in chunks, starting with the number of ;;; texts requested. If they come up empty (which is common when ;;; scanning from the beginning of a map), the increment is ;;; exponentially increased up to a maximum of 150. ;;; ;;; lyskom-get-texts-by is also careful to filter out those texts that ;;; are not readable, hence the added complexity in that function. ;;; (defun lyskom-get-texts-by (persno num &optional again pstart) "Get NUM texts written by PERSNO. Args: persno num" (let ((persstat (blocking-do 'get-pers-stat persno))) (lyskom-check-review-access t persstat) (lyskom-get-texts-by-generic persno num nil nil again pstart))) (defun lyskom-get-texts-by-generic (persno num pred args &optional again pstart) "Get NUM texts written by PERSNO. Args: persno num" (let ((persstat (blocking-do 'get-pers-stat persno))) (cond ((and again (null num)) (setq num lyskom-last-review-num)) ((and again (< lyskom-last-review-num 0)) (setq num (- num)))) (let* ((plow (or pstart (pers-stat->first-created-text persstat))) (phigh (1- (+ plow (pers-stat->no-of-created-texts persstat)))) (result (if again lyskom-last-review-saved-result-list nil)) (increment (if num (abs num))) (mark (cond (again lyskom-last-review-pmark) ((and num (< num 0)) plow) (t phigh))) (collector nil) (found nil) (start nil) (data nil)) (if (null num) (setq num (1+ phigh) mark phigh increment (1+ phigh))) (while (and (<= mark phigh) (>= mark plow) (> (abs num) (length result))) (setq increment (min lyskom-fetch-map-nos increment)) (setq start (if (< num 0) mark (- mark (1- increment)))) (if (< start 0) (progn (setq increment (- increment start)) (setq start 0))) (setq data (lyskom-remove-zeroes (listify-vector (map->text-nos (blocking-do 'get-created-texts persno start increment))))) (setq collector (make-collector)) (mapcar (function (lambda (x) (initiate-get-text-stat 'main (function (lambda (x collector pred args) (when (and x (or (null pred) (apply pred x args))) (collector-push (text-stat->text-no x) collector)))) x collector pred args))) data) (lyskom-wait-queue 'main) (setq found (nreverse (collector->value collector))) (if (> num 0) (setq result (nconc found result) mark (- mark increment)) (setq result (nconc result found) mark (+ mark increment))) (if (null found) (setq increment (min lyskom-fetch-map-nos (* increment 2))) (setq increment (- (abs num) (length result))))) (setq lyskom-last-review-pmark mark) (if (> num 0) (progn (setq lyskom-last-review-saved-result-list (nfirst (- (length result) num) result)) (nthcdr (- (length result) num) result)) (progn (setq lyskom-last-review-saved-result-list (nthcdr (- num) result)) (nfirst (- num) result)))))) (defun lyskom-get-texts-to (confno num &optional again cstart) "From CONFNO get NUM texts." (let ((confstat (blocking-do 'get-conf-stat confno))) (lyskom-check-review-access confstat t) (cond ((and again (null num)) (setq num lyskom-last-review-num)) ((and again (< lyskom-last-review-num 0)) (setq num (- num)))) (let* ((clow (or cstart (conf-stat->first-local-no confstat))) (chigh (1- (+ clow (conf-stat->no-of-texts confstat)))) (result (if again lyskom-last-review-saved-result-list nil)) (start nil) (increment (and num (abs num))) (mark (cond (again lyskom-last-review-cmark) ((and num (< num 0)) clow) (t chigh)))) (if (null num) (setq num (1+ chigh) increment (1+ chigh) mark chigh)) (while (and (<= mark chigh) (>= mark clow) (> (abs num) (length result))) (setq increment (min lyskom-fetch-map-nos increment)) (setq start (if (< num 0) mark (- mark (1- increment)))) (if (< start 0) (progn (setq increment (- increment start)) (setq start 0))) (let ((found (lyskom-remove-zeroes (listify-vector (map->text-nos (blocking-do 'get-map confno start increment)))))) (if (> num 0) (setq result (nconc found result) mark (- mark increment) increment (- (abs num) (length result))) (setq result (nconc result found) mark (+ mark increment))) (if (null found) (setq increment (min lyskom-fetch-map-nos (* increment 2))) (setq increment (- (abs num) (length result)))))) (setq lyskom-last-review-cmark mark) (if (> num 0) (progn (setq lyskom-last-review-saved-result-list (nfirst (- (length result) num) result)) (nthcdr (- (length result) num) result)) (progn (setq lyskom-last-review-saved-result-list (nthcdr (- num) result)) (nfirst (- num) result)))))) ;;; ============================================================ ;;; Återse baklänges ;;; (def-kom-command kom-review-backward () "Toggles the reviewing order. If reading forward then starts reading backward and the other way round." (interactive) (cond ((and (not (read-list-isempty lyskom-reading-list)) (or (eq (read-info->type (read-list->first lyskom-reading-list)) 'REVIEW) (eq (read-info->type (read-list->first lyskom-reading-list)) 'REVIEW-MARK))) (let* ((info (read-list->first lyskom-reading-list)) (list (read-info->text-list info)) (texts (cdr list)) (forward (read-info->forward info))) (setcdr list (nreverse texts)) (set-read-info->forward info (not forward)) (lyskom-format-insert 'you-review (lyskom-get-string (if (not forward) 'forward 'backward))))) (t (lyskom-insert-string 'illegal-command)))) ;;; ================================================================ ;;; ]terse tr{det - review tree ;;; Author: Linus Tolke (def-kom-command kom-review-tree (&optional text-no) "Review all comments to this text. Descends recursively in the comment-tree without marking the texts as read. The tree is forgotten when a kom-go-to-next-conf command is issued. If optional prefix argument TEXT-NO is present view tree from that text instead. In this case the text TEXT-NO is first shown." (interactive (list (cond ((null current-prefix-arg) lyskom-current-text) ((integerp current-prefix-arg) current-prefix-arg) (t (signal 'lyskom-internat-error '(kom-review-tree)))))) (lyskom-tell-internat 'kom-tell-review) (if text-no (let ((ts (blocking-do 'get-text-stat text-no))) (lyskom-follow-comments ts nil 'review (lyskom-get-current-priority) t)) (lyskom-insert-string 'read-text-first))) (def-kom-command kom-find-root (&optional text-no) "Finds the root text of the tree containing the text in lyskom-current-text." (interactive) (lyskom-tell-internat 'kom-tell-review) (cond (lyskom-current-text (let* ((ts (blocking-do 'get-text-stat (or text-no lyskom-current-text))) (r (lyskom-find-root ts t))) (cond ((> (length r) 1) (lyskom-format-insert-before-prompt (lyskom-get-string 'more-than-one-root) ts) (read-list-enter-read-info (lyskom-create-read-info 'REVIEW nil (lyskom-get-current-priority) (lyskom-create-text-list r) nil t) lyskom-reading-list t)) (r (lyskom-view-text (car r))) (t (signal 'lyskom-internal-error "Could not find root"))) ) ) (t (lyskom-insert-string 'read-text-first)))) (def-kom-command kom-find-root-review () "Finds the root text of the tree containing the text in lyskom-current-text and reviews the whole tree in deep-first order." (interactive) (lyskom-tell-internat 'kom-tell-review) (cond (lyskom-current-text (let* ((ts (blocking-do 'get-text-stat lyskom-current-text)) (start (lyskom-find-root ts t))) (cond ((> (length start) 1) (lyskom-format-insert-before-prompt (lyskom-get-string 'more-than-one-root-review) ts) (lyskom-review-tree (car start))) (start (lyskom-review-tree (car start))) (t (signal 'lyskom-internal-error "Could not find root"))))) (t (lyskom-insert-string 'read-text-first)))) (defun lyskom-find-root (text-stat &optional all) "Finds the root text of the tree containing the text TEXT-STAT. Args: TEXT-STAT &optional ALL If ALL is set, return a list of all root texts." (cond (text-stat (let ((queue (list text-stat)) (head nil) (misclist nil) (tmp nil) (result nil)) (while queue (setq head (car queue)) (setq queue (cdr queue)) (setq tmp nil) ;; ;; For each parent, add it to the queue ;; (setq misclist (text-stat->misc-info-list head)) (while misclist (cond ((eq (misc-info->type (car misclist)) 'COMM-TO) (setq tmp (cons (blocking-do 'get-text-stat (misc-info->comm-to (car misclist))) tmp))) ((eq (misc-info->type (car misclist)) 'FOOTN-TO) (setq tmp (cons (blocking-do 'get-text-stat (misc-info->footn-to (car misclist))) tmp)))) (setq misclist (cdr misclist))) ;; ;; Remove unreadable texts ;; (setq tmp (delq nil tmp)) ;; ;; If no parents were found, this is is a top-level text ;; (when (null tmp) (setq result (cons head result)) (if (not all) (setq queue nil))) (setq queue (nconc tmp queue))) (if all (mapcar 'text-stat->text-no result) (text-stat->text-no (car result))))) (t nil))) (defun lyskom-review-tree (text) "Takes a TEXT as an arg, shows the text and the tree of all comments. Does a lyskom-end-of-command. Text is a text-no." (cond ((integerp text) (lyskom-view-text text nil t nil (lyskom-get-current-priority) t)) (t (signal 'lyskom-internal-error (list 'lyskom-review-tree "Called with incorrect argument." text))))) ;;; ================================================================ ;;; ]terse n{sta - review next ;;; Author: Linus Tolke (def-kom-command kom-review-next () "Resumes an interupted review by moving all review and review-tree entries in the lyskom-reading-list to the beginning. i.e by moving all other types to the end." (interactive) (lyskom-tell-internat 'kom-tell-review) (let ((len (read-list-length lyskom-reading-list)) (finished nil)) (while (and (not finished) (> len 1)) (let ((type (read-info->type (read-list->first lyskom-reading-list)))) (if (and (not (eq type 'REVIEW)) (not (eq type 'REVIEW-TREE)) (not (eq type 'REVIEW-MARK))) (read-list-rotate lyskom-reading-list) (setq finished t))) (setq len (1- len))))) ;;; ================================================================ ;;; ]terse stacken - Review stack ;;; Author: Linus (def-kom-command kom-review-stack () "Displays the review-stack." (interactive) (mapcar (function (lambda (info) (let ((un (length (cdr (read-info->text-list info)))) (type (read-info->type info)) (cto (read-info->comm-to info))) (cond ((eq type 'REVIEW) (lyskom-format-insert 'review-n-texts un)) ((eq type 'REVIEW-TREE) ; +++ Hmmm. Pluralformer. Besv{rligt! (if (= un 1) (lyskom-format-insert 'review-one-comment cto) (lyskom-format-insert 'review-many-comments cto un))) ((eq type 'REVIEW-MARK) (lyskom-format-insert 'review-marked un)))))) (read-list->all-entries lyskom-reading-list))) ;;; ================================================================ ;;; ]terse hoppa - review clear ;;; Author: Linus Tolke (def-kom-command kom-review-clear () "Deletes all review-types from the lyskom-reading-list and lyskom-to-do-list." (interactive) (if (not (read-list-isempty lyskom-reading-list)) (while (or (eq (read-info->type (read-list->first lyskom-reading-list)) 'REVIEW) (eq (read-info->type (read-list->first lyskom-reading-list)) 'REVIEW-TREE) (eq (read-info->type (read-list->first lyskom-reading-list)) 'REVIEW-MARK)) (set-read-list-del-first lyskom-reading-list))) (if (not (read-list-isempty lyskom-to-do-list)) (while (or (eq (read-info->type (read-list->first lyskom-to-do-list)) 'REVIEW) (eq (read-info->type (read-list->first lyskom-to-do-list)) 'REVIEW-TREE) (eq (read-info->type (read-list->first lyskom-to-do-list)) 'REVIEW-MARK)) (set-read-list-del-first lyskom-to-do-list)))) ;;; ================================================================ ;;; ]terse det kommenterade - View commented text ;;; Author: Inge Wallin (def-kom-command kom-review-comments () "View the comments to this text. If the current text has comments in (footnotes in) some texts then the first text is shown and a REVIEW list is built to shown the other ones." (interactive) (lyskom-tell-internat 'kom-tell-review) (lyskom-review-comments (blocking-do 'get-text-stat lyskom-current-text))) (defun lyskom-review-comments (text-stat) "Handles the return from the initiate-get-text-stat, displays and builds list." (let* ((misc-info-list (and text-stat (text-stat->misc-info-list text-stat))) (misc-infos (and misc-info-list (append (lyskom-misc-infos-from-list 'FOOTN-IN misc-info-list) (lyskom-misc-infos-from-list 'COMM-IN misc-info-list)))) (text-nos (and misc-infos (mapcar (function (lambda (misc-info) (if (equal (misc-info->type misc-info) 'COMM-IN) (misc-info->comm-in misc-info) (misc-info->footn-in misc-info)))) misc-infos)))) (if text-nos (progn (lyskom-format-insert 'review-text-no (car text-nos)) (if (cdr text-nos) (read-list-enter-read-info (lyskom-create-read-info 'REVIEW nil (lyskom-get-current-priority) (lyskom-create-text-list (cdr text-nos)) lyskom-current-text) lyskom-reading-list t)) (lyskom-view-text (car text-nos))) (lyskom-insert-string 'no-such-text)))) ;;; ================================================================ ;;; ]terse igen - kom-review-last-normally-read ;;; ;;; Author: Linus Tolke (def-kom-command kom-review-last-normally-read (no) "Reviews the NO last normally read texts." (interactive (list (lyskom-read-number (lyskom-get-string 'read-normally-read) 1))) (lyskom-tell-internat 'kom-tell-review) (let* ((text-nos (nreverse (nfirst no lyskom-normally-read-texts)))) (if text-nos (progn (lyskom-format-insert 'review-text-no (car text-nos)) (if (cdr text-nos) (read-list-enter-read-info (lyskom-create-read-info 'REVIEW nil (lyskom-get-current-priority) (lyskom-create-text-list (cdr text-nos)) lyskom-current-text) lyskom-reading-list t)) (lyskom-view-text (car text-nos))) (lyskom-format-insert 'no-such-text)))) ;; Review a non-converted text ;; Author: Linus Tolke (defun kom-review-noconversion (&optional text-no) "Displays the last read text without any conversion." (interactive (list (cond ((null current-prefix-arg) lyskom-current-text) ((integerp current-prefix-arg) current-prefix-arg) ((and (listp current-prefix-arg) (integerp (car current-prefix-arg)) (null (cdr current-prefix-arg))) (car current-prefix-arg)) (t (signal 'lyskom-internal-error '(kom-review-noconversion)))))) (lyskom-start-of-command 'kom-review-noconversion) (let ((kom-emacs-knows-iso-8859-1 t) (lyskom-format-special nil) (kom-autowrap nil)) (ignore kom-emacs-knows-iso-8859-1) (lyskom-view-text text-no)) (lyskom-end-of-command)) ;;; ============================================================ ;;; Återse senaste dagarnas inlägg ;;; ;;; Author: David Byers ;;; ;;; Algorithm: ;;; ;;; Binärsökning i mappen efter inlägg med rätt datum. ;;; ;;; Utilityfunktioner: Beräkna diff i dagar mellan två datum. ;;; Subtrahera n dagar från ett datum. ;;; ;;; Användarkommandot: Återse N inlägg av person X till Y från DATE ;;; ;;; Hitta index i X och Y där det sökta datumet börjar ;;; Låt de vanliga återsefunktionerna accepter cmin och pmin som ;;; parametrar så de kan söka igenom en del av en map. ;;; ;;; Problem med binärsökning i mapparna är hålen. Det finns risk att ;;; man försöker binärsöka bland en massa nollor, och det lär ta tid. ;;; I de fallen får man nog göra get-next-text eller get-previous-text ;;; för att få ett riktigt textnummer att titta på. Risk: att man ;;; tittar på samma text två gånger och går i loop. ;;; ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: edit-text.el,v 44.26.2.2 1999/10/13 12:13:02 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: edit-text.el ;;;; ;;;; This file contains functions which lets the LysKOM user edit ;;;; a text in a window. It also defines a new mode - lyskom-edit-mode. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: edit-text.el,v 44.26.2.2 1999/10/13 12:13:02 byers Exp $\n")) ;;;; ================================================================ ;;; Set variables to make lyskom-edit-mode a minor mode. This ;;; simplifies some stuff a lot (defvar lyskom-edit-mode nil "Mode variable for lyskom-edit-mode") (make-variable-buffer-local 'lyskom-edit-mode) (defvar lyskom-edit-sending-mode nil "Mode variable for lyskom-edit-sending-mode") (make-variable-buffer-local 'lyskom-edit-sending-mode) (defvar lyskom-edit-sent-mode nil "Mode variable for lyskom-edit-sent-mode") (make-variable-buffer-local 'lyskom-edit-sent-mode) (put 'lyskom-edit-mode 'permanent-local t) (or (assq 'lyskom-edit-mode minor-mode-alist) (setq minor-mode-alist (cons '(lyskom-edit-mode " LysKOM Edit") minor-mode-alist))) (or (assq 'lyskom-edit-sending-mode minor-mode-alist) (setq minor-mode-alist (cons '(lyskom-edit-sending-mode " LysKOM Sending") minor-mode-alist))) (or (assq 'lyskom-edit-sent-mode minor-mode-alist) (setq minor-mode-alist (cons '(lyskom-edit-sent-mode " LysKOM Sent") minor-mode-alist))) (or (assq 'lyskom-edit-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'lyskom-edit-mode lyskom-edit-mode-map) minor-mode-map-alist))) (or (assq 'lyskom-edit-sending-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'lyskom-edit-sending-mode lyskom-edit-mode-map) minor-mode-map-alist))) (or (assq 'lyskom-edit-sent-mode minor-mode-map-alist) (setq minor-mode-map-alist (cons (cons 'lyskom-edit-sending-mode lyskom-edit-mode-map) minor-mode-map-alist))) (defvar lyskom-edit-mode-name "LysKOM edit" "Name of the mode.") (defvar lyskom-edit-text-sent nil "Non-nil when a text has been sent") (defvar lyskom-is-dedicated-edit-window nil "Status variable for an edit-window.") (defvar lyskom-edit-handler nil "Status variable for an edit-buffer. See lyskom-edit-handler-data.") (defvar lyskom-edit-handler-data nil "Status variable for an edit-buffer. See lyskom-edit-handler.") (defvar lyskom-edit-return-to-configuration nil "Status variable for an edit-buffer.") ;;; Error signaled by lyskom-edit-parse-headers (put 'lyskom-edit-text-abort 'error-conditions '(error lyskom-error lyskom-edit-error lyskom-edit-text-abort)) (put 'lyskom-unknown-header 'error-conditions '(error lyskom-error lyskom-edit-error lyskom-unknown-header)) (put 'lyskom-no-subject 'error-conditions '(error lyskom-error lyskom-edit-error lyskom-no-subject)) (put 'lyskom-edit-error 'error-conditions '(error lyskom-error lyskom-edit-error)) (defun lyskom-edit-text (proc misc-list subject body &optional handler &rest data) "Edit a text in a new buffer. PROC is the associated process. MISC-LIST is the default misc-list. SUBJECT is subject (a string). BODY is the default text-body (a string, normally empty.) HANDLER is a function to call when the text has been created. DATA is extra data to send to the function. HANDLER is called with (apply HANDLER text-no DATA) where text-no is the number of the text. Does lyskom-end-of-command." (setq lyskom-is-writing t) (lyskom-dispatch-edit-text proc misc-list subject body handler data)) (defun lyskom-dispatch-edit-text (proc misc-list subject body &optional handler &rest data) "Same as lyskom-edit-text except that it doesn't set lyskom-is-writing." (let ((buffer (lyskom-get-buffer-create 'write-texts (concat (buffer-name (process-buffer proc)) "-edit"))) (config (current-window-configuration))) (lyskom-display-buffer buffer) (text-mode) (lyskom-ignore-errors (run-hooks 'lyskom-edit-mode-mode-hook)) (lyskom-edit-mode) (make-local-variable 'lyskom-edit-handler) (make-local-variable 'lyskom-edit-handler-data) (make-local-variable 'lyskom-edit-return-to-configuration) (setq lyskom-edit-handler handler) (setq lyskom-edit-handler-data data) (setq lyskom-edit-return-to-configuration config) (buffer-disable-undo) (lyskom-edit-insert-miscs misc-list subject body) (buffer-enable-undo) (goto-char (point-min)) (re-search-forward (regexp-quote (lyskom-get-string 'header-subject)) (point-max) 'end) (if (not (looking-at "\\s-*$")) (goto-char (point-max))) (lyskom-message "%s" (lyskom-get-string 'press-C-c-C-c))) (set-buffer lyskom-buffer) ) (defun lyskom-edit-insert-miscs (misc-list subject body) "Insert MISC-LIST into header of text. recpt -> Mottagare: <%d> %s. cc-recpt -> Extra kopia: <%d> %s. bcc-recpt -> För kännedom: <%d> %s. comm-to -> Kommentar till text %d. footn-to -> Fotnot till text %d." (let ((edit-buffer (current-buffer)) (where-put-misc (point-min-marker)) (main-buffer lyskom-buffer)) (set-buffer main-buffer) (setq misc-list (cdr misc-list)) (while (not (null misc-list)) (let ((key (car (car misc-list))) (data (cdr (car misc-list)))) (cond ((eq key 'recpt) (lyskom-edit-insert-misc-conf (blocking-do 'get-conf-stat data) (lyskom-get-string 'recipient) where-put-misc data)) ((eq key 'cc-recpt) (lyskom-edit-insert-misc-conf (blocking-do 'get-conf-stat data) (lyskom-get-string 'carbon-copy) where-put-misc data)) ((eq key 'bcc-recpt) (lyskom-edit-insert-misc-conf (blocking-do 'get-conf-stat data) (lyskom-get-string 'blank-carbon-copy) where-put-misc data)) ((eq key 'comm-to) (lyskom-edit-get-commented-author (blocking-do 'get-text-stat data) (lyskom-get-string 'comment) where-put-misc data)) ((eq key 'footn-to) (lyskom-edit-get-commented-author (blocking-do 'get-text-stat data) (lyskom-get-string 'footnote) where-put-misc data))) (setq misc-list (cdr misc-list)))) (princ (lyskom-format 'text-mass subject (substitute-command-keys (lyskom-get-string 'header-separator)) body (lyskom-get-string 'header-subject)) where-put-misc) (set-buffer edit-buffer) (goto-char where-put-misc) )) (defun lyskom-edit-goto-char (marker) "Positions the editing at MARKER." (let ((curbuf (current-buffer))) (set-buffer (marker-buffer marker)) (save-window-excursion (goto-char marker)) (set-buffer curbuf))) (defun lyskom-edit-insert-misc-conf (conf-stat string stream number) "Insert Mottagare: or Extra kopia: in edit-buffer. Args: CONF-STAT STRING STREAM NUMBER CONF-STAT is the conf-stat of the conference that is about to be put in, STRING is the string that is inserted. STREAM is the buffer or a marker telling the position. NUMBER is the number of the person. Used if the conf-stat is nil." (lyskom-princ (lyskom-format "%#1s <%#2m> %#3M\n" string (or conf-stat number) (or conf-stat "")) stream)) (defun lyskom-edit-get-commented-author (text-stat string stream number) (if text-stat (lyskom-edit-insert-commented-author (blocking-do 'get-conf-stat (text-stat->author text-stat)) string stream number) (lyskom-edit-insert-commented-author nil string stream number))) (defun lyskom-edit-insert-commented-author (conf-stat string stream number) (lyskom-princ (lyskom-format 'comment-to-by string number (if conf-stat (lyskom-format 'by conf-stat) "")) stream)) (defun lyskom-create-misc-list (&rest misc-pairs) "Create a misc-list. Note that a misc-list is very different from a misc-info-list. A misc-list is used when creating a new text, and sent to the server. A misc-info-list is what is received from the server. Although the server has the same format for the two things, this client uses two quite different formats. The arguments to this function is any number of pairs of data. The first item in each pair should be one of recpt, cc-recpt, comm-to or footn-to. The second item should be the corresponding conf- or text-no. The result is a list of dotted pairs: ('recpt . conf-no) ('cc-recpt . conf-no) ('bcc-recpt . conf-no) ('comm-to . text-no) ('footn-to . text-no). First element is a type-tag." (let ((result (cons 'MISC-LIST nil))) (while (not (null misc-pairs)) (nconc result (cons (cons (car misc-pairs) (car (cdr misc-pairs))) nil)) (setq misc-pairs (cdr (cdr misc-pairs)))) result)) ;;; ================================================================ ;;; lyskom-edit-mode (defvar lyskom-edit-mode-hook nil "*List of functions to be called when entering lyskom-edit-mode. Watch out! None of these functions are allowed to do kill-all-local-variables because kom-edit-send and other functions depend on some variables to be able to enter the text in the correct lyskom-process.") (defvar lyskom-edit-mode-mode-hook nil "*List of functions to be called when entering lyskom-edit-mode. Watch out! None of these functions are allowed to do kill-all-local-variables because kom-edit-send and other functions depend on some variables to be able to enter the text in the correct lyskom-process. This one differs from lyskom-edit-mode-hook in that it is called before the lyskom-special key bindings are added.") ;;;(defun lyskom-edit-mode () ;;; "\\Mode for editing texts for LysKOM. ;;;Commands: ;;;\\[kom-edit-send] sends the text when you are ready. The buffer will be ;;; deleted if (and only if) the server accepts the text. ;;;\\[kom-edit-quit] aborts the editing. You will get back to the LysKOM buffer. ;;; ;;;\\[kom-edit-show-commented] shows the commented text in a temporary buffer. ;;; ;;;\\[kom-edit-add-recipient] asks for another recipient and adds him to the header. ;;;\\[kom-edit-add-copy] as \\[kom-edit-add-recipient] but adds him as copy-recipient. ;;; ;;;\\[kom-edit-insert-commented] inserts the commented of footnoted text. ;;;\\[kom-edit-insert-text] inserts the shown text, you tell the number." ;;; (interactive) ;;; (let ((tmp-keymap nil)) ;;; (kill-all-local-variables) ;;; (text-mode) ;;; ;;; (run-hooks 'lyskom-edit-mode-mode-hook) ;;; ;;; (setq tmp-keymap (and (current-local-map) ;;; (copy-keymap (current-local-map)))) ;;; ;;; (lyskom-set-menus 'lyskom-edit-mode lyskom-edit-mode-map) ;;; (setq mode-line-buffer-identification '("LysKOM (server: %b)")) ;;; (setq major-mode 'lyskom-edit-mode) ;;; (setq mode-name lyskom-edit-mode-name) ;;; ;;; (if tmp-keymap ;;; (let ((new-keymap (make-sparse-keymap))) ;;; (make-local-variable 'lyskom-edit-mode-map) ;;; (setq lyskom-edit-mode-map ;;; (lyskom-default-value 'lyskom-edit-mode-map)) ;;; ;;; (lyskom-xemacs-or-gnu ;;; (set-keymap-parents new-keymap ;;; (list lyskom-edit-mode-map ;;; tmp-keymap)) ;;; (progn (set-keymap-parent new-keymap lyskom-edit-mode-map) ;;; (lyskom-overlay-keymap lyskom-edit-mode-map ;;; tmp-keymap ;;; new-keymap))) ;;; (use-local-map new-keymap)) ;;; ;;; (lyskom-use-local-map lyskom-edit-mode-map)) ;;; ;;; ;;; (auto-save-mode 1) ;;; (auto-fill-mode 1) ;;; (make-local-variable 'paragraph-start) ;;; (make-local-variable 'paragraph-separate) ;;; (setq paragraph-start (concat "^" ;;; (regexp-quote ;;; (substitute-command-keys ;;; (lyskom-get-string 'header-separator))) ;;; "$\\|" paragraph-start)) ;;; (setq paragraph-separate (concat "^" ;;; (regexp-quote ;;; (substitute-command-keys ;;; (lyskom-get-string 'header-separator))) ;;; "$\\|" paragraph-separate)) ;;; (run-hooks 'lyskom-edit-mode-hook))) (defun lyskom-edit-mode (&optional arg) "\\Mode for editing texts for LysKOM. Commands: \\[kom-edit-send] sends the text when you are ready. The buffer will be deleted if (and only if) the server accepts the text. \\[kom-edit-quit] aborts the editing. You will get back to the LysKOM buffer. \\[kom-edit-show-commented] shows the commented text in a temporary buffer. \\[kom-edit-add-recipient] asks for another recipient and adds him to the header. \\[kom-edit-add-copy] as \\[kom-edit-add-recipient] but adds him as copy-recipient. \\[kom-edit-insert-commented] inserts the commented of footnoted text. \\[kom-edit-insert-text] inserts the shown text, you tell the number. Even though this is a minor mode, it's not intended to be turned on and off, so it's not as clean as it ought to be." (interactive "P") (setq lyskom-edit-mode (if (null arg) (not lyskom-edit-mode) (> (prefix-numeric-value arg) 0))) (when lyskom-edit-mode (lyskom-edit-sending-mode 0) (lyskom-edit-sent-mode 0) (auto-fill-mode 1) (auto-save-mode 1) (when (not (local-variable-p 'lyskom-edit-text-sent (current-buffer))) (make-local-variable 'lyskom-edit-text-sent) (setq lyskom-edit-text-sent nil)) (make-local-variable 'paragraph-start) (make-local-variable 'paragraph-separate) (setq paragraph-start (concat "^" (regexp-quote (substitute-command-keys (lyskom-get-string 'header-separator))) "$\\|" paragraph-start)) (setq paragraph-separate (concat "^" (regexp-quote (substitute-command-keys (lyskom-get-string 'header-separator))) "$\\|" paragraph-separate)) (run-hooks 'lyskom-edit-mode-hook))) (defun lyskom-edit-sending-mode (arg) (interactive "P") (setq lyskom-edit-sending-mode (if (null arg) (not lyskom-edit-sending-mode) (> (prefix-numeric-value arg) 0))) (when lyskom-edit-sending-mode (lyskom-edit-mode 0) (lyskom-edit-sent-mode 0))) (defun lyskom-edit-sent-mode (arg) (interactive "P") (setq lyskom-edit-sent-mode (if (null arg) (not lyskom-edit-sent-mode) (> (prefix-numeric-value arg) 0))) (when lyskom-edit-sent-mode (lyskom-edit-sending-mode 0) (lyskom-edit-mode 0))) ;;; ================================================================ ;;; Functions bound to keyboard seqences in lyskom-edit-mode ;;; (defun kom-edit-send-anonymous () "Send the text anonymously to the server." (interactive) (lyskom-edit-send 'initiate-create-anonymous-text)) (defun kom-edit-send () "Send the text to the server." (interactive) (lyskom-edit-send 'initiate-create-text)) (defun lyskom-edit-send (send-function) "Send the text to the server by calling SEND-FUNCTION." (condition-case err (if (or (not lyskom-edit-text-sent) ;++MINOR checked mode-name against lyskom-edit-mode-name (j-or-n-p (lyskom-get-string 'already-sent))) (progn (let ((buffer (current-buffer)) headers misc-list subject message) (save-excursion (setq headers (lyskom-edit-parse-headers) misc-list (apply 'lyskom-create-misc-list (cdr headers)) subject (car headers))) ;; ;; Check that there is a subject ;; (if (or (null subject) (string= subject "")) (let ((old (point))) (goto-char (point-min)) (re-search-forward (lyskom-get-string 'header-subject) nil t) (end-of-line) (if (/= (point) old) (signal 'lyskom-no-subject '(enter-subject-idi))))) ;; ;; Check the recipients ;; (let ((extra-headers (lyskom-edit-send-check-recipients misc-list subject))) (if extra-headers (setq misc-list (apply 'lyskom-create-misc-list (cdr (nconc headers extra-headers)))))) ;; ;; Run user hooks ;; ####: ++++: FIXME: We should quit more graciously. (if (not (run-hook-with-args-until-failure 'lyskom-send-text-hook)) (signal 'lyskom-edit-text-abort nil)) ;; ;; Transform the message text ;; (setq message (if (fboundp lyskom-send-text-transform-function) (funcall lyskom-send-text-transform-function (lyskom-edit-extract-text)) (lyskom-edit-extract-text))) ;++MINOR (setq mode-name "LysKOM sending") (lyskom-edit-sending-mode 1) (save-excursion (let ((full-message (cond ((and lyskom-allow-missing-subject (or (null subject) (string= subject "")) (not (string-match ".*\n" message))) message) (t (concat (or subject "") "\n" message))))) (set-buffer lyskom-buffer) ;; Don't change the prompt if we won't see our own text (if kom-created-texts-are-read (setq lyskom-dont-change-prompt t)) (setq lyskom-is-writing nil) (lyskom-tell-internat 'kom-tell-send) (funcall send-function 'sending 'lyskom-create-text-handler full-message misc-list buffer)))) (lyskom-undisplay-buffer) (goto-char (point-max)))) ;; ;; Catch no-subject and other things ;; (lyskom-edit-text-abort (apply 'lyskom-message (cdr-safe err))) (lyskom-no-subject (lyskom-beep kom-ding-on-no-subject) (if (cdr-safe (cdr-safe err)) (goto-char (car-safe (cdr-safe (cdr-safe err))))) (lyskom-message "%s" (lyskom-get-string (car (cdr err)))) (condition-case nil (let ((text "")) (save-excursion (set-buffer lyskom-buffer) (if (and (string= "kom.lysator.liu.se" lyskom-server-name) (eq lyskom-pers-no 698)) (setq text "Ärende, IDI!"))) (save-excursion (insert text))) (error nil))) (lyskom-unknown-header (lyskom-message "%s" (lyskom-get-string (car (cdr err))))))) (eval-when-compile (defvar ispell-dictionary nil)) (eval-when-compile (defvar ispell-message-text-end nil)) (eval-when-compile (defvar ispell-message-start-skip nil)) (eval-when-compile (defvar ispell-message-end-skip nil)) (defun lyskom-ispell-text () "Check spelling of the text body. Put this in lyskom-send-text-hook" (kom-ispell-message) t) (eval-when-compile (defvar ispell-dictionary nil) (defvar ispell-message-text-end nil) (defvar ispell-message-start-skip nil) (defvar ispell-message-end-skip nil)) (defun kom-ispell-message () "Check spelling of the text. kom-ispell-dictionary is the dictionary to use to check spelling. Based on ispell-message." (interactive) (require 'ispell) (let ((ispell-dictionary (or kom-ispell-dictionary ispell-dictionary)) (kill-ispell (or (not (boundp 'ispell-dictionary)) (not (string= kom-ispell-dictionary ispell-dictionary)))) (result nil)) (when kill-ispell (ispell-kill-ispell t)) ;; Checking code (save-excursion (goto-char (point-min)) (let* ((internal-messagep (save-excursion (re-search-forward (concat "^" (regexp-quote (substitute-command-keys (lyskom-get-string 'header-separator))) "$") nil t))) (limit (copy-marker (cond ((not ispell-message-text-end) (point-max)) ((char-or-string-p ispell-message-text-end) (if (re-search-forward ispell-message-text-end nil t) (match-beginning 0) (point-max))) (t (min (point-max) (funcall ispell-message-text-end)))))) (cite-regexp (regexp-quote (lyskom-default-value 'kom-cite-string))) (cite-regexp-start (concat "^[ \t]*$\\|" cite-regexp)) (cite-regexp-end (concat "^\\(" cite-regexp "\\)")) (old-case-fold-search case-fold-search) (case-fold-search t) (ispell-checking-message t) (subject-string (concat "^" (regexp-quote (lyskom-get-string 'subject))))) (goto-char (point-min)) (while (if internal-messagep (< (point) internal-messagep) (not (eobp))) (if (looking-at subject-string) (progn (goto-char (match-end 0)) (let ((case-fold-search old-case-fold-search)) (ispell-region (point) (progn (end-of-line) (point))))) (forward-line 1))) (while (< (point) limit) (while (and (looking-at cite-regexp-start) (< (point) limit) (zerop (forward-line 1)))) (if (< (point) limit) (let* ((start (point)) (end-c (and (re-search-forward cite-regexp-end limit 'end) (match-beginning 0))) (end-fwd (and (goto-char start) (boundp 'ispell-message-start-skip) (re-search-forward ispell-message-start-skip limit 'end))) (end (or (and end-c end-fwd (min end-c end-fwd)) end-c end-fwd (marker-position limit)))) (goto-char start) (setq result (ispell-region start end)) (if (and end-fwd (= end end-fwd)) (progn (goto-char end) (re-search-forward ispell-message-end-skip limit 'end)) (goto-char end))))) (set-marker limit nil) result)) (when kill-ispell (ispell-kill-ispell t)) result)) (defun lyskom-edit-send-check-recipients (misc-list subject) "Check that the recipients of this text are OK. Ask the user to confirm multiple recipients; check that the author of the commented text is a member of some recipient of this text." (let* ((comm-to-list nil) (recipient-list nil) (author-list nil) (author-is-member nil) (text-stat nil) (collector (make-collector)) (extra-headers nil) (buffer (current-buffer)) (me (save-excursion (set-buffer lyskom-buffer) lyskom-pers-no)) (num-me 0)) (ignore text-stat) ; Have no idea if its ever used... ;; ;; List all texts this text is a comment to ;; List all recipients of the text ;; (lyskom-traverse misc (cdr misc-list) (cond ((eq (car misc) 'comm-to) (setq comm-to-list (cons (cdr misc) comm-to-list))) ((or (eq (car misc) 'recpt) (eq (car misc) 'cc-recpt)) (eq (car misc) 'bcc-recpt) (if (eq (cdr misc) me) (setq num-me (1+ num-me))) (setq recipient-list (cons (cdr misc) recipient-list))))) ;; ;; Check for new comments ;; (when (save-excursion (set-buffer lyskom-buffer) (cond ((null kom-check-for-new-comments) nil) ((functionp kom-check-for-new-comments) (funcall kom-check-for-new-comments buffer misc-list subject)) (t t))) (lyskom-message (lyskom-format 'checking-comments)) (save-excursion (set-buffer lyskom-buffer) (set-collector->value collector nil) (mapcar (function (lambda (text-stat) (cache-del-text-stat text-stat) (initiate-get-text-stat 'sending 'collector-push text-stat collector))) comm-to-list) (lyskom-wait-queue 'sending) (lyskom-traverse text-stat (collector->value collector) (when text-stat (when (catch 'unread (lyskom-traverse misc-item (text-stat->misc-info-list text-stat) (when (and (eq (misc-info->type misc-item) 'COMM-IN) (not (lyskom-text-read-at-least-once-p (blocking-do 'get-text-stat (misc-info->comm-in misc-item))))) (throw 'unread t)))) (unless (lyskom-j-or-n-p (lyskom-format 'have-unread-comment text-stat)) (signal 'lyskom-edit-text-abort (list "%s" (lyskom-get-string 'please-check-commented-texts)))))))) (lyskom-message (lyskom-format 'checking-comments-done))) ;; ;; Confirm multiple recipients ;; (set-collector->value collector nil) (if (and (lyskom-default-value 'kom-confirm-multiple-recipients) (not (eq (lyskom-default-value 'kom-confirm-multiple-recipients) 'before)) (> (- (length recipient-list) num-me) 1)) (save-excursion (goto-char (point-min)) (if (not (lyskom-j-or-n-p (lyskom-format 'comment-all-relevant-p) t)) (signal 'lyskom-edit-text-abort (list "%s" (lyskom-get-string 'please-edit-recipients)))))) (if (and (lyskom-default-value 'kom-check-commented-author-membership) (assq 'comm-to (cdr misc-list))) (progn (lyskom-message (lyskom-get-string 'checking-rcpt)) ;; ;; For each commented text, get the author ;; (setq author-list (mapcar (function (lambda (x) (text-stat->author (blocking-do 'get-text-stat x)))) comm-to-list)) ;; ;; For each author, see if the author is a direct recipient ;; of the text. If so, there is no point in continuing. ;; (People can unsubscribe from their mailboxes, but if they ;; do, this code won't help anyway.) ;; (lyskom-traverse misc (cdr misc-list) (cond ((eq (car misc) 'comm-to) (setq comm-to-list (cons (cdr misc) comm-to-list))) ((or (eq (car misc) 'recpt) (eq (car misc) 'bcc-recpt) (eq (car misc) 'cc-recpt)) (if (or (memq (cdr misc) author-list) (eq (cdr misc) me)) (setq author-list (delq (cdr misc) author-list)))))) ;; ;; For each author, get his or her memberships in all ;; recipient conferences. ;; (save-excursion (set-buffer lyskom-buffer) (mapcar (function (lambda (author-number) (mapcar (function (lambda (conference-number) (initiate-query-read-texts 'sending 'collector-push author-number conference-number collector))) recipient-list) (lyskom-wait-queue 'sending) (setq author-is-member (collector->value collector)) (if (and (null (delq nil author-is-member)) (not (zerop author-number)) (lyskom-j-or-n-p (let ((kom-deferred-printing nil)) (lyskom-format 'add-recipient-p author-number)) t)) (setq extra-headers (nconc (list 'recpt author-number) extra-headers))))) author-list)))) extra-headers)) (defun lyskom-send-enriched (message) (condition-case err (let ((buf (lyskom-get-buffer-create 'lyskom-enriched "lyskom-enriched" t))) (unwind-protect (save-excursion (set-buffer buf) (insert message) (goto-char (point-min)) (format-encode-buffer 'text/enriched) (goto-char (point-min)) (search-forward "\n\n") (if (and (not (string= (buffer-substring (point) (point-max)) message)) (save-excursion (set-buffer lyskom-buffer) (lyskom-j-or-n-p (lyskom-get-string 'send-formatted) t))) (concat "enriched:\n" (buffer-string)) message)) (kill-buffer buf))) (error (if (lyskom-j-or-n-p (lyskom-format (lyskom-get-string 'transform-error) (error-message-string err))) message (signal 'lyskom-edit-text-abort nil))))) (defun kom-edit-quit () "Kill the text (if any) written so far and continue reading." (interactive) (let ((edit-buffer (current-buffer))) (goto-char (point-max)) (setq lyskom-is-writing nil) (lyskom-tell-internat 'kom-tell-regret) (lyskom-save-excursion (set-buffer edit-buffer) (delete-auto-save-file-if-necessary)) (lyskom-undisplay-buffer edit-buffer) (kill-buffer edit-buffer)) (garbage-collect)) ;Take care of the garbage. (defun kom-edit-show-commented () "Show the commented text in another window." (interactive) (lyskom-edit-get-commented 'lyskom-edit-show-commented)) (defun kom-edit-insert-commented () "Insert the commented text with '>' first on each line" (interactive) (lyskom-edit-get-commented 'lyskom-edit-insert-commented)) (defun kom-edit-insert-digit-text () (interactive) (setq unread-command-events (cons last-command-event unread-command-events)) (call-interactively 'kom-edit-insert-text nil)) (defun kom-edit-insert-text (no) "Insert the text number NO with '>' first on each line" (interactive (list (cond ((null current-prefix-arg) (string-to-int (read-from-minibuffer (format "%s" (lyskom-get-string 'which-text-include))))) ((prefix-numeric-value current-prefix-arg))))) (let ((buffer (current-buffer)) (window (selected-window))) (set-buffer lyskom-buffer) (initiate-get-text 'edit 'lyskom-edit-insert-commented no buffer window) (set-buffer buffer) (sit-for 0))) (defun lyskom-edit-get-commented (thendo) "Get the commented text and then do THENDO with it." (let ((p (point))) (save-excursion (let* ((buffer (current-buffer)) (window (selected-window)) (headers (condition-case nil (cdr (lyskom-edit-parse-headers)) (lyskom-edit-error nil))) ; Ignore these errors (no nil)) (while headers (if (or (eq (car headers) 'comm-to) (eq (car headers) 'footn-to)) (setq no (car (cdr headers)) headers nil) (setq headers (cdr (cdr headers))))) (cond (no (goto-char p) (set-buffer lyskom-buffer) (initiate-get-text 'edit thendo no buffer window) (set-buffer buffer)) (t (lyskom-message "%s" (lyskom-get-string 'no-such-text-m)))))) (sit-for 0))) ;;; ================================================================ ;;; Add recipient, copy-recipient - Addera mottagare ;;; ;;; Author: Anders Gertz ;;; Changed by: Linus Tolke (defun kom-edit-add-comment () "Adds a text as commented to the text being edited." (interactive) (let* ((edit-buffer (current-buffer)) (insert-at (point-min-marker)) (text-no (lyskom-read-number (lyskom-get-string 'text-to-comment-q))) (text-stat (blocking-do 'get-text-stat text-no))) (lyskom-save-excursion (if text-stat (lyskom-edit-get-commented-author (blocking-do 'get-text-stat text-no) (lyskom-get-string 'comment) insert-at text-no) (lyskom-error "%s" (lyskom-get-string 'no-such-text-m)))))) (defun kom-edit-add-recipient () "Adds a conference as recipient to the text being edited." (interactive) (lyskom-edit-add-recipient/copy (lyskom-get-string 'added-recipient) (lyskom-get-string 'recipient))) (defun kom-edit-add-bcc () "Adds a conference as bcc recipient to the text being edited." (interactive) (lyskom-edit-add-recipient/copy (lyskom-get-string 'added-blank-carbon-copy) (lyskom-get-string 'blank-carbon-copy))) (defun kom-edit-add-copy () "Adds a conference to which a copy of the edited text will be sent." (interactive) (lyskom-edit-add-recipient/copy (lyskom-get-string 'added-carbon-copy) (lyskom-get-string 'carbon-copy))) (defun kom-edit-move-text () "Adds a conference as a recipient, and changes all other recipients to CC recipients." (interactive) (lyskom-edit-add-recipient/copy (lyskom-get-string 'who-to-move-to-q) (lyskom-get-string 'recipient) 'lyskom-edit-move-recipients)) (defun lyskom-edit-move-recipients (conf-stat insert-at edit-buffer) (save-excursion (set-buffer edit-buffer) (let* ((tmp (lyskom-edit-parse-headers)) (subject (car tmp)) (miscs (cons 'MISC-LIST (mapcar (function (lambda (x) (if (eq (car x) 'recpt) (cons 'cc-recpt (cdr x)) x))) (cdr (lyskom-edit-translate-miscs (cdr tmp))))))) (lyskom-edit-replace-miscs subject miscs) (lyskom-edit-insert-misc-conf conf-stat (lyskom-get-string 'recipient) (point-min-marker) nil)))) (defun lyskom-edit-add-recipient/copy (prompt string &optional what-to-do) "Adds a new recipient or a cc-recipient to the text which is being edited." (let ((edit-buffer (current-buffer)) (insert-at (point-min-marker)) (conf-stat (lyskom-read-conf-stat prompt '(all) nil "" t))) (lyskom-save-excursion (save-excursion (set-buffer lyskom-buffer) ;; +++ The information about msg-of-day might be old. We should ;; make sure it is up-to-date. (let ((text-no (conf-stat->msg-of-day conf-stat))) (if (zerop text-no) (if what-to-do (funcall what-to-do conf-stat insert-at edit-buffer) (lyskom-edit-insert-misc-conf conf-stat string insert-at nil)) (let ((text (blocking-do 'get-text text-no))) (if (and text (get-buffer-window edit-buffer)) (let ((win-config (current-window-configuration))) ;;(set-buffer buffer) (with-output-to-temp-buffer "*Motd*" (princ (lyskom-format 'conf-has-motd-no (text->text-no text) (text->text-mass text)))) (and (j-or-n-p (lyskom-get-string 'still-want-to-add)) (if what-to-do (funcall what-to-do conf-stat insert-at edit-buffer) (lyskom-edit-insert-misc-conf conf-stat string insert-at nil))) (set-window-configuration win-config)) (if what-to-do (funcall what-to-do conf-stat insert-at edit-buffer) (lyskom-edit-insert-misc-conf conf-stat string insert-at nil)))))))))) ;;; ================================================================ ;;; Help functions for the functions bound to keyboard sequences ;;; in lyskom-edit-mode. (defun lyskom-edit-translate-miscs (misc-list) "Translate result of lyskom-edit-parse-header to something we can send to lyskom-edit-replace-miscs" (let ((result nil)) (while misc-list (setq result (cons (cons (car misc-list) (car (cdr misc-list))) result)) (setq misc-list (cdr (cdr misc-list)))) (cons 'MISC-LIST (nreverse result)))) (defun lyskom-edit-replace-miscs (subject misc-list) "Replace all headers with SUBJECT and MISC-LIST" (save-excursion (let ((start nil) (end nil)) (goto-char (point-min)) (setq start (point-marker)) (set-marker-insertion-type start t) (search-forward (substitute-command-keys (lyskom-get-string 'header-separator))) (end-of-line) (setq end (point-marker)) (goto-char (point-min)) (lyskom-edit-insert-miscs misc-list subject "") (delete-region start end) (goto-char end) (delete-char 1)))) (defun lyskom-looking-at-header (header match-number) "Check if point is at the beginning of a header of type HEADER. Return the corresponding number (conf no etc.) if MATCH-NUMBER is non-nil. If MATCH-NUMBER is 'angled, only match a number inside <>." (if (looking-at (concat (lyskom-get-string header) (cond ((eq match-number 'angled) "[^0-9]*<\\([0-9]+\\)>") (match-number "[^0-9]*\\([0-9]+\\)") (nil "")))) (if match-number (string-to-int (buffer-substring (match-beginning 1) (match-end 1))) t) nil)) (defun lyskom-edit-parse-headers () "Parse the headers of an article. They are returned as a list where the first element is the subject, and the rest is a list (HEADER DATA HEADER DATA ...), where HEADER is either 'recpt, 'cc-recpt, 'comm-to or 'footn-to. This is to make it easy to use the result in a call to `lyskom-create-misc-list'." (goto-char (point-min)) (let ((result (cons nil nil))) ; The car will be replaced by ; the real subject (save-restriction ;; Narrow to headers (search-forward (substitute-command-keys (lyskom-get-string 'header-separator))) (beginning-of-line) (narrow-to-region (point-min) (point)) (goto-char (point-min)) (while (< (point) (point-max)) (let ((case-fold-search t) n) (cond ((setq n (lyskom-looking-at-header 'recipient-prefix 'angled)) (nconc result (list 'recpt n))) ((setq n (lyskom-looking-at-header 'carbon-copy-prefix 'angled)) (nconc result (list 'cc-recpt n))) ((setq n (lyskom-looking-at-header 'blank-carbon-copy-prefix 'angled)) (nconc result (list 'bcc-recpt n))) ((setq n (lyskom-looking-at-header 'comment-prefix t)) (nconc result (list 'comm-to n))) ((setq n (lyskom-looking-at-header 'footnote-prefix t)) (nconc result (list 'footn-to n))) ((lyskom-looking-at-header 'header-subject nil) (setcar result (lyskom-edit-extract-subject))) (t (signal 'lyskom-unknown-header (list 'unknown-header (point)))))) (forward-line 1))) result)) (defun lyskom-edit-extract-subject () "Find the subject. Point must be located on the line where the subject is." (re-search-forward ": \\(.*\\)") (buffer-substring (match-beginning 1) (match-end 1))) (defun lyskom-edit-extract-text () "Get text as a string." (save-excursion (goto-char (point-min)) (if (not (or (re-search-forward (substitute-command-keys (lyskom-get-string 'header-separator)) nil (point-max)) (search-forward (substitute-command-keys (lyskom-get-string 'header-separator)) nil (point-max)))) (signal 'lyskom-internal-error "Altered lyskom-header-separator line.") (buffer-substring (1+ (point)) (progn (goto-char (1- (point-max))) (while (looking-at "\\s-") ; remove trailing (backward-char 1)) ; whitespace (forward-char 1) (point)))))) (defun lyskom-create-text-handler (text-no edit-buffer) "Handle an attempt to write a text." (lyskom-tell-internat 'kom-tell-silence) (message "") (cond ((null text-no) (lyskom-insert-before-prompt (lyskom-format 'could-not-create-text lyskom-errno (lyskom-get-error-text lyskom-errno))) (beep) (lyskom-message "%s" (lyskom-format 'could-not-create-text lyskom-errno (lyskom-get-error-text lyskom-errno))) (set-buffer edit-buffer) (lyskom-edit-mode 1) ;++MINOR (setq mode-name lyskom-edit-mode-name) (sit-for 0)) (t (lyskom-insert-before-prompt (lyskom-format 'text-created text-no)) ;; Immediately mark the text as read if kom-created-texts-are-read is set. (cond (kom-created-texts-are-read (lyskom-is-read text-no) (initiate-get-text-stat 'background 'lyskom-mark-as-read text-no) (lyskom-run 'background 'set 'lyskom-dont-change-prompt nil) (lyskom-run 'background 'lyskom-set-mode-line)) (t ; Probably not necessary (setq lyskom-dont-change-prompt nil))) (set-buffer edit-buffer) ;Need local variables. (lyskom-edit-sent-mode 1) ;; Record the text number (lyskom-setq-default lyskom-last-written text-no) ;; Select the old configuration. (let ((hnd lyskom-edit-handler) (dta lyskom-edit-handler-data)) (cond ((get-buffer-window edit-buffer) (set-window-configuration lyskom-edit-return-to-configuration) (set-buffer (window-buffer (selected-window))) (goto-char (point-max)))) ;; Apply handler. (set-buffer lyskom-buffer) (if hnd (apply hnd text-no dta))) ;; Kill the edit-buffer. (lyskom-save-excursion (set-buffer edit-buffer) (delete-auto-save-file-if-necessary)) (kill-buffer edit-buffer) ))) (defun lyskom-edit-show-commented (text editing-buffer window) "Handles the TEXT from the return of the call of the text. The EDITING-BUFFER is the buffer the editing is done in. If this buffer is not displayed nothing is done. If displayed then this buffer is chosen then the with-output-to-temp-buffer command is issued to make them both apear." (and text (get-buffer-window editing-buffer) (progn (set-buffer editing-buffer) (select-window window) (let ((buf (lyskom-get-buffer-create 'view-commented "*Commented*")) (kom-deferred-printing nil)) (save-selected-window (lyskom-display-buffer buf) (save-excursion (set-buffer buf) (erase-buffer) (lyskom-view-text (text->text-no text)) (set-buffer-modified-p nil) (lyskom-view-mode))))))) (defun lyskom-edit-insert-commented (text editing-buffer window) "Handles the TEXT from the return of the call of the text. The text is inserted in the buffer with '>' first on each line." (if text (progn (set-buffer editing-buffer) (and (not (bolp)) (insert "\n")) (and (not (eolp)) (open-line 1)) (let* ((pb (point)) (as (string-match "\n" (text->text-mass text))) (te (substring (text->text-mass text) (1+ as)))) (insert te) (while (<= pb (point)) (beginning-of-line) (insert (or (lyskom-default-value 'kom-cite-string) 62)) (forward-line -1) ))) (lyskom-message "%s" (lyskom-get-string 'no-get-text)))) ;;; ================================================================ ;;; Maphanteringsfunktion - keymap handling. ;;; ;;; Author: Linus Tolke ;;; (defun overlay-map (oldmap newmap) "Returns a map that is the union of OLDMAP and NEWMAP. NEW-MAP has priority. This function chooses whether the returned map is a list or an array. Currently always same type as oldmap. BUG: does not descend in the maps." (cond ((not (keymapp oldmap)) newmap) ((not (keymapp newmap)) oldmap) (t (let ((map (copy-keymap oldmap)) (r 0)) (cond ((fboundp 'map-keymap) ;Special for lucid-emacs (map-keymap (function (lambda (event function) (define-key map (vector event) function))) newmap)) ((and (string-match "^19" emacs-version) (arrayp (car (cdr newmap)))) (while (< r (length (car (cdr newmap)))) (if (aref (car (cdr newmap)) r) (define-key map (char-to-string r) (aref (car (cdr newmap)) r))) (setq r (1+ r))) (mapcar (function (lambda (ele) (define-key map (cond ((integerp (car ele)) (char-to-string (car ele))) ((vector (car ele)))) (cdr ele)))) (cdr (cdr newmap)))) ((arrayp newmap) (while (< r (length newmap)) (if (aref newmap r) (define-key map (char-to-string r) (aref newmap r))) (setq r (1+ r)))) (t (mapcar (function (lambda (ele) (define-key map (cond ((integerp (car ele)) (char-to-string (car ele))) ((vector (car ele)))) (cdr ele)))) (cdr newmap)))) map)))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: filter.el,v 44.7.2.2 1999/10/13 12:13:08 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: filter.el ;;;; ;;;; Contains the support functions for text filtering. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: filter.el,v 44.7.2.2 1999/10/13 12:13:08 byers Exp $\n")) ;;;============================================================ ;;; ;;; Filter pattern accessors ;;; ;;; Filters are lists with the following structure ;;; ;;; (filter [ PATTERNS ATTRIBUTES FUNCTION]) ;;; ;;; Where PATTERNS is a list of filter patterns and ATTRIBUTES is ;;; an association list. FUNCTION is a lisp function implementing ;;; the filter. ;;; ;;; The following attributes are reserved ;;; ;;; action -- What action to take when the pattern matches. Currently ;;; one of dontshow, skip or skip-comments. ;;; expire -- When the filter expires. Not used. ;;; (defun make-filter (&optional p a) "Creates and returns a filter structure. Optional P and A initialize pattern and attributes, respectively." (list 'filter (vector p a (lyskom-create-compile-filter-function p)))) (defun copy-filter (f) "Create a copy of the filter F" (make-filter (copy-tree (filter->pattern f)) (copy-tree (filter->attribute-list f)))) (defun filter-p (f) "Returns T if f looks like a filter" (and (listp f) (eq 'filter (car f)))) (defun filter->pattern (f) "Extract the patterns part of a filter F" (elt (elt f 1) 0)) (defun filter->attribute-list (f) "Extract the attribute list of F." (elt (elt f 1) 1)) (defun filter->attribute (f a) "From filter F, extract the value of attribute A. Returns nil if no such attribute is present." (cdr (assq a (filter->attribute-list f)))) (defun set-filter->pattern (f p) "Set the patterns part of F to P." (aset (elt f 1) 0 p)) (defun set-filter->attribute-list (f l) "Set the attribute list of filter F to L" (aset (elt f 1) 1 l)) (defun set-filter->attribute (f a v) "Set the value in filter F of attribute A to V." (let ((x (assq a (filter->attribute-list f)))) (if x (setcdr x v) (set-filter->attribute-list f (cons (cons a v) (filter->attribute-list f)))))) (defun filter->function (f) "Get the function for filter F" (elt (elt f 1) 2)) (defun set-filter->function (f fn) "Set the function for filter F to FN" (aset (elt f 1) 2 fn)) ;;;============================================================ ;;; ;;; (defvar lyskom-filter-hack nil "Variable to busy-wait on to get the filter action. Set to invalid-value until a filter action has been selected.") (defun lyskom-filter-text-p (text-no) (if (null lyskom-filter-list) nil (progn (setq lyskom-filter-hack 'invalid-value) (initiate-get-text-stat 'filter 'lyskom-filter-text-p-2 text-no) ;; ;; Block until done ;; (while (eq lyskom-filter-hack 'invalid-value) (lyskom-accept-process-output)) lyskom-filter-hack))) (defun lyskom-filter-text-p-2 (text-stat) (if (null text-stat) (setq lyskom-filter-hack nil) (progn ;; ;; Collect information from the server ;; (lyskom-collect 'filter) ;; ;; Get the conf-stat of the author of the text ;; Get the text body ;; (initiate-get-conf-stat 'filter nil (text-stat->author text-stat)) (initiate-get-text 'filter nil (text-stat->text-no text-stat)) ;; ;; Get the conf-stat of the recipients ;; (lyskom-traverse misc (text-stat->misc-info-list text-stat) (let ((type (misc-info->type misc))) (if (or (eq type 'RECPT) (eq type 'CC-RECPT) (eq type 'BCC-RECPT)) (initiate-get-conf-stat 'filter nil (misc-info->recipient-no misc))))) ;; ;; Use the results ;; (lyskom-use 'filter 'lyskom-filter-text-p-3 text-stat)))) (defun lyskom-filter-text-p-3 (author text &rest data) (if (or (null text) (null author)) (setq lyskom-filter-hack nil) (let (subject text-stat) ;; ;; Extract the subject ;; (cond ((string-match "\n" (text->text-mass text)) (setq subject (substring (text->text-mass text) 0 (match-beginning 0)))) (t (setq subject ""))) ;; ;; Extract the text-stat which is the last element of data ;; Next shorten the list in data to exclude the text-stat. ;; (setq text-stat (elt data (- (length data) 1))) (if (= (length data) 1) (setq data nil) (rplacd (nthcdr (- (length data) 2) data) nil)) ;; ;; Do the checking ;; (setq lyskom-filter-hack (lyskom-check-filter-list text-stat author data subject (text->text-mass text) lyskom-filter-list))))) (defun lyskom-check-filter-list (text-stat author recipient-list subject text filter-list) (let (tmp) (while filter-list (condition-case nil (if (functionp (filter->function (car filter-list))) (setq tmp (funcall (filter->function (car filter-list)) (car filter-list) author recipient-list subject text-stat text))) (error nil)) (if tmp (setq filter-list nil) (setq filter-list (cdr filter-list)))) tmp)) ;;;======================================== ;;; The filter compiler. ;;; (defmacro lyskom-filter-is-member (testfn arg list selector) (` (let (found (objlist (, list))) (while (and objlist (not found)) (and ((, testfn) (, arg) ((, selector) (car objlist))) (setq found t)) (setq objlist (cdr objlist))) found))) (defun lyskom-create-compile-filter-function (pattern) (if (null pattern) (byte-compile '(lambda (filter author recipient-list subject text-stat text) nil)) (byte-compile (lyskom-create-filter-function pattern)))) (defun lyskom-create-filter-function (pattern) (` (lambda (filter author recipient-list subject text-stat text) (, (cons 'and (lyskom-create-filter-function-body pattern)))))) (defun lyskom-create-filter-function-body (pattern) (let (inverse) (cond ;; ;; End of pattern ;; ((null pattern) '((filter->attribute filter 'action))) ;; ;; Bad pattern ;; ((or (not (listp pattern)) (not (listp (car pattern)))) (lyskom-error "%s" (lyskom-get-string 'filter-error-specification))) ;; ;; Assume valid pattern ;; (t (let ((key (car (car pattern))) (args (cdr (car pattern))) (form nil)) (if (eq key 'not) (if (not (listp args)) (lyskom-error "%s" (lyskom-get-string 'filter-error-bad-not)) (setq key (car args) args (cdr args) inverse t))) (setq form (cond ((eq key 'author) (lyskom-filter-check-args 'stringp args) (` (string-match (, (regexp-quote args)) (conf-stat->name author)))) ((eq key 'author-re) (lyskom-filter-check-args 'regexpp args) (` (string-match (, args) (conf-stat->name author)))) ((eq key 'author-no) (lyskom-filter-check-args 'integerp args) (` (= (, args) (conf-stat->conf-no author)))) ((eq key 'recipient) (lyskom-filter-check-args 'stringp args) (` (lyskom-filter-is-member string-match (, (regexp-quote args)) recipient-list conf-stat->name))) ((eq key 'recipient-re) (lyskom-filter-check-args 'regexpp args) (` (lyskom-filter-is-member string-match (, args) recipient-list conf-stat->name))) ((eq key 'recipient-no) (lyskom-filter-check-args 'integerp args) (` (lyskom-filter-is-member = (, args) recipient-list conf-stat->conf-no))) ((eq key 'subject) (lyskom-filter-check-args 'stringp args) (` (string-match (, (regexp-quote args)) subject))) ((eq key 'subject-re) (lyskom-filter-check-args 'regexpp args) (` (string-match (, args) subject))) ((eq key 'text) (lyskom-filter-check-args 'stringp args) (` (string-match (, (regexp-quote args)) text))) ((eq key 'text-re) (lyskom-filter-check-args 'regexpp args) (` (string-match (, args) text))) (t (lyskom-error (lyskom-get-string 'filter-error-unknown-key) key )))) (if inverse (setq form (list 'not form))) (cons form (lyskom-create-filter-function-body (cdr pattern)))))))) (defun lyskom-filter-check-args (fn arg) (if (not (funcall fn arg)) (lyskom-error (lyskom-get-string 'filter-error-key-arg) fn arg))) ;;; ============================================================ ;;; lyskom-filter-prompt ;;; ;;; Print a notice that a text has been filtered. ;;; (defun lyskom-filter-prompt (text-no prompt) (setq lyskom-filter-hack t) (let ((text-stat (blocking-do 'get-text-stat text-no)) (subject nil)) (if text-stat (blocking-do-multiple ((text (get-text text-no)) (conf-stat (get-conf-stat (text-stat->author text-stat)))) (if text (progn (setq subject (if (string-match "\n" (text->text-mass text)) (substring (text->text-mass text) 0 (match-beginning 0)) (text->text-mass text))) (lyskom-format-insert prompt text-stat subject (or conf-stat (text-stat->author text-stat))) (lyskom-scroll)))))) (setq lyskom-filter-hack nil)) ;;;======================================== ;;; User functions and support functions ;;; (defun lyskom-add-filter (filter) "Add the filter FILTER to the LysKOM filtering mechanism." (if (filter->attribute filter 'expire) (setq kom-session-filter-list (cons filter kom-session-filter-list)) (progn (setq kom-permanent-filter-list (cons filter kom-permanent-filter-list)) (lyskom-save-options (current-buffer) (lyskom-get-string 'filter-edit-saving) (lyskom-get-string 'filter-edit-saving-done) (lyskom-get-string 'filter-edit-saving-error)))) (setq lyskom-filter-list (cons filter lyskom-filter-list))) (defun lyskom-filter-read-action () "Read a filter action from the minibuffer, returning its symbol" (let ((completion-ignore-case t)) (car (rassoc (completing-read (lyskom-get-string 'filter-action) (lyskom-reverse-pairs lyskom-filter-actions) nil nil (cdr (car lyskom-filter-actions)) t) lyskom-filter-actions)))) (defun lyskom-filter-read-permanent () "Ask the user is a filter is permanent and return t in this case. Otherwise return nil." (lyskom-j-or-n-p (lyskom-get-string 'filter-permanent))) ;;;======================================== ;;; Filtrera ärende --- Filter subject ;;; (def-kom-command kom-filter-subject (&optional subject) "Interactively filter a subject. Optional SUBJECT is subject to filter." (interactive) (if (/= 0 lyskom-current-conf) (let ((conf-stat (blocking-do 'get-conf-stat lyskom-current-conf))) (let (conf perm filter action) (if (null subject) (setq subject lyskom-current-subject)) (setq subject (read-from-minibuffer (lyskom-get-string 'filter-subject) subject)) (setq filter (cons (cons 'subject subject) filter)) (setq conf (lyskom-read-conf-no (lyskom-get-string 'filter-in-conf) '(all) t (or (and (conf-stat->conf-no conf-stat) (cons (conf-stat->name conf-stat) 0)) "") t)) (if (/= conf 0) (setq filter (cons (cons 'recipient-no conf) filter))) (setq action (lyskom-filter-read-action)) (setq perm (lyskom-filter-read-permanent)) (lyskom-add-filter (make-filter filter (list (cons 'action action) (cons 'expire (not perm))))))))) ;;;======================================== ;;; Filtrera författare --- Filter author ;;; (def-kom-command kom-filter-author () "Interactively filter an author." (interactive) (let (auth-stat author conf filter action permanent) (blocking-do-multiple ((text-stat (get-text-stat (or lyskom-current-text 0))) (conf-stat (get-conf-stat lyskom-current-conf))) (if text-stat (setq auth-stat (blocking-do 'get-conf-stat (text-stat->author text-stat)))) (setq author (lyskom-read-conf-no (lyskom-get-string 'filter-author) '(pers) t (or (and auth-stat (cons (conf-stat->name auth-stat) 0)) "") t)) (if (/= author 0) (setq filter (cons (cons 'author-no author) filter))) (setq conf (lyskom-read-conf-no (lyskom-get-string 'filter-in-conf) '(all) t (or (and conf-stat (cons (conf-stat->name conf-stat) 0)) "") t)) (if (/= conf 0) (setq filter (cons (cons 'recipient-no conf) filter))) (setq action (lyskom-filter-read-action)) (setq permanent (lyskom-filter-read-permanent)) (lyskom-add-filter (make-filter filter (list (cons 'action action) (cons 'expire (not permanent)))))))) ;;;============================================================ ;;; ;;; Superhoppa ;;; (def-kom-command kom-super-jump () "Skip all texts and comments that share the subject and recipient of the current text" (interactive) (if (or (null lyskom-current-text) (zerop lyskom-current-text)) (lyskom-insert-string 'have-to-read) (let ((text-stat (blocking-do 'get-text-stat lyskom-current-text)) (recipients nil) (cc-recipients nil) (bcc-recipients nil) (filter-recipient nil) (conf-stat (if (and lyskom-current-conf (not (zerop lyskom-current-conf))) (blocking-do 'get-conf-stat lyskom-current-conf)))) (lyskom-traverse misc (text-stat->misc-info-list text-stat) (cond ((eq (misc-info->type misc) 'RECPT) (setq recipients (cons (misc-info->recipient-no misc) recipients))) ((eq (misc-info->type misc) 'CC-RECPT) (setq cc-recipients (cons (misc-info->recipient-no misc) cc-recipients))) ((eq (misc-info->type misc) 'BCC-RECPT) (setq bcc-recipients (cons (misc-info->recipient-no misc) bcc-recipients))))) (setq filter-recipient (or (and conf-stat (or (memq lyskom-current-conf recipients) (memq lyskom-current-conf cc-recipients)) lyskom-current-conf) (car (nreverse recipients)) (car (nreverse cc-recipients)) (car (nreverse bcc-recipients)))) (if (null filter-recipient) (lyskom-insert-string 'no-recipient) (lyskom-add-filter (make-filter (list (cons 'subject-re (concat "\\([rR][eE]: *\\|[Ff][Ww][Dd]: *\\)*" (replace-in-string (regexp-quote lyskom-current-subject) "[ \t]+" "[ \t]+"))) (cons 'recipient-no filter-recipient)) (list (cons 'action 'skip-tree) (cons 'expire t)))) (lyskom-format-insert 'super-jump (copy-sequence lyskom-current-subject) filter-recipient))))) ;;;============================================================ ;;; ;;; Filtrera text ;;; (def-kom-command kom-filter-text (&optional text) "Interactively filter on text contents. Optional TEXT is subject to filter." (interactive) (if (/= 0 lyskom-current-conf) (let ((conf-stat (blocking-do 'get-conf-stat lyskom-current-conf)) (conf nil) (action nil) (perm nil) (filter nil)) (if conf-stat (progn (setq text (read-from-minibuffer (lyskom-get-string 'filter-which-text) (or text ""))) (setq filter (cons (cons 'text text) filter)) (setq conf (lyskom-read-conf-no (lyskom-get-string 'filter-in-conf) '(all) t (or (and (conf-stat->conf-no conf-stat) (cons (conf-stat->name conf-stat) 0)) "") t)) (if (/= conf 0) (setq filter (cons (cons 'recipient-no conf) filter))) (setq action (lyskom-filter-read-action)) (setq perm (lyskom-filter-read-permanent)) (lyskom-add-filter (make-filter filter (list (cons 'action action) (cons 'expire (not perm)))))))))) ;;;============================================================ ;;; Lista filter (kom-list-filters) ;;; ;;; Author: David Byers ;;; Calls internal functions in filter-edit mode. This may or ;;; may not be a good idea, but it works... (def-kom-command kom-list-filters () "Display all filters" (interactive) (let ((filters lyskom-filter-list)) (goto-char (point-max)) (if (null filters) (lyskom-insert (lyskom-get-string 'no-filters)) (progn (lyskom-insert (lyskom-get-string 'view-filters-header)) (while filters (goto-char (point-max)) (lyskom-format-filter-pattern (car filters)) (setq filters (cdr filters))) (lyskom-insert (lyskom-get-string 'view-filters-footer)))))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: filter-edit.el,v 44.4.2.2 1999/10/13 12:13:07 byers Exp $ ;;;;; Copyright (C) 1994, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;;============================================================ ;;;;============================================================ ;;;; ;;;; File: filter-edit.el ;;;; ;;;; This file contains the filter editor ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: filter-edit.el,v 44.4.2.2 1999/10/13 12:13:07 byers Exp $\n")) (defvar filter-edit-currently-edited-filter-entry-list nil "List of filters currently being edited in a filter editor") (defvar filter-edit-change-flag nil) (defvar filter-edit-filter-list nil) (defvar filter-edit-list-start nil) (defvar filter-edit-list-end nil) (defun copy-filter-list (l) "Copy the filter list L" (cond ((null l) nil) (t (cons (copy-filter (car l)) (copy-filter-list (cdr l)))))) (defun lyskom-reverse-pairs (l) "Reverse the pairs in the assoc list L" (mapcar (function (lambda (e) (cons (cdr e) (car e)))) l)) ;;;======================================== ;;; Data types ;;; ;;; filter-entry ;;; Entry in the filter-entry list ;;; ;;; A filter entry is a vector consisting of ;;; ;;; [START END LINES PATTERN] ;;; ;;; START is the starting position (mark) in the buffer ;;; END is the ending position (mark) in the buffer ;;; LINES is a list of starting positions (marks) of the lines ;;; PATTERN is the filter displayed (type filter) ;;; (defun filter-entry->start (e) "Get starting position of entry E." (aref e 0)) (defun set-filter-entry->start (e s) "Set starting position of entry E to S." (aset e 0 s)) (defun filter-entry->end (e) "Get end position of entry E." (aref e 1)) (defun set-filter-entry->end (e s) "Set end position of entry E to S." (aset e 1 s)) (defun filter-entry->lines (e) "Get line start list of entry E." (aref e 2)) (defun set-filter-entry->lines (e p) "Set line start list of entry E to P." (aset e 2 p)) (defun filter-entry->filter (e) "Get filter of entry E." (aref e 3)) (defun set-filter-entry->filter (e p) "Set filter of entry E to P." (aset e 3 p)) (defun make-filter-entry (start end lines pattern) "Create an filter entry with START, END, LINES and PATTERN as values." (vector start end lines pattern)) ;;;============================================================ ;;; Verification functions ;;; (defun lyskom-verify-filter-list (filter) "Return non-nil if FILTER is a valid filter list" (cond ((null filter) t) ((not (listp filter)) nil) ((not (filter-p (car filter))) nil) (t (and (lyskom-verify-filter-pattern (filter->pattern (car filter))) (lyskom-verify-filter-list (cdr filter)))))) (defun lyskom-verify-filter-pattern (filter) "Return non-nil if FILTER is a valid filter pattern" (cond ((null filter) nil) ((and (= (length filter) 1) (symbolp (car filter))) t) ((not (listp (car filter))) nil) ((eq 'not (car (car filter))) (lyskom-verify-filter-pattern (cons (cdr (car filter)) (cdr filter)))) ((or (eq 'author-re (car (car filter))) (eq 'recipient-re (car (car filter))) (eq 'subject-re (car (car filter))) (eq 'text-re (car (car filter)))) (and (lyskom-filter-verify-regexp (cdr (car filter))) (lyskom-verify-filter-pattern (cdr filter)))) ((or (eq 'author (car (car filter))) (eq 'subject (car (car filter))) (eq 'recipient (car (car filter))) (eq 'text (car (car filter)))) (and (stringp (cdr (car filter))) (lyskom-verify-filter-pattern (cdr filter)))) ((or (eq 'author-no (car (car filter))) (eq 'recipient-no (car (car filter)))) (and (integerp (cdr (car filter))) (lyskom-verify-filter-pattern (cdr filter)))) (t nil))) (defun lyskom-filter-verify-regexp (re) "Return t if RE is a valid regexp." (condition-case nil (progn (string-match re "teststring") t) (error nil))) ;;;======================================== ;;; Locator functions ;;; (defun lyskom-filter-edit-lineno (where entry) "Return the line number at WHERE in the entry ENTRY. -1 means the header. 0 is the first line. Any number higher than the number of lines means outside the pattern." (let* ((lines (append (filter-entry->lines entry) (cons (filter-entry->end entry) nil))) (line -1) (current-line (length lines))) (if (>= where (filter-entry->start entry)) (while lines (if (< where (car lines)) (progn (setq current-line line) (setq lines nil)) (progn (setq lines (cdr lines)) (setq line (1+ line)))))) current-line)) (defun lyskom-filter-edit-locate (where) "Locate the entry at character position WHERE. nil means WHERE is not in any entry." (let ((entry-no (lyskom-filter-edit-locate-no where))) (if (= -1 entry-no) nil (elt filter-edit-currently-edited-filter-entry-list entry-no)))) (defun lyskom-filter-edit-locate-no (where) "Find the filter-edit-currently-edited-filter-entry-list index of the entry covering the character position WHERE. -1 means WHERE is not covered y any entry." (let ((i 0) (entry-no -1) (l filter-edit-currently-edited-filter-entry-list)) (while l (if (and (>= where (filter-entry->start (car l))) (<= where (filter-entry->end (car l)))) (progn (setq entry-no i) (setq l nil)) (progn (setq i (1+ i)) (setq l (cdr l))))) entry-no)) ;;;======================================== ;;; Formatting functions ;;; (defun lyskom-format-filter-list (filters) "Format the filter list FILTERS and insert the result into the current buffer. The buffer variable FILTER-EDIT-CURRENTLY-EDITED-FILTER-ENTRY-LIST is also updated." (let ((inhibit-read-only t)) (setq filter-edit-currently-edited-filter-entry-list nil) (lyskom-format-filter-list-2 filters) (setq filter-edit-currently-edited-filter-entry-list (nreverse filter-edit-currently-edited-filter-entry-list)))) (defun lyskom-format-filter-list-2 (filters) "Format the filter list FILTERS and insert the result into the current buffer." (cond ((null filters) nil) (t (setq filter-edit-currently-edited-filter-entry-list (cons (lyskom-format-filter-pattern (car filters)) filter-edit-currently-edited-filter-entry-list)) (lyskom-format-filter-list-2 (cdr filters))))) (defun lyskom-format-filter-pattern (pat) "Format and insert the filter pattern PAT into the current buffer. Returns an filter-entry structure representing the entry." (let ((inhibit-read-only t) start end lines) ;; ;; Insert text representation ;; (setq start (point-marker)) (lyskom-filter-format-entry-header pat t) (setq lines (lyskom-format-filter-pattern-2 (filter->pattern pat) nil)) (setq end (point-marker)) (insert "\n") (make-filter-entry start end lines pat))) (defun lyskom-format-filter-pattern-2 (pat lines &optional neg) "Format and insert the body of the filter pattern PAT into the current buffer. Accumulate line starts in LINES. If NEG is non-nil, the first line will be negated." (cond ((or (null pat)) (nreverse lines)) ((eq (car (car pat)) 'not) (lyskom-format-filter-pattern-2 (cons (cdr (car pat)) (cdr pat)) lines t)) (t (setq lines (cons (point-marker) lines)) (lyskom-format-filter-pattern-insert pat neg) (lyskom-format-filter-pattern-2 (cdr pat) lines)))) (defun lyskom-format-filter-pattern-insert (pat neg) "Format and insert the first pattern in PAT. If NEG is non-nil, format the negation." (let (tmp) (insert (format " %s %s %S" (cdr (assoc (car (car pat)) lyskom-filter-what)) (if neg " != " " = ") (cdr (car pat)))) (cond ((or (eq (car (car pat)) 'recipient-no) (eq (car (car pat)) 'author-no)) (save-excursion (if (boundp 'lyskom-buffer) (set-buffer lyskom-buffer)) (setq tmp (blocking-do 'get-conf-stat (cdr (car pat))))) (insert (format " <%s>" (conf-stat->name tmp))))) (insert "\n"))) (defun lyskom-filter-format-entry-header (filter &optional newline action) "Format the header of a filter entry. FILTER is the filter to format. If NEWLINE is non-nil, insert a newline after the header." (let (permanent) (setq action (filter->attribute filter 'action) permanent (null (filter->attribute filter 'expire))) (insert (format "--- %s %s" (cdr (assq action lyskom-filter-actions )) (lyskom-get-string (if permanent 'permanent 'temporary)))) (if newline (insert "\n")))) ;;;======================================== ;;; User commands ;;; (defun lyskom-filter-edit-next-pattern (arg) "Move to the ARGth next pattern line in the current buffer." (interactive "p") (if (null arg) (setq arg 1)) (if (< arg 0) (lyskom-filter-edit-prev-entry (- arg)) (while (/= arg 0) (let ((entry-no (lyskom-filter-edit-locate-no (point))) tmp) (if (= -1 entry-no) (if (car filter-edit-currently-edited-filter-entry-list) (goto-char (filter-entry->start (car filter-edit-currently-edited-filter-entry-list))) (lyskom-error (lyskom-get-string 'filter-edit-empty-list))) (let* ((entry (elt filter-edit-currently-edited-filter-entry-list entry-no)) (lineno (lyskom-filter-edit-lineno (point) entry))) (cond ((= lineno -1) (if (filter-entry->lines entry) (setq tmp (car (filter-entry->lines entry))) (progn (setq tmp (elt filter-edit-currently-edited-filter-entry-list (1+ entry-no))) (if tmp (setq tmp (filter-entry->start tmp)) (lyskom-error (lyskom-get-string 'filter-edit-end-of-list)))))) ((= lineno (1- (length (filter-entry->lines entry)))) (setq tmp (elt filter-edit-currently-edited-filter-entry-list (1+ entry-no))) (if tmp (setq tmp (filter-entry->start tmp)) (lyskom-error (lyskom-get-string 'filter-edit-end-of-list)))) (t (setq tmp (elt (filter-entry->lines entry) (1+ lineno))))) (goto-char tmp) (setq arg (1- arg)))))))) (defun lyskom-filter-edit-prev-pattern (arg) "Move to the ARGth previous pattern line in the current buffer." (interactive "p") (if (null arg) (setq arg 1)) (if (< arg 0) (lyskom-filter-edit-next-entry (- arg)) (while (/= arg 0) (let ((entry-no (lyskom-filter-edit-locate-no (point))) tmp) (if (= -1 entry-no) (if (car filter-edit-currently-edited-filter-entry-list) (goto-char (filter-entry->start (car filter-edit-currently-edited-filter-entry-list))) (lyskom-error (lyskom-get-string 'filter-edit-empty-list))) (let* ((entry (elt filter-edit-currently-edited-filter-entry-list entry-no)) (lineno (lyskom-filter-edit-lineno (point) entry))) (cond ((= lineno -1) (if (= 0 entry-no) (lyskom-error (lyskom-get-string 'filter-edit-start-of-list)) (progn (setq entry (elt filter-edit-currently-edited-filter-entry-list (1- entry-no))) (setq tmp (car (nthcdr (1- (length (filter-entry->lines entry))) (filter-entry->lines entry)))) (if (null tmp) (setq tmp (filter-entry->start entry)))))) ((= lineno 0) (setq tmp (filter-entry->start entry))) (t (setq tmp (elt (filter-entry->lines entry) (1- lineno))))) (goto-char tmp) (setq arg (1- arg)))))))) (defun lyskom-filter-edit-next-entry (arg) "Move to the ARGth next entry in the current buffer." (interactive "p") (if (null arg) (setq arg 1)) (if (< arg 0) (lyskom-filter-edit-prev-entry (- arg)) (while (/= 0 arg) (let ((entry-no (lyskom-filter-edit-locate-no (point)))) (if (= -1 entry-no) (if (car filter-edit-currently-edited-filter-entry-list) (goto-char (filter-entry->start (car filter-edit-currently-edited-filter-entry-list))) (lyskom-error (lyskom-get-string 'filter-edit-empty-list))) (let ((tmp (elt filter-edit-currently-edited-filter-entry-list (1+ entry-no)))) (if tmp (progn (goto-char (filter-entry->start tmp)) (setq arg (1- arg))) (lyskom-error (lyskom-get-string 'filter-edit-end-of-list))))))))) (defun lyskom-filter-edit-prev-entry (arg &optional noerror) "Move to the ARGth previous entry in the current buffer." (interactive "p") (not (catch 'fail (if (null arg) (setq arg 1)) (if (< arg 0) (lyskom-filter-edit-next-entry (- arg)) (while (/= 0 arg) (let ((entry-no (lyskom-filter-edit-locate-no (point)))) (if (= -1 entry-no) (if (car filter-edit-currently-edited-filter-entry-list) (goto-char (filter-entry->start (car filter-edit-currently-edited-filter-entry-list))) (if noerror (throw 'fail t) (lyskom-error (lyskom-get-string 'filter-edit-empty-list))))) (if (= 0 entry-no) (if noerror (throw 'fail t) (lyskom-error (lyskom-get-string 'filter-edit-start-of-list))) (let ((tmp (elt filter-edit-currently-edited-filter-entry-list (1- entry-no)))) (setq arg (1- arg)) (goto-char (filter-entry->start tmp)))))))))) (defun lyskom-filter-edit-beginning-of-list () "Move to the first entry in the list" (interactive) (if (null filter-edit-currently-edited-filter-entry-list) (lyskom-error (lyskom-get-string 'filter-edit-empty-list)) (progn (push-mark) (goto-char (filter-entry->start (car filter-edit-currently-edited-filter-entry-list)))))) (defun lyskom-filter-edit-end-of-list () "Move to the last entry in the list" (interactive) (if (null filter-edit-currently-edited-filter-entry-list) (lyskom-error (lyskom-get-string 'filter-edit-empty-list)) (let ((entry (elt filter-edit-currently-edited-filter-entry-list (1- (length filter-edit-currently-edited-filter-entry-list))))) (push-mark) (goto-char (or (elt (filter-entry->lines entry) (1- (length (filter-entry->lines entry)))) (filter-entry->start entry)))))) (defun lyskom-filter-edit-insert-entry () "Add an entry to the end of the list" (interactive) (let ((inhibit-read-only t) (completion-ignore-case t) (rev-actions (lyskom-reverse-pairs lyskom-filter-actions)) action permanent filter start end entry) (if filter-edit-currently-edited-filter-entry-list (progn (goto-char (filter-entry->end (elt filter-edit-currently-edited-filter-entry-list (1- (length filter-edit-currently-edited-filter-entry-list))))) (insert "\n")) (goto-char filter-edit-list-end)) (setq action (completing-read (lyskom-get-string 'filter-edit-filter-how) rev-actions nil t)) (setq permanent (lyskom-j-or-n-p (lyskom-get-string 'filter-permanent))) (setq filter (make-filter nil (list (cons 'action (cdr (assoc action rev-actions))) (cons 'expire (not permanent))))) (setq start (point-marker)) (lyskom-filter-format-entry-header filter t) (setq end (point-marker)) (setq entry (make-filter-entry start end nil filter)) (if filter-edit-currently-edited-filter-entry-list (setcdr (nthcdr (1- (length filter-edit-currently-edited-filter-entry-list)) filter-edit-currently-edited-filter-entry-list) (cons entry nil)) (setq filter-edit-currently-edited-filter-entry-list (cons entry nil))) (setq filter-edit-change-flag t) (goto-char start))) (defun lyskom-filter-edit-insert-pattern () "Add a pattern line to the current list entry." (interactive) (let ((entry-no (lyskom-filter-edit-locate-no (point)))) (if (= -1 entry-no) (lyskom-error (lyskom-get-string 'filter-edit-outside-entry)))) (let ((what nil) (pred nil) (arg nil) (argstring nil) (lineno nil) (entry nil) (filter nil) (pat nil) (inhibit-read-only t) (completion-ignore-case t) (rev-what (lyskom-reverse-pairs lyskom-filter-what))) (setq what (completing-read (lyskom-get-string 'filter-edit-filter-what) rev-what nil t)) (setq pred (completing-read (lyskom-format 'filter-edit-insert-pred what) lyskom-filter-predicate-list nil t)) (setq argstring (read-from-minibuffer (lyskom-format 'filter-edit-insert-arg what pred))) (setq what (cdr (assoc what rev-what))) (if (not (cond ((or (eq what 'author) (eq what 'subject) (eq what 'text) (eq what 'recipient)) (setq arg argstring)) ((or (eq what 'author-no) (eq what 'recipient-no)) (setq arg (string-to-int argstring))) ((or (eq what 'author-re) (eq what 'subject-re) (eq what 'text-re) (eq what 'recipient-re)) (setq arg argstring) (lyskom-filter-verify-regexp arg)))) (lyskom-error (lyskom-get-string 'filter-edit-bad-argument) argstring)) ;; ;; Build pattern ;; (setq pat (cons what arg)) (if (cdr (assoc pred lyskom-filter-predicate-list)) (setq pat (cons 'not pat))) ;; ;; Locate current entry ;; Locate current line ;; (setq entry (lyskom-filter-edit-locate (point))) (setq lineno (lyskom-filter-edit-lineno (point) entry)) (setq filter (filter-entry->filter entry)) ;; ;; Splice the new pattern into the old pattern at the ;; proper position. If lineno is -1 (the cursor is not in ;; the pattern area, append the pattern. ;; (if (= -1 lineno) (setq lineno (length (filter->pattern filter)))) (cond ((= lineno 0) (set-filter->pattern filter (cons pat (filter->pattern filter)))) (t (if (filter->pattern filter) (setcdr (nthcdr (1- lineno) (filter->pattern filter)) (cons pat (nthcdr lineno (filter->pattern filter)))) (set-filter->pattern filter pat)))) ;; ;; Update display ;; (if (= lineno (length (filter-entry->lines entry))) (goto-char (filter-entry->end entry)) (goto-char (elt (filter-entry->lines entry) lineno))) ;; ;; OK, right now, POINT is on top os a marker that represents the ;; NEXT line. This marker must be puched forward to avoid duplicating ;; it. ;; (forward-line -1) (end-of-line) (insert "\n") (lyskom-format-filter-pattern-insert (cons (if (eq (car pat) 'not) (cdr pat) pat) nil) (eq (car pat) 'not)) (forward-char -1) (delete-char 1) (beginning-of-line) ;; ;; Update lines list in the entry ;; (cond ((= lineno 0) (set-filter-entry->lines entry (cons (point-marker) (filter-entry->lines entry)))) (t (setcdr (nthcdr (1- lineno) (filter-entry->lines entry)) (cons (point-marker) (nthcdr lineno (filter-entry->lines entry)))))) (setq filter-edit-change-flag t))) (defun lyskom-filter-edit-delete-pattern (arg) "Delete ARG pattern lines, starting with the one at point. Only lines in the current entry will be deleted." (interactive "p") (let* ((inhibit-read-only t) (entry (lyskom-filter-edit-locate (point))) (filter (filter-entry->filter entry))) (if (null entry) (lyskom-error (lyskom-get-string 'filter-edit-outside-list)) (progn (while (/= 0 arg) (let ((lineno (lyskom-filter-edit-lineno (point) entry))) (if (null arg) (setq arg 1)) (if (and (> lineno -1) (< lineno (length (filter-entry->lines entry)))) (progn (setq arg (1- arg)) (setq lineno (lyskom-filter-edit-lineno (point) entry)) (delete-region (save-excursion (beginning-of-line) (point)) (1+ (save-excursion (end-of-line) (point)))) (if (= lineno (1- (length (filter-entry->lines entry)))) (forward-line -1)) (if (= lineno 0) (progn (set-filter-entry->lines entry (cdr (filter-entry->lines entry))) (set-filter->pattern filter (cdr (filter->pattern filter))) (setq filter-edit-change-flag t)) (progn (setcdr (nthcdr (1- lineno) (filter-entry->lines entry)) (nthcdr (1+ lineno) (filter-entry->lines entry))) (setcdr (nthcdr (1- lineno) (filter->pattern (filter-entry->filter entry))) (nthcdr (1+ lineno) (filter->pattern (filter-entry->filter entry)))) (setq filter-edit-change-flag t)))) (lyskom-error (lyskom-get-string 'filter-edit-end-of-pattern))))))))) (defun lyskom-filter-edit-delete-entry (arg &optional which noerror) "Delete ARG entries, starting with the one covering point. If optional WHICH is non-nil, start with entry number WHICH. If NOERROR is non-nil, return nil instead of signaling an error." (interactive "p") (let ((inhibit-read-only t)) (not (catch 'fail (if (null arg) (setq arg 1)) (while (/= 0 arg) (let* ((entry-no (or which (lyskom-filter-edit-locate-no (point)))) (entry nil)) (if (= -1 entry-no) (if noerror (throw 'fail t) (lyskom-error (lyskom-get-string 'filter-edit-end-of-list)))) (setq entry (elt filter-edit-currently-edited-filter-entry-list entry-no)) (delete-region (filter-entry->start entry) (1+ (filter-entry->end entry))) (cond ((= 0 entry-no) (setq filter-edit-currently-edited-filter-entry-list (cdr filter-edit-currently-edited-filter-entry-list)) (setq filter-edit-change-flag t)) (t (setcdr (nthcdr (1- entry-no) filter-edit-currently-edited-filter-entry-list) (nthcdr (1+ entry-no) filter-edit-currently-edited-filter-entry-list)) (setq filter-edit-change-flag t))) (if (= entry-no (length filter-edit-currently-edited-filter-entry-list)) (progn (if (lyskom-filter-edit-prev-entry 1 t) (setq arg 0) (throw 'fail t))) (setq arg (1- arg))))))))) (defun lyskom-filter-edit-quit () "Quit filter edit mode and ask to save changes (if any)" (interactive) (let ((save nil)) (if filter-edit-change-flag (setq save (lyskom-j-or-n-p (lyskom-get-string 'filter-edit-save-p)))) (if save (lyskom-filter-edit-save)) (set-window-configuration lyskom-edit-return-to-configuration))) (defun lyskom-filter-edit-expunge () "Delete all entries that are completely empty" (interactive) (let ((e filter-edit-currently-edited-filter-entry-list) (index 0)) (while e (if (null (filter-entry->lines (car e))) (lyskom-filter-edit-delete-entry 1 index t) (setq index (1+ index))) (setq e (cdr e))))) (defun lyskom-filter-empty-patterns-p () "Return non-nil if the entry list contains empty entries." (let ((e filter-edit-currently-edited-filter-entry-list) (result nil)) (while e (if (null (filter-entry->lines (car e))) (progn (setq e nil) (setq result t)) (setq e (cdr e)))) result)) (defun lyskom-filter-edit-save () "Save changes in filter edit mode" (interactive) (if (and (lyskom-filter-empty-patterns-p) (lyskom-j-or-n-p (lyskom-get-string 'filter-edit-remove-empty))) (lyskom-filter-edit-expunge)) (let ((e filter-edit-currently-edited-filter-entry-list) (xpermanent-list nil) (xtemporary-list nil)) (while e (set-filter->function (filter-entry->filter (car e)) (lyskom-create-compile-filter-function (filter->pattern (filter-entry->filter (car e))))) (set (if (filter->attribute (filter-entry->filter (car e)) 'expire) 'xtemporary-list 'xpermanent-list) (cons (filter-entry->filter (car e)) (if (filter->attribute (filter-entry->filter (car e)) 'expire) xtemporary-list xpermanent-list))) (setq e (cdr e))) (save-excursion (set-buffer lyskom-buffer) (setq lyskom-filter-list (append (setq kom-permanent-filter-list (nreverse xpermanent-list)) (setq kom-session-filter-list (nreverse xtemporary-list)))) (setq filter-edit-change-flag nil) (lyskom-message "%s" (lyskom-get-string 'filter-edit-saving)) (lyskom-save-options lyskom-buffer (lyskom-get-string 'filter-edit-saving) (lyskom-get-string 'filter-edit-saving-done) (lyskom-get-string 'filter-edit-saving-error))))) (defun lyskom-filter-edit-revert () "Discard changes and restart editing" (interactive) (if (or (not filter-edit-change-flag) (and filter-edit-change-flag (lyskom-j-or-n-p (lyskom-get-string 'filter-edit-restart-p)))) (let ((inhibit-read-only t)) (setq filter-edit-currently-edited-filter-entry-list nil) (delete-region filter-edit-list-start filter-edit-list-end) (goto-char filter-edit-list-start) (insert "\n") (lyskom-format-filter-list (copy-filter-list lyskom-filter-list)) (setq filter-edit-change-flag nil) (lyskom-filter-edit-beginning-of-list)))) (defun lyskom-filter-edit-toggle-permanent () "Toggle the permanent flag of the current entry" (interactive) (let ((entry-no (lyskom-filter-edit-locate-no (point))) (inhibit-read-only t)) (if (= -1 entry-no) (lyskom-error (lyskom-get-string 'filter-edit-outside-entry))) (let ((entry (elt filter-edit-currently-edited-filter-entry-list entry-no))) (set-filter->attribute (filter-entry->filter entry) 'expire (not (filter->attribute (filter-entry->filter entry) 'expire))) (setq filter-edit-change-flag t) (save-excursion (goto-char (filter-entry->start entry)) (delete-region (point) (save-excursion (end-of-line) (point))) (lyskom-filter-format-entry-header (filter-entry->filter entry)))))) (defun lyskom-filter-edit-toggle-action () "Toggle the filter action of the current entry." (interactive) (let ((entry-no (lyskom-filter-edit-locate-no (point))) (inhibit-read-only t)) (if (= -1 entry-no) (lyskom-error (lyskom-get-string 'filter-edit-outside-entry))) (let* ((entry (elt filter-edit-currently-edited-filter-entry-list entry-no)) (action-list lyskom-filter-actions) (action (car (cdr (memq (assq (filter->attribute (filter-entry->filter entry) 'action) action-list) action-list)))) (new-action (or action (car action-list)))) (setq filter-edit-change-flag t) (set-filter->attribute (filter-entry->filter entry) 'action (car new-action)) (save-excursion (goto-char (filter-entry->start entry)) (delete-region (point) (save-excursion (end-of-line) (point))) (lyskom-filter-format-entry-header (filter-entry->filter entry)))))) (defun lyskom-filter-edit-brief-help () "Display a help message in the minibuffer." (interactive) (lyskom-message "%s" (lyskom-get-string 'filter-edit-help))) (defun lyskom-filter-edit-mode () "\\Mode for editing LysKOM filters. Entry to this mode runs lyskom-filter-edit-hook Commands: \\[lyskom-filter-edit-prev-pattern] Moves up in the pattern list. \\[lyskom-filter-edit-next-pattern] Moves down in the pattern list. \\[lyskom-filter-edit-prev-entry] Moves up one filter in the list. \\[lyskom-filter-edit-next-entry] Moves down one filter in the list. \\[lyskom-filter-edit-beginning-of-list] Moves to the beginning of the list. \\[lyskom-filter-edit-end-of-list] Moves to the end of the list. \\[lyskom-filter-edit-delete-pattern] Deletes the pattern line at point. \\[lyskom-filter-edit-delete-entry] Deletes the filter containing point. \\[lyskom-filter-edit-insert-pattern] Inserts a pattern line at point. \\[lyskom-filter-edit-insert-entry] Inserts a new filter into the list. \\[lyskom-filter-edit-expunge] Deletes all empty filters from the list. \\[lyskom-filter-edit-revert] Discards all changes to the list. \\[lyskom-filter-edit-toggle-action] Toggles the filter action of the filter containing point. \\[lyskom-filter-edit-toggle-permanent] Toggles between permanent and temporary. \\[lyskom-filter-edit-save] Saves the filters. \\[lyskom-filter-edit-quit] Quit and return to LysKOM. All key bindings: \\{lyskom-filter-edit-map} " (interactive) (kill-all-local-variables) (make-local-variable 'filter-edit-currently-edited-filter-entry-list) (make-local-variable 'filter-edit-change-flag) (make-local-variable 'filter-edit-filter-list) (make-local-variable 'filter-edit-list-start) (make-local-variable 'filter-edit-list-end) (make-local-variable 'lyskom-buffer) (make-local-variable 'lyskom-edit-return-to-configuration) (setq buffer-read-only t) (setq filter-edit-change-flag nil) (buffer-disable-undo (current-buffer)) (lyskom-use-local-map lyskom-filter-edit-map) (setq mode-name "LysKOM Filter Edit") (setq major-mode 'lyskom-filter-edit-mode) (setq local-abbrev-table 'lyskom-filter-edit-abbrev-table) (run-hooks 'lyskom-filter-edit-hook)) ;;;======================================== ;;; LysKOM command to start editing ;;; (defun kom-filter-edit () (interactive) (let ((buf (current-buffer)) (filters lyskom-filter-list) (server-name lyskom-server-name) (curwin (current-window-configuration))) (lyskom-display-buffer (lyskom-get-buffer-create 'edit-filters (concat (buffer-name buf) "-" (lyskom-get-string 'filter-edit-buffer-name)) t)) (let ((inhibit-read-only t)) (erase-buffer)) (lyskom-filter-edit-mode) (setq lyskom-buffer buf) (let ((inhibit-read-only t)) (setq filter-edit-filter-list filters) (insert (format (lyskom-get-string 'filter-edit-header) server-name)) (setq filter-edit-list-start (point-marker)) (insert "\n") (lyskom-format-filter-list (copy-filter-list filter-edit-filter-list)) (setq filter-edit-list-end (point-max-marker))) (setq lyskom-edit-return-to-configuration curwin) (lyskom-filter-edit-beginning-of-list))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;; $Id: lyskom-buttons.el,v 44.16.2.2 1999/10/13 12:13:14 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: lyskom-buttons.el ;;;; Author: David Byers ;;;; ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: lyskom-buttons.el,v 44.16.2.2 1999/10/13 12:13:14 byers Exp $\n")) (lyskom-external-function glyph-property) (lyskom-external-function widget-at) (lyskom-external-function widget-get) (lyskom-external-function w3-widget-button-click) (lyskom-external-function w3-popup-menu) (lyskom-external-function Info-goto-node) (lyskom-external-function term-char-mode) (defun lyskom-menu-selection nil "Variable used to work around the handling of menus in XEmacs.") (defun lyskom-add-button-action (type text func) "Add a new action to the popup menu for a class of objects. Arguments are TYPE, the type of object to adjust, TEXT the menu text for the action and FUNC, the function to call when the action is selected. By default TYPE may be any one of text, conf, pers or url although users can add other types. FUNC must be a function with three arguments, BUFFER, ARGUMENT and TEXT. BUFFER is the LysKOM buffer that the command should use, TEXT is the text of the selected button and ARGUMENT is the data argument associated with the object. For button type text it is a text number. For types conf and pers it is the conference number for the object. For URLs it is the text of the URL (a string) or NIL. For other (user-defined) types, it is a string. For more information on button types and arguments, see the documentation for the variable lyskom-text-buttons." (nconc (nth 3 (assq type lyskom-button-actions)) (list (cons text func)))) (defun lyskom-set-default-button-action (type func) "Set the default action for buttons of the type TYPE to FUNC. FUNC must be a valid button action function. For more information on such functions see the documentation for lyskom-add-button-action." (let ((el (assq type lyskom-button-actions))) (setcdr (nthcdr 1 el) (cons func (nthcdr 3 el))))) (defun kom-previous-link (num) "Move the cursor to the previous active area in the LysKOM buffer." (interactive "p") (while (> num 0) (let ((where (previous-single-property-change (point) 'lyskom-button-text))) (if where (progn (if (not (get-text-property where 'lyskom-button-text)) (setq where (previous-single-property-change where 'lyskom-button-text))) (if where (goto-char where) (goto-char (point-min)) (setq num 1))))) (setq num (1- num)))) (defun kom-next-link (num) "Move the cursor to the next active area in the LysKOM buffer." (interactive "p") (while (> num 0) (let ((where (next-single-property-change (point) 'lyskom-button-text))) (if where (progn (if (not (get-text-property where 'lyskom-button-text)) (setq where (next-single-property-change where 'lyskom-button-text))) (if where (goto-char where) (goto-char (point-max)) (setq num 1))))) (setq num (1- num)))) (defun kom-button-press () "Simulate a mouse button press at point." (interactive) (lyskom-button-press (point))) (defun kom-button-click (event &optional do-default) "Execute the default action of the active area under the mouse. If optional argument do-default is non-nil, call the default binding of this-command-keys." (interactive "@e") (let* ((pos (event-point event)) (glyph (event-glyph event)) (widget (and pos (or (and glyph (glyph-property glyph 'widget)) (widget-at pos)))) (parent (and widget (widget-get widget ':parent))) (href (or (and widget (widget-get widget ':href)) (and parent (widget-get parent ':href)) (and widget (widget-get widget 'href)) (and parent (widget-get parent 'href))))) (cond (href (require 'w3) (w3-widget-button-click event)) ((and do-default (or (null pos) (null (get-text-property pos 'lyskom-button-type)))) (let ((fn (lookup-key global-map (this-command-keys)))) (when (commandp fn) (call-interactively fn)))) (t (lyskom-button-press pos))))) (defun kom-button-click-or-yank (event) "Execute the default action of the active area under the mouse. If there is no active area, then do something else." (interactive "@e") (kom-button-click event t)) (defun kom-popup-menu (event) "Pop up a menu of actions to be taken at the active area under the mouse." (interactive "@e") (let* ((pos (event-point event)) (glyph (event-glyph event)) (widget (and pos (or (and glyph (glyph-property glyph 'widget)) (widget-at pos)))) (parent (and widget (widget-get widget ':parent))) (href (or (and widget (widget-get widget ':href)) (and parent (widget-get parent ':href)) (and widget (widget-get widget 'href)) (and parent (widget-get parent 'href))))) (cond (href (require 'w3) (w3-popup-menu event)) ((and pos (get-text-property pos 'lyskom-button-type)) (lyskom-button-menu pos event)) (t (lyskom-background-menu pos event))))) (defun kom-mouse-null (event) "Do nothing." ;; This is here to pervent unwanted events when clicking mouse-3 (interactive "e")) (defun lyskom-make-button-menu (title entries buf arg text) "Create a menu keymap from a list of button actions." ;; Use the command as the event for simplicity. Note that the menu ;; function alters the menu, so we copy the entries to prevent it ;; from fiddling with lyskom-button-actions. (cond ((string-match "XEmacs" (emacs-version)) (cons title (mapcar (function (lambda (entry) (vector (car entry) (` ((, (cdr entry)) (, buf) (, arg) (, text))) ':active t))) entries))) (t (append (list 'keymap title) (mapcar '(lambda (entry) (cons (` ((, (cdr entry)) (, buf) (, arg) (, text))) (copy-tree entry))) entries))))) (defun lyskom-button-menu (pos event) "Internal function used by kom-popup-menu" (let* ((type (get-text-property pos 'lyskom-button-type)) (arg (get-text-property pos 'lyskom-button-arg)) (text (get-text-property pos 'lyskom-button-text)) (buf (get-text-property pos 'lyskom-buffer)) (data (assq type lyskom-button-actions)) (title (lyskom-format (lyskom-get-string (or (intern-soft (concat (symbol-name type) "-popup-title")) 'generic-popup-title)) text)) (actl (or (and data (elt data 3)) nil))) (cond ((null data) (goto-char pos)) ((null actl) (goto-char pos)) ((null buf) (goto-char pos)) ((null (get-buffer buf)) (lyskom-message "%s" (lyskom-get-string 'no-such-buffer))) (t (if (symbolp title) (setq title (lyskom-get-string title))) (set-buffer buf) ;; There is a simple bug in x-popup-menu which causes menus ;; from simple keymaps to be title-less. A list consisting ;; of a single keymap works better. A patch is submittet to ;; the GNU folks. /davidk (let* ((menu (lyskom-make-button-menu title actl buf arg text))) (lyskom-do-popup-menu menu event)))))) (defun lyskom-button-press (pos) "Execute the default action of the active area at POS if any." (when pos (let* ((type (get-text-property pos 'lyskom-button-type)) (arg (get-text-property pos 'lyskom-button-arg)) (text (get-text-property pos 'lyskom-button-text)) (buf (get-text-property pos 'lyskom-buffer)) (hint (get-text-property pos 'lyskom-button-hint)) (data (assq type lyskom-button-actions)) (act (or (and kom-use-button-hints hint) (and data (elt data 2))))) (cond ((null act) (goto-char pos)) ((null buf) (goto-char pos)) ((and buf (null (get-buffer buf))) (lyskom-message "%s" (lyskom-get-string 'no-such-buffer))) (t (and buf (set-buffer buf)) (funcall act buf arg text)))))) (defun lyskom-fix-pseudo-url (url) (save-match-data (if (not (string-match lyskom-url-protocol-regexp url)) (cond ((string-match "^www\\." url) (concat "http://" url)) ((string-match "^ftp\\." url) (concat "ftp://" url)) ((string-match "^gopher\\." url) (concat "gopher://" url)) ((string-match "^wais\\." url) (concat "wais://" url)) (t (concat "http://" url))) url))) (defun lyskom-button-transform-text (text) "Add text properties to the string TEXT according to the definition of lyskom-text-buttons. Returns the modified string." (let ((blist lyskom-text-buttons) (start 0) (el nil)) (while blist (setq el (car blist)) (setq start 0) (while (string-match (elt el 0) text start) (add-text-properties (match-beginning (or (elt el 2) 0)) (match-end (or (elt el 2) 0)) (cond ((eq (elt el 1) 'text) (lyskom-generate-button 'text (lyskom-button-get-arg el text) (lyskom-button-get-text el text) (lyskom-button-get-face el))) ((eq (elt el 1) 'conf) (lyskom-generate-button 'conf (lyskom-button-get-arg el text) (lyskom-button-get-text el text) (lyskom-button-get-face el))) ((eq (elt el 1) 'pers) (lyskom-generate-button 'pers (lyskom-button-get-arg el text) (lyskom-button-get-text el text) (lyskom-button-get-face el))) ((eq (elt el 1) 'url) (lyskom-generate-button 'url nil (lyskom-button-get-text el text) (lyskom-button-get-face el))) ((eq (elt el 1) 'pseudo-url) (let ((url (lyskom-fix-pseudo-url (lyskom-button-get-text el text)))) (lyskom-generate-button 'url nil url (lyskom-button-get-face el)))) ((eq (elt el 1) 'info-node) (lyskom-generate-button 'info-node (lyskom-button-get-arg el text) (lyskom-button-get-text el text) (lyskom-button-get-face el))) ((eq (elt el 1) 'email) (lyskom-generate-button 'email nil (lyskom-button-get-text el text) (lyskom-button-get-face el))) (t nil)) text) (setq start (match-end 0))) (setq blist (cdr blist)))) text) (defun lyskom-button-get-arg (el text) "Get the button argument for button type EL from TEXT according to the current match-data." (let ((no (or (elt el 3) 0))) (substring text (match-beginning no) (match-end no)))) (defun lyskom-button-get-text (el text) "Get the button text for button type EL from TEXT according to the current match-data." (let ((no (or (elt el 2) 0))) (substring text (match-beginning no) (match-end no)))) (defun lyskom-button-get-face (el) "Get the button face for button type EL from TEXT according to the current match-data." (elt el 4)) (defun lyskom-get-button-hint (hints) "Get the hint to be used right now (if any) from HINTS" (let ((result nil) (hint nil)) (while (and hints (null result)) (setq hint (car hints)) (setq hints (cdr hints)) (cond ((null (car hint)) (if (and (eq lyskom-current-function (elt hint 1)) (or (null (elt hint 2)) (eq lyskom-current-function-phase (elt hint 2)))) (setq result (elt hint 3)))) ((listp (car hint)) (if (and lyskom-executing-command (memq lyskom-current-command (car hint))) (setq result (cdr hint)))) ((symbolp (car hint)) (if (and lyskom-executing-command lyskom-current-command (eq lyskom-current-command (car hint))) (setq result (cdr hint)))))) result)) (defun lyskom-generate-button (type arg &optional text face) "Generate the properties for a button of type TYPE with argument ARG. Optional argument TEXT is the button text to be saved as a property and FACE is the default text face for the button." (let* ((persno (cond ((boundp 'lyskom-pers-no) lyskom-pers-no) ((and (boundp 'lyskom-buffer) lyskom-buffer) (save-excursion (set-buffer lyskom-buffer) lyskom-pers-no)) (t -1))) (numarg (cond ((numberp arg) arg) ((stringp arg) (string-to-number arg)) (t nil))) (data (assq type lyskom-button-actions)) (hints (and data (elt data 4))) (the-hint (lyskom-get-button-hint hints)) (props (cond ((and (or (eq type 'conf) (eq type 'pers)) numarg) (list 'face (or face (cond ((eq persno numarg) 'kom-me-face) ((memq numarg kom-friends) 'kom-friends-face) (t 'kom-active-face))) 'mouse-face 'kom-highlight-face 'lyskom-button-text text 'lyskom-button-type type 'lyskom-button-arg numarg 'lyskom-buffer lyskom-buffer)) ((and (eq type 'text) numarg) (list 'face (or face 'kom-text-no-face) 'mouse-face 'kom-highlight-face 'lyskom-button-text text 'lyskom-button-type type 'lyskom-button-arg numarg 'lyskom-buffer lyskom-buffer)) ((eq type 'url) (list 'face (or face 'kom-active-face) 'mouse-face 'kom-highlight-face 'lyskom-button-text text 'lyskom-button-type type 'lyskom-button-arg arg 'lyskom-buffer lyskom-buffer)) (t (list 'face (or face 'kom-active-face) 'mouse-face 'kom-highlight-face 'lyskom-button-text text 'lyskom-button-type type 'lyskom-button-arg arg 'lyskom-buffer lyskom-buffer))))) (append (list 'rear-nonsticky t) (if the-hint (cons 'lyskom-button-hint (cons the-hint props)) props)))) (defun lyskom-default-button (type arg) "Generate a button of type TYPE from data in ARG. ARG can be almost any type of data and is converted to the proper argument type for buttons of type TYPE before being send to lyskom-generate-button." (and kom-text-properties (let (xarg text) (cond ((eq type 'conf) (cond ((lyskom-conf-stat-p arg) (if (conf-type->letterbox (conf-stat->conf-type arg)) (setq type 'pers)) (setq xarg (conf-stat->conf-no arg) text (conf-stat->name arg))) ((numberp arg) (if (setq xarg (cache-get-conf-stat arg)) (progn (if (conf-type->letterbox (conf-stat->conf-type xarg)) (setq type 'pers)) (setq text (conf-stat->name xarg)) (setq xarg (conf-stat->conf-no xarg))) (setq text "" xarg arg))) (t (setq text "" xarg 0)))) ((eq type 'pers) (cond ((lyskom-conf-stat-p arg) (setq xarg (conf-stat->conf-no arg) text (conf-stat->name arg))) ((lyskom-pers-stat-p arg) (setq xarg (pers-stat->pers-no arg) text (or (conf-stat->name (cache-get-conf-stat (pers-stat->pers-no arg))) ""))) ((numberp arg) (setq text (or (conf-stat->name (cache-get-conf-stat arg)) "") xarg arg)) (t (setq text "" xarg 0)))) ((eq type 'text) (cond ((stringp arg) (setq xarg (string-to-number arg) text arg)) ((numberp arg) (setq xarg arg text (number-to-string arg))) ((lyskom-text-stat-p arg) (setq xarg (text-stat->text-no arg) text (number-to-string (text-stat->text-no arg)))) (t (setq xarg 0 text "")))) ((eq type 'url) (cond ((stringp arg) (setq xarg nil text arg)) (t (setq xarg nil text "")))) (t (setq xarg arg text ""))) (lyskom-generate-button type xarg text nil)))) ;;;======================================== ;;; Button actions ;;; (defun lyskom-button-view-text (buf arg text) "In the LysKOM buffer BUF, view the text ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-view arg)))) (defun lyskom-button-review-noconversion (buf arg text) "In the LysKOM buffer BUF, view the text ARG without conversion. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-review-noconversion arg)))) (defun lyskom-button-review-tree (buf arg text) "In the LysKOM buffer BUF, view the text ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-review-tree arg)))) (defun lyskom-button-find-root (buf arg text) "In the LysKOM buffer BUF, view the text ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-find-root arg)))) (defun lyskom-button-comment-text (buf arg text) "In the LysKOM buffer BUF, comment the text ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-write-comment arg)))) (defun lyskom-button-private-comment-text (buf arg text) "In the LysKOM buffer BUF, write a private comment the text ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-private-answer arg)))) (defun lyskom-button-mark-text (buf arg text) "In the LysKOM buffer BUF, mark the text ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (unwind-protect (progn (pop-to-buffer buf) (lyskom-start-of-command 'kom-mark-text) (lyskom-mark-text arg nil 1)) (lyskom-end-of-command))))) (defun lyskom-button-unmark-text (buf arg text) "In the LysKOM buffer BUF, unmark the text ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (unwind-protect (progn (pop-to-buffer buf) (lyskom-start-of-command 'kom-unmark-text) (lyskom-mark-text arg nil 0)) (lyskom-end-of-command))))) (defun lyskom-button-view-conf-presentation (buf arg text) "In the LysKOM buffer BUF, view the presentation of ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-review-presentation arg)))) (defun lyskom-button-view-conf-status (buf arg text) "In the LysKOM buffer BUF, view the status of conference ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-status-conf arg)))) (defun lyskom-button-goto-conf (buf arg text) "In the LysKOM buffer BUF, go to the conference ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-go-to-conf arg)))) (defun lyskom-button-add-self (buf arg text) "In the LysKOM buffer buf, add self to conference ARG." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-add-self arg)))) (defun lyskom-button-sub-self (buf arg text) "In the LysKOM buffer buf, sub self from conference ARG." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-sub-self arg)))) (defun lyskom-button-view-pers-presentation (buf arg text) "In the LysKOM buffer BUF, view the presentation of person ARG. Last argument TEXT is ignored. This is a LysKOM button action." (lyskom-button-view-conf-presentation buf arg text)) (defun lyskom-button-view-pers-status (buf arg text) "In the LysKOM buffer BUF, view the status of person ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-status-person arg)))) (defun lyskom-button-mail (buf arg text) "In the LysKOM buffer BUF, send mail to the conference ARG. Last argument TEXT is ignored. This is a LysKOM button action." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-send-letter arg)))) (defun lyskom-button-send-message (buf arg text) "In the LysKOM buffer BUF, send a personal message to person ARG." (cond ((not (integerp arg)) nil) (t (pop-to-buffer buf) (kom-send-message arg nil)))) (defun lyskom-button-copy-email (but arg text) "In the LysKOM buffer BUF, ignore ARG and copy TEXT to the kill ring. This is a LysKOM button action." (kill-new text)) (defun lyskom-button-open-email (but arg text) "In the LysKOM buffer BUF, ignore ARG and open TEXT as an e-mail address. This is a LysKOM button action." (mail nil text)) (defun lyskom-button-copy-url (but arg text) "In the LysKOM buffer BUF, ignore ARG and copy TEXT to the kill ring. This is a LysKOM button action." (kill-new (replace-in-string text "\\s-+" ""))) (defun lyskom-button-open-url (buf arg text) "In the LysKOM buffer BUF, ignore ARG and open TEXT as an URL. This is a LysKOM button action." (let* ((url (lyskom-fix-pseudo-url (replace-in-string text "\\s-+" ""))) protocol url-manager) (string-match lyskom-url-protocol-regexp url) (setq protocol (match-string 1 url)) (setq url-manager (lyskom-get-url-manager protocol)) (if (null url-manager) (lyskom-error "Can't find URL viewer")) (goto-char (point-max)) (funcall (elt url-manager 3) url url-manager))) ;;; ;;; Info node button ;;; (defun lyskom-button-goto-info-node (buf arg text) "In the LysKOM buffer BUF, open ARG as an Info node, and ignore TEXT. This is a LysKOM button action." (when (not (fboundp 'Info-goto-node)) (autoload 'Info-goto-node "info" "Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME." t)) (setq arg (replace-in-string arg "\n" " " t)) (setq arg (replace-in-string arg " +" " " t)) (Info-goto-node arg)) ;;; ;;; LysKOM URL Management ;;; (defun lyskom-get-url-manager (protocol) "Get the URL manager for PROTOCOL (a string). Returns a function." (let ((managers kom-url-managers) (preferences kom-url-viewer-preferences) (result nil)) (while (and preferences (not result)) (setq managers kom-url-managers) (while (and managers (not result)) (if (and (string-match (car (car managers)) (car preferences)) (string-match (car (cdr (car managers))) protocol)) (setq result (car managers))) (setq managers (cdr managers))) (setq preferences (cdr preferences))) result)) (defun lyskom-url-manager-starting (manager) "Tell the user that the URL manager MANAGER is starting." (lyskom-message "%s" (lyskom-format (lyskom-get-string 'starting-program) (elt manager 2)))) (eval-when-compile (defvar browse-url-browser-function nil)) (defun lyskom-view-url-browse-url (url manager) (require 'browse-url) (funcall browse-url-browser-function url)) (defun lyskom-view-url-w3 (url manager) "View the URL URL using W3. Second argument MANAGER is ignored." (w3-fetch url)) (defun lyskom-view-url-dired (url manager) "View the URL URL using dired. Second argument MANAGER is ignored." (if (not (and (string-match "\\(file\\|ftp\\)://\\([^/:]*\\)\\(:[0-9]*\\)?\\(/\\|$\\)" url) (match-beginning 0) (match-beginning 1) (match-beginning 2))) (lyskom-error "Bad URL")) (let ((host (substring url (match-beginning 2) (match-end 2))) (path (substring url (match-end 0))) (user "anonymous")) (if (string-match ";type=.$" path) (setq path (substring path 0 (match-beginning 0)))) (if (and (string-match "\\([^@]*\\)@" host) (match-beginning 1)) (progn (setq user (substring host (match-beginning 1) (match-end 1))) (setq host (substring host (match-end 0))))) (cond ((string= host "localhost") (find-file path)) (t (find-file (concat "/" user "@" host ":/" path)))) ;; (message "%s %s %s" user host path) )) (defun lyskom-view-url-telnet (url manager) "View the URL URL using telnet. Second argument MANAGER is ignored." (if (not (and (string-match "telnet://\\([^@]*@\\)?\\([^/:]*\\)\\(:[0-9]*\\)?" url) (match-beginning 0) (match-beginning 2))) (lyskom-error "Bad URL")) (let ((host (substring url (match-beginning 2) (match-end 2))) (port (if (match-beginning 3) (substring url (1+ (match-beginning 3)) (match-end 3)) "")) (user (if (match-beginning 1) (substring url (match-beginning 1) (1- (match-end 1))) nil)) ;; (password nil) ) (if (and user (string-match "^\\([^:]*\\):\\(.*\\)" user)) (progn ;; (setq password (substring user ;; (match-beginning 2) ;; (match-end 2))) (setq user (substring user (match-beginning 1) (match-end 1))))) (telnet (concat host " " port)) ;; (message "u:%s p:%s h:%s #:%s" ;; (or user "") ;; (or password "

") ;; (or host "") ;; (or port "<#>")) )) (defun lyskom-view-url-mailmode (url manager) "View the URL URL using mail in Emacs. The second argument MANAGER is ignored." (if (not (and (string-match "mailto:\\([^@]+@.*\\)$" url) (match-beginning 1))) (lyskom-error "Bad URL")) (mail nil (substring url (match-beginning 1) (match-end 1)))) (defun lyskom-view-url-netscape (url manager) "View the URL URL using Netscape Navigator. The second argument MANAGER is the URL manager that started Netscape. This function attempts to load the URL in a running Netscape, but failing that, starts a new one." (let* ((url-string (if (eq window-system 'win32) (list url) (list "-remote" (format "openUrl(%s)" url)))) (proc (apply 'start-process "netscape" nil (if (listp kom-netscape-command) (car kom-netscape-command) kom-netscape-command) (if (listp kom-netscape-command) (append (cdr kom-netscape-command) url-string) url-string))) (status 'run) (exit nil)) (lyskom-url-manager-starting manager) (while (eq status 'run) (accept-process-output) (setq status (process-status proc))) (setq exit (process-exit-status proc)) (cond ((and (eq status 'exit) (eq exit 1)) (apply 'start-process "netscape" nil (if (listp kom-netscape-command) (car kom-netscape-command) kom-netscape-command) (if (listp kom-netscape-command) (append (cdr kom-netscape-command) (list url)) (list url)))) (t nil)))) (defun lyskom-view-url-mosaic (url manager) "View the URL URL using NCSA Mosaic. The attempts to open the URL in an existing Mosaic process. Failing that, it starts a new Mosaic." (let ((pid -1) tempbuffer (filename "/tmp/Mosaic.")) (if (file-exists-p (expand-file-name "~/.mosaicpid")) (save-excursion (set-buffer (setq tempbuffer (get-buffer-create " *kom*-mosaicpid"))) (insert-file-contents (expand-file-name "~/.mosaicpid")) (setq pid (read tempbuffer)) (delete-region (point-min) (point-max)) (insert "newwin\n") (insert url) (insert "\n") (setq filename (concat filename (number-to-string pid))) (write-region (point-min) (point-max) filename nil 'x) (kill-buffer tempbuffer) (if (= -1 (signal-process pid 30)) (apply 'start-process "mosaic" (current-buffer) (if (listp kom-mosaic-command) (car kom-mosaic-command) kom-mosaic-command ) (if (listp kom-mosaic-command) (append (cdr kom-mosaic-command) (list url)) (list url))) (lyskom-url-manager-starting manager))) (save-excursion (apply 'start-process "mosaic" (current-buffer) (if (listp kom-mosaic-command) (car kom-mosaic-command) kom-mosaic-command ) (if (listp kom-mosaic-command) (append (cdr kom-mosaic-command) (list url)) (list url))) (lyskom-url-manager-starting manager))))) ;; Added by Peter Liljenberg (defun lyskom-view-url-lynx (url manager) "View the URL URL using Lynx. Lynx will be run either in an xterm or in Emacs terminal mode, depending on the value of `kom-lynx-terminal'." (cond ((eq kom-lynx-terminal 'xterm) (apply 'start-process "lynx" nil (car kom-lynx-xterm-command) (append (cdr kom-lynx-xterm-command) (list url))) (lyskom-url-manager-starting manager)) ((eq kom-lynx-terminal 'terminal) (let* ((lbuf (get-buffer "*Lynx*")) (lproc (and lbuf (get-buffer-process lbuf)))) (if lproc ;; Tell existing Lynx to fetch URL (process-send-string lproc (concat "g" url "\n")) ;; Create a new Lynx (switch-to-buffer (apply 'make-term "Lynx" (if (listp kom-lynx-terminal-command) (car kom-lynx-terminal-command) kom-lynx-terminal-command) nil (if (listp kom-lynx-terminal-command) (append (cdr kom-lynx-terminal-command) (list url)) (list url)))) (delete-other-windows) (term-char-mode) (set-process-sentinel (get-buffer-process (current-buffer)) (function (lambda (proc str) (kill-buffer (process-buffer proc)))))) (lyskom-url-manager-starting manager))) (t (lyskom-error "Bad Lynx terminal: %s" kom-lynx-terminal)) )) ;;; ;;; email buttons ;;; (defun lyskom-button-send-mail (to) (mail nil to)) ;;;;; -*-coding: raw-text; unibyte: t; -*- ;;;;; ;;;;; $Id: view-text.el,v 44.11.2.2 1999/10/13 12:13:40 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;; ================================================================ ;;; ================================================================ ;;; ;;; File: view-text.el ;;; ;;; This file contains functions that have to do with putting ;;; a text into the lyskom buffer. ;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: view-text.el,v 44.11.2.2 1999/10/13 12:13:40 byers Exp $\n")) (defun lyskom-view-text (text-no &optional mark-as-read follow-comments conf-stat priority build-review-tree filter-active) "Display text number TEXT-NO. Args: TEXT-NO &optional MARK-AS-READ FOLLOW-COMMENTS CONF-STAT PRIORITY BUILD-REVIEW-TREE. If MARK-AS-READ is non-nil the text will be marked as read. If FOLLOW-COMMENTS is non-nil all comments and footnotes to this text will be read before the next text. CONF-STAT must be the conference status of the current conference, and PRIORITY the priority, if FOLLOW-COMMENTS is non-nil. If BUILD-REVIEW-TREE is non-nil then it fixes a new entry in the lyskom-reading-list to read the comments to this. Note that this function must not be called asynchronously." (let ((inhibit-read-only t) (filter (and filter-active (lyskom-filter-text-p text-no))) (start nil) (end nil) (todo nil) (lyskom-last-text-format-flags nil)) (cond ((eq filter 'skip-text) (lyskom-filter-prompt text-no 'filter-text) (setq todo 'next-text) (lyskom-mark-as-read (blocking-do 'get-text-stat text-no)) 'next-text) ((eq filter 'skip-tree) (lyskom-filter-prompt text-no 'filter-tree) ;;(initiate-get-text-stat 'main 'lyskom-jump text-no t) ;; Let's try something else: (lyskom-jump (blocking-do 'get-text-stat text-no) t) (lyskom-wait-queue 'main) (setq todo 'next-text) 'next-text) (t (if (not (or (null filter) (eq filter 'dontshow))) (lyskom-message "%s" (lyskom-get-string 'invalid-filter-list))) (if (eq filter 'dontshow) (setq todo 'next-text)) (blocking-do-multiple ((text-stat (get-text-stat text-no)) (text (get-text text-no))) (if (and text-stat text) (progn (run-hooks 'lyskom-view-text-hook) ;; Use a marker, because the buffer may lose data ;; at the top if kom-max-buffer-size is set. (setq start (point-max-marker)) (lyskom-format-insert "%#1n " text-stat) (lyskom-print-date-and-time (text-stat->creation-time text-stat) 'time-y-m-d-h-m) (lyskom-insert (if (= 1 (text-stat->no-of-lines text-stat)) (lyskom-get-string 'line) (lyskom-format 'lines (let ((n (text-stat->no-of-lines text-stat))) (if (= n 0) ; Added to increase 2 ; compatibility with old KOM. /lw n))))) (if (eq filter 'dontshow) (lyskom-format-insert "%#1P %#2s\n" (text-stat->author text-stat) (lyskom-get-string 'filtered)) (lyskom-format-insert "%#1P\n" (text-stat->author text-stat))) (setq end (point-max)) (if (and kom-text-properties (null filter) (not (lyskom-face-default-p 'kom-first-line-face))) (add-text-properties start end '(face kom-first-line-face))) (set-marker start nil) ;; All recipients and other header lines. (if (eq filter 'dontshow) (lyskom-mark-as-read (blocking-do 'get-text-stat text-no)) (lyskom-traverse misc (text-stat->misc-info-list text-stat) (let ((type (misc-info->type misc))) (cond ((or (eq type 'RECPT) (eq type 'BCC-RECPT) (eq type 'CC-RECPT)) (lyskom-print-header-recpt (misc-info->recipient-no misc) misc)) ((eq type 'COMM-IN) (if kom-reading-puts-comments-in-pointers-last nil (if lyskom-show-comments ; +++SOJGE (lyskom-print-header-comm (misc-info->comm-in misc) misc)))) ((eq type 'FOOTN-IN) (if kom-reading-puts-comments-in-pointers-last nil (lyskom-print-header-comm (misc-info->footn-in misc) misc))) ((eq type 'COMM-TO) (lyskom-print-header-comm (misc-info->comm-to misc) misc)) ((eq type 'FOOTN-TO) (lyskom-print-header-comm (misc-info->footn-to misc) misc)) ))) (let ((num-marks (text-stat->no-of-marks text-stat)) (is-marked-by-me (cache-text-is-marked (text-stat->text-no text-stat)))) (if (> num-marks 0) (lyskom-insert (if is-marked-by-me (if (= num-marks 1) (lyskom-get-string 'marked-by-you) (if (= num-marks 2) (lyskom-get-string 'marked-by-you-and-one) (lyskom-format 'marked-by-you-and-several (1- num-marks)))) (if (= num-marks 1) (lyskom-get-string 'marked-by-one) (lyskom-format 'marked-by-several num-marks)))))) (lyskom-print-text text-stat text mark-as-read text-no)) (if kom-reading-puts-comments-in-pointers-last (lyskom-view-text-handle-saved-comments text-stat)) (if (or follow-comments ;; Checking build-review-tree should not be ;; necessary, really /davidk build-review-tree) ;; This shows footnotes also. (progn ;; this is a bit silly, as it prefetches all ;; the texts many times. (lyskom-prefetch-texttree text-no) (lyskom-follow-comments text-stat conf-stat mark-as-read priority build-review-tree))) ) (lyskom-format-insert 'no-such-text-no text-no))))) todo)) (defun lyskom-follow-comments (text-stat conf-stat mark-as-read priority review-tree) "Arrange so that all comments and footnotes to this text will be read. This will essentially fix the reading list and issue calls for the cache to be filled. Arguments are: TEXT-STAT CONF-STAT PRIORITY REVIEW-TREE TEXT-STAT is the current text. CONF-STAT the current conference PRIORITY the priority of the reading. If REVIEW-TREE is non-nil then build an entry of type 'REVIEW-TREE in the lyskom-reading-list." ;; . Find footnotes and show them. ;; . Fix the reading-list ;; . Issue cache-filling initiate-calls for everything left comments. (let (flist clist) (lyskom-traverse misc (text-stat->misc-info-list text-stat) (cond ((and (eq (misc-info->type misc) 'FOOTN-IN) (> (misc-info->footn-in misc) (text-stat->text-no text-stat)) kom-show-footnotes-immediately) ;; Show the footnote (lyskom-view-text (misc-info->footn-in misc) mark-as-read t conf-stat priority review-tree) (lyskom-is-read (misc-info->footn-in misc))) ((eq (misc-info->type misc) 'FOOTN-IN) (setq flist (cons (misc-info->footn-in misc) flist))) ((eq (misc-info->type misc) 'COMM-IN) (if lyskom-show-comments ; +++SOJGE (setq clist (cons (misc-info->comm-in misc) clist)))))) (let (comments footnotes) ;; Find the comments that we should read and enter them into the ;; read-list. (lyskom-traverse no clist (let ((text-stat (blocking-do 'get-text-stat no))) (if (or review-tree (and text-stat (not (lyskom-text-read-p text-stat)))) (setq comments (cons no comments))))) (if comments (read-list-enter-read-info (lyskom-create-read-info (if review-tree 'REVIEW-TREE 'COMM-IN) conf-stat priority (lyskom-create-text-list comments) (text-stat->text-no text-stat)) lyskom-reading-list t)) ;; Find the footnotes that we should read and enter them into ;; the read-list. A slight trick is to increase the priority so ;; that they will be read first. (lyskom-traverse no flist (let ((text-stat (blocking-do 'get-text-stat no))) (if (or review-tree (and text-stat (not (lyskom-text-read-p text-stat)))) (setq footnotes (cons no footnotes))))) (if footnotes (read-list-enter-read-info (lyskom-create-read-info (if review-tree 'REVIEW-TREE 'FOOTN-IN) conf-stat (1+ priority) (lyskom-create-text-list footnotes) (text-stat->text-no text-stat)) lyskom-reading-list t))))) (defun lyskom-fetch-text-for-cache (text-stat) "Fetches the author and other things of a text and does nothing with it." (cond (text-stat (lyskom-fetch-author-for-cache text-stat) (initiate-get-text 'fill-cache nil (text-stat->text-no text-stat)) (lyskom-traverse misc (text-stat->misc-info-list text-stat) (cond ((eq (misc-info->type misc) 'FOOTN-IN) (initiate-get-text-stat 'fill-cache 'lyskom-fetch-author-for-cache (misc-info->footn-in misc))) ((eq (misc-info->type misc) 'FOOTN-TO) (initiate-get-text-stat 'fill-cache 'lyskom-fetch-author-for-cache (misc-info->footn-to misc))) ((eq (misc-info->type misc) 'COMM-IN) (initiate-get-text-stat 'fill-cache 'lyskom-fetch-author-for-cache (misc-info->comm-in misc))) ((eq (misc-info->type misc) 'COMM-TO) (initiate-get-text-stat 'fill-cache 'lyskom-fetch-author-for-cache (misc-info->comm-to misc)))))))) (defun lyskom-fetch-author-for-cache (text-stat) "Fetches the author of a text and does nothing with it." (if text-stat ;Error check. (initiate-get-conf-stat 'fill-cache nil (text-stat->author text-stat)))) (defun lyskom-text-read-p (text-stat) "Return t if TEXT-STAT has been marked as read in all recipients to it that the user is a member in." (let* ((misc-info-list (text-stat->misc-info-list text-stat)) (i (length misc-info-list)) (res 'not-member)) (while (and res (not (zerop i))) (setq i (1- i)) (let* ((misc-info (elt misc-info-list i)) (type (misc-info->type misc-info))) (cond ((or (eq type 'RECPT) (eq type 'BCC-RECPT) (eq type 'CC-RECPT)) ;; Is this function ever called asynchronously? If not, we ;; can use lyskom-get-membership istead. (let ((membership (lyskom-try-get-membership (misc-info->recipient-no misc-info))) (loc-no (misc-info->local-no misc-info))) ;; Make a note that this text really is in a group we are ;; a member of. (if (and res membership) (setq res t)) (if (and membership (> loc-no (membership->last-text-read membership)) (not (lyskom-vmemq loc-no (membership->read-texts membership)))) (setq res nil))))))) (if (eq res 'not-member) (not kom-follow-comments-outside-membership) res))) (defun lyskom-text-read-at-least-once-p (text-stat) "Return t if TEXT-STAT has been marked as read in any of the recipients the user is a member of. Uses blocking-do. Returns t if TEXT-STAT is nil." (if text-stat (let* ((misc-info-list (text-stat->misc-info-list text-stat)) (misc-item nil) (type nil) (membership nil) (is-member nil) (result nil)) (while misc-info-list (setq misc-item (car misc-info-list)) (setq type (misc-info->type misc-item)) (setq misc-info-list (cdr misc-info-list)) (cond ((or (eq type 'RECPT) (eq type 'BCC-RECPT) (eq type 'CC-RECPT)) (setq membership (lyskom-get-membership (misc-info->recipient-no misc-item))) (when membership (setq is-member t) (when (or (<= (misc-info->local-no misc-item) (membership->last-text-read membership)) (lyskom-vmemq (misc-info->local-no misc-item) (membership->read-texts membership))) (setq result t) (setq misc-info-list nil)))))) (cond (result result) ((not is-member) (not kom-follow-comments-outside-membership)) (t nil))) t)) (defun lyskom-subtract-one-day (x) (let ((high-x (1- (car x))) (low-x (car (cdr x)))) (if (> 20864 low-x) (setq high-x (1- high-x) low-x (+ low-x 65536))) (setq low-x (- low-x 20864)) (list high-x low-x nil))) (defun lyskom-calculate-day-diff (time) (let* ((now (current-time)) (yesterday (lyskom-subtract-one-day now)) (decnow (decode-time now)) (decthen (decode-time yesterday))) (cond ((and (= (time->mday time) (elt decnow 3)) (= (1+ (time->mon time)) (elt decnow 4)) (= (+ (time->year time) 1900) (elt decnow 5))) 'today) ((and (= (time->mday time) (elt decthen 3)) (= (1+ (time->mon time)) (elt decthen 4)) (= (+ (time->year time) 1900) (elt decthen 5))) 'yesterday) (t nil)))) (defun lyskom-return-date-and-time (time &optional fmt) "Return date and time as a string. Arg: TIME." (let* ((diff (and lyskom-print-complex-dates (lyskom-calculate-day-diff time)))) (lyskom-format (if diff (intern (concat (symbol-name diff) "-time-format-string")) (or fmt 'time-yyyy-mm-dd-hh-mm)) (+ (time->year time) 1900) (1+ (time->mon time)) (time->mday time) (time->hour time) (time->min time) (and diff (lyskom-get-string diff))))) (defun lyskom-print-date-and-time (time &optional fmt) "Print date and time. Arg: TIME" (lyskom-insert (lyskom-return-date-and-time time fmt))) (defun lyskom-format-text-footer (text author author-name format format-flags) "Format the footer of a text." (let* ((result "") (start 0) (format-letter nil) (field-width nil) (kom-deferred-printing nil) (have-author (and format (string-match "%=?[0-9]*P" format)))) (if (null format) (lyskom-format (cond ((and kom-dashed-lines kom-show-author-at-end) "(%#1n) /%#2P/%#3s%#4s") (kom-dashed-lines "(%#1n) %#3s%#4s") (kom-show-author-at-end "(%#1n) /%#2P/") (t "(%#1n)")) text (or author author-name) (if kom-show-author-at-end (if (> (length author-name) 42) "" (make-string (- 42 (length author-name)) ?-)) "------------------------------------------") (if format-flags (lyskom-get-string format-flags) "")) (while (string-match "%\\(=?-?[0-9]+\\)?\\([-nPpf% ]\\)" format start) (setq result (concat result (substring format start (match-beginning 0)))) (setq format-letter (aref format (match-beginning 2))) (setq field-width (match-string 1 format)) (when (null field-width) (setq field-width "")) (setq start (match-end 0)) (setq result (concat result (cond ((eq format-letter ?p) (lyskom-format (format "%%%s#1p" field-width) author)) ((eq format-letter ?P) (lyskom-format (format "%%%s#1P" field-width) (or author author-name))) ((eq format-letter ?n) (lyskom-format (format "%%%s#1n" field-width) (text-stat->text-no text))) ((eq format-letter ?f) (if format-flags (lyskom-format (format "%%%s#1s" field-width) (lyskom-get-string format-flags)) "")) ((eq format-letter ?-) (let ((width (cond ((null field-width) 42) ((string= "" field-width) 42) ((eq ?= (aref field-width 0)) (string-to-int (substring field-width 1))) (t (string-to-int field-width))))) (lyskom-format "%#1s" (if have-author (if (< (length author-name) width) (make-string (- width (length author-name)) ?-) "") (make-string width ?-))))) ((eq format-letter ?%) "%") (t (concat "%" field-width (make-string 1 format-letter)))))) ) (setq result (concat result (substring format start))) (if (string-match "[ \t]+\\'" result) (substring result 0 (match-beginning 0)) result)))) (defun lyskom-deferred-insert-footer (conf-stat defer-info) "Insert the name of a conference at a previously reserved place." (let* ((text-stat (elt (defer-info->data defer-info) 0)) (format-flags (elt (defer-info->data defer-info) 1)) (name (cond (conf-stat (conf-stat->name conf-stat)) ((= (defer-info->call-par defer-info) 0) (lyskom-get-string 'person-is-anonymous)) (t (lyskom-format 'person-does-not-exist (defer-info->call-par defer-info)))))) (lyskom-replace-deferred defer-info (lyskom-format-text-footer text-stat conf-stat name kom-text-footer-format format-flags)))) (defun lyskom-print-text (text-stat text mark-as-read text-no) "Print a text. The header must already be printed. Print an error message if TEXT-STAT or TEXT is nil. Mark the text as read if (and only if) MARK-AS-READ is non-nil. Args: TEXT-STAT TEXT MARK-AS-READ TEXT-NO." (let ((lyskom-current-function 'lyskom-print-text)) (cond ((or (null text) (null text-stat)) (lyskom-format-insert 'no-such-text-no text-no) (setq lyskom-previous-text lyskom-current-text) (setq lyskom-current-text text-no)) (t (let* ((str (text->text-mass text)) ;; s1 s2 t1 t2 body) (cond ((string-match "\n" str) (setq lyskom-current-subject (substring str 0 (match-beginning 0))) (setq body (substring str (match-end 0))) (lyskom-insert-string 'head-Subject) (let ((lyskom-current-function-phase 'subject)) (lyskom-format-insert "%#1r\n" (copy-sequence lyskom-current-subject))) (if kom-dashed-lines (lyskom-insert "------------------------------------------------------------\n") (lyskom-insert "\n")) ;; (setq t1 (point-max)) (let ((lyskom-current-function-phase 'body)) (lyskom-format-insert "%#1t" body)) ;; (setq t2 (point-max)) ) (t ;No \n found. Don't print header. (if kom-dashed-lines (lyskom-insert "------------------------------------------------------------\n") (lyskom-insert "\n")) (lyskom-format-insert "%#1t" str) (setq lyskom-current-subject ""))) (if (lyskom-text-p (cache-get-text (text->text-no text))) (cache-del-text (text->text-no text))) (sit-for 0) (let ((lyskom-current-function-phase 'footer)) (lyskom-insert "\n") (if kom-deferred-printing (progn (lyskom-format-insert "%#1s\n" lyskom-defer-indicator) (lyskom-defer-insertion (lyskom-create-defer-info 'get-conf-stat (text-stat->author text-stat) 'lyskom-deferred-insert-footer (set-marker (make-marker) (- (point-max) (length lyskom-defer-indicator) 1)) (length lyskom-defer-indicator) "%#1s" (list text-stat lyskom-last-text-format-flags)))) (let* ((conf-stat (blocking-do 'get-conf-stat (text-stat->author text-stat))) (author-name (or (conf-stat->name conf-stat) (and (eq (text-stat->author text-stat) 0) (lyskom-get-string 'person-is-anonymous)) (lyskom-format 'person-does-not-exist (text-stat->author text-stat))))) (lyskom-insert (lyskom-format-text-footer text-stat conf-stat author-name kom-text-footer-format lyskom-last-text-format-flags))) (lyskom-insert "\n"))) (if mark-as-read (lyskom-mark-as-read text-stat)) (setq lyskom-previous-text lyskom-current-text) (setq lyskom-current-text (text-stat->text-no text-stat))))))) (defun lyskom-mark-as-read (text-stat) "Mark a text as read in all conferences that are recipients. Tell the server that it is read. Args: TEXT-STAT This function does not remove the text from the internal structures of the client. That is done by lyskom-is-read." (let ((misc-info-list (text-stat->misc-info-list text-stat))) (lyskom-traverse misc-info misc-info-list (if (and (or (eq (misc-info->type misc-info) 'RECPT) (eq (misc-info->type misc-info) 'BCC-RECPT) (eq (misc-info->type misc-info) 'CC-RECPT)) ;; The whole membership list might not be fetched ;; yet. So we better mark it as read in all conferences. ;; (lyskom-member-p (misc-info->recipient-no misc-info)) ) (initiate-mark-as-read 'background nil (misc-info->recipient-no misc-info) (list (misc-info->local-no misc-info))))))) (defun lyskom-print-header-recpt (conf-no misc) "Print a line of info about a recipient (or cc-recipient) of a text." (lyskom-format-insert "%#1s: %#2M <%#3d>\n" (cond ((eq (misc-info->type misc) 'RECPT) (lyskom-get-string 'Recipient)) ((eq (misc-info->type misc) 'BCC-RECPT) (lyskom-get-string 'Hidden-recipient)) ((eq (misc-info->type misc) 'CC-RECPT) (lyskom-get-string 'Extra-recipient)) (t (lyskom-get-string 'Strange-recipient))) conf-no (misc-info->local-no misc)) (if (misc-info->sent-at misc) (lyskom-format-insert 'send-at (lyskom-return-date-and-time (misc-info->sent-at misc)))) (if (misc-info->sender misc) (lyskom-format-insert 'sent-by (misc-info->sender misc))) (if (misc-info->rec-time misc) (lyskom-format-insert 'recieved-at (lyskom-return-date-and-time (misc-info->rec-time misc))))) (defun lyskom-view-text-handle-saved-comments (text-stat) "Ask server for what is needed to print the references to commenting texts and prints the references. Used at the bottom of the text. Args: TEXT-STAT of the text being read." (lyskom-traverse misc (text-stat->misc-info-list text-stat) (let ((type (misc-info->type misc))) (cond ((eq type 'COMM-IN) (if lyskom-show-comments ;+++SOJGE (lyskom-print-header-comm (misc-info->comm-in misc) misc))) ((eq type 'FOOTN-IN) (lyskom-print-header-comm (misc-info->footn-in misc) misc)))))) (defun lyskom-print-header-comm (text misc) "Get author of TEXT-NO and print a header line." (let ((text-stat (if kom-deferred-printing (cache-get-text-stat text) (blocking-do 'get-text-stat text)))) ;; Print information about the link (cond (text-stat (lyskom-insert-header-comm text-stat misc)) ((not kom-deferred-printing) (lyskom-insert-header-comm text-stat misc)) (t (let ((defer-info (lyskom-create-defer-info 'get-text-stat text 'lyskom-insert-deferred-header-comm (point-max-marker) (length lyskom-defer-indicator) nil ; Filled in later misc))) (lyskom-format-insert "%#1s\n" lyskom-defer-indicator) (lyskom-defer-insertion defer-info)))) ;; Print information about who added the link (if (misc-info->sent-at misc) (lyskom-format-insert 'send-at (lyskom-return-date-and-time (misc-info->sent-at misc)))) (if (misc-info->sender misc) (lyskom-format-insert 'sent-by (misc-info->sender misc))))) (defun lyskom-insert-deferred-header-comm (text-stat defer-info) (let* ((author (if text-stat (text-stat->author text-stat) nil)) (misc (defer-info->data defer-info)) (type (misc-info->type misc)) fmt data) (cond ((eq type 'COMM-TO) (setq fmt (if author 'comment-to-text-by 'comment-to-text) data (misc-info->comm-to misc))) ((eq type 'FOOTN-TO) (setq fmt (if author 'footnote-to-text-by 'footnote-to-text) data (misc-info->footn-to misc))) ((eq type 'COMM-IN) (setq fmt (if author 'comment-in-text-by 'comment-in-text) data (misc-info->comm-in misc))) ((eq type 'FOOTN-IN) (setq fmt (if author 'footnote-in-text-by 'footnote-in-text) data(misc-info->footn-in misc)))) (set-defer-info->format defer-info fmt) ; Note: author is ignored if fmt is not *-by (lyskom-replace-deferred defer-info data author))) (defun lyskom-insert-header-comm (text-stat misc) "Get author of TEXT-NO and print a header line." ;;+++ error kommer att se annorlunda ut. (let ((author (if text-stat (text-stat->author text-stat) nil)) (type (misc-info->type misc))) (cond ((eq type 'COMM-TO) (lyskom-format-insert 'comment-to-text (misc-info->comm-to misc))) ((eq type 'FOOTN-TO) (lyskom-format-insert 'footnote-to-text (misc-info->footn-to misc))) ((eq type 'COMM-IN) (lyskom-format-insert 'comment-in-text (misc-info->comm-in misc))) ((eq type 'FOOTN-IN) (lyskom-format-insert 'footnote-in-text (misc-info->footn-in misc)))) (if author (lyskom-format-insert 'written-by author) (lyskom-insert "\n")))) ;;; Local Variables: ;;; eval: (put 'lyskom-traverse 'lisp-indent-hook 2) ;;; end: ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: async.el,v 44.8.2.2 1999/10/13 12:12:49 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: async.el ;;;; ;;;; These functions implement a nice service that give the user ;;;; continuous messages about what other users are doing and what ;;;; is happening inside the lyskom server. ;;;; ;;;; Author: Linus Tolke ;;;; Entry: Inge Wallin ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: async.el,v 44.8.2.2 1999/10/13 12:12:49 byers Exp $\n")) (defun lyskom-parse-async (tokens buffer) "Parse an asynchronous message from the server. The message consists of TOKENS tokens. Unknown messages are skipped. Actions are taken to perform the various tasks that is required on reciept of an asynchronous message. If variable kom-presence-messages is non-nil or some minibuffer editing is going on then nothing is printed on the message area. This function is called with the lyskom-unparsed-buffer as current-buffer. All calls using the lyskom-variables have to be made using the buffer BUFFER. Be careful when editing this. All parsing is done with the buffer this function is called with as the current-buffer, while all calls from this function shall be with current-buffer the BUFFER." (let ((msg-no (lyskom-parse-num))) (cond ((eq msg-no 0) ; New text (let* ((text-no (lyskom-parse-num)) (text-stat (lyskom-parse-text-stat text-no))) (lyskom-save-excursion (set-buffer buffer) (lyskom-async-new-text text-stat)))) ; ((eq msg-no 1) ; Logout (obsolete) (lyskom-skip-tokens tokens)) ((eq msg-no 2) ; Login, obsolete. (lyskom-skip-tokens tokens)) ((eq msg-no 3) ; Conference deleted (lyskom-skip-tokens tokens)) ((eq msg-no 4) ; Conference created (lyskom-skip-tokens tokens)) ((eq msg-no 5) ; A person or conference has ; changed name. (let ((conf-no (lyskom-parse-num)) (old-name (lyskom-parse-string)) (new-name (lyskom-parse-string))) (lyskom-save-excursion (set-buffer buffer) (if (and lyskom-pers-no (= conf-no lyskom-pers-no)) (lyskom-format-insert-before-prompt 'you-changed-name-to new-name (lyskom-default-button 'conf conf-no))) ;; (cache-del-conf-stat conf-no) ;+++Borde {ndra i cachen i st{llet. (let ((cached-stat (cache-get-conf-stat conf-no))) (if cached-stat (set-conf-stat->name cached-stat new-name))) (cond ((lyskom-is-in-minibuffer)) (kom-presence-messages (lyskom-message "%s" (lyskom-format 'name-has-changed-to-name old-name new-name)))) (cond (kom-presence-messages-in-buffer (lyskom-format-insert-before-prompt 'name-has-changed-to-name-r old-name new-name (lyskom-default-button 'conf conf-no))))))) ((eq msg-no 6) ;i_am_on - something is moving (let ((info (lyskom-parse-who-info))) (lyskom-save-excursion (set-buffer buffer) (if (or (not lyskom-pers-no) (zerop lyskom-pers-no)) nil (cache-add-who-info info))))) ((eq msg-no 7) ; Database is syncing. (lyskom-save-excursion (set-buffer buffer) ;; I removed the test for kom-presence-messages /david (if (not (lyskom-is-in-minibuffer)) (lyskom-message "%s" (lyskom-get-string 'database-sync))) (setq mode-line-process (lyskom-get-string 'mode-line-saving)) (setq lyskom-is-saving t) ;; I guess the following two lines could be replaced by ;; force-mode-line-update in a modern emacs. (set-buffer-modified-p (buffer-modified-p)) (sit-for 0) (if (not lyskom-pending-calls) (initiate-get-time 'async nil)))) ((eq msg-no 8) ; Forced leave conference (lyskom-skip-tokens tokens)) ((eq msg-no 9) ; A person has logged in (let ((pers-no (lyskom-parse-num)) (session-no (lyskom-parse-num))) (lyskom-save-excursion (set-buffer buffer) (if (and lyskom-pers-no (not (zerop lyskom-pers-no)) (/= pers-no lyskom-pers-no)) ; Don't show myself. (initiate-get-conf-stat 'follow 'lyskom-show-logged-in-person pers-no)) (if (and lyskom-pers-no (not (zerop lyskom-pers-no)) lyskom-who-info-buffer-is-on) (initiate-get-session-info 'who-buffer 'cache-add-session-info session-no)) ))) ;; msg-no 10 is the old broadcast message. No longer used. ((eq msg-no 11) (lyskom-save-excursion (set-buffer buffer) (lyskom-insert-before-prompt (lyskom-get-string 'lyskom-is-full)) ;;; (if (and (eq major-mode 'lyskom-mode) ;;; (not (listp lyskom-time-last-command)) ;;; kom-auto-quit-when-idle) ;;; (progn ;;; (lyskom-insert-before-prompt ;;; (lyskom-get-string 'session-auto-ended)) ;;; (kom-quit 1) )) ((eq msg-no 12) ; Message to the user (or everybody) (let ((recipient (lyskom-parse-num)) (sender (lyskom-parse-num)) (message (lyskom-parse-string))) (lyskom-save-excursion (set-buffer buffer) (if (zerop recipient) (initiate-get-conf-stat 'async 'lyskom-handle-personal-message sender 0 message) (lyskom-collect 'async) (initiate-get-conf-stat 'async nil sender) (initiate-get-conf-stat 'async nil recipient) (lyskom-use 'async 'lyskom-handle-personal-message message))))) ((eq msg-no 13) ; New logout (let ((pers-no (lyskom-parse-num)) (session-no (lyskom-parse-num))) (lyskom-save-excursion (set-buffer buffer) (if (and lyskom-pers-no (not (zerop lyskom-pers-no)) (/= lyskom-pers-no pers-no) (or kom-presence-messages kom-presence-messages-in-buffer)) (initiate-get-conf-stat 'follow 'lyskom-show-logged-out-person pers-no session-no)) (if (and lyskom-pers-no (not (zerop lyskom-pers-no))) (lyskom-run 'who-buffer 'cache-del-who-info session-no))))) (t (lyskom-skip-tokens tokens))))) (defsubst lyskom-show-presence (num flag) "Returns non-nil if presence messages for NUM should be displayed according to the value of FLAG." (cond ((null flag) nil) ((and (listp flag) (memq num flag)) t) ((not (listp flag)) t))) (defun lyskom-show-logged-in-person (conf-stat) "Visa p} kommandoraden vem som loggat in." (cond ((lyskom-is-in-minibuffer)) ((lyskom-show-presence (conf-stat->conf-no conf-stat) kom-presence-messages) (lyskom-message "%s" (lyskom-format 'has-entered (or conf-stat (lyskom-get-string 'secret-person)))))) (cond ((lyskom-show-presence (conf-stat->conf-no conf-stat) kom-presence-messages-in-buffer) (if conf-stat (lyskom-format-insert-before-prompt 'has-entered-r conf-stat (and kom-text-properties '(face kom-presence-face))) (lyskom-format-insert-before-prompt 'has-entered-r (lyskom-get-string 'secret-person) (and kom-text-properties '(face kom-presence-face))))))) (defun lyskom-show-logged-out-person (conf-stat session-no) "Visa p} kommandoraden vem som loggat ut." (cond ((lyskom-is-in-minibuffer)) ((lyskom-show-presence (conf-stat->conf-no conf-stat) kom-presence-messages) (lyskom-message "%s" (lyskom-format 'has-left (or conf-stat (lyskom-get-string 'secret-person)))))) (cond ((lyskom-show-presence (conf-stat->conf-no conf-stat) kom-presence-messages-in-buffer) (if conf-stat (lyskom-format-insert-before-prompt 'has-left-r conf-stat (and kom-text-properties '(face kom-presence-face))) (lyskom-format-insert-before-prompt 'has-left-r (lyskom-get-string 'secret-person) (and kom-text-properties '(face kom-presence-face))))))) (defun lyskom-show-changed-person (personconfstat conf-num doing) "Tells the user what another person is doing." (if personconfstat ;+++ Annan felhantering (progn (cond ((and (lyskom-show-presence (conf-stat->conf-no personconfstat) kom-presence-messages) (or (= 0 conf-num) (eq conf-num lyskom-current-conf)) (/= 0 (length doing))) (lyskom-message "%s %s" (conf-stat->name personconfstat) (let ((string (concat (char-to-string (downcase (string-to-char doing))) (substring doing 1)))) string)))) (cond ((and (lyskom-show-presence (conf-stat->conf-no personconfstat) kom-presence-messages-in-buffer) (or (= 0 conf-num) (eq conf-num lyskom-current-conf)) (/= 0 (length doing))) (lyskom-format-insert-before-prompt "%#1M %#2s\n" personconfstat (concat (char-to-string (downcase (string-to-char doing))) (substring doing 1)))))))) (defun lyskom-is-in-minibuffer () "Returns non-nil if I am using the minibuffer for some reading." (or lyskom-inhibit-minibuffer-messages (not (zerop (minibuffer-depth))))) (defun lyskom-show-personal-message (sender recipient message &optional when nobeep) "Insert a personal message into the lyskom buffer. Args: SENDER: conf-stat for the person issuing the broadcast message or a string that is the sender. RECIPIENT: 0 if this message is for everybody, otherwise the conf-stat of the recipient. MESSAGE: A string containing the message. WHEN: Optional time of arrival. Same format as (current-time-string) NOBEEP: True means don't beep. No matter what." (lyskom-insert-personal-message sender recipient message when nobeep) (setq lyskom-last-personal-message-sender (if (stringp sender) sender (conf-stat->name sender))) (setq lyskom-last-group-message-recipient (if (and recipient (not (eq 0 recipient)) (not (eq (conf-stat->conf-no recipient) lyskom-pers-no))) (conf-stat->name recipient) nil)) (run-hooks 'lyskom-personal-message-hook)) (defun lyskom-insert-personal-message (sender recipient message &optional when nobeep) "Insert a personal message in the current buffer. Arguments: SENDER RECIPIENT MESSAGE. SENDER is a conf-stat (possibly nil) or a string. RECIPIENT is 0 if the message is public, otherwise the pers-no of the user. MESSAGE is a string containing the message. WHEN, if given, is the time when the message arrived. It must be of the same format at (current-time-string) Non-nil NOBEEP means don't beep." (lyskom-handle-as-personal-message (lyskom-format-as-personal-message sender recipient message when nobeep) (conf-stat->conf-no sender) nil)) (defun lyskom-format-as-personal-message (sender recipient message &optional when nobeep) "Formats a personal message, returning it as a string. Arguments: SENDER RECIPIENT MESSAGE. SENDER is a conf-stat (possibly nil) or a string. RECIPIENT is 0 if the message is public, otherwise the pers-no of the user. MESSAGE is a string containing the message. WHEN, if given, is the time when the message arrived. It must be of the same format at (current-time-string) Non-nil NOBEEP means don't beep." (let ((lyskom-last-text-format-flags nil)) (if (null when) (setq when (current-time-string))) (if (not (string= (substring when 0 10) (substring (current-time-string) 0 10))) (setq when (substring when 4 19)) (setq when (substring when 11 19))) (cond ((or (null recipient) ; Have been seen to be nil when ; listing recorded ; messages. Should it be? ; /davidk (eq recipient 0)) ; Public message (if (not nobeep) (lyskom-beep kom-ding-on-common-messages)) (lyskom-format 'message-broadcast (cond ((stringp sender) sender) (sender sender) (t (lyskom-get-string 'unknown))) message when)) ((= (conf-stat->conf-no recipient) lyskom-pers-no) ; Private (if (not nobeep) (lyskom-beep kom-ding-on-personal-messages)) (lyskom-format 'message-from (cond ((stringp sender) sender) (sender sender) (t (lyskom-get-string 'unknown))) message when)) (t ; Group message (if (not nobeep) (lyskom-beep kom-ding-on-group-messages)) (lyskom-format 'message-from-to message (cond ((stringp sender) sender) (sender sender) (t (lyskom-get-string 'unknown))) (cond ((stringp recipient) recipient) (recipient recipient) (t (lyskom-get-string 'unknown))) when))))) (defun lyskom-handle-as-personal-message (string from &optional filter) "Insert STRING as a personal message and beep if not from me and supposed to. The buffer, is chosen according to the kom-show-personal-messages-in-buffer variable value. The text is converted, before insertion." (if (and filter (or (eq 0 (string-match "^Remote-command: [0-9]+ [0-9]+\n" string)) (eq 0 (string-match "^Auto-reply:\n" string)))) nil (let ((pop kom-pop-personal-messages)) (lyskom-save-excursion (cond ((eq kom-show-personal-messages-in-buffer t) (lyskom-insert-before-prompt string) (if pop (display-buffer (current-buffer)))) ((null kom-show-personal-messages-in-buffer)) (t (set-buffer (get-buffer-create kom-show-personal-messages-in-buffer)) (goto-char (point-max)) (lyskom-insert string ) (if pop (save-selected-window (select-window (display-buffer (current-buffer))) (goto-char (point-max)) (recenter -1))))))))) ;;; ================================================================ ;;; Functions for dealing with a new text (defun lyskom-default-new-text-hook (text-stat) "Print a message if the user was waiting. Change the prompt. run hooks." (if (and (not lyskom-dont-change-prompt) ;We shall change it (not lyskom-executing-command)) ;We have time to do it. (lyskom-update-prompt)) (let ((no-message nil)) (run-hooks 'lyskom-new-text-hook) (if (and (not no-message) lyskom-is-waiting (not (lyskom-is-in-minibuffer))) (lyskom-message "%s" (lyskom-format 'text-is-created (text-stat->text-no text-stat)))))) (defun lyskom-async-new-text (text-stat) "Take care of a message that a new text has been created." (cache-del-pers-stat (text-stat->author text-stat)) ;+++Borde {ndra i cachen i st{llet. (lyskom-traverse misc-info (text-stat->misc-info-list text-stat) (let ((type (misc-info->type misc-info))) (cond ((or (eq type 'RECPT) (eq type 'CC-RECPT) (eq type 'BCC-RECPT)) ;; add on lyskom-reading-list and lyskom-to-do-list if ;; this recipient is a recipient that has been checked. (if (and (eq (misc-info->recipient-no misc-info) lyskom-pers-no) (not (eq (text-stat->author text-stat) lyskom-pers-no))) (lyskom-beep kom-ding-on-new-letter)) (initiate-get-conf-stat 'async 'lyskom-add-new-text (misc-info->recipient-no misc-info) (text-stat->text-no text-stat) (misc-info->local-no misc-info))) ((eq type 'COMM-TO) (cache-del-text-stat (misc-info->comm-to misc-info))) ((eq type 'FOOTN-TO) (cache-del-text-stat (misc-info->footn-to misc-info))) (t (signal 'lyskom-internal-error (list 'lyskom-async-new-text "Unexpected misc-info in new text " type)))))) ;; A little to much work, really (lyskom-prefetch-text-all (text-stat->text-no text-stat)) ;; Give a message if the user is waiting. Update the prompt. (lyskom-run 'async 'lyskom-default-new-text-hook text-stat) (lyskom-run 'async 'lyskom-prefetch-and-print-prompt)) (defun lyskom-add-new-text (recipient text-no local-no) "RECIPIENT is a conf-stat and recipient of TEXT-NO. Args: RECIPIENT TEXT-NO LOCAL-NO. LOCAL-NO is the texts local number in RECIPIENT. This info is used to update the no-of-texts field in the cache. Also add this info in lyskom-to-do-list if info about RECIPIENT as been fetched. Does not try to print prompt or do any prefetch. That will be done after all the confs has been handled. If recipient is nil this means we are crossposting to a protected conference. In that case, just discard this call." (cond (recipient ;+++ Annan felhantering. ;; Update the cache. (set-conf-stat->no-of-texts recipient (max (conf-stat->no-of-texts recipient) (+ local-no -1 (- (conf-stat->first-local-no recipient))))) ;; Update the read-lists. ;; Prefetch thoughts: ;; We need a way to check if a conferences is fetched. ;; davidk /960924 (let ((membership (lyskom-try-get-membership (conf-stat->conf-no recipient)))) (if (and membership ;; (lyskom-conf-fetched-p (conf-stat->conf-no recipient)) (lyskom-visible-membership membership) (not (read-list-enter-text text-no recipient lyskom-to-do-list))) ;; If we have already read all texts in the conference or the ;; text has not been prefetched (let ((info (lyskom-create-read-info 'CONF recipient (membership->priority membership) (lyskom-create-text-list (list text-no))))) (read-list-enter-read-info info lyskom-to-do-list) (if (= lyskom-current-conf (conf-stat->conf-no recipient)) (read-list-enter-first info lyskom-reading-list))))) (lyskom-set-mode-line)))) ;;; Local Variables: ;;; eval: (put 'lyskom-traverse 'lisp-indent-hook 2) ;;; end: ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: completing-read.el,v 44.11.2.2 1999/10/13 12:12:58 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: completing-read.el ;;;; Author: David Byers ;;;; ;;;; This file implements functions for reading a conference name ;;;; or a person name with completion and other help. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: completing-read.el,v 44.11.2.2 1999/10/13 12:12:58 byers Exp $\n")) (defvar lyskom-name-hist nil) ;;; ============================================================ ;;; ;;; Name lookup caches ;;; (defvar lyskom-completing-who-info-cache nil "Temporary cache of who-info data") (defvar lyskom-completing-lookup-name-cache nil "Temporary cache of server queries") (defvar lyskom-completing-use-dynamic-info nil) (defun lyskom-completing-clear-cache () (setq lyskom-completing-who-info-cache nil) (setq lyskom-completing-lookup-name-cache nil)) (defun lyskom-completing-who-is-on () "Get information about who is on, first checking the cache. Returns what \(blocking-do 'who-is-on\) would, but as a list, not a vector" (if lyskom-completing-who-info-cache lyskom-completing-who-info-cache (setq lyskom-completing-who-info-cache (listify-vector (if (or (and (lyskom-is-in-minibuffer) lyskom-completing-use-dynamic-info) lyskom-dynamic-session-info-flag) (blocking-do 'who-is-on-dynamic t t 0) (blocking-do 'who-is-on)))))) (defun lyskom-completing-cache-completion (string data) (let* ((downs (lyskom-unicase string)) (tmp (assoc downs lyskom-completing-lookup-name-cache))) (if (null tmp) (setq lyskom-completing-lookup-name-cache (cons (cons downs data) lyskom-completing-lookup-name-cache))) string)) (defun lyskom-completing-lookup-z-name (string want-conf want-pers) "Look up STRING as a name. Same as \(blocking-do 'lookup-z-name ...\) but first checks a cache." (let* ((downs (lyskom-unicase string)) (tmp (assoc downs lyskom-completing-lookup-name-cache))) (if tmp (cdr tmp) (progn (setq tmp (blocking-do 'lookup-z-name string want-conf want-pers)) (setq lyskom-completing-lookup-name-cache (cons (cons downs tmp) lyskom-completing-lookup-name-cache)) tmp)))) ;;; ============================================================ ;;; ;;; Keymaps ;;; (defvar lyskom-minibuffer-local-completion-map (let ((map (copy-keymap minibuffer-local-completion-map))) (define-key map " " nil) map) "Keymap used for reading LysKOM names.") (defvar lyskom-minibuffer-local-must-match-map (let ((map (copy-keymap minibuffer-local-must-match-map))) (lyskom-xemacs-or-gnu (set-keymap-parent map lyskom-minibuffer-local-completion-map) (define-key map " " nil)) map) "Keymap used for reading LysKOM names.") (defun lyskom-read-conf-no (prompt type &optional empty initial mustmatch) "Read a conference name from the minibuffer with completion and return its number or zero if nothing was matched. See lyskom-read-conf for a description of the parameters." (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch))) (cond ((null conf-z-info) 0) ((stringp conf-z-info) 0) ((lyskom-conf-stat-p conf-z-info) (conf-stat->conf-no conf-z-info)) (t (conf-z-info->conf-no conf-z-info))))) (defun lyskom-read-conf-stat (prompt type &optional empty initial mustmatch) "Read a conference name from the minibuffer with completion and return its conf-stat or nil if nothing was matched. See lyskom-read-conf for a description of the parameters." (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch))) (cond ((null conf-z-info) nil) ((stringp conf-z-info) nil) ((lyskom-conf-stat-p conf-z-info) conf-z-info) (t (blocking-do 'get-conf-stat (conf-z-info->conf-no conf-z-info)))))) (defun lyskom-read-conf-name (prompt type &optional empty initial mustmatch) "Read a conference name from the minibuffer with completion and return its name. See lyskom-read-conf for a description of the parameters." (let ((conf-z-info (lyskom-read-conf prompt type empty initial mustmatch))) (cond ((null conf-z-info) "") ((stringp conf-z-info) conf-z-info) ((lyskom-conf-stat-p conf-z-info) (conf-stat->name conf-z-info)) (t (conf-z-info->name conf-z-info))))) (defun lyskom-read-conf (prompt type &optional empty initial mustmatch) "Completing read a conference or person from the minibuffer. PROMPT is the prompt type type. TYPE is the type of conferences to return. It is a list of one or more of the following: all Return any conference, conf Return conferences (not letterboxes), pers Return persons (letterboxes), login Return persons who are also logged-in, and none Return names that do not match anything in the database. Optional arguments EMPTY allow nothing to be entered. INITIAL initial contents of the minibuffer MUSTMATCH if non-nil, the user must enter a valid name. The return value may be one of A conf-z-info: The conf-z-info associated with the name entered, nil: Nothing was entered, or A string: A name that matched nothing in the database." (lyskom-completing-clear-cache) (let* ((completion-ignore-case t) (minibuffer-local-completion-map lyskom-minibuffer-local-completion-map) (minibuffer-local-must-match-map lyskom-minibuffer-local-must-match-map) (read-string nil) (result nil) (keep-going t)) (while keep-going (lyskom-with-lyskom-minibuffer (setq read-string (completing-read prompt 'lyskom-read-conf-internal type mustmatch initial 'lyskom-name-hist))) (setq result (cond ((null read-string) nil) ((string= "" read-string) nil) (t (lyskom-lookup-conf-by-name read-string type)))) (setq keep-going (and (not empty) (null result)))) result)) (defun lyskom-read-conf-get-logins () "Used internally by lyskom-read-conf-internal to get a list of persons who are logged on." (let ((lyskom-completing-use-dynamic-info (cdr-safe (assq 'lyskom-dynamic-session-info-flag (buffer-local-variables lyskom-buffer))))) (mapcar (if lyskom-completing-use-dynamic-info (function (lambda (el) (dynamic-session-info->person el))) (function (lambda (el) (who-info->pers-no el)))) (lyskom-completing-who-is-on)))) (defun lyskom-read-conf-expand-specials (string predicate login-list x-list &optional return-cs) "Used internally by lyskom-read-conf-internal to expand person and conference number specifications to something useful." (cond ((string-match (lyskom-get-string 'person-or-conf-no-regexp) string) (let* ((no (string-to-int (match-string 1 string))) (cs (blocking-do 'get-conf-stat no))) (if (and cs (lyskom-read-conf-internal-verify-type (conf-stat->conf-no cs) (conf-stat->conf-type cs) predicate login-list x-list)) (if return-cs cs (list string))))) ((string-match (lyskom-get-string 'session-no-regexp) string) (let* ((no (string-to-int (match-string 1 string))) (si (blocking-do 'get-session-info no)) (cs (and si (blocking-do 'get-conf-stat (session-info->pers-no si))))) (if (and cs (lyskom-read-conf-internal-verify-type (conf-stat->conf-no cs) (conf-stat->conf-type cs) predicate login-list x-list)) (if return-cs cs (list string))))))) (defun lyskom-read-conf-lookup-specials (string predicate login-list x-list) "Used internally by lyskom-read-conf-internal to look up conf-stats from person and conference number specifications." (lyskom-read-conf-expand-specials string predicate login-list x-list t)) (defun lyskom-lookup-conf-by-name (string predicate) "Return the conf-z-info associated with STRING that also satisfies PREDICATE or nil if no name matches. See lyskom-read-conf-internal for a documentation of PREDICATE." (if (string= string "") nil (lyskom-read-conf-internal string predicate 'lyskom-lookup))) (defun lyskom-read-conf-internal (string predicate all) "Complete the name STRING according to PREDICATE and ALL. STRING is a string to complete. PREDICATE is a list of name types to return. Valid types are all Any existing name may be returned, pers Names of persons may be returned, conf Names of conferences may be returned, login Names of logged-in persons may be returned, and none Names that match nothing may be returned. ALL is set by try-completion and all-completions. See the Emacs lisp manual for a description. Special value 'lyskom-lookup makes the function work as a name-to-conf-stat translator." ;; ;; Catch some degenerate cases that can cause...problems. This ;; won't solve all the...problems, but should speed things up a ;; little bit. ;; (cond ((and (null all) (string= string "")) "") ((and (eq all 'lyskom-lookup) (string= string "")) nil) ((and (eq all 'lambda) (string= string "")) nil) (t (let* ((login-list (and (memq 'login predicate) (lyskom-read-conf-get-logins))) (x-list (lyskom-completing-lookup-z-name string 1 1)) (candidate-list (and x-list (listify-vector (conf-z-info-list->conf-z-infos x-list)))) (result-list nil)) ;; ;; login-list now contains a list of logins, IF the predicate ;; includes 'login ;; ;; candidate-list contains a list of conf-nos, with the ;; corresponding conf-types in candidate-type-list. ;; ;; Now set result-list to the conf-z-infos that fulfill the ;; predicate, fetching the conf-stats asynchronously. ;; (lyskom-traverse el candidate-list (if (lyskom-read-conf-internal-verify-type (conf-z-info->conf-no el) (conf-z-info->conf-type el) predicate login-list candidate-list) (setq result-list (cons el result-list)))) ;; ;; Now the matching conf-z-infos are in result-list ;; (cond ((eq all 'lyskom-lookup) (let ((names (mapcar 'conf-z-info->name result-list)) (specials (lyskom-read-conf-expand-specials string predicate login-list candidate-list))) (cond ((= (length result-list) 1) (car result-list)) ((and (> (length result-list) 1) (lyskom-completing-member string names)) (elt result-list (- (length result-list) (length (lyskom-completing-member string names))))) (specials (lyskom-read-conf-lookup-specials string predicate login-list candidate-list)) ((string-match (lyskom-get-string 'person-or-conf-no-regexp) string) nil) ((string-match (lyskom-get-string 'session-no-regexp) string) nil) ((lyskom-read-conf-internal-verify-type nil nil predicate login-list candidate-list) string)))) ;; ;; Check for exact match. We have an exact match in the server ;; when there was a single match OR when there was no match, and ;; no match is valid according to predicate ;; ((eq all 'lambda) (let ((specials (lyskom-read-conf-expand-specials string predicate login-list candidate-list))) (cond ((= (length result-list) 1) t) ((and (> (length result-list) 1) (let ((names (mapcar 'conf-z-info->name result-list))) (and (lyskom-completing-member string names) t)))) (result-list nil) ((= (length specials) 1) t) (specials nil) ((string-match (lyskom-get-string 'person-or-conf-no-regexp) string) nil) ((string-match (lyskom-get-string 'session-no-regexp) string) nil) (t (lyskom-read-conf-internal-verify-type nil nil predicate login-list candidate-list))))) ;; ;; Called from all-completions. Return a list of all possible ;; completions, in this case all names in the result list plus, ;; if the input string is a person or conf number specification, ;; the input string, PROVIDED, the requested conference matches ;; the predicate. If there were no matches, return the input ;; string if no matches satisfies the predicate. ;; (all (let ((names (mapcar 'conf-z-info->name result-list)) (specials (lyskom-read-conf-expand-specials string predicate login-list candidate-list))) (cond (specials (append specials names)) (names names) ((string-match (lyskom-get-string 'person-or-conf-no-regexp) string) nil) ((string-match (lyskom-get-string 'session-no-regexp) string) nil) ((lyskom-read-conf-internal-verify-type nil nil predicate login-list candidate-list) (list string)) (t nil)))) ;; ;; Called from try-completion, and there were no matches. Try to ;; expand the input string as a person or conf number ;; specification or return something sensible if the predicate ;; is satisfied by no matches. ;; ((null result-list) (let ((specials (lyskom-read-conf-expand-specials string predicate login-list candidate-list))) (cond (specials (car specials)) ((string-match (lyskom-get-string 'person-or-conf-no-regexp) string) nil) ((string-match (lyskom-get-string 'session-no-regexp) string) nil) ((lyskom-read-conf-internal-verify-type nil nil predicate login-list candidate-list) t) (t nil)))) ;; ;; Called from try-completion, and there were matches in the ;; server. Return t if the string is an exact match to any ;; string returned from the server. Otherwise, expand the string ;; as far as possible and return that ;; (t (let ((name-list (mapcar 'conf-z-info->name result-list)) (specials (lyskom-read-conf-expand-specials string predicate login-list candidate-list))) (if specials (setq name-list (nconc specials name-list))) (cond ((lyskom-completing-member string name-list) (or (and (= (length name-list) 1) t) string)) ; Exact match ((= (length name-list) 1) (car name-list)) ((string-match (lyskom-get-string 'person-or-conf-no-regexp) string) nil) ((string-match (lyskom-get-string 'session-no-regexp) string) nil) (t (or (lyskom-completing-cache-completion (lyskom-complete-string name-list) x-list) (and (lyskom-read-conf-internal-verify-type nil nil predicate login-list candidate-list) (list string)))))))))))) (defun lyskom-completing-member (string list) (let ((string (lyskom-unicase (lyskom-completing-strip-name string))) (result nil)) (while (and list (not result)) (if (string= string (lyskom-unicase (lyskom-completing-strip-name (car list)))) (setq result list) (setq list (cdr list)))) result)) (defun lyskom-completing-strip-name (string) "Strip parens and crap from a name" (while (string-match "([^()]*)" string) (setq string (replace-match " " t t string))) (while (string-match "\\s-\\s-+" string) (setq string (replace-match " " t t string))) (if (string-match "^\\s-*\\(.*\\S-\\)\\s-*$" string) (match-string 1 string) string)) (defun lyskom-read-conf-internal-verify-type (conf-no conf-type predicate logins x-list) (or (and (memq 'all predicate) conf-no) (and (memq 'conf predicate) conf-type (not (conf-type->letterbox conf-type))) (and (memq 'pers predicate) conf-type (conf-type->letterbox conf-type)) (and (memq 'login predicate) conf-type (memq conf-no logins)) (and (memq 'none predicate) (and (null conf-no) (null x-list))))) ;(defun lyskom-complete-show-data-list (state data) ; (save-excursion ; (pop-to-buffer (get-buffer-create "*kom*-complete")) ; (erase-buffer) ; (setq enable-multibyte-characters nil) ; (while data ; (insert ; (format "%s\n" (substring (aref (car data) 2) ; (aref (car data) 0) ; (aref (car data) 1)))) ; (setq data (cdr data))) ; (insert (format "%S %S: %S" (symbol-value current-state) ; (elt state 0) ; (elt state 1))) ; (sit-for 1))) (defun lyskom-complete-string (string-list) "Find the longest common prefix of all strings in STRING-LIST according to the LysKOM rules of string matching." (let ((main-state 'start-of-string) (tmp-state nil) (current-state 'main-state) (main-accumulator nil) (tmp-accumulator nil) (current-accumulator 'main-accumulator) (done nil) (paren-depth 0) (have-here nil) (last-event-worth-noting nil) (data-list (lyskom-complete-string-munge-input string-list)) (next-char-state (vector nil nil))) (while (not done) (lyskom-complete-string-next-char next-char-state data-list) ; (lyskom-complete-show-data-list next-char-state data-list) (cond ;; ;; Case one, a match of two non-special characters. ;; Accumulate one character and advance the lists ;; ((eq (aref next-char-state 0) 'match) (if (eq (aref next-char-state 1) ?\ ) (progn (cond ((or (eq (symbol-value current-state) 'start-of-word) (eq (symbol-value current-state) 'start-of-string)) nil) ((eq last-event-worth-noting 'mismatch) (lyskom-complete-string-accumulate current-accumulator 'SPC)) (t (lyskom-complete-string-accumulate current-accumulator ?\ ))) (set current-state 'start-of-word) (lyskom-complete-string-advance data-list)) (progn (set current-state 'in-a-word) (lyskom-complete-string-accumulate current-accumulator (aref next-char-state 1)) (lyskom-complete-string-advance data-list))) (setq last-event-worth-noting 'match)) ;; ;; Case two, a match of two open-paren expressions Increase ;; paren depth and accumulate a character. First set ;; current-accumulator to the temporary if paren-depth is zero ;; to start with. ;; ((eq (aref next-char-state 0) 'open-paren-match) (setq last-event-worth-noting 'match) (if (zerop paren-depth) (progn (setq current-accumulator 'tmp-accumulator) (setq current-state 'tmp-state) (setq tmp-state main-state) (setq tmp-accumulator nil))) (setq paren-depth (1+ paren-depth)) (lyskom-complete-string-accumulate current-accumulator (aref next-char-state 1)) (lyskom-complete-string-advance data-list)) ;; ;; Case three, a match of two close-paren expressions ;; Accumulate a character. If paren-depth is postitive, ;; decrease it. If it ends up zero, add the temporary ;; accumulator to the main accumulator and set the current ;; accumulator to the main accumulator. ;; ((eq (aref next-char-state 0) 'close-paren-match) (setq last-event-worth-noting 'match) (lyskom-complete-string-accumulate current-accumulator (aref next-char-state 1)) (if (> paren-depth 0) (progn (setq paren-depth (1- paren-depth)) (if (zerop paren-depth) (progn (setq main-accumulator (nconc tmp-accumulator main-accumulator)) (setq main-state tmp-state) (setq current-state 'main-state) (setq current-accumulator 'main-accumulator))))) (lyskom-complete-string-advance data-list)) ;; ;; Case two, a mismatch of any kind in a paren expression ;; ((and (> paren-depth 0) (or (eq (aref next-char-state 0) 'mismatch) (eq (aref next-char-state 0) 'space-mismatch) (eq (aref next-char-state 0) 'open-paren-mismatch))) (setq last-event-worth-noting 'mismatch) (setq tmp-accumulator nil) (setq tmp-state nil) (setq current-state 'main-state) (setq current-accumulator 'main-accumulator) (lyskom-complete-string-close-parens data-list paren-depth) (setq paren-depth 0)) ;; ;; Case two and a half or so, a space mismatch. This is ignored ;; if we're still at the start of the string ;; ((and (eq (aref next-char-state 0) 'space-mismatch) (or (eq (symbol-value current-state) 'start-of-string) (eq (symbol-value current-state) 'start-of-word))) (setq last-event-worth-noting nil) (lyskom-complete-string-skip-whitespace data-list)) ;; ;; Case three, a mismatch of regular characters outside a paren ;; Advance to the end of the current word ;; ((and (or (eq (aref next-char-state 0) 'mismatch) (eq (aref next-char-state 0) 'space-mismatch)) (zerop paren-depth)) (setq last-event-worth-noting 'mismatch) (if (or (eq (symbol-value current-state) 'start-of-word) (eq (symbol-value current-state) 'start-of-string)) (setq done t) (progn (if (not have-here) (progn (lyskom-complete-string-accumulate current-accumulator 'HERE) (setq have-here t))) (lyskom-complete-string-advance-to-end-of-word data-list) (set current-state 'in-a-word)))) ;; ;; Case four, a mistmatch where one character is an open-paren ;; ((eq (aref next-char-state 0) 'open-paren-mismatch) (setq last-event-worth-noting 'mismatch) (lyskom-complete-string-skip-parens data-list)) ;; ;; Case five, eof ;; ((eq (aref next-char-state 0) 'eof) (setq done t)) ;; ;; Case six, can't happen ;; (t (error "This can't happen: %S" next-char-state)))) ;; ;; Build the result by reversing the result list and making a ;; string out of it. ;; (if (eq (car main-accumulator) 'SPC) (setq main-accumulator (cdr main-accumulator))) (setq main-accumulator (nreverse main-accumulator)) (if (memq 'HERE main-accumulator) (let ((backup (length (memq 'HERE main-accumulator)))) (if lyskom-experimental-features (setq unread-command-events (append (cons ? (make-list (1- backup) 2)) unread-command-events))) (setq main-accumulator (delq 'HERE main-accumulator)))) (let ((tmp (make-string (length main-accumulator) 0)) (index 0)) (lyskom-traverse el main-accumulator (aset tmp index (if (eq el 'SPC) 32 el)) (setq index (1+ index))) tmp))) (defun lyskom-complete-string-accumulate (accumulator char) (set accumulator (cons char (symbol-value accumulator)))) (defun lyskom-complete-string-munge-input (string-list) (mapcar (function (lambda (x) (vector 0 (length x) x))) string-list)) ;;; ;;; Advance one regular character or multiple whitespaces ;;; (defun lyskom-complete-string-advance (data-list) (lyskom-traverse el data-list (string-match "\\([ \t]+\\|[^ \t]\\|$\\)" (aref el 2) (aref el 0)) (aset el 0 (match-end 0)))) (defun lyskom-complete-string-skip-whitespace (data-list) (lyskom-traverse el data-list (string-match "[ \t]*" (aref el 2) (aref el 0)) (aset el 0 (match-end 0)))) ;;; ;;; Advance to the end of the current word ;;; (defun lyskom-complete-string-advance-to-end-of-word (data-list) (lyskom-traverse el data-list (aset el 0 (string-match "\\([ \t]\\|$\\)" (aref el 2) (aref el 0))))) ;;; ;;; Unwind a number of parens ;;; (defun lyskom-complete-string-skip-parens (data-list) (lyskom-traverse el data-list (if (eq ?\( (aref (aref el 2) (aref el 0))) (progn (aset el 0 (1+ (aref el 0))) (lyskom-complete-string-close-parens-2 el 1))))) (defun lyskom-complete-string-close-parens (data-list depth) (lyskom-traverse el data-list (lyskom-complete-string-close-parens-2 el depth))) (defun lyskom-complete-string-close-parens-2 (el depth) (let ((string (aref el 2)) (pos (aref el 0))) (while (> depth 0) (cond ((>= pos (length string)) (setq depth 0)) ((= (aref string pos) ?\)) (setq depth (1- depth))) ((= (aref string pos) ?\() (setq depth (1+ depth)))) (setq pos (1+ pos))) (aset el 0 pos))) ;;; ;;; Check what's happenin' next ;;; (defun lyskom-complete-string-next-char (state data-list) (let ((eofp nil) (open-paren-p nil) (close-paren-p nil) (matchp t) (spacep nil) (char nil) (xchar nil)) (lyskom-save-excursion (set-buffer lyskom-buffer) (mapcar (function (lambda (x) (cond ((>= (aref x 0) (aref x 1)) (setq eofp t) (setq matchp nil)) ((eq (aref (aref x 2) (aref x 0)) ?\() (setq open-paren-p t)) ((eq (aref (aref x 2) (aref x 0)) ?\)) (setq close-paren-p t)) ((eq (aref (aref x 2) (aref x 0)) ?\ ) (setq spacep t))) (setq matchp (and matchp (if (null char) (progn (setq xchar (aref (aref x 2) (aref x 0))) (setq char (lyskom-unicase-char xchar))) (eq char (lyskom-unicase-char (aref (aref x 2) (aref x 0))))))))) data-list)) (aset state 1 xchar) (cond (eofp (aset state 0 'eof)) ((and matchp open-paren-p) (aset state 0 'open-paren-match)) ((and matchp close-paren-p) (aset state 0 'close-paren-match)) (matchp (aset state 0 'match)) (spacep (aset state 0 'space-mismatch)) (open-paren-p (aset state 0 'open-paren-mismatch)) (t (aset state 0 'mismatch)))) state) ;;; ============================================================ ;;; ;;; Session reading ;;; ;;; (defun lyskom-read-session-no (prompt &optional empty initial only-one) (let ((possible-matches (lyskom-session-from-conf (lyskom-read-conf-no prompt (if kom-permissive-completion '(pers) '(login)) empty initial t)))) (if (and (> (length possible-matches) 1) only-one) (lyskom-read-session-resolve-ambiguity possible-matches) possible-matches))) (defun lyskom-session-from-conf (conf-no) (let ((who-list (lyskom-completing-who-is-on)) (sessions nil)) (if lyskom-dynamic-session-info-flag (while who-list (if (eq (dynamic-session-info->person (car who-list)) conf-no) (setq sessions (cons (dynamic-session-info->session (car who-list)) sessions))) (setq who-list (cdr who-list))) (while who-list (if (eq (who-info->pers-no (car who-list)) conf-no) (setq sessions (cons (who-info->connection (car who-list)) sessions))) (setq who-list (cdr who-list)))) (cond ((and (null sessions) kom-permissive-completion) (list (- conf-no))) (t sessions)))) (defun lyskom-read-session-resolve-ambiguity (sessions) (lyskom-insert "\n") (let* ((s-width (1+ (apply 'max (mapcar (function (lambda (x) (length (int-to-string x)))) sessions)))) (format-string-s (lyskom-info-line-format-string s-width "s" "s")) (format-string-p (lyskom-info-line-format-string s-width "P" "M"))) (lyskom-format-insert format-string-s "" (lyskom-get-string 'lyskom-name) (lyskom-get-string 'is-in-conf)) (lyskom-format-insert format-string-s "" (lyskom-get-string 'from-machine) (lyskom-get-string 'is-doing)) (lyskom-insert (concat (make-string (- (lyskom-window-width) 2) ?-) "\n")) (let ((result nil) (who-info (mapcar (function (lambda (el) (let* ((info (blocking-do 'get-session-info el)) (confconfstat (blocking-do 'get-conf-stat (session-info->working-conf info)))) (lyskom-format-insert format-string-p (format "%d%s" (session-info->connection info) (if (eq (session-info->connection info) lyskom-session-no) "*" " ")) (session-info->pers-no info) (if (conf-stat->name confconfstat) confconfstat (lyskom-get-string 'not-present-anywhere))) (lyskom-format-insert format-string-p "" (lyskom-return-username info) (concat "(" (session-info->doing info) ")")) (cons (number-to-string (session-info->connection info)) info)))) (sort sessions '<)))) (lyskom-insert (concat (make-string (- (lyskom-window-width) 2) ?-) "\n")) (lyskom-insert (lyskom-format 'total-users (length who-info))) (lyskom-scroll) (while (string= "" (lyskom-with-lyskom-minibuffer (setq result (completing-read (lyskom-get-string 'resolve-session) who-info nil t (car (car who-info)) nil))))) (list (session-info->connection (cdr (assoc result who-info))))))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: prioritize.el,v 44.8.4.2 1999/10/13 12:13:24 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ;;;; File: prioritize.el ;;;; Author: David Byers ;;;; ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: prioritize.el,v 44.8.4.2 1999/10/13 12:13:24 byers Exp $\n")) ;;; ================================================================ ;;; Global variables ;;; (defvar lyskom-prioritize-mode-line '("" mode-line-modified mode-line-buffer-identification " " global-mode-string " %[(" mode-name mode-line-process minor-mode-alist ")%] " lyskom-prioritize-mode-line-selected "--" (-3 . "%p") "-%-")) (defvar lyskom-prioritize-entry-list nil "List of entries to be prioritized.") (defvar lyskom-prioritize-selection nil "List of selected entries in the prioritization list.") (defvar lyskom-prioritize-mode-line-selected "" "String showing number of selected entries.") ;;; ================================================================ ;;; Data types ;;; (defun make-prioritize-entry (prio conf-stat) (vector prio conf-stat nil nil)) (defun prioritize-entry->priority (el) (aref el 0)) (defun prioritize-entry->name (el) (conf-stat->name (aref el 1))) (defun prioritize-entry->conf-stat (el) (aref el 1)) (defun prioritize-entry->selected (el) (aref el 2)) (defun set-prioritize-entry->priority (el prio) (aset el 0 prio)) (defun set-prioritize-entry->conf-stat (el conf) (aset el 1 conf)) (defun set-prioritize-entry->selected (el marks) (aset el 2 marks)) ;;; ================================================================ ;;; Utility functions ;;; (defun lyskom-prioritize-remove-from-list (elem l) "Destructively emove the element at index ELEM from the list L." (if (> elem (length l)) (error "Args out of range: %S, %d" l elem)) (if (= 0 elem) (cdr l) (setcdr (nthcdr (1- elem) l) (nthcdr (1+ elem) l)) l)) (defun lyskom-prioritize-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 lyskom-prioritize-move-element (from to l) "Move element from position FROM to position TO in list L using side-fx." (setq from (1- from)) (setq to (1- to)) (let ((elem (if (< from 0) nil (elt l from)))) (lyskom-prioritize-add-to-list to elem (lyskom-prioritize-remove-from-list from l)))) (defun lyskom-prioritize-current-entry () "Get the entry on the line containing point." (save-excursion (beginning-of-line) (lyskom-prioritize-get-entry-from-no (- (1+ (count-lines 1 (point))) lyskom-prioritize-header-lines)))) (defun lyskom-prioritize-get-entry-from-no (no) "Get entry number NO from the prioritize list." (elt lyskom-prioritize-entry-list (1- no))) (defun lyskom-prioritize-get-no-from-entry (entry) "Get the index of entry ENTRY in the prioritize list." (1+ (- (length lyskom-prioritize-entry-list) (length (memq entry lyskom-prioritize-entry-list))))) (defun lyskom-prioritize-get-selected () "Get a list of all selected entries." lyskom-prioritize-selection) (defun lyskom-prioritize-find-entry-from-conf (conf-no) "Get the entry for conference conf-no" (let ((result nil)) (lyskom-traverse entry lyskom-prioritize-entry-list (when (eq (conf-stat->conf-no (prioritize-entry->conf-stat entry)) conf-no) (setq result entry))) result)) (defun lyskom-prioritize-get-entry-from-priority (priority first) (let ((result nil)) (lyskom-traverse entry lyskom-prioritize-entry-list (cond ((= (prioritize-entry->priority entry) priority) (when (or (not first) (null result)) (setq result entry))) ((< (prioritize-entry->priority entry) priority) (when (null result) (setq result entry))))) result)) (defun lyskom-prioritize-goto-entry (entry) "Go to the line containing ENTRY." (goto-line (+ lyskom-prioritize-header-lines (lyskom-prioritize-get-no-from-entry entry))) (beginning-of-line)) (defun lyskom-prioritize-redraw-entry (entry) "Redraw the prioritize entry ENTRY in the buffer" (save-excursion (let ((lineno (+ lyskom-prioritize-header-lines (lyskom-prioritize-get-no-from-entry entry))) (buffer-read-only nil)) (goto-line lineno) (delete-region (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (point))) (insert (lyskom-prioritize-format-entry entry))))) (defun lyskom-prioritize-format-entry (entry) "Return a string representation of the prioritize entry ENTRY" (lyskom-format "%#1s %3#2s %#3M" (if (prioritize-entry->selected entry) "*" " ") (if (= 0 (prioritize-entry->priority entry)) "-" (format "%d" (prioritize-entry->priority entry))) (prioritize-entry->conf-stat entry))) (defun lyskom-prioritize-redraw-buffer () "Update the entire buffer contents" (save-excursion (let ((inhibit-read-only t)) (erase-buffer) (insert lyskom-prioritize-header) (mapcar (function (lambda (el) (insert (concat (lyskom-prioritize-format-entry el) "\n")))) lyskom-prioritize-entry-list)))) (defun lyskom-prioritize-add-membership (membership) (let ((buffer (car (lyskom-buffers-of-category 'prioritize)))) (if (buffer-live-p buffer) (save-excursion (set-buffer buffer) (let ((tmp (lyskom-prioritize-get-entry-from-no (membership->conf-no membership)))) (if tmp (lyskom-prioritize-replace-membership membership (lyskom-default-value 'lyskom-membership)) (let* ((entry (lyskom-prioritize-get-entry-from-priority (membership->priority membership) t)) (no (lyskom-prioritize-get-no-from-entry entry))) (setq lyskom-prioritize-entry-list (lyskom-prioritize-add-to-list (1- no ) (make-prioritize-entry (membership->priority membership) (blocking-do 'get-conf-stat (membership->conf-no membership))) lyskom-prioritize-entry-list)) (goto-line (+ no lyskom-prioritize-header-lines)) (let ((buffer-read-only nil)) (open-line 1) (lyskom-prioritize-redraw-entry (lyskom-prioritize-get-entry-from-no no))))))) (lyskom-remove-hook 'lyskom-add-membership-hook 'lyskom-prioritize-add-membership)))) (defun lyskom-prioritize-remove-membership (conf-no membership-list) (let ((buffer (car (lyskom-buffers-of-category 'prioritize)))) (if (buffer-live-p buffer) (save-excursion (set-buffer buffer) (let ((entry (lyskom-prioritize-find-entry-from-conf conf-no))) (lyskom-prioritize-goto-entry entry) (let ((buffer-read-only nil)) (delete-region (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (point))) (delete-char 1)) (setq lyskom-prioritize-entry-list (lyskom-prioritize-remove-from-list (1- (lyskom-prioritize-get-no-from-entry entry)) lyskom-prioritize-entry-list)))) (lyskom-remove-hook 'lyskom-remove-membership-hook 'lyskom-prioritize-remove-membership)))) (defun lyskom-prioritize-replace-membership (membership membership-list) (let ((buffer (car (lyskom-buffers-of-category 'prioritize)))) (if (buffer-live-p buffer) (save-excursion (set-buffer buffer) (let* ((entry (lyskom-prioritize-find-entry-from-conf (membership->conf-no membership))) (target-priority (membership->priority membership)) (entry-priority (prioritize-entry->priority entry)) (move-up (> target-priority entry-priority)) (target-entry (lyskom-prioritize-get-entry-from-priority target-priority (not move-up)))) (when (not (eq target-priority entry-priority)) (set-prioritize-entry->priority entry target-priority) (lyskom-prioritize-move-entry (lyskom-prioritize-get-no-from-entry entry) (+ (lyskom-prioritize-get-no-from-entry target-entry) (cond ((and move-up (= (prioritize-entry->priority target-entry) target-priority)) 1) ((not move-up) -1) (t 0))) t t)))) (lyskom-remove-hook 'lyskom-replace-membership-hook 'lyskom-prioritize-replace-membership)))) (defun lyskom-prioritize-move-entry (from to &optional dontset forceup) "Move entry from position FROM to position TO. Non-nil optional DONTSET means don't change priority. Non-nil optional FORCEUP means force update of entry." (let ((inhibit-read-only t)) (if (/= from to) (let ((entry (lyskom-prioritize-get-entry-from-no from)) (after nil) (before nil) (start (1+ (count-lines 1 (point))))) (if (null entry) (error (lyskom-get-string 'cant-move-nothing-nowhere))) ;; ;; Move the entry in the prioritize list ;; (setq lyskom-prioritize-entry-list (lyskom-prioritize-move-element from to lyskom-prioritize-entry-list)) (if (not dontset) (progn (setq after (lyskom-prioritize-get-entry-from-no (1+ to)) before (lyskom-prioritize-get-entry-from-no (1- to))) (if (> from to) (if (and after (/= (prioritize-entry->priority after) (prioritize-entry->priority entry))) (set-prioritize-entry->priority entry (prioritize-entry->priority after))) (if (and before (/= (prioritize-entry->priority before) (prioritize-entry->priority entry))) (set-prioritize-entry->priority entry (prioritize-entry->priority before)))))) ;; ;; Update the buffer ;; (goto-line (+ from lyskom-prioritize-header-lines)) (delete-region (save-excursion (beginning-of-line) (point)) (1+ (save-excursion (end-of-line) (point)))) (goto-line (+ to lyskom-prioritize-header-lines)) (insert (concat (lyskom-prioritize-format-entry entry) "\n")) (goto-line start)) (if forceup (lyskom-prioritize-redraw-entry (lyskom-prioritize-get-entry-from-no from)))))) (defun lyskom-prioritize-update-selection (entry arg) (setq lyskom-prioritize-selection (let (result) (mapcar (function (lambda (x) (if (prioritize-entry->selected x) (setq result (cons x result))))) lyskom-prioritize-entry-list) (nreverse result))) (lyskom-prioritize-update-mode-line)) (defun lyskom-prioritize-select (entry arg) (set-prioritize-entry->selected entry arg) (lyskom-prioritize-update-selection entry arg)) ;;; ================================================================ ;;; User commands ;;; (defun kom-prioritize-help () "Get brief help on prioritize mode." (interactive) (lyskom-message "%s" (lyskom-get-string 'prioritize-help))) (defun kom-prioritize-deselect-all () "Deselect all selected entries" (interactive) (let ((entry nil)) (while lyskom-prioritize-selection (setq entry (car lyskom-prioritize-selection)) (lyskom-prioritize-select entry nil) (lyskom-prioritize-redraw-entry entry)))) (defun kom-prioritize-select (&optional arg) "Select the record on the line containing point. If ARG is null, toggle selection. Positive arg means always select and negative arg means always deselect" (interactive "P") (let ((entry (lyskom-prioritize-current-entry)) (start (point))) (cond ((or (not (integerp arg)) (= arg 0)) (if (prioritize-entry->selected entry) (lyskom-prioritize-select entry nil) (lyskom-prioritize-select entry t)) (lyskom-prioritize-redraw-entry entry)) ((> arg 0) (if (not (prioritize-entry->selected entry)) (progn (lyskom-prioritize-select entry t) (lyskom-prioritize-redraw-entry entry)))) ((< arg 0) (if (prioritize-entry->selected entry) (progn (lyskom-prioritize-select entry nil) (lyskom-prioritize-redraw-entry entry))))) (goto-char start))) (defun kom-prioritize-next-line (arg) "Move forward ARG lines." (interactive "p") (forward-line arg) (let* ((entry (lyskom-prioritize-current-entry))) (if (< (count-lines 1 (point)) lyskom-prioritize-header-lines) (goto-line (1+ lyskom-prioritize-header-lines))) (if (> (lyskom-prioritize-get-no-from-entry entry) (length lyskom-prioritize-entry-list)) (goto-line (+ lyskom-prioritize-header-lines (length lyskom-prioritize-entry-list)))) (setq entry (lyskom-prioritize-current-entry)))) (defun kom-prioritize-previous-line (arg) "Move backward ARG lines." (interactive "p") (kom-prioritize-next-line (- arg))) (defun kom-prioritize-beginning () "Move to the beginning of the entry list." (interactive) (set-mark (point)) (goto-line (1+ lyskom-prioritize-header-lines))) (defun kom-prioritize-end () "Move to the end of the entry list." (interactive) (set-mark (point)) (goto-line (+ lyskom-prioritize-header-lines (length lyskom-prioritize-entry-list)))) (defun kom-prioritize-goto-priority (arg) "Move to the first entry with priority ARG. Asks for a priority if no prefix argument is given." (interactive "P") (let ((prio (or arg (lyskom-read-num-range 0 255 (lyskom-get-string 'goto-priority-prompt)))) (where 0) (entry nil) (lineno nil)) (while (< where (length lyskom-prioritize-entry-list)) (setq entry (lyskom-prioritize-get-entry-from-no where)) (if (<= (prioritize-entry->priority entry) prio) (setq lineno where where (length lyskom-prioritize-entry-list)) (setq where (1+ where)))) (if lineno (goto-line (+ lineno lyskom-prioritize-header-lines)) (goto-line (+ lyskom-prioritize-header-lines where))))) (defun kom-prioritize-move-up (arg) "Move current entry up ARG steps. If the entry is at the top of a priority group, change its priority to the same as the entry above it, but to not move it." (interactive "p") (let ((entry (lyskom-prioritize-current-entry))) (beginning-of-line) (while (> arg 0) (let* ((start (lyskom-prioritize-get-no-from-entry entry)) (target (1- start)) (before (if (>= target 1) (lyskom-prioritize-get-entry-from-no target) nil))) (cond ((null before) (error (lyskom-get-string 'beginning-of-list))) ((> (prioritize-entry->priority before) (prioritize-entry->priority entry)) (set-prioritize-entry->priority entry (prioritize-entry->priority before)) (lyskom-prioritize-redraw-entry entry)) (t (lyskom-prioritize-move-entry start target) (forward-line -1))) (setq arg (1- arg)))))) (defun kom-prioritize-move-down (arg) "Move current-entry down ARG steps. If the entry is at the top of a priority group, change its priority to the same as the entry above it, but to not move it." (interactive "p") (let ((entry (lyskom-prioritize-current-entry))) (beginning-of-line) (while (> arg 0) (let* ((start (lyskom-prioritize-get-no-from-entry entry)) (target (1+ start)) (after (if (<= target (length lyskom-prioritize-entry-list)) (lyskom-prioritize-get-entry-from-no target) nil))) (cond ((null after) (error (lyskom-get-string 'end-of-list))) ((< (prioritize-entry->priority after) (prioritize-entry->priority entry)) (set-prioritize-entry->priority entry (prioritize-entry->priority after)) (lyskom-prioritize-redraw-entry entry)) (t (lyskom-prioritize-move-entry start target) (forward-line 1))) (setq arg (1- arg)))))) (defun kom-prioritize-set-priority (arg) "Set priority of all selected conferences." (interactive "P") (set-mark-command nil) (let* ((entry (lyskom-prioritize-current-entry)) (selected (lyskom-prioritize-get-selected)) (priority (or (and (integerp arg) arg) (lyskom-read-num-range 0 255 (lyskom-format (lyskom-get-string (if selected 'priority-prompt-marked 'priority-prompt)) (prioritize-entry->conf-stat entry)) t)))) (setq selected (or selected (list entry))) (while selected (lyskom-prioritize-set-priority (car selected) priority) (setq selected (cdr selected))) (lyskom-prioritize-goto-entry entry))) (defun lyskom-prioritize-set-priority (entry priority) (let ((list lyskom-prioritize-entry-list) (target nil)) (cond ((= (prioritize-entry->priority entry) priority) nil) ;; ;; Moving up ;; Find the LAST ENTRY with EQUAL or HIGHER priority ;; ((> priority (prioritize-entry->priority entry)) (while list (cond ((>= (prioritize-entry->priority (car list)) priority) (setq list (cdr list))) (t (setq target (1+ (- (length lyskom-prioritize-entry-list) (length list)))) (setq list nil)))) (if (null target) (setq target 1)) (set-prioritize-entry->priority entry priority) (lyskom-prioritize-move-entry (lyskom-prioritize-get-no-from-entry entry) target t t)) ;; ;; Moving down ;; Find the FIRST ENTRY with EQUAL or LOWER priority ;; ((< priority (prioritize-entry->priority entry)) (while list (cond ((> (prioritize-entry->priority (car list)) priority) (setq list (cdr list))) (t (setq target (- (length lyskom-prioritize-entry-list) (length list))) (setq list nil)))) (if (null target) (setq target (length lyskom-prioritize-entry-list))) (set-prioritize-entry->priority entry priority) (lyskom-prioritize-move-entry (lyskom-prioritize-get-no-from-entry entry) target t t))))) (defun kom-prioritize-reprioritize () "Reprioritize all entries with a given priority." (interactive) (let* ((tmp (lyskom-prioritize-current-entry)) (default (if tmp (prioritize-entry->priority tmp) nil)) (prio-from (lyskom-read-num-range 0 255 (lyskom-get-string 'reprioritize-from) t default)) (prio-to (lyskom-read-num-range 0 255 (lyskom-get-string 'reprioritize-to) t)) (inhibit-read-only t) (where 1) (elem nil)) (if (not (eq default prio-from)) (setq tmp nil)) (if (and prio-from prio-to) (progn (while (<= where (length lyskom-prioritize-entry-list)) (setq elem (lyskom-prioritize-get-entry-from-no where)) (if (= (prioritize-entry->priority elem) prio-from) (progn (set-prioritize-entry->priority elem prio-to) (if (null tmp) (setq tmp elem)))) (setq where (1+ where))) (lyskom-prioritize-sort-entries) (lyskom-prioritize-redraw-buffer) (lyskom-prioritize-goto-entry tmp))))) (defun kom-prioritize-yank () "Move all marked entries to before point." (interactive) (let* ((old-entry (lyskom-prioritize-current-entry)) (entry-list (lyskom-prioritize-get-selected)) (prio (prioritize-entry->priority old-entry)) (from nil) (to nil) (start (car entry-list))) (cond ((null entry-list) nil) (t (while entry-list (setq from (lyskom-prioritize-get-no-from-entry (car entry-list))) (setq to (lyskom-prioritize-get-no-from-entry (lyskom-prioritize-current-entry))) (if (< from to) (setq to (1- to))) (set-prioritize-entry->priority (car entry-list) prio) (lyskom-prioritize-move-entry from to t t) (setq entry-list (cdr entry-list)) (lyskom-prioritize-goto-entry old-entry)) (lyskom-prioritize-goto-entry start))))) (defun kom-prioritize-save () "Save changes in the prioritization buffer." (interactive) (lyskom-prioritize-tell-server)) (defun kom-prioritize-quit () "Quit from the prioritization mode." (interactive) (lyskom-prioritize-tell-server) (lyskom-undisplay-buffer)) ;;; ====================================================================== ;;; LysKOM User command ;;; LysKOM Prioritize mode and related functions ;;; (defun kom-prioritize () "Re-prioritize all conferences you are a member in. Show memberships last visited, priority, unread and name in a buffer. In that buffer you can use various commands to chande ordering and priorities of conferences you are a member of." (interactive) (lyskom-start-of-command 'kom-prioritize) (let* ((buffer (current-buffer)) (tmp-buffer (lyskom-get-buffer-create 'prioritize (concat (buffer-name buffer) "-prioritize") t)) (collector (make-collector))) (unwind-protect (progn (if lyskom-membership-is-read nil (signal 'lyskom-internal-error '(membership-isnt-read kom-prioritize))) (let ((pers-stat (blocking-do 'get-pers-stat lyskom-pers-no)) (membership-list (blocking-do 'get-membership lyskom-pers-no))) (cond ((null membership-list) (lyskom-insert (lyskom-get-string 'cannot-get-membership))) ((null pers-stat) (lyskom-insert (lyskom-get-string 'cannot-get-pers-stat))) (t (let* ((pers-no lyskom-pers-no) (string (concat (lyskom-mode-name-from-host) " prioritize: " lyskom-server-name))) (set-buffer tmp-buffer) (make-local-variable 'lyskom-pers-no) (make-local-variable 'lyskom-prioritize-entry-list) (setq lyskom-prioritize-entry-list nil) (setq lyskom-pers-no pers-no) (setq mode-line-buffer-identification string) (lyskom-prioritize-mode) (set-buffer buffer) (lyskom-traverse memb-ship membership-list (initiate-get-conf-stat 'prioritize 'lyskom-prioritize-handle-get-conf-stat (membership->conf-no memb-ship) collector)) (lyskom-wait-queue 'prioritize) (lyskom-save-excursion (lyskom-display-buffer tmp-buffer) (setq lyskom-prioritize-entry-list (nreverse (collector->value collector))) (lyskom-prioritize-sort-entries) (lyskom-prioritize-redraw-buffer) (goto-char (point-max)) (let ((inhibit-read-only t)) (insert " ")) (lyskom-prioritize-goto-entry (lyskom-prioritize-get-entry-from-no 1)))))))) (save-excursion (set-buffer buffer) (lyskom-end-of-command))))) (defun lyskom-prioritize-handle-get-conf-stat (conf-stat collector) (let ((tmp (make-prioritize-entry (membership->priority (lyskom-get-membership (conf-stat->conf-no conf-stat))) conf-stat))) (collector-push tmp collector))) (defun lyskom-prioritize-sort-entries () "Sort the prioritization entry list." (setq lyskom-prioritize-entry-list (sort lyskom-prioritize-entry-list (function (lambda (x y) (> (prioritize-entry->priority x) (prioritize-entry->priority y)))))) (save-excursion (set-buffer lyskom-buffer) (setq lyskom-membership (sort lyskom-membership 'lyskom-membership-<)))) (defun lyskom-prioritize-mode () "\\Mode for prioritizing conferences in LysKOM. Commands: \\[kom-prioritize-move-up]\tMove conference on current line up one line. \\[kom-prioritize-move-down]\tMove conference on current line down one line. \\[kom-prioritize-yank]\tMove all selected conferences to near the current line. \\[kom-prioritize-select]\tToggle selection of the conference on the current line. \\[kom-prioritize-goto-priority]\tMove cursor to an entry with a certain priority. \\[kom-prioritize-set-priority]\tAlter the priority of the selected conferences. \\[kom-prioritize-reprioritize]\tChange one priority to another. \\[kom-prioritize-save]\tSave changes to priorities. \\[kom-prioritize-quit]\tSave changes and return to LysKOM. All bindings: \\{lyskom-prioritize-mode-map} Entry to this mode runs lyskom-prioritize-mode-hook." (interactive) (setq major-mode 'lyskom-prioritize-mode) (setq mode-name "Prioritize") (make-local-variable 'lyskom-prioritize-entry-list) (make-local-variable 'lyskom-prioritize-mode-line-selected) (make-local-variable 'lyskom-prioritize-selection) (setq lyskom-prioritize-mode-line-selected "") (setq lyskom-prioritize-selection nil) (setq lyskom-prioritize-entry-list nil) (setq mode-line-format lyskom-prioritize-mode-line) (lyskom-prioritize-update-mode-line) (setq buffer-read-only t) (lyskom-use-local-map lyskom-prioritize-mode-map) (lyskom-add-hook 'lyskom-add-membership-hook 'lyskom-prioritize-add-membership 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 'lyskom-prioritize-mode-hook)) (defun lyskom-prioritize-update-mode-line () (setq lyskom-prioritize-mode-line-selected (cond ((= (length (lyskom-prioritize-get-selected)) 0) (lyskom-get-string 'no-selection)) (t (format (lyskom-get-string 'selection) (length (lyskom-prioritize-get-selected)))))) (force-mode-line-update)) ;;; ================================================================ ;;; Saving changes ;;; (defun lyskom-prioritize-tell-server (&optional entry) "Tell the server about the changes. If optional arg ENTRY is given, only tell server about that entry." (cond ((null entry) (mapcar (function (lambda (x) (if x (lyskom-prioritize-tell-server x)))) lyskom-prioritize-entry-list)) (t (let* ((conf-stat (prioritize-entry->conf-stat entry)) (conf-no (conf-stat->conf-no conf-stat)) (entry-number (1- (lyskom-prioritize-get-no-from-entry entry)))) (save-excursion (set-buffer lyskom-buffer) (set-membership->priority (lyskom-get-membership conf-no) (prioritize-entry->priority entry)) (initiate-add-member 'priority 'lyskom-prioritize-handler conf-no lyskom-pers-no (prioritize-entry->priority entry) entry-number)))))) (defun lyskom-prioritize-handler (res) "Arg: RES. Barf if RES is nil." (or res (lyskom-error "%s" (lyskom-get-string 'prio-died)))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: flags.el,v 44.7.2.2 1999/10/13 12:13:09 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: flags.el ;;;; ;;;; This file contains code for editing the user variables and saving ;;;; them in the user area. ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: flags.el,v 44.7.2.2 1999/10/13 12:13:09 byers Exp $\n")) ;;; Author: Linus Tolke ;;; Dummy defun of original-user-variable-p to eliminate compiler warning. (defun original-user-variable-p (x) nil) (fset 'original-user-variable-p (symbol-function 'user-variable-p)) (defun lyskom-user-variable-p (symbol) (and (original-user-variable-p symbol) (or (string-match "^kom-" (symbol-name symbol)) (string-match "^lyskom-" (symbol-name symbol))))) (defun lyskom-Edit-options-modify (modfun) (save-excursion (let ((inhibit-read-only t) var pos tmp) (re-search-backward "^;; \\|\\`") (forward-char 3) (setq pos (point)) (save-restriction (narrow-to-region pos (progn (end-of-line) (1- (point)))) (goto-char pos) (setq var (read (current-buffer)))) (goto-char pos) (forward-line 1) (forward-char 1) (save-excursion (set var (setq tmp (funcall modfun var))) (if (boundp 'lyskom-buffer) (set-buffer lyskom-buffer)) (set var tmp)) (kill-sexp 1) (prin1 (symbol-value var) (current-buffer))))) (defvar lyskom-options-text nil "Text mass when reading options.") (def-kom-command kom-save-options () "Save options that have been set somewhere." (interactive) (lyskom-save-options (or lyskom-buffer (current-buffer)) (lyskom-get-string 'saving-settings) (lyskom-get-string 'saving-settings-done) (lyskom-get-string 'could-not-save-options))) (defun kom-edit-options () "Edit options for the lyskom client." (interactive) (fset 'user-variable-p (symbol-function 'lyskom-user-variable-p)) (let ((buf (current-buffer)) (curwin (current-window-configuration))) (edit-options) (fset 'Edit-options-modify (symbol-function 'lyskom-Edit-options-modify)) (make-local-variable 'lyskom-buffer) (make-local-variable 'lyskom-edit-return-to-configuration) (setq lyskom-buffer buf) (setq lyskom-edit-return-to-configuration curwin) (local-set-key "\C-c\C-c" 'kom-edit-options-send) (local-set-key "\C-c\C-k" 'kom-edit-quit) ) (fset 'user-variable-p (symbol-function 'original-user-variable-p))) ;;;============================================================ ;;; kom-edit-options-send ;;; ;;; Finish an edit options session. ;;; This function must be kept in sync with lyskom-save-options ;;; below. ;;; (defun kom-edit-options-send () "Finishes the edit options and sends the new settings to the server." (interactive) ; The check for changes is not a very good one. (cond ((not (eq major-mode 'Edit-options-mode)) (error "You are not in the correct buffer. (Couldn't fool me this time.")) ((buffer-modified-p (current-buffer)) ;lets do it. ;lyskom-global-variables is a list of variables in the common block. ;lyskom-elisp-variables is a list of varibles in the elisp block. (let* ((optbuf (current-buffer)) (print-readably t) (common-block nil) (elisp-block nil)) (save-excursion (set-buffer lyskom-buffer) (setq common-block (concat (mapconcat (function (lambda (var) (lyskom-format-objects (substring (symbol-name var) 4) (if (symbol-value var) "1" "0")))) lyskom-global-boolean-variables "\n") "\n" (mapconcat (function (lambda (var) (lyskom-format-objects (substring (symbol-name var) 4) (prin1-to-string (symbol-value var))))) lyskom-global-non-boolean-variables "\n") ) elisp-block (mapconcat (function (lambda (var) (lyskom-format-objects (symbol-name var) (prin1-to-string (symbol-value var))))) lyskom-elisp-variables "\n")) (lyskom-start-of-command (lyskom-get-string 'saving-settings) t) (lyskom-insert-string 'hang-on) (initiate-create-text 'options 'lyskom-edit-options-send ;;; This is a cludge awaiting prot-B (apply 'lyskom-format-objects (apply 'lyskom-format-objects "common" "elisp" (mapcar (function car) lyskom-other-clients-user-areas)) common-block elisp-block (mapcar (function cdr) lyskom-other-clients-user-areas)) ; (concat common-block "----------\n" elisp-block) (lyskom-create-misc-list) optbuf)))) (t (let ((optbuf (current-buffer))) (set-buffer lyskom-buffer) (lyskom-start-of-command (lyskom-get-string 'saving-settings) t) (lyskom-insert-string 'no-changes) (lyskom-edit-options-done t optbuf))))) (defun lyskom-edit-options-send (text-no optbuf) "Handles the call after the options text has been sent to the buffer." (if text-no (initiate-set-user-area 'options 'lyskom-edit-options-done lyskom-pers-no text-no optbuf) (lyskom-insert-string 'could-not-create-area) (lyskom-end-of-command))) (defun lyskom-edit-options-done (success optbuf) "Handles the return from the set user area call. If successful then set the buffer not-modified. Else print a warning." (if success (save-excursion ;;;+++ This should be done with the asynchronous call instead. (cache-del-pers-stat lyskom-pers-no) (set-buffer optbuf) (not-modified) (set-window-configuration lyskom-edit-return-to-configuration)) (lyskom-format-insert 'could-not-set-user-area lyskom-errno)) (lyskom-end-of-command)) (def-kom-var lyskom-options-done nil "When we have read all options this is turned non-nil." local) ;;;============================================================ ;;; lyskom-save-options ;;; ;;; Save user-area without feedback in the KOM buffer. This ;;; is for use by all functions but edit-options. ;;; ;;; Messages are given in the minibuffer (defun lyskom-save-options (kombuf start-message done-message error-message) (let* ((print-readably t) (common-block (concat (mapconcat (function (lambda (var) (lyskom-format-objects (substring (symbol-name var) 4) (if (symbol-value var) "1" "0")))) lyskom-global-boolean-variables "\n") "\n" (mapconcat (function (lambda (var) (lyskom-format-objects (substring (symbol-name var) 4) (prin1-to-string (symbol-value var))))) lyskom-global-non-boolean-variables "\n") )) (elisp-block (mapconcat (function (lambda (var) (lyskom-format-objects (symbol-name var) (prin1-to-string (symbol-value var))))) lyskom-elisp-variables "\n"))) (save-excursion (set-buffer kombuf) (lyskom-message "%s" start-message) (initiate-create-text 'options 'lyskom-save-options-2 (apply 'lyskom-format-objects (apply 'lyskom-format-objects "common" "elisp" (mapcar (function car) lyskom-other-clients-user-areas)) common-block elisp-block (mapcar (function cdr) lyskom-other-clients-user-areas)) (lyskom-create-misc-list) kombuf done-message error-message)))) (defun lyskom-save-options-2 (text-no kombuf done-message error-message) (if text-no (initiate-set-user-area 'options 'lyskom-save-options-3 lyskom-pers-no text-no kombuf done-message error-message) (save-excursion (set-buffer kombuf) (lyskom-insert-string 'could-not-save-options) (lyskom-message "%s" (lyskom-get-string 'could-not-save-options))))) (defun lyskom-save-options-3 (success kombuf done-message error-message) (save-excursion (set-buffer kombuf) (if success (progn (cache-del-pers-stat lyskom-pers-no) (lyskom-message "%s" done-message)) (lyskom-format-insert 'could-not-set-user-area lyskom-errno) (lyskom-message "%s" error-message)))) (defun lyskom-read-options () "Reads the user-area and sets the variables according to the choises." (if (and lyskom-pers-no (not (zerop lyskom-pers-no))) (let ((pers-stat (blocking-do 'get-pers-stat lyskom-pers-no))) (if (not pers-stat) ;+++ Other error handler. (lyskom-insert-string 'you-dont-exist) (setq lyskom-other-clients-user-areas nil) (if (zerop (pers-stat->user-area pers-stat)) (progn ;; (lyskom-tell-phrases-validate) (setq lyskom-options-done t)) (lyskom-read-options-eval (blocking-do 'get-text (pers-stat->user-area pers-stat)))))))) (defun lyskom-read-options-eval (text) "Handles the call from where we have the text." (if text ;+++ Other error handler (let* ((lyskom-options-text (text->text-mass text)) (pointers (lyskom-read-options-eval-get-holerith)) common-no elisp-no (rest lyskom-options-text) working (r 1)) (let* ((lyskom-options-text pointers) word (r 1)) (while (> (length lyskom-options-text) 2) (setq word (lyskom-read-options-eval-get-holerith)) (cond ((string= word "common") (setq common-no r)) ((string= word "elisp") (setq elisp-no r)) (t (setq lyskom-other-clients-user-areas (cons (cons word r) lyskom-other-clients-user-areas)))) (++ r))) (setq lyskom-other-clients-user-areas (nreverse lyskom-other-clients-user-areas)) (setq lyskom-options-text rest) (while (> (length lyskom-options-text) 2) (setq working (lyskom-read-options-eval-get-holerith)) (cond ;; Note that common-no may be nil here, so the comparison ;; cannot be performed with '=. ((equal r common-no) (let ((lyskom-options-text working) name gname value) (while (> (length lyskom-options-text) 2) (setq gname (lyskom-read-options-eval-get-holerith)) (setq value (lyskom-read-options-eval-get-holerith)) (setq name (concat "kom-" gname)) (if (memq (intern-soft name) lyskom-global-boolean-variables) (if (string= value "1") (setq value "t") (setq value "nil")) (if (memq (intern-soft name) lyskom-global-non-boolean-variables) nil (setq name (concat "UNK-" gname)) (setq lyskom-global-non-boolean-variables (cons name lyskom-global-non-boolean-variables)))) (lyskom-maybe-set-var-from-string name value)))) ;; Note that elisp-no may be nil here, so the comparison ;; cannot be performed with '=. ((equal r elisp-no) (let ((lyskom-options-text working) name value) (while (> (length lyskom-options-text) 2) (setq name (lyskom-read-options-eval-get-holerith)) (setq value (lyskom-read-options-eval-get-holerith)) (lyskom-maybe-set-var-from-string name value)))) (t (let ((pos lyskom-other-clients-user-areas)) (while (and pos (not (= (cdr (car pos)) r))) (setq pos (cdr pos))) (if pos (setcdr (car pos) working))))) (++ r)) (setq lyskom-filter-list (append kom-permanent-filter-list kom-session-filter-list)) (setq lyskom-do-when-done (cons kom-do-when-done kom-do-when-done)) ;; Remove not found user-areas (let ((pos lyskom-other-clients-user-areas)) (if pos (progn (while (stringp (cdr (car (cdr pos)))) (setq pos (cdr pos))) (setcdr pos nil)))))) (setq lyskom-options-done t)) (defun lyskom-read-options-eval-get-holerith () (while (string-match "\\s-" (substring lyskom-options-text 0 1)) (setq lyskom-options-text (substring lyskom-options-text 1))) (let ((len (string-to-int lyskom-options-text)) (start (progn (string-match "[0-9]+H" lyskom-options-text) (match-end 0)))) (let ((name (substring lyskom-options-text start (+ start len)))) (setq lyskom-options-text (substring lyskom-options-text (+ start len))) name))) (defun lyskom-maybe-set-var-from-string (var string) "This is a wrapper around lyskom-set-var-from-string that does nothing if the variable is in kom-dont-read-saved-variables." (cond ((eq kom-dont-read-saved-variables t) nil) ((memq (intern var) kom-dont-read-saved-variables) nil) (t (lyskom-set-var-from-string var string)))) (defun lyskom-set-var-from-string (var string) "This is a wrapper aroud read-from-string. It returns nil, and writes a message when an error occurs." (set (intern var) (car (condition-case nil (read-from-string string) (invalid-read-syntax (lyskom-format-insert (lyskom-get-string 'error-in-options) var string) nil))))) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: messages.el,v 44.1.2.2 1999/10/13 12:13:19 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: messages.el ;;;; Author: David Byers ;;;; ;;;; This file implements the personal message handler queue ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: messages.el,v 44.1.2.2 1999/10/13 12:13:19 byers Exp $\n")) (defvar lyskom-personal-message-handlers nil "A list of personal message handlers. Each element of the list is a function of four arguments, MESSAGE-TYPE SENDER RECIPIENT and TEXT. MESSAGE-TYPE is one of personal, group or common and denotes the type of message. SENDER is the conf-stat of the sender of the message. RECIPIENT is the conf-stat of the message recipient or zero for common messages. The functions may use the lyskom-set-current-message-text function to modify the message text. A non-nil return value from the function indicates that the message was handlerd and no other handlers need to be called and a nil return value means that the message was not handled and should be sent to the next handler.") (defvar lyskom-message-current-text "" "The text of the current message. Use lyskom-set-current-message-text to modify this variable.") (defun lyskom-set-current-message-text (text) "Set the current message text to TEXT. For use by personal message handlers." (setq lyskom-message-current-text text)) (defun lyskom-handle-personal-message (sender recipient text) "Handle a personal message. SENDER is the sender of the message (a conf-stat) RECIPIENT is the recipient of the message (a conf-stat or zero for common messages. TEXT is the text of the message." (let ((message-type (cond ((eq recipient 0) 'common) ((= (conf-stat->conf-no recipient) lyskom-pers-no) 'personal) (t 'group))) (lyskom-message-current-text text) (handlers lyskom-personal-message-handlers) (done nil)) (while (and (not done) handlers) (setq done (funcall (car handlers) message-type sender recipient lyskom-message-current-text)) (setq handlers (cdr handlers))) (if (not done) (lyskom-show-personal-message sender recipient lyskom-message-current-text)))) (defun lyskom-add-personal-message-handler (handler &optional place relative new) "Add HANDLER to the queue of personal message handlers. Optional argument PLACE can be one of 'before or 'after. Optional argument RELATIVE can be another handler in the queue. IF fourth argument NEW is t, the handler is only added if it does not already exist in the list. The new handler is placed first in the queue if PLACE is 'before and RELATIVE is not specified; last if PLACE is 'after and RELATIVE is not specified; or before or after the handler RELATIVE in the queue, depending on the value of PLACE. If PLACE is nil, 'after is assumed." (if (or (not new) (not (memq handler lyskom-personal-message-handlers))) (progn (setq place (or (and (eq place 'before) 'before) 'after)) (setq relative (car-safe (memq relative lyskom-personal-message-handlers))) (let ((pos (if relative (- (length lyskom-personal-message-handlers) (length (memq relative lyskom-personal-message-handlers)))))) (cond ((and relative (eq place 'after)) (setcdr (nthcdr pos lyskom-personal-message-handlers) (cons handler (nthcdr (1+ pos) lyskom-personal-message-handlers))) ) ((and relative (eq place 'before) (> pos 0)) (setcdr (nthcdr (1- pos) lyskom-personal-message-handlers) (cons handler (nthcdr pos lyskom-personal-message-handlers))) ) ((and lyskom-personal-message-handlers (eq place 'after)) (setcdr (nthcdr (1- (length lyskom-personal-message-handlers)) lyskom-personal-message-handlers) (cons handler nil))) ((or (null lyskom-personal-message-handlers) (eq place 'before)) (setq lyskom-personal-message-handlers (cons handler lyskom-personal-message-handlers))) (t (setcdr (nthcdr (1- (length lyskom-personal-message-handlers)) lyskom-personal-message-handlers) (cons handler nil))))) lyskom-personal-message-handlers))) (defun lyskom-info-request-handler (message-type sender recipient text) (if (string= text " ") (progn (initiate-send-message 'follow nil (conf-stat->conf-no sender) (format "emacs-version: %s\nclient-version: %s" (emacs-version) lyskom-clientversion)) t) nil)) (lyskom-add-personal-message-handler 'lyskom-info-request-handler 'before) (provide 'lyskom-messages) ;;; messages.el ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: ansaphone.el,v 44.2.2.2 1999/10/13 12:12:48 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: ansaphone.el ;;;; Author: David Byers ;;;; ;;;; This file implements the auto-reply facility. ;;;; It must be loaded after messages.el ;;;; (eval-when-compile (require 'lyskom-vars "vars") (require 'lyskom-macros "macros") (require 'lyskom-command "command") (require 'lyskom-language "language") (require 'lyskom-messages "messages") (require 'lyskom-services "services")) (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: ansaphone.el,v 44.2.2.2 1999/10/13 12:12:48 byers Exp $\n")) (defconst lyskom-ansaphone-tag "Auto-reply:\n") ;;;============================================================ ;;; ;;; User functions ;;; (def-kom-command kom-change-auto-reply (&optional message) "Change the default automatic reply message." (interactive) (let ((message (or message (read-from-minibuffer (lyskom-get-string 'ansaphone-new-message)))) (lyskom-last-text-format-flags nil)) (setq kom-ansaphone-default-reply message) (lyskom-format-insert (lyskom-get-string 'ansaphone-message) kom-ansaphone-default-reply))) (def-kom-command kom-toggle-auto-reply () "Toggle automatic replies to personal messages." (interactive) (setq kom-ansaphone-on (not kom-ansaphone-on)) (lyskom-format-insert (lyskom-get-string 'ansaphone-state-r) (lyskom-get-string (if kom-ansaphone-on 'state-on 'state-off))) (if kom-ansaphone-on (progn (setq lyskom-ansaphone-when-set (current-time-string)) (lyskom-format-insert (lyskom-get-string 'ansaphone-message) kom-ansaphone-default-reply)))) (def-kom-command kom-list-messages () "List collected messages" (interactive) (if (null lyskom-ansaphone-messages) (lyskom-format-insert (lyskom-get-string 'ansaphone-no-messages)) (progn (lyskom-format-insert (lyskom-get-string 'ansaphone-message-list-start)) (mapcar (function (lambda (msg) (lyskom-show-personal-message (blocking-do 'get-conf-stat (elt msg 0)) (blocking-do 'get-conf-stat (elt msg 1)) (elt msg 2) (elt msg 3) 'nobeep))) (reverse lyskom-ansaphone-messages)) (lyskom-format-insert (lyskom-get-string 'ansaphone-message-list-end))))) (def-kom-command kom-erase-messages () "Erase collected messages" (interactive) (lyskom-message "%s" (lyskom-get-string 'ansaphone-messages-gone)) (setq lyskom-ansaphone-messages nil)) (defun lyskom-ansaphone-send-message (recipient message) (initiate-send-message 'async nil (if (numberp recipient) recipient (conf-stat->conf-no recipient)) (concat lyskom-ansaphone-tag message))) (defun lyskom-ansaphone-message-handler (message-type sender recipient text) "Personal message handler. Automatically reply to certain personal messages and strip auto-reply identification from messages. See kom-ansaphone-on" (let ((is-automatic (eq 0 (string-match lyskom-ansaphone-tag text)))) (if is-automatic (progn (string-match (concat "^" lyskom-ansaphone-tag "\\(\\(.\\|\n\\)*\\)") text) (lyskom-set-current-message-text (substring text (match-beginning 1) (match-end 1))))) ;; ;; See if we want to reply to this message ;; (if (and kom-ansaphone-on sender recipient (not is-automatic)) (let ((reply (lyskom-ansaphone-find-reply message-type (conf-stat->conf-no sender) (cond ((numberp recipient) recipient) (t (conf-stat->conf-no recipient))) text))) (if (and reply (elt reply 4)) (progn (setq reply (concat (lyskom-format (lyskom-get-string 'ansaphone-message-header) lyskom-ansaphone-when-set) (elt reply 4))) (lyskom-ansaphone-send-message sender reply))))) ;; ;; See if we want to record this message ;; (if (and kom-ansaphone-on kom-ansaphone-record-messages sender) (lyskom-ansaphone-record-message sender recipient lyskom-message-current-text))) ;; ;; Perhaps we want to show the message, perhaps not ;; (if kom-ansaphone-on (not kom-ansaphone-show-messages) nil)) (defun lyskom-ansaphone-find-reply (message-type sender recipient text) "Find an automatic reply suitable for messages of type MESSAGE-TYPE from SENDER to RECIPIENT consisting of TEXT. See the documentation for kom-ansaphone-default-reply and kom-ansaphone-replies." (let ((exprs kom-ansaphone-replies) (result nil)) (while exprs (if (and (or (null (elt (car exprs) 0)) (eq (elt (car exprs) 0) message-type)) (or (null (elt (car exprs) 1)) (eq (elt (car exprs) 1) sender) (and (listp (elt (car exprs) 1)) (memq sender (elt (car exprs) 1)))) (or (null (elt (car exprs) 2)) (eq (elt (car exprs) 2) recipient) (and (listp (elt (car exprs) 2)) (memq recipient (elt (car exprs) 2)))) (or (null (elt (car exprs) 3)) (string-match (elt (car exprs) 3) text))) (progn (setq result (car exprs)) (setq exprs nil))) (setq exprs (cdr-safe exprs))) (or result (and (eq message-type 'personal) (list nil nil nil nil kom-ansaphone-default-reply))))) (defun lyskom-ansaphone-record-message (sender recipient text) (if (not (numberp sender)) (setq sender (conf-stat->conf-no sender))) (if (not (numberp recipient)) (setq recipient (conf-stat->conf-no recipient))) (setq lyskom-ansaphone-messages (cons (list sender recipient text (current-time-string)) lyskom-ansaphone-messages))) (lyskom-add-personal-message-handler 'lyskom-ansaphone-message-handler 'before nil t) (provide 'lyskom-ansaphone) ;;; ansaphone.el ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: remote-control.el,v 44.1.2.2 1999/10/13 12:13:25 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: remote-control.el ;;;; Author: David Byers ;;;; ;;;; This file implements the remote control mechanism. ;;;; It must be loaded after messages.el ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: remote-control.el,v 44.1.2.2 1999/10/13 12:13:25 byers Exp $\n")) ;;;============================================================ ;;; ;;; Internal variables. ;;; (defconst lyskom-remote-commands '(("set message" . lyskom-remote-set-message) ("list messages" . lyskom-remote-list-messages) ("erase messages" . lyskom-remote-erase-messages) ("autoreply" . lyskom-remote-autoreply) ("quit" . lyskom-remote-quit))) ;;;============================================================ ;;; ;;; Interactive functions ;;; (def-kom-command kom-remote-autoreply (&optional session-no state) "Remotely turn on or off the auto-reply facility of another client. Optional argument SESSION-NO specifies the target session. Optional argument STATE can be one of 'on, 'off or nil. on means turn auto-reply on, off turn it off and nil toggle its state." (interactive) (setq session-no (or session-no (car (lyskom-read-session-no (lyskom-get-string 'remote-control-who) nil nil t)))) (setq state (or state (cdr-safe (assoc (completing-read (lyskom-get-string 'remote-control-autoreply) lyskom-onoff-table nil t nil nil) lyskom-onoff-table)))) (let ((info (blocking-do 'get-session-info session-no))) (lyskom-send-message (session-info->pers-no info) (format "Remote-command: %d %d\nautoreply\n%s" lyskom-session-no session-no (cond ((eq state 'on) "on") ((eq state 'off) "off") (t ""))) t))) (def-kom-command kom-remote-set-message (&optional session-no message) "Remotely set the default reply message of another client. Optional argument SESSION-NO specifies the target session. Optional argument MESSAGE specifies the message." (interactive) (setq session-no (or session-no (car (lyskom-read-session-no (lyskom-get-string 'remote-control-who) nil nil t)))) (setq message (or message (lyskom-read-string (lyskom-get-string 'message-prompt)))) (let ((info (blocking-do 'get-session-info session-no))) (lyskom-send-message (session-info->pers-no info) (format "Remote-command: %d %d\nset message\n%s" lyskom-session-no session-no message) t))) (def-kom-command kom-remote-list-messages (&optional session-no) "List messages collected from a remote auto-reply facility. Optional argument SESSION-NO specifies the target session." (interactive) (setq session-no (or session-no (car (lyskom-read-session-no (lyskom-get-string 'remote-control-who) nil nil t)))) (let ((info (blocking-do 'get-session-info session-no))) (lyskom-send-message (session-info->pers-no info) (format "Remote-command: %d %d\nlist messages\n" lyskom-session-no session-no) t))) (def-kom-command kom-remote-erase-messages (&optional session-no) "Erase stored messages on a remote auto-reply facility. Optional argument SESSION-NO specifies the target session." (interactive) (setq session-no (or session-no (car (lyskom-read-session-no (lyskom-get-string 'remote-control-who) nil nil t)))) (let ((info (blocking-do 'get-session-info session-no))) (lyskom-send-message (session-info->pers-no info) (format "Remote-command: %d %d\nerase messages\n" lyskom-session-no session-no) t))) (def-kom-command kom-remote-quit (&optional session-no) "Quit a remote client. Optional argument SESSION-NO specifies the target session." (interactive) (setq session-no (or session-no (car (lyskom-read-session-no (lyskom-get-string 'remote-control-who) nil nil t)))) (let ((info (blocking-do 'get-session-info session-no))) (lyskom-send-message (session-info->pers-no info) (format "Remote-command: %d %d\nquit\n" lyskom-session-no session-no) t))) ;;;============================================================ ;;; ;;; Main handler function ;;; (defun lyskom-remote-handler (message-type sender recipient text) "Personal message handler. Handler to implement remote control of the ansaphone." (let* ((error nil) (is-remote (eq 0 (string-match "^Remote-command: \\([0-9]+\\) \\([0-9]+\\)\n" text))) (is-from-me (and is-remote (= (string-to-number (substring text (match-beginning 1) (match-end 1))) lyskom-session-no))) (is-to-me (and is-remote (= (string-to-number (substring text (match-beginning 2) (match-end 2))) lyskom-session-no))) (is-valid (eq 0 (string-match "^Remote-command: \\([0-9]+\\) \\([0-9]+\\)\n\\(.*\\)\n\\(\\(\n\\|.\\)*\\)$" text))) (is-trusted (or (memq (conf-stat->conf-no sender) kom-remote-controllers) (and kom-self-control (eq (conf-stat->conf-no sender) lyskom-pers-no))))) (cond ((not is-remote) nil) (is-from-me t) ((not is-to-me) t) ((not is-trusted) (lyskom-ansaphone-send-message lyskom-pers-no (lyskom-format (lyskom-get-string 'illegal-remote) (current-time-string) sender recipient text)) (lyskom-ansaphone-send-message sender (lyskom-format (lyskom-get-string 'illegal-remote-reply) (lyskom-get-string 'remote-not-in-list))) t) ((not is-valid) (setq error 'remote-bad-command)) (t (let* ((command (substring text (match-beginning 3) (match-end 3))) (arg (substring text (match-beginning 4) (match-end 4))) (desc (assoc command lyskom-remote-commands))) (if (null desc) (setq error 'remote-bad-command) (setq error (funcall (cdr desc) arg sender recipient text)))))) (if error (progn (lyskom-ansaphone-send-message sender (lyskom-format (lyskom-get-string 'illegal-remote-reply) (or (lyskom-get-string error) (lyskom-get-string 'remote-unknown-error)))))) is-remote)) (defun lyskom-remote-set-message (arg sender recipient text) (if arg (let ((lyskom-last-text-format-flags nil)) (setq kom-ansaphone-default-reply arg) (setq lyskom-ansaphone-when-set (current-time-string)) (lyskom-ansaphone-send-message sender (concat (lyskom-get-string 'ansaphone-new-message) arg)) (lyskom-insert-before-prompt (lyskom-format (lyskom-get-string 'remote-set-message) sender (current-time-string) arg)) nil) 'remote-bad-command)) ;;;============================================================ ;;; ;;; Command handlers ;;; (defun lyskom-remote-autoreply (arg sender recipient text) (cond ((string= (downcase arg) "on") (setq kom-ansaphone-on t)) ((string= (downcase arg) "off") (setq kom-ansaphone-on nil)) (t (setq kom-ansaphone-on (not kom-ansaphone-on)))) (lyskom-ansaphone-send-message sender (lyskom-format (lyskom-get-string 'ansaphone-state) (lyskom-get-string (if kom-ansaphone-on 'state-on 'state-off)))) (lyskom-insert-before-prompt (lyskom-format (lyskom-get-string 'remote-set-ansaphone) sender (current-time-string) (lyskom-get-string (if kom-ansaphone-on 'state-on 'state-off)))) nil) (defun lyskom-remote-list-messages (arg sender recipient text) (if (null lyskom-ansaphone-messages) (lyskom-ansaphone-send-message sender (lyskom-get-string 'ansaphone-no-messages)) (progn (lyskom-collect 'follow) (let ((tmp (reverse lyskom-ansaphone-messages))) (while tmp (initiate-get-conf-stat 'follow nil (elt (car tmp) 0)) (initiate-get-conf-stat 'follow nil (elt (car tmp) 1)) (setq tmp (cdr tmp)))) (lyskom-use 'follow 'lyskom-remote-list-messages-1 sender))) nil) (defun lyskom-remote-list-messages-1 (sender &rest pairs) (let ((message "") (tmp (reverse lyskom-ansaphone-messages)) (from nil) (to nil)) (while pairs (setq from (car pairs) to (car (cdr pairs))) (setq pairs (cdr (cdr pairs))) (setq message (concat message (lyskom-format-as-personal-message from to (elt (car tmp) 2) (elt (car tmp) 3)) (if pairs "\n\n" ""))) (setq tmp (cdr tmp))) (lyskom-ansaphone-send-message sender message) (lyskom-insert-before-prompt (lyskom-format (lyskom-get-string 'remote-list-messages) sender (current-time-string))))) (defun lyskom-remote-erase-messages (arg sender recipient text) (setq lyskom-ansaphone-messages nil) (lyskom-insert-before-prompt (lyskom-format (lyskom-get-string 'remote-erase-messages) sender (current-time-string))) nil) (defun lyskom-remote-quit (arg sender recipient text) (lyskom-insert-before-prompt (lyskom-format (lyskom-get-string 'remote-quit) sender (current-time-string))) (lyskom-quit)) ;;;============================================================ ;;; ;;; Clean-up and installation ;;; (lyskom-add-personal-message-handler 'lyskom-remote-handler 'before 'lyskom-ansaphone-message-handler t) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: menus.el,v 44.15.2.2 1999/10/13 12:13:18 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: menus.el ;;;; Author: Niels Möller ;;;; ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: menus.el,v 44.15.2.2 1999/10/13 12:13:18 byers Exp $\n")) (lyskom-external-function set-buffer-menubar) (lyskom-external-function popup-menu) (lyskom-external-function add-submenu) (defvar lyskom-current-menu-category nil "Category of menus currently used in buffer") (make-variable-buffer-local 'lyskom-current-menu-category) (defvar lyskom-menu-template '((menu read ((item kom-view-next-text) (item kom-list-news) (hline review-separator) (item kom-view-commented-text) (item kom-view-previous-commented-text) (item kom-review-comments) (item kom-review-tree) (item kom-find-root) (item kom-find-root-review) (item kom-review-clear) (hline jump-separator) (item kom-jump) (item kom-super-jump) (item kom-set-unread))) (menu write ((item kom-write-text) (item kom-send-letter) (item kom-write-comment) (item kom-private-answer) (item kom-comment-previous) (hline send-separator) (item kom-send-message))) (menu conference ((item kom-go-to-conf) (item kom-go-to-next-conf) (hline info-separator) (item kom-membership) (item kom-list-conferences) (item kom-status-conf) (item kom-review-presentation) (hline member-separator) (item kom-add-self) (item kom-sub-self) (item kom-prioritize))) (menu person ((item kom-who-is-on) (item kom-status-session) (hline info-separator) (item kom-list-persons) (item kom-status-person) (item kom-review-presentation) (hline change-separator) (item kom-change-name) (item kom-change-password))) (menu other ((item kom-customize)))) "The menus used in LysKOM.") (defvar lyskom-popup-menu-template (` (menu lyskom ((,@ lyskom-menu-template)))) "Popup-menu in the backgrouond of the LysKOM window") (defvar lyskom-edit-menu-template '((menu lyskom ((item kom-ispell-message) (item kom-edit-send) ; (item kom-edit-send-anonymous) (hline reciever-separator) (item kom-edit-add-recipient) (item kom-edit-add-copy) (hline comment-separator) (item kom-edit-show-commented) ; (item kom-edit-insert-commented) (hline send-separator) (item kom-edit-quit)))) "The menus for editing LysKOM messages.") (defvar lyskom-menu-list '((lyskom-mode . lyskom-menu) (lyskom-edit-mode . lyskom-edit-menu)) "List of menu sets in LysKOM") (defvar lyskom-menu nil "A keymap describing the LysKOM top menu.") ;(when (not lyskom-menu) ; (setq lyskom-menu (make-sparse-keymap))) (defvar lyskom-edit-menu nil "A keymap the LysKOM menu in the edit buffer.") ;(when (not lyskom-edit-menu) ; (setq lyskom-edit-menu (make-sparse-keymap))) (defvar lyskom-popup-menu nil "A keymap the LysKOM menu in the edit buffer.") ;(when (not lyskom-popup-menu) ; (setq lyskom-popup-menu (make-sparse-keymap))) (defun lyskom-build-menus () "Create menus according to LYSKOM-MENUS" (lyskom-xemacs-or-gnu (lyskom-build-menus-xemacs) (lyskom-build-menus-gnu))) (defun lyskom-build-menus-xemacs () (setq lyskom-edit-menu (lyskom-define-menu-xemacs lyskom-edit-menu-template)) (setq lyskom-popup-menu (lyskom-define-menu-xemacs lyskom-popup-menu-template)) (setq lyskom-menu (lyskom-define-menu-xemacs lyskom-menu-template))) (defun lyskom-build-menus-gnu () "Rebuilds the LysKOM menus" (setq lyskom-menu (make-sparse-keymap)) (setq lyskom-edit-menu (make-sparse-keymap)) (setq lyskom-popup-menu (make-sparse-keymap)) (lyskom-define-menu-gnu lyskom-menu lyskom-menu-template) (lyskom-define-menu-gnu lyskom-edit-menu lyskom-edit-menu-template) (lyskom-define-menu-gnu lyskom-popup-menu (list lyskom-popup-menu-template)) (setq lyskom-popup-menu (lookup-key lyskom-popup-menu [lyskom]))) (defun lyskom-define-menu-xemacs (menus) (let ((type nil) (parameters nil)) (ignore type parameters) ; Are they ever used? (cond ((null (car menus))) ((listp (car menus)) ; Menu bar (mapcar 'lyskom-define-menu-xemacs menus)) ((eq (car menus) 'menu) ; A menu (let ((menu-title (car (cdr menus))) (menu-items (car (cdr (cdr menus))))) (cons (lyskom-get-menu-string menu-title) (mapcar (function (lambda (item) (cond ((eq (car item) 'item) (vector (lyskom-get-menu-string (car (cdr item))) (car (cdr item)) ':active t)) ((eq (car item) 'hline) (vector "--:shadowEtchedIn" nil ':active nil) ) ((eq (car item) 'menu) (lyskom-define-menu-xemacs item)) (t (error "Bad menu item: %S" item))))) menu-items)))) (t nil)))) (defun lyskom-define-menu-gnu (map menus) (when menus (lyskom-define-menu-gnu map (cdr menus)) (let ((type (car (car menus))) (symbol (car (cdr (car menus))))) (cond ((eq 'hline type) (define-key map (vector symbol) '("--"))) ((eq 'menu type) (let* ((name (lyskom-get-menu-string symbol)) (submap (make-sparse-keymap name))) (define-key map (vector symbol) (cons name submap)) (lyskom-define-menu-gnu submap (car (cdr (cdr (car menus))))))) ((eq 'item type) (define-key map (vector symbol) (cons (lyskom-get-menu-string symbol) symbol))) (t (error "Menu description invalid in lyskom-define-menu")))))) (defun lyskom-get-menu-category (menu-category) (symbol-value (cdr (assq menu-category lyskom-menu-list)))) (defun lyskom-update-menus () (lyskom-build-menus) (when (and (boundp 'lyskom-current-menu-category) lyskom-current-menu-category) (mapcar (function (lambda (mc) (lyskom-set-menus mc (current-local-map)))) lyskom-current-menu-category))) (defun lyskom-set-menus (menu-category keymap) (lyskom-xemacs-or-gnu (lyskom-set-menus-xemacs menu-category) (lyskom-set-menus-gnu menu-category keymap))) (defun lyskom-set-menus-gnu (menu-category keymap) "Update the menus" (define-key keymap [menu-bar] (lyskom-get-menu-category menu-category)) (make-local-variable 'lyskom-current-menu-category) (if (not (boundp 'lyskom-current-menu-category)) (setq lyskom-current-menu-category (list menu-category)) (add-to-list 'lyskom-current-menu-category menu-category))) (eval-when-compile (defvar default-menubar nil)) (defun lyskom-set-menus-xemacs (menu-category) "Update the menus" (make-local-variable 'current-menubar) (make-local-variable 'lyskom-current-menu-category) (set-buffer-menubar default-menubar) (mapcar (function (lambda (menu) (add-submenu nil menu))) (lyskom-get-menu-category menu-category)) (setq lyskom-current-menu-category (list menu-category))) ;;; ;;; This function would have been completely unnecessary if Gnu Emacs ;;; didn't carry around an ancient version of popup-menu that is ;;; completely incompatible with XEmacs version of the same function. ;;; Sometimes I hate elisp. ;;; (defun lyskom-do-popup-menu (menu event) "Pop up a menu" (lyskom-xemacs-or-gnu (popup-menu menu event) (let* ((result (nreverse (x-popup-menu (or event t) (list menu))))) (cond ((null result)) ((listp (car result)) (apply (car (car result)) (cdr (car result)))) ((commandp (car result)) (call-interactively (car (nreverse result)))) ((functionp (car result)) (funcall (car result))) (t nil))))) (defun lyskom-background-menu (pos event) "Pop up a menu with LysKOM commands and execute the selected command." (let* ((menu lyskom-popup-menu) (result (lyskom-do-popup-menu menu event))))) ;;;;(Återse) Baklänges Addera extra kopiemottagare ;;;;Addera kommentar Addera medlem ;;;;Addera mottagare Automatsvar ;;;;Avmarkera (inlägg) Bli medlem i möte ;;;;Börja med nytt namn Endast läsa senaste ;;;;Filtrera författare Filtrera innehåll ;;;;Filtrera ärende Fjärrkontrollera automatsvar ;;;;Fjärrkontrollera avsluta Fjärrkontrollera lista meddelanden ;;;;Fjärrkontrollera radera meddelanden ;;;;Fjärrkontrollera ändra svarsmeddelande ;;;;Flytta inlägg Fotnot till inlägg ;;;;Få skäll Få uppmuntran ;;;;Gå till möte Gå till nästa möte ;;;;Hjälp Hoppa över alla kommentarer ;;;;Kasta ut en session Kommentera föregående inlägg ;;;;Kommentera inlägget Ladda ner fil ;;;;Ladda upp fil Lista (med) regexpar ;;;;Lista filarean Lista filter ;;;;Lista klienter Lista meddelanden ;;;;Lista medlemsskap Lista möten ;;;;Lista nyheter Lista personer ;;;;Lista ärenden Läsa nästa inlägg ;;;;Långsamma kommandon Markera (inlägg) ;;;;Personligt svar Personligt svar på föregående inlägg ;;;;Prioritera möten Radera inlägg ;;;;Radera meddelanden Se tiden ;;;;Skapa möte Skicka brev ;;;;Skriva ett inlägg Sluta ;;;;Snabba kommandon Spara text (på fil) ;;;;Spara variabler Status (för) möte ;;;;Status (för) person Status (för) session ;;;;Subtrahera kommentar Subtrahera mottagare ;;;;Superhoppa Sända meddelande ;;;;Sätt lapp på dörren Sätt läsnivå ;;;;Ta bort lapp på dörren Uppskjuta läsning ;;;;Uteslut medlem Utplåna ;;;;Utträda ur möte Var (är) jag ;;;;Vilka är inloggade Visa user-arean ;;;;Vänta på ett inlägg Ändra filter ;;;;Ändra livslängd Ändra lösenord ;;;;Ändra mötestyp Ändra namn ;;;;Ändra organisatör Ändra presentation ;;;;Ändra supermöte Ändra svarsmeddelande ;;;;Ändra tillåtna författare Ändra variabler ;;;;Återse alla Återse alla kommentarer ;;;;Återse alla kommentarer rekursivt Återse alla markerade ;;;;Återse det föregående kommenterade ;;;;Återse det kommenterade Återse första ;;;;Återse hoppa Återse igen ;;;;Återse inlägg Återse lista ;;;;Återse markerade Återse nästa ;;;;Återse omodifierat Återse presentation ;;;;Återse senaste Återse träd ;;;;Återse urinlägget Återstarta kom ;;;;Övergå till administratörsmod (provide 'lyskom-menus) ;;; menus.el ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: slow.el,v 44.5.4.2 1999/10/13 12:13:29 byers Exp $ ;;;;; Copyright (C) 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: slow.el ;;;; ;;;; This file contains the code that makes it possible to run a ;;;; long-commands mode in the lyskom-buffer. ;;;; ;;;; ================================================================ ;;;; ;;; Author: Linus Tolke ;;; Modified by: David Kågedal (defvar lyskom-slow-mode-map (make-sparse-keymap) "Mode map for the `slow' lyskom command mode.") (define-key lyskom-slow-mode-map "\r" 'kom-parse-command-and-execute) (define-key lyskom-slow-mode-map "\t" 'kom-expand-slow-command) (define-key lyskom-slow-mode-map " " 'kom-expand-slow-or-next-command) (defun lyskom-get-entered-slow-command () "Get the text that the user has entered after the last prompt. Note that this function leaves point at the end of the prompt. If no text is entered, nil is returned." (goto-char (point-max)) (save-restriction (when (> lyskom-last-viewed (point-max)) (setq lyskom-last-viewed (point-max))) (narrow-to-region lyskom-last-viewed (point-max)) (if (search-backward lyskom-current-prompt-text nil t) (forward-char (length lyskom-current-prompt-text)) (goto-char (point-max)) (beginning-of-line)) (when (looking-at "\\(\\s-+\\)") (goto-char (match-end 0)))) (if (= (point) (point-max)) nil (buffer-substring (point) (point-max)))) (defun kom-expand-slow-command () "Tries to complete the command at point. If the completion was exact return a pair `(COMMAND . POINT)' where COMMAND is the command and POINT is the point where the command text starts. If the completion was not exact it returns nil." (interactive) (let* ((text (lyskom-get-entered-slow-command)) (completion-ignore-case t) (alternatives (mapcar (function (lambda (pair) (cons (cdr pair) (car pair)))) (lyskom-get-strings lyskom-commands 'lyskom-command))) (completes (and text (all-completions text alternatives))) (command nil)) (cond ((null text) (lyskom-beep t)) ((null completes) (lyskom-insert-before-prompt (lyskom-get-string 'no-such-command)) (lyskom-beep t)) ((= (length completes) 1) (setq command (cons (cdr (assq (car completes) alternatives)) (point))) (delete-region (point) (point-max)) (insert (car completes))) ((> (length completes) 1) (let ((longest (try-completion text alternatives))) (cond ((eq longest 't) (delete-region (point) (point-max)) (insert (car completes))) ((stringp longest) (if (string= (upcase longest) (upcase text)) (lyskom-format-insert-before-prompt 'command-completions (mapconcat 'identity completes "\n "))) (delete-region (point) (point-max)) (insert longest)) (t (signal 'lyskom-internal-error '())))))) command)) (defun kom-expand-slow-or-next-command () "If any part of a slow command has been entered, call `kom-expand-slow-command'. Otherwise, do `kom-next-command'." (interactive) (if (lyskom-get-entered-slow-command) (kom-expand-slow-command) (buffer-disable-undo) (kom-next-command))) (defun kom-parse-command-and-execute () "Reads a command from the last line in the buffer and executes it." (interactive) (let* ((text (lyskom-get-entered-slow-command)) (command (and text (kom-expand-slow-command)))) (buffer-disable-undo) (cond ((null text) (call-interactively 'kom-next-command)) (command (delete-region (cdr command) (point-max)) (call-interactively (car command)))))) (defun kom-slow-mode () "Starts the slow-command-mode." (interactive) (lyskom-start-of-command 'kom-slow-mode) (unless lyskom-slow-mode (setq lyskom-saved-read-only buffer-read-only) (setq lyskom-slow-mode t) (setq buffer-read-only nil) (use-local-map lyskom-slow-mode-map)) (lyskom-end-of-command)) (defun kom-quick-mode () "Starts the quick-command-mode." (interactive) (lyskom-start-of-command 'kom-quick-mode) (when lyskom-slow-mode (setq buffer-read-only lyskom-saved-read-only) (setq lyskom-slow-mode nil) (use-local-map lyskom-mode-map)) (lyskom-end-of-command)) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;; $Id: elib-string.el,v 44.0.4.2 1999/10/13 12:13:04 byers Exp $ ;;;; This file contains some miscellaneous string functions ;; Copyright (C) 1991-1995 Free Software Foundation ;; Author: Sebastian Kremer ;; Per Cederqvist ;; Inge Wallin ;; Maintainer: elib-maintainers@lysator.liu.se ;; Created: before 9 May 1991 ;; Keywords: extensions, lisp ;;;; This file is part of the GNU Emacs lisp library, Elib. ;;;; ;;;; GNU Elib is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by ;;;; the Free Software Foundation; either version 2, or (at your option) ;;;; any later version. ;;;; ;;;; GNU Elib is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; GNU General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU General Public License ;;;; along with GNU Elib; see the file COPYING. If not, write to ;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;;; Boston, MA 02111-1307, USA ;;;; ;;;; Author: Sebastian Kremer ;;;; sk@thp.Uni-Koeln.DE ;;;; ;;; Commentary: ;;; ;;; This file is part of the elisp library Elib. ;;; It implements simple generic string functions for use in other ;;; elisp code: replace regexps in strings, split strings on regexps. ;;; ;;; NOTE NOTE NOTE NOTE NOTE ;;; ;;; This package has been slightly modified in the following section: (defvar newtext) (defvar string) ;;; Code: (provide 'string) ;; This function is a near-equivalent of the elisp function replace-match ;; which work on strings instead of a buffer. The FIXEDCASE parameter ;; of replace-match is not implemented. (defun string-replace-match (regexp string newtext &optional literal global) "Replace first match of REGEXP in STRING with NEWTEXT. If no match is found, nil is returned instead of the new string. Optional arg LITERAL non-nil means to take NEWTEXT literally. If LITERAL is nil, character `\\' is the start of one of the following sequences: \\\\ will be replaced by a single \\. \\& will be replaced by the text which matched the regexp. \\N where N is a number and 1 <= N <= 9, will be replaced by the Nth subexpression in REGEXP. Subexpressions are grouped inside \\( \\). Optional arg GLOBAL means to replace all matches instead of only the first." (let ((data (match-data))) (unwind-protect (if global (let ((result "") (start 0) matchbeginning matchend) (while (string-match regexp string start) (setq matchbeginning (match-beginning 0) matchend (match-end 0) result (concat result (substring string start matchbeginning) (if literal newtext (elib-string-expand-newtext))) start matchend)) (if matchbeginning ; matched at least once (concat result (substring string start)) nil)) ;; not GLOBAL (if (not (string-match regexp string 0)) nil (concat (substring string 0 (match-beginning 0)) (if literal newtext (elib-string-expand-newtext)) (substring string (match-end 0))))) (store-match-data data)))) (defun elib-string-expand-newtext () ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT. ;; Uses match data and fluid vars `newtext', `string'. ;; Note that in Emacs 18 match data are clipped to current buffer ;; size...so the buffer should better not be smaller than STRING. (let ((pos 0) (len (length newtext)) (expanded-newtext "")) (while (< pos len) (setq expanded-newtext (concat expanded-newtext (let ((c (aref newtext pos))) (if (= ?\\ c) (cond ((= ?\& (setq c (aref newtext (setq pos (1+ pos))))) (substring string (match-beginning 0) (match-end 0))) ((and (>= c ?1) (<= c ?9)) ;; return empty string if N'th ;; sub-regexp did not match: (let ((n (- c ?0))) (if (match-beginning n) (substring string (match-beginning n) (match-end n)) ""))) (t (char-to-string c))) (char-to-string c))))) (setq pos (1+ pos))) expanded-newtext)) (defun string-split (pattern string &optional limit) "Splitting on regexp PATTERN, turn string STRING into a list of substrings. Optional third arg LIMIT (>= 1) is a limit to the length of the resulting list." (let ((data (match-data))) (unwind-protect (let* ((start (string-match pattern string)) (result (list (substring string 0 start))) (count 1) (end (if start (match-end 0)))) (if end ; else nothing left (while (and (or (not (integerp limit)) (< count limit)) (string-match pattern string end)) (setq start (match-beginning 0) count (1+ count) result (cons (substring string end start) result) end (match-end 0) start end))) (if (and (or (not (integerp limit)) (< count limit)) end) ; else nothing left (setq result (cons (substring string end) result))) (nreverse result)) (store-match-data data)))) ;;; string.el ends here ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: option-edit.el,v 44.16.2.2 1999/10/13 12:13:20 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: option-edit.el ;;;; ;;;; Customization for LysKOM ;;;; (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: option-edit.el,v 44.16.2.2 1999/10/13 12:13:20 byers Exp $\n")) (lyskom-external-function widget-default-format-handler) (lyskom-external-function popup-mode-menu) ;;; ====================================================================== ;;; Require Per Abrahamsens widget package, version 0.991 or later. ;;; ;;; ====================================================================== ;;; Global variables (defvar lyskom-widgets nil "List of widgets in the customize buffer.") (defvar lyskom-customize-buffer-format '("\n" (lyskom bold centered) "\n\n" lyskom-doc "\n\n" [kom-customize-format] "\n\n" section (look-and-feel-misc bold centered) section "\n" [kom-default-language] [kom-show-namedays] "\n" [kom-idle-hide] [kom-show-where-and-what] "\n" [kom-friends] "\n" [kom-presence-messages] [kom-presence-messages-in-buffer] "\n" [kom-page-before-command] "\n\n" section (window-locations bold centered) section "\n" (windows-where bold centered) "\n" windows-doc "\n\n" [kom-customize-in-window] [kom-edit-filters-in-window] [kom-prioritize-in-window] [kom-list-membership-in-window] [kom-write-texts-in-window] [kom-view-commented-in-window] "\n\n" section (audio-cues bold centered) section "\n" [kom-audio-player] "\n" (audio-cues-when bold centered) "\n" audio-cues-doc "\n\n" [kom-ding-on-priority-break] [kom-ding-on-new-letter] [kom-ding-on-wait-done] [kom-ding-on-common-messages] [kom-ding-on-group-messages] [kom-ding-on-personal-messages] [kom-ding-on-no-subject] "\n\n" section (reading bold centered) section "\n" [kom-created-texts-are-read] [kom-higher-priority-breaks] [kom-show-footnotes-immediately] [kom-follow-comments-outside-membership] "\n" [kom-default-mark] [kom-membership-default-priority] "\n" [kom-print-number-of-unread-on-entrance] [kom-autowrap] [kom-dashed-lines] [kom-show-author-at-end] "\n\n" section (writing bold centered) section "\n" [kom-cite-string] [kom-ispell-dictionary] "\n" sending-doc "\n\n" [kom-confirm-multiple-recipients] [kom-check-commented-author-membership] [kom-check-for-new-comments] "\n\n" section (urls bold centered) section "\n" [kom-url-viewer-preferences] [kom-mosaic-command] [kom-netscape-command] "\n\n" section (personal-messages bold centered) section "\n" [kom-show-personal-messages-in-buffer] [kom-pop-personal-messages] [kom-default-message-recipient] "\n" (automatic-replies bold centered) "\n" [kom-ansaphone-record-messages] [kom-ansaphone-show-messages] "\n" [kom-ansaphone-default-reply] "\n\n" section (remote-control bold centered) section "\n" [kom-remote-control] [kom-self-control] "\n" [kom-remote-controllers] "\n\n" section (hooks bold centered) section "\n" [kom-login-hook] [kom-do-when-done] )) ;;; ====================================================================== ;;; User functions ;;; (defun lyskom-customize-apply () "Set the variables in the LysKOM buffer according to their values in the customize buffer but do not save them to the server." (interactive) (let ((tmp lyskom-widgets)) (save-excursion (set-buffer lyskom-buffer) (while tmp (set (car (car tmp)) (widget-value (cdr (car tmp)))) (setq tmp (cdr tmp)))))) (eval-when-compile (defvar save-options-init-file nil)) (defun lyskom-customize-send () "Save variables to the server" (save-excursion (set-buffer lyskom-buffer) (lyskom-save-options (current-buffer) (lyskom-get-string 'saving-settings) (lyskom-get-string 'saving-settings-done) (lyskom-get-string 'could-not-save-options)) (let ((var-list nil)) (mapcar (function (lambda (e) (when (and (vectorp e) (symbolp (elt e 0)) (not (memq (elt e 0) lyskom-elisp-variables)) (not (memq (elt e 0) lyskom-global-boolean-variables)) (not (memq (elt e 0) lyskom-global-non-boolean-variables)) (boundp (elt e 0))) (setq var-list (cons (cons (elt e 0) (symbol-value (elt e 0))) var-list))))) lyskom-customize-buffer-format) (let* ((actual-save-options-init-file (or (and (boundp 'save-options-init-file) save-options-init-file) (and (not (equal user-init-file "")) user-init-file) (and (eq system-type 'ms-dos) (concat "~" (user-login-name) "/_emacs")) (concat "~" (user-login-name) "/.emacs"))) (init-output-buffer (find-file-noselect actual-save-options-init-file)) (init-output-marker nil)) (save-excursion (set-buffer init-output-buffer) ;; ;; Find and delete the previously saved data, and position to write. ;; (goto-char (point-min)) (if (re-search-forward "^;;; LysKOM Settings *\n" nil 'move) (let ((p (match-beginning 0))) (goto-char p) (or (re-search-forward "^;;; End of LysKOM Settings *\\(\n\\|\\'\\)" nil t) (error "can't find END of saved state in .emacs")) (delete-region p (match-end 0))) (goto-char (point-max)) (insert "\n")) (setq init-output-marker (point-marker))) (let ((standard-output init-output-marker)) (princ ";;; LysKOM Settings\n") (princ ";;; =====================\n") (mapcar (function (lambda (x) (princ (format "(setq %S %s%S)\n" (car x) (cond ((symbolp (cdr x)) "'") ((listp (cdr x)) "'") (t "")) (cdr x))))) var-list) (princ ";;; ============================\n") (princ ";;; End of LysKOM Settings\n")) (set-marker init-output-marker nil) (save-excursion (set-buffer init-output-buffer) (save-buffer)) )))) (defun lyskom-customize-save () "Apply changes and save them to the server." (interactive) (lyskom-customize-apply) (lyskom-customize-send)) (defun lyskom-customize-quit () "Quit the customize buffer without saving" (interactive) (let ((buf (current-buffer))) (lyskom-undisplay-buffer buf) (kill-buffer buf))) (defun lyskom-customize-save-and-quit () "Save and quit the customize buffer" (interactive) (lyskom-customize-apply) (lyskom-customize-send) (lyskom-customize-quit)) (defun lyskom-customize-help () (interactive) (message (lyskom-get-string 'customize-help))) (defun lyskom-widget-click (event) (interactive "e") (let ((pos (event-point event))) (if (and pos (widget-at pos)) (widget-button-click event) (popup-mode-menu)))) (defun kom-customize () "Open the customize buffer" (interactive) (let ((buf (lyskom-get-buffer-create 'customize (lyskom-format (lyskom-custom-string 'buffer-name) lyskom-server-name) t))) (unwind-protect (progn (lyskom-start-of-command 'kom-customize) (save-excursion (set-buffer buf) (kill-all-local-variables) (make-local-variable 'lyskom-widgets) (setq lyskom-widgets nil) (let ((inhibit-read-only t)) (erase-buffer)) (use-local-map lyskom-customize-map) (condition-case nil (copy-face 'kom-active-face 'widget-button-face) (error nil)) (mapcar 'lyskom-custom-insert lyskom-customize-buffer-format) (widget-setup) (mapcar (function (lambda (variable) (widget-value-set (cdr variable) (save-excursion (set-buffer lyskom-buffer) (symbol-value (car variable)))))) lyskom-widgets) (widget-setup)) (lyskom-display-buffer buf)) (save-excursion (set-buffer lyskom-buffer) (lyskom-end-of-command))) (goto-char (point-min)))) ;;; ============================================================ ;;; Non-user functions ;;; (defun lyskom-custom-insert (w) (cond ((symbolp w) (widget-insert (substitute-command-keys (lyskom-custom-string w)))) ((listp w) (let ((start (point)) (end nil) (inhibit-read-only t)) (widget-insert (lyskom-custom-string (car w))) (setq end (point)) (mapcar (function (lambda (fn) (funcall (intern (concat "lyskom-custom-insert-" (symbol-name fn))) start end))) (cdr w)))) ((stringp w) (widget-insert w)) ((vectorp w) (setq lyskom-widgets (cons (cons (aref w 0) (lyskom-create-widget (aref w 0))) lyskom-widgets))))) (defun lyskom-custom-insert-bold (s e) (add-text-properties s e (list 'face 'bold 'end-closed nil))) (defun lyskom-custom-insert-centered (s e) (save-excursion (goto-char s) (center-line 1))) (defun lyskom-custom-get-value (var) (save-excursion (set-buffer lyskom-buffer) (symbol-value var))) (defun lyskom-custom-string (s) (lyskom-get-string s 'lyskom-custom-strings)) (defvar lyskom-custom-variables '((kom-emacs-knows-iso-8859-1 (toggle (yes no))) (kom-write-texts-in-window (open-window)) (kom-list-membership-in-window (open-window)) (kom-edit-filters-in-window (open-window)) (kom-prioritize-in-window (open-window)) (kom-customize-in-window (open-window)) (kom-view-commented-in-window (open-window)) (kom-edit-filters-in-window (open-window)) (kom-list-membership-in-window (open-window)) (kom-customize-format (choice ((const (long-format long)) (const (short-format short))))) (kom-default-language (language-choice)) (kom-user-prompt-format (string)) (kom-user-prompt-format-executing (string)) (kom-cite-string (string)) (kom-created-texts-are-read (toggle (yes no))) (kom-default-mark (choice ((number (1 255) :tag selected-mark :format "%[%t%] (%v)" :size 0) (const (ask nil))))) (kom-reading-puts-comments-in-pointers-last (toggle (before after))) (kom-autowrap (choice ((const (on t)) (const (off nil)) (number nil :tag max-text-length)))) (kom-dashed-lines (toggle (on off))) (kom-show-author-at-end (toggle (on off))) (kom-print-number-of-unread-on-entrance (toggle (yes no))) (kom-presence-messages (choice ((const (on t)) (repeat (person nil :tag name) :tag some-persons :menu-tag some-persons)))) (kom-presence-messages-in-buffer (choice ((const (on t)) (repeat (person nil :tag name) :tag some-persons :menu-tag some-persons)))) (kom-show-where-and-what (toggle (yes no))) (kom-idle-hide (number)) (kom-show-footnotes-immediately (toggle (yes no))) (kom-follow-comments-outside-membership (toggle (yes no))) (kom-read-depth-first (toggle (depth-first time-order))) (kom-continuous-scrolling (toggle (on off))) (kom-deferred-printing (toggle (on off))) (kom-higher-priority-breaks (choice ((const (express-break express)) (const (break t)) (const (no-break nil))))) (kom-login-hook (repeat (command nil :tag command))) (kom-do-when-done (repeat (choice ((command nil :tag command) (kbd-macro nil :tag kbd-macro)) :tag execute :help-echo select-what-to-execute :format "%[%t%] %v"))) (kom-page-before-command (choice ((const (page-none nil)) (const (page-all t)) (repeat (command nil :tag command) :tag page-some :menu-tag page-some :format "%[%t%] %v" :value (kom-view-next-text))) :format "%[%t%] %v")) (kom-permissive-completion (noggle (on off))) (kom-membership-default-priority (choice ((const (ask-every-time nil)) (number (0 255) :tag fixed-priority :help-echo select-priority :format "%[%t%] (%v)" :size 0)))) (kom-show-personal-messages-in-buffer (choice ((const (messages-in-lyskom-buffer t)) (const (discard-messages nil)) (string nil :tag in-named-buffer :help-echo select-buffer)))) (kom-pop-personal-messages (toggle (yes no))) (kom-ding-on-new-letter (ding)) (kom-ding-on-priority-break (ding)) (kom-ding-on-wait-done (ding)) (kom-ding-on-common-messages (ding)) (kom-ding-on-group-messages (ding)) (kom-ding-on-personal-messages (ding)) (kom-ding-on-no-subject (ding)) (kom-audio-player (file)) (kom-default-message-recipient (choice ((const (everybody-rcpt everybody)) (const (group-rcpt group)) (const (sender-rcpt sender))))) (lyskom-filter-outgoing-messages (noggle (yes no))) (kom-friends (repeat (person nil :tag name))) (kom-url-viewer-preferences (repeat (url-viewer nil :tag viewer-program))) (kom-mosaic-command (file)) (kom-netscape-command (file)) (kom-confirm-multiple-recipients (choice ((const (dont-check nil)) (const (check-before-open before)) (const (check-before-send after) :match (lambda (w v) (and v (not (eq v 'before)))))))) (kom-check-commented-author-membership (toggle (yes no))) (kom-check-for-new-comments (toggle (yes no))) (kom-inhibit-typeahead (noggle (yes no))) (kom-max-buffer-size (choice ((const (no-size-limit nil)) (number nil :tag max-size-in-bytes :help-echo select-buffer-size)))) (kom-ansaphone-record-messages (toggle (yes no))) (kom-ansaphone-show-messages (toggle (yes no))) (kom-ansaphone-default-reply (string nil :format "%[%t%]\n%v")) (kom-remote-control (toggle (on off))) (kom-remote-controllers (repeat (person nil :tag name))) (kom-self-control (toggle (yes no))) (kom-ispell-dictionary (ispell-dictionary)) (kom-show-namedays (toggle (on off))) )) (defvar lyskom-widget-functions '((toggle . lyskom-toggle-widget) (noggle . lyskom-toggle-widget-inverse) (ding . lyskom-ding-widget) (choice . lyskom-choice-widget) (string . lyskom-string-widget) (number . lyskom-number-widget) (const . lyskom-item-widget) (repeat . lyskom-repeat-widget) (kbd-macro . lyskom-kbd-macro-widget) (url-viewer . lyskom-url-viewer-widget) (ispell-dictionary . lyskom-ispell-dictionary-widget) (open-window . lyskom-open-window-widget) (command . lyskom-command-widget) (person . lyskom-person-widget) (language-choice . lyskom-language-widget) (file . lyskom-file-widget) )) (defun lyskom-make-menu-tag (str) "Make a menu tag from the string STR." (if (string-match "\\(.*\\):\\s-*" str) (match-string 1 str) str)) (defun lyskom-create-widget (variable) (let* ((el (assq variable lyskom-custom-variables)) (dummy (or el (error "Unknown variable: %S" variable))) (spec (lyskom-widget-convert-specification (car (cdr el)))) (tag-sym (intern (concat (symbol-name variable) "-tag"))) (doc-sym (intern (concat (symbol-name variable) "-doc"))) (help-sym (intern (concat (symbol-name variable) "-help"))) (value (save-excursion (set-buffer lyskom-buffer) (symbol-value variable)))) (ignore value help-sym dummy) ; Are they ever used? (setq spec (cons (car spec) (append (list ':tag (lyskom-custom-string tag-sym) ':menu-tag (lyskom-make-menu-tag (lyskom-custom-string tag-sym)) ':value (lyskom-custom-get-value variable) ':help-echo (lyskom-format (lyskom-custom-string 'default-help-echo) (symbol-name variable)) ) (cdr spec)))) (let ((widget (apply 'widget-create spec))) (condition-case nil (progn (lyskom-custom-string doc-sym) (widget-insert " ") (widget-create 'lyskom-widget-help ':value (lyskom-default-value 'kom-customize-format) ':help-echo (if (eq (lyskom-default-value 'kom-customize-format) 'long) (lyskom-custom-string 'hide-doc) (lyskom-custom-string 'show-doc)) ':args (list (list 'long "\n%s\n\n" (lyskom-custom-string doc-sym) (lyskom-custom-string 'hide-doc) "!") (list 'short "%s" "" (lyskom-custom-string 'show-doc) "?")) ':format "%[[%T]%]\n%D")) (error (widget-insert "\n"))) widget))) (defun lyskom-widget-convert-specification (spec) "Convert a LysKOM widget specification to something widget-create accepts" (let ((convertfn (assq (car spec) lyskom-widget-functions))) (if (null convertfn) (error "Unknown widget type: %S" spec)) (nconc (funcall (cdr convertfn) (car spec) (car (cdr spec)) (car (cdr (cdr spec)))) (lyskom-widget-convert-props spec)))) (defun lyskom-widget-convert-props (spec) "Convert widget properties to a format that widget-create likes" (let ((propl (nthcdr 2 spec)) (result)) (if (/= 0 (% (length propl) 2)) (error "Widget property list has odd length: %S" spec)) (while propl (setq result (cons (car propl) result)) (setq propl (cdr propl)) (setq result (cons (cond ((symbolp (car propl)) (cond ((eq (car propl) t) t) ((eq (car propl) nil) nil) (t (lyskom-custom-string (car propl))))) ((and (consp (car propl)) (eq 'quote (car (car propl)))) (car (cdr (car propl)))) (t (car propl))) result)) (setq propl (cdr propl))) (nreverse result))) (defun lyskom-file-widget (type &optional args propl) (list 'file ':format "%[%t%] %v" ':size 0)) (defun lyskom-person-widget (type &optional args propl) (list 'lyskom-name)) (defun lyskom-command-widget (type &optional args propl) (list 'lyskom-command)) (defun lyskom-kbd-macro-widget (type &optional args propl) (list 'lyskom-kbd-macro ':macro-buffer lyskom-buffer)) (defun lyskom-item-widget (type &optional args propl) (list 'item ':format "%t" ':tag (lyskom-custom-string (elt args 0)) ':value (elt args 1))) (defun lyskom-language-widget (type &optional args propl) (list 'menu-choice ':format "%[%t%] %v" ':case-fold t ':args (mapcar (function (lambda (x) (list 'item ':tag (lyskom-language-name (car x)) ':format "%t" ':value (elt x 0)))) lyskom-languages))) (defun lyskom-ispell-dictionary-widget (type &optional args propl) (require 'ispell) (list 'menu-choice ':format "%[%t%] %v" ':case-fold nil ':args (cons (list 'item ':tag "ispell-dictionary" ':format "%t" ':value nil) (delq nil (mapcar (function (lambda (x) (and (car x) (list 'item ':tag (car x) ':format "%t" ':value (car x))))) ispell-dictionary-alist))))) (defun lyskom-url-viewer-widget (type &optional args propl) (list 'menu-choice ':format "%[%v%]\n" ':case-fold t ':help-echo (lyskom-custom-string 'select-url-viewer) ':args (list (list 'item ':tag (lyskom-custom-string 'no-viewer) ':format "%t" ':value nil) (list 'item ':tag (lyskom-custom-string 'default-viewer) ':format "%t" ':value "default") (list 'item ':tag (lyskom-custom-string 'netscape-viewer) ':format "%t" ':value "netscape") (list 'item ':tag (lyskom-custom-string 'emacs-w3-viewer) ':format "%t" ':value "w3") (list 'item ':tag (lyskom-custom-string 'emacs-general-viewer) ':format "%t" ':value "emacs") (list 'item ':tag (lyskom-custom-string 'emacs-dired-viewer) ':format "%t" ':value "dired") (list 'item ':tag (lyskom-custom-string 'emacs-mail-viewer) ':format "%t" ':value "mail-mode") (list 'item ':tag (lyskom-custom-string 'emacs-telnet-viewer) ':format "%t" ':value "telnet-mode") (list 'item ':tag (lyskom-custom-string 'mosaic-viewer) ':format "%t" ':value "mosaic") (list 'item ':tag (lyskom-custom-string 'lynx-viewer) ':format "%t" ':value "lynx")))) (defun lyskom-open-window-widget (type &optional args propl) (list 'menu-choice ':case-fold t ':format "%[%t%] %v" ':args (list (list 'item ':tag (lyskom-custom-string 'other-window) ':format "%t" ':value 'other) (list 'item ':tag (lyskom-custom-string 'other-frame) ':format "%t" ':value 'other-frame) (list 'item ':tag (lyskom-custom-string 'new-frame) ':format "%t" ':value 'new-frame) (list 'item ':tag (lyskom-custom-string 'lyskom-window) ':format "%t" ':value nil) (list 'editable-field ':tag (lyskom-custom-string 'window-on-buffer) ':format "%[%t%]: `%v'" ':value "" ':size 0)))) (defun lyskom-ding-widget (type &optional args propl) (list 'menu-choice ':case-fold t ':format "%[%t%] %v" ':args (list (list 'item ':tag (lyskom-custom-string 'turned-off) ':value nil ':format "%t" ':match '(lambda (w v) (or (null v) (eq v 0)))) (list 'lyskom-number ':tag (lyskom-custom-string 'number-of-times) ':help-echo (lyskom-custom-string 'select-number) ':value "1" ':format "%[%t%]: (%v)" ':size 0 ':min-value 1 ':max-value 255) (list 'lyskom-string ':tag (lyskom-custom-string 'sound-file) ':help-echo (lyskom-custom-string 'select-audio-file) ':size 0)))) (defun lyskom-toggle-widget-inverse (type &optional args propl) (list 'menu-choice ':case-fold t ':format "%[%t%] %v" ':args (list (list 'item ':tag (lyskom-custom-string (elt args 0)) ':value nil ':format "%t") (list 'item ':tag (lyskom-custom-string (elt args 1)) ':value t ':match '(lambda (w v) v) ':format "%t")))) (defun lyskom-toggle-widget (type &optional args propl) (list 'menu-choice ':case-fold t ':format "%[%t%] %v" ':args (list (list 'item ':tag (lyskom-custom-string (elt args 0)) ':value t ':format "%t" ':match '(lambda (w v) v)) (list 'item ':tag (lyskom-custom-string (elt args 1)) ':value nil ':format "%t")))) (defun lyskom-repeat-widget (type &optional args propl) (list 'editable-list ':format "%[%t%]\n%v%i" ':args (list (lyskom-widget-convert-specification args)))) (defun lyskom-choice-widget (type &optional args propl) (list 'menu-choice ':case-fold t ':format "%[%t%] %v" ':args (mapcar 'lyskom-widget-convert-specification args))) (defun lyskom-string-widget (type &optional args propl) (list 'lyskom-string ':size 0 ':format "%[%t%] `%v'")) (defun lyskom-number-widget (type &optional args propl) (if args (list 'lyskom-number ':min-value (elt args 0) ':max-value (elt args 1) ':size 0) (list 'lyskom-number ':size 0))) ;;; ====================================================================== ;;; Generic LysKOM widget functions ;;; (defun lyskom-widget-value-get (widget) (widget-get widget ':value)) (defun lyskom-widget-value-delete (widget) (set-marker (widget-get widget ':value-from) nil) (set-marker (widget-get widget ':value-to) nil)) (defun lyskom-widget-value-to-external (widget value) value) (defun lyskom-widget-value-to-internal (widget value) value) (defun lyskom-widget-invalid-value (widget) (widget-put widget ':error (lyskom-format (lyskom-custom-string 'invalid-value) (widget-value widget))) widget) ;;; ;;; The Person Widget ;;; (defun lyskom-widget-name-action (widget &optional event) (widget-value-set widget (save-excursion (set-buffer lyskom-buffer) (lyskom-read-conf-no (lyskom-custom-string (cond ((widget-get widget ':lyskom-prompt) (widget-get widget ':lyskom-prompt)) ((and (memq 'pers (widget-get widget ':lyskom-predicate)) (memq 'conf (widget-get widget ':lyskom-predicate))) 'which-conf-or-person) ((memq 'pers (widget-get widget ':lyskom-predicate)) 'which-person) ((memq 'conf (widget-get widget ':lyskom-predicate)) 'which-conf) (t 'which-name))) (widget-get widget ':lyskom-predicate) nil nil t))) (widget-setup)) (defun lyskom-widget-name-value-create (widget) (let* ((size (widget-get widget ':size)) (value (widget-get widget ':value)) (from (point)) (string (save-excursion (set-buffer lyskom-buffer) (cond ((or (null value) (eq 0 value)) "") (t (or (conf-stat->name (blocking-do 'get-conf-stat value)) (lyskom-format (lyskom-custom-string 'some-person) value))))))) (if (null size) (insert string) (insert string) (if (< (length value) size) (insert-char ?\ (- size (length value))))) (widget-put widget ':value-from (copy-marker from)) (widget-put widget ':value-to (copy-marker (point))) (set-marker-insertion-type (widget-get widget ':value-to) nil) (if (null size) (insert ?\n) (insert ?\ )))) (defun lyskom-widget-name-match (widget value) (and (numberp value) (>= value 0))) (defun lyskom-widget-name-validate (widget) (let ((value (widget-value widget))) (if (and (numberp value) (>= value 0)) nil (lyskom-widget-invalid-value widget)))) (define-widget 'lyskom-name 'default "A LysKOM person" ':format "%[[*]%] %v" ':help-echo (lyskom-custom-string 'change-this-name) ':value 0 ':lyskom-predicate '(pers) ':action 'lyskom-widget-name-action ':value-create 'lyskom-widget-name-value-create ':value-delete 'lyskom-widget-value-delete ':value-get 'lyskom-widget-value-get ':value-to-external 'lyskom-widget-value-to-external ':value-to-internal 'lyskom-widget-value-to-internal ':match 'lyskom-widget-name-match ':validate 'lyskom-widget-name-validate ) (define-widget 'lyskom-name-list 'editable-list "A list of LysKOM commands" ':entry-format "%i %d %v" ':args '(lyskom-name)) ;;; ;;; The Command Widget ;;; (defun lyskom-widget-command-action (widget &optional event) (widget-value-set widget (save-excursion (set-buffer lyskom-buffer) (lyskom-read-extended-command))) (widget-setup)) (defun lyskom-widget-command-value-create (widget) (let* ((size (widget-get widget ':size)) (value (widget-get widget ':value)) (from (point)) (string (save-excursion (set-buffer lyskom-buffer) (cond ((null value) "") (t (or (lyskom-get-string value 'lyskom-command) (lyskom-format (lyskom-custom-string 'unknown-command) (symbol-name value)))))))) (if (null size) (insert string) (insert string) (if (< (length value) size) (insert-char ?\ (- size (length value))))) (widget-put widget ':value-from (copy-marker from)) (widget-put widget ':value-to (copy-marker (point))) (set-marker-insertion-type (widget-get widget ':value-to) nil) (if (null size) (insert ?\n) (insert ?\ )))) (defun lyskom-widget-command-match (widget value) (symbolp value)) (defun lyskom-widget-command-validate (widget) (if (symbolp (widget-value widget)) nil (lyskom-widget-invalid-value widget))) (define-widget 'lyskom-command 'default "A LysKOM command" ':format "%[%t%] %v" ':help-echo (lyskom-custom-string 'select-command) ':value 'kom-display-time ':action 'lyskom-widget-command-action ':value-create 'lyskom-widget-command-value-create ':value-delete 'lyskom-widget-value-delete ':value-get 'lyskom-widget-value-get ':value-to-external 'lyskom-widget-value-to-external ':value-to-internal 'lyskom-widget-value-to-internal ':match 'lyskom-widget-command-match ':validate 'lyskom-widget-command-validate ) (define-widget 'lyskom-command-list 'editable-list "A list of LysKOM commands" ':entry-format "%i %d %v" ':args '(lyskom-command)) ;;; ;;; A new String widget ;;; (defun lyskom-widget-string-action (widget &optional event) (let ((tmp (read-from-minibuffer (format "%s: " (widget-get widget ':tag)) (widget-value widget)))) (widget-value-set widget tmp) (widget-setup))) (define-widget 'lyskom-string 'editable-field "A string" ':format "%[%t%] %v" ':action 'lyskom-widget-string-action) ;;; ;;; A Number widget ;;; (defun lyskom-widget-number-action (widget &optional event) (let ((min (widget-get widget ':min-value)) (max (widget-get widget ':max-value))) (widget-value-set widget (if (and min max) (lyskom-read-num-range min max (concat (widget-get widget ':tag) ": ") t (widget-value widget)) (lyskom-read-number (concat (widget-get widget ':tag) ": ") (widget-value widget)))) (widget-setup))) (defun lyskom-widget-number-value-to-external (widget value) (string-to-int value)) (defun lyskom-widget-number-value-to-internal (widget value) (format "% 4d " value)) (defun lyskom-widget-number-validate (widget) (if (numberp (widget-value widget)) nil (lyskom-widget-invalid-value widget))) (defun lyskom-widget-number-match (widget value) (if (and (widget-get widget ':max-value) (widget-get widget ':min-value)) (and (numberp value) (>= value (widget-get widget ':min-value)) (<= value (widget-get widget ':max-value))) (numberp value))) (define-widget 'lyskom-number 'editable-field "A number" ':format "%[%t%] %v" ':action 'lyskom-widget-number-action ':value-to-external 'lyskom-widget-number-value-to-external ':value-to-internal 'lyskom-widget-number-value-to-internal ':match 'lyskom-widget-number-match ':validate 'lyskom-widget-number-validate) ;;; ;;; Keyboard macro widget ;;; (defun lyskom-widget-kbd-macro-match (widget value) (or (stringp value) (vectorp value))) (defun lyskom-widget-kbd-macro-validate (widget) (if (lyskom-widget-kbd-macro-match widget (widget-value widget)) nil (lyskom-widget-invalid-value widget))) (defun lyskom-widget-kbd-macro-value-create (widget) (let* ((size (widget-get widget ':size)) (value (widget-get widget ':value)) (from (point)) (string (mapconcat 'single-key-description (append value nil) " "))) (if (null size) (insert string) (insert string) (if (< (length string) size) (insert-char ?\ (- size (length string))))) (widget-put widget ':value-from (copy-marker from)) (widget-put widget ':value-to (copy-marker (point))) (set-marker-insertion-type (widget-get widget ':value-to) nil) (if (null size) (insert ?\n) (insert ?\ )))) ;;; ;;; This is a truly disgusting piece of work. In Gnu Emacs it's not ;;; possible to simply read a keyboard macro in a recursive command ;;; loop and have the command loop end when macro definition time is ;;; up, so we start a macro definition, make the normal end-kbd-macro ;;; keys just exit the recursive command loop, go recursive and when ;;; the recursive loop is over, any which way, we see if a macro was ;;; defined and reset the keyboard bindings. ;;; (defun lyskom-widget-end-kbd-macro () (interactive) (exit-recursive-edit)) (defun lyskom-widget-kbd-macro-action (widget &optional event) (let ((tmp last-kbd-macro) (value nil)) (save-window-excursion (unwind-protect (progn (mapcar (function (lambda (k) (define-key global-map k 'lyskom-widget-end-kbd-macro))) (where-is-internal 'end-kbd-macro)) (if (widget-get widget ':macro-buffer) (pop-to-buffer (widget-get widget ':macro-buffer))) (start-kbd-macro nil) (recursive-edit)) (mapcar (function (lambda (k) (define-key global-map k 'end-kbd-macro))) (where-is-internal 'lyskom-widget-end-kbd-macro)) (condition-case e (end-kbd-macro) (error (setq last-kbd-macro nil))))) (setq value (prog1 last-kbd-macro (setq last-kbd-macro tmp))) (if value (progn (widget-value-set widget value) (widget-setup))))) (define-widget 'lyskom-kbd-macro 'default "A Keyboard Macro" ':action 'lyskom-widget-kbd-macro-action ':value "" ':format "%[%t%] %v" ':validate 'lyskom-widget-kbd-macro-validate ':value-create 'lyskom-widget-kbd-macro-value-create ':value-delete 'lyskom-widget-value-delete ':value-get 'lyskom-widget-value-get ':value-to-external 'lyskom-widget-value-to-external ':value-to-internal 'lyskom-widget-value-to-internal ':match 'lyskom-widget-kbd-macro-match) (defun lyskom-widget-help-action (widget &optional event) (let* ((value (widget-get widget ':value)) (spec (assq value (widget-get widget ':args))) (syms (car (cdr (memq spec (widget-get widget ':args)))))) (if (null syms) (setq syms (car (widget-get widget ':args)))) (widget-put widget ':help-echo (elt syms 3)) (widget-value-set widget (car syms)) (widget-setup))) (defun lyskom-widget-help-format-handler (widget escape) (let* ((value (widget-get widget ':value)) (spec (assq value (widget-get widget ':args)))) (cond ((eq escape ?D) (if (widget-get widget ':indent) (insert-char ? (widget-get widget ':indent))) (insert (format (elt spec 1) (elt spec 2)))) ((eq escape ?T) (if (widget-get widget ':indent) (insert-char ? (widget-get widget ':indent))) (insert (elt spec 4))) (t (widget-default-format-handler widget escape))))) (define-widget 'lyskom-widget-help 'push-button "A help widget" ':format "%[[%t]%] %D" ':action 'lyskom-widget-help-action ':format-handler 'lyskom-widget-help-format-handler) ;;;;; -*-coding: raw-text; unibyte: t;-*- ;;;;; ;;;;; $Id: lyskom-rest.el,v 44.50.2.2 1999/10/13 12:13:16 byers Exp $ ;;;;; Copyright (C) 1991, 1996 Lysator Academic Computer Association. ;;;;; ;;;;; This file is part of the LysKOM server. ;;;;; ;;;;; LysKOM is free software; you can redistribute it and/or modify it ;;;;; under the terms of the GNU General Public License as published by ;;;;; the Free Software Foundation; either version 2, or (at your option) ;;;;; any later version. ;;;;; ;;;;; LysKOM is distributed in the hope that it will be useful, but WITHOUT ;;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License ;;;;; for more details. ;;;;; ;;;;; You should have received a copy of the GNU General Public License ;;;;; along with LysKOM; see the file COPYING. If not, write to ;;;;; Lysator, c/o ISY, Linkoping University, S-581 83 Linkoping, SWEDEN, ;;;;; or the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, ;;;;; MA 02139, USA. ;;;;; ;;;;; Please mail bug reports to bug-lyskom@lysator.liu.se. ;;;;; ;;;; ================================================================ ;;;; ================================================================ ;;;; ;;;; File: lyskom-rest.el ;;;; ;;;; This is the rest of what was once the entire source code of the ;;;; client. Now most of the source resides in other files. Eventually ;;;; the functions in here will be distributed out to other files. ;;;; Below follows the original header of the LysKOM elisp client: ;;;; ;;;; ================================================================ ;;;; ;;;; Simple LysKOM elisp client. ;;;; ;;;; Originally written by Per Cederqvist. ;;;; ;;;; Heavily hacked by: ;;;; Thomas Bellman ;;;; Linus Tolke ;;;; Inge Wallin ;;;; David K}gedal ;;;; David Byers ;;;; and others. ;;;; ;;;; Some ideas stolen from lpmud.el written by Lars Willf|r and Thomas Bellman ;;;; ;;;; Conventions: ;;;; ;;;; All functions, variables etc follow one of these conventions: ;;;; lyskom- general functions. ;;;; cache- cache-routines. ;;;; initiate- call a service. (Might look up in cache) ;;;; kom- user kommands. ;;;; lyskom-parse- parse (part of) a reply from the server. ;;;; these are found in parse.el ;;;; lyskom-edit- Things related to the editing of texts. ;;;; {lyskom,kom}-edit-options- ;;;; things related to editing options ;;;; (found in flags.el) ;;;; {lyskom,kom}-prioritize- ;;;; things related to the prioritize ;;;; buffer. The file is prioritize.el ;;;; {lyskom,kom}-{completing-read,completing,complete}- ;;;; things related to ;;;; lyskom-completing-read. Found in ;;;; completing-read.el ;;;; lyskom-*-hook hooks. ;;;; ;;;; Three plus-signs (+++) in the code marks a place where more ;;;; work is needed. ;;;; (require 'lyskom-menus "menus") (setq lyskom-clientversion-long (concat lyskom-clientversion-long "$Id: lyskom-rest.el,v 44.50.2.2 1999/10/13 12:13:16 byers Exp $\n")) (lyskom-external-function find-face) ;;;; ================================================================ ;;;; New errors. (put 'lyskom-protocol-error 'error-conditions '(error lyskom-error lyskom-protocol-error)) (put 'lyskom-protocol-error 'error-message "LysKOM protocol error:") (put 'lyskom-internal-error 'error-conditions '(error lyskom-error lyskom-internal-error)) (put 'lyskom-internal-error 'error-message "Internal LysKOM error.") (put 'lyskom-format-error 'error-conditions '(error lyskom-error lyskom-format-error)) (put 'lyskom-internal-error 'error-message "Internal LysKOM format error.") ;;; ================================================================ ;;; Global variables ;;; (defvar lyskom-unread-mode-line nil) ;;; ================================================================ ;;; Error reporting from a number of commands. ;;; ;;; Author: Inge Wallin (defun lyskom-get-error-text (errno) "Get a string which is the error ERRNO in plain text." (or (lyskom-get-string-internal (intern (concat "error-" (number-to-string errno))) 'lyskom-error-texts) (lyskom-format 'error-not-found errno))) (defun lyskom-report-command-answer (answer) "Handles a void return from call to the server." (if answer (lyskom-insert-string 'done) (lyskom-insert-string 'nope) (lyskom-format-insert 'error-code (lyskom-get-error-text lyskom-errno) lyskom-errno))) ;;; ---------------------------------------------------------------- ;;; Author: Aronsson (defsubst lyskom-tell-string (key) "Retrieve the phrase indexed by the key from the kom-tell-phrases assoc list." (lyskom-get-string key 'kom-tell-phrases)) (defun lyskom-tell-internat (key) "Same as lyskom-tell-server, but use a key to a list of phrases." ;; The server at Lysator produces a lot of network traffic. The ;; solution should to be less verbose. This is very interesting ;; anymore, anyway. (lyskom-tell-server (lyskom-tell-string key))) ;;; Resume operation after a crash. (defun kom-recover (&optional refetch) "Try to recover from an error. If the optional argument REFETCH is non-nil, `lyskom-refetch' is called." (interactive "p") (lyskom-init-parse lyskom-buffer) (setq lyskom-call-data nil) (setq lyskom-pending-calls nil) (setq lyskom-output-queues (make-vector 10 nil)) (let ((i 0)) (while (< i 10) (aset lyskom-output-queues i (lyskom-queue-create)) (++ i))) (setq lyskom-number-of-pending-calls 0) (setq lyskom-is-parsing nil) (if refetch (lyskom-refetch)) (lyskom-tell-internat 'kom-tell-recover) (lyskom-end-of-command)) ;;; ================================================================ ;;; Run default command. ;;; Author: Tommy Persson (defun kom-page-next-command () "Scroll the bottom to the top and run the next command if it should be run" (interactive) (if (pos-visible-in-window-p (point-max)) (progn (goto-char (point-max)) (recenter 0) (lyskom-next-command)) (recenter 0) (move-to-window-line -1) (lyskom-set-last-viewed))) ;;; Author: Lars Willf|r (defun kom-next-command () "Run next command or scroll one page." (interactive) (if (pos-visible-in-window-p (point-max)) (lyskom-next-command) (move-to-window-line -1) (lyskom-set-last-viewed) (lyskom-scroll))) (defun kom-line-next-command () "Run next command or scroll one line." (interactive) (if (pos-visible-in-window-p (point-max)) (lyskom-next-command) (move-to-window-line 1) (lyskom-set-last-viewed) (lyskom-scroll))) ;;; Author: Per Cederqvist (defun lyskom-next-command () "Run next command." (let ((lyskom-doing-default-command t)) (cond ((eq lyskom-command-to-do 'next-pri-text) (lyskom-view-priority-text)) ((eq lyskom-command-to-do 'next-text) (kom-view-next-text)) ((eq lyskom-command-to-do 'next-conf) (kom-go-to-next-conf)) ((eq lyskom-command-to-do 'next-pri-conf) (lyskom-go-to-pri-conf)) ((eq lyskom-command-to-do 'when-done) (let ((command (lyskom-what-to-do-when-done))) (cond ((or (stringp command) (vectorp command)) (execute-kbd-macro command)) ((commandp command) (call-interactively command)) (t (lyskom-start-of-command nil) (lyskom-end-of-command))))) ((eq lyskom-command-to-do 'unknown) (lyskom-insert (lyskom-get-string 'wait-for-server))) (t (signal 'lyskom-internal-error '(kom-next-command)))))) ;;; ================================================================ ;;; View text. (defun kom-initial-digit-view () (interactive) (setq unread-command-events (cons last-command-event unread-command-events)) (call-interactively 'kom-view nil)) (defun kom-view (text-no) "View text number TEXT-NO." (interactive "P") (unwind-protect (progn (let ((kom-page-before-command nil)) (lyskom-start-of-command 'kom-view) (lyskom-tell-internat 'kom-tell-review) ) (if (setq text-no (cond ((null text-no) nil) ((listp text-no) (car text-no)) (t text-no))) nil (setq text-no (lyskom-read-number (lyskom-get-string 'review-text-q) lyskom-current-text))) (if (or (not (listp kom-page-before-command)) (memq 'kom-view kom-page-before-command)) (recenter 1)) (lyskom-tell-internat 'kom-tell-review) (lyskom-format-insert 'review-text-no text-no) (lyskom-view-text text-no)) (lyskom-end-of-command))) ;;;; ================================================================ ;;;; View next text. (defun kom-view-next-new-text () "Display next new text (putting all review constructs at the end of this conf)." (interactive) (let ((len (read-list-length lyskom-reading-list)) (finished nil)) (while (and (not finished) (> len 1)) (let ((type (read-info->type (read-list->first lyskom-reading-list)))) (cond ((or (eq type 'REVIEW) (eq type 'REVIEW-TREE) (eq type 'REVIEW-MARK)) (read-list-rotate lyskom-reading-list)) ((or (eq type 'COMM-IN) (eq type 'FOOTN-IN)) (set-read-list-del-first lyskom-reading-list)) (t (setq finished t)))) (-- len))) (kom-view-next-text)) ;;; Modified to handle filters (def-kom-command kom-view-next-text () "Display next text (from lyskom-reading-list)." (interactive) (lyskom-tell-internat 'kom-tell-read) (let ((action 'next-text)) (while (eq action 'next-text) (if (read-list-isempty lyskom-reading-list) (progn (if (/= 0 lyskom-current-conf) (lyskom-insert-string 'completely-read-conf) (lyskom-insert-string 'not-in-any-conf)) (setq action nil)) (progn (let* ((tri (read-list->first lyskom-reading-list)) (text-no (car (cdr (read-info->text-list tri)))) (type (read-info->type tri)) (priority (read-info->priority (read-list->first lyskom-reading-list))) (is-review-tree (eq type 'REVIEW-TREE)) (is-review (or (eq type 'REVIEW) (eq type 'REVIEW-MARK) is-review-tree)) (mark-as-read (not is-review))) (if is-review (delq text-no (read-info->text-list tri))) ;First entry only (setq action (lyskom-view-text text-no mark-as-read (and kom-read-depth-first (not is-review)) (read-info->conf-stat (read-list->first lyskom-reading-list)) priority is-review-tree (not is-review))) (if mark-as-read (lyskom-is-read text-no) (read-list-delete-text nil lyskom-reading-list) (read-list-delete-text nil lyskom-to-do-list)))))))) ;;; Modified to handle filters ;; This is horribly ugly. It acts like a user command, but it isn't. (defun lyskom-view-priority-text () "Display the first text from the next conference on the lyskom-to-do-list." (lyskom-start-of-command 'kom-view-next-text) (unwind-protect (progn (lyskom-tell-internat 'kom-tell-read) (let* ((tri (read-list->first lyskom-to-do-list)) (priority (read-info->priority (read-list->first lyskom-reading-list))) (text-no (car (text-list->texts (read-info->text-list tri))))) (lyskom-is-read text-no) (lyskom-view-text text-no t nil (read-info->conf-stat tri) priority nil t)) (lyskom-wait-queue 'main)) (lyskom-end-of-command))) (defun lyskom-is-read (text-no) "Remove TEXT-NO from the list of texts to read. Deletes TEXT-NO from lyskom-reading-list and lyskom-to-do-list. Adds info in lyskom-membership. This function only modifies the internal state of the client. It does not mark the text as read in the server. That function is performed by lyskom-mark-as-read." (read-list-delete-text text-no lyskom-reading-list) (read-list-delete-text text-no lyskom-to-do-list) (initiate-get-text-stat 'main 'lyskom-is-read-handler text-no) (setq lyskom-normally-read-texts (cons text-no lyskom-normally-read-texts))) (defun lyskom-is-read-handler (text-stat) "Update lyskom-membership for all recipients to TEXT-STAT." (lyskom-traverse misc (text-stat->misc-info-list text-stat) (if (or (eq 'RECPT (misc-info->type misc)) (eq 'BCC-RECPT (misc-info->type misc)) (eq 'CC-RECPT (misc-info->type misc))) (let ((membership (lyskom-try-get-membership (misc-info->recipient-no misc)))) (if membership (set-membership->read-texts membership (vconcat (vector (misc-info->local-no misc)) (membership->read-texts membership)))))))) ;;; ================================================================ ;;; Go to next conf. (def-kom-command kom-go-to-next-conf () "Go to next conf. Take first conf from lyskom-to-do-list and copy it to lyskom-reading-list. Tell server what the user is doing. If the user is reading a conf it is moved last on lyskom-to-do-list, with priority 0." (interactive) (lyskom-maybe-move-unread t) (lyskom-go-to-next-conf)) (defun lyskom-go-to-pri-conf () "Go to the conf with higher priority. This differs from kom-go-to-next-conf only in the place where the yet unread in the current conf is placed." (lyskom-start-of-command 'kom-go-to-next-conf) (lyskom-maybe-move-unread nil) (lyskom-go-to-next-conf) (lyskom-end-of-command)) (defun lyskom-go-to-next-conf () "Actually go to the next conference on the lyskom-to-do-list" ;; Copy first element on lyskom-to-do-list to lyskom-reading-list. (if (not (read-list-isempty lyskom-to-do-list)) (progn (read-list-enter-first (read-list->first lyskom-to-do-list) lyskom-reading-list) ;; Tell server which conf the user is reading. (let ((conf-stat (read-info->conf-stat (read-list->first lyskom-reading-list)))) (when conf-stat (lyskom-enter-conf conf-stat (read-list->first lyskom-reading-list)) (lyskom-set-mode-line conf-stat)))) (lyskom-insert-string 'all-conf-unread-r) (lyskom-set-mode-line (lyskom-get-string 'all-conf-unread-s)))) (defun lyskom-maybe-move-unread (bury) "Empty the reading list. If the argument BURY is non-nil and there are unread artilces left in the reading list then the conf is inserted last in the to do list." (if (not (read-list-isempty lyskom-reading-list)) (progn (if bury (let ((conf-no nil) (r 0)) (while (and (not conf-no) (< r (read-list-length lyskom-reading-list))) (if (eq (read-info->type (read-list->nth lyskom-reading-list r)) 'CONF) (setq conf-no (conf-stat->conf-no (read-info->conf-stat (read-list->nth lyskom-reading-list r)))) (++ r))) (if conf-no (progn (read-list-delete-read-info conf-no lyskom-to-do-list) (read-list-enter-first (read-list->nth lyskom-reading-list r) lyskom-to-do-list) (read-list-rotate lyskom-to-do-list))))) (set-read-list-empty lyskom-reading-list)))) (defun lyskom-enter-conf (conf-stat read-info) "Tell server which conf the user is reading. Prints the name and amount of unread in the conference we just went to according to the value of kom-print-number-of-unread-on-entrance. Args: CONF-STAT READ-INFO" (lyskom-run-hook-with-args 'lyskom-change-conf-hook lyskom-current-conf (conf-stat->conf-no conf-stat)) (initiate-pepsi 'main nil (conf-stat->conf-no conf-stat)) (setq lyskom-current-conf (conf-stat->conf-no conf-stat)) (let ((num-unread (text-list->length (read-info->text-list read-info)))) (lyskom-format-insert (if (not kom-print-number-of-unread-on-entrance) 'enter-conf (if (= num-unread 1) 'one-unread 'several-unread)) conf-stat num-unread))) ;;;================================================================ ;;; in vars.el: ;(defvar lyskom-sessions-with-unread nil ; "Global variable. List of lyskom-sessions with unread articles.") ;;;Must be called after lyskom-get-string is defined. Also after running ;;;load hooks. ;;;(or (assq 'lyskom-sessions-with-unread minor-mode-alist) ;;; (setq minor-mode-alist (cons (list 'lyskom-sessions-with-unread ;;; (lyskom-get-string 'mode-line-unread)) ;;; minor-mode-alist))) (defun lyskom-set-mode-line (&optional conf) "Sets mode-line-conf-name to the name of the optional argument conf CONF. CONF can be a a conf-stat or a string." (let ((name (cond ((null conf) (if (zerop lyskom-current-conf) (lyskom-get-string 'not-present-anywhere) (initiate-get-conf-stat 'modeline 'lyskom-set-mode-line lyskom-current-conf) nil)) ((stringp conf) conf) ((lyskom-conf-stat-p conf) (conf-stat->name conf)) (t ""))) (unread -1) (total-unread 0) (letters 0) (len 0) (read-info-list nil)) (if (null name) nil ; We didn't have the name. ;; Set unread to the number of unread texts in CONF. (if (lyskom-conf-stat-p conf) (progn (setq read-info-list (read-list->all-entries lyskom-to-do-list)) ;; This was weird. Someone had begun to write an if, but ;; this was all there was: (if (while read-info-list (if (read-info->conf-stat (car read-info-list)) (progn (setq len (text-list->length (read-info->text-list (car read-info-list)))) (if (= (conf-stat->conf-no conf) (conf-stat->conf-no (read-info->conf-stat (car read-info-list)))) (setq unread len)) (if (= lyskom-pers-no (conf-stat->conf-no (read-info->conf-stat (car read-info-list)))) (setq letters len)) (setq total-unread (+ total-unread len)))) (setq read-info-list (cdr read-info-list))))) (if (= unread -1) (setq unread 0)) (if (null name) nil (setq mode-line-conf-name (substring (concat (if (lyskom-conf-stat-p conf) (if (> lyskom-session-priority 0) (format "(%d/%d:%d) " unread total-unread lyskom-session-priority) (format "(%d/%d) " unread total-unread)) "") name (make-string 27 ? )) 0 27))) (if (zerop total-unread) (setq lyskom-sessions-with-unread (delq lyskom-buffer lyskom-sessions-with-unread)) (or (memq lyskom-buffer lyskom-sessions-with-unread) (setq lyskom-sessions-with-unread (cons lyskom-buffer lyskom-sessions-with-unread)))) (if (zerop letters) (setq lyskom-sessions-with-unread-letters (delq lyskom-buffer lyskom-sessions-with-unread-letters)) (or (memq lyskom-buffer lyskom-sessions-with-unread-letters) (setq lyskom-sessions-with-unread-letters (cons lyskom-buffer lyskom-sessions-with-unread-letters))))) (force-mode-line-update))) ;;; ================================================================ ;;; +++Where should this be moved??? (defun lyskom-try-get-membership (conf-no) "Returns non-nil if conference CONF-NO is present on lyskom-membership. The value is actually the membership for the conference. For foreground functions, lyskom-get-membership should probably be used instead. This function does not use blocking-do." (let ((list lyskom-membership) (found nil)) (while (and (not found) (not (null list))) (if (= conf-no (membership->conf-no (car list))) (setq found (car list))) (setq list (cdr list))) found)) (defun lyskom-get-membership (conf-no) "Get the membership for CONF-NO, or nil if the user is not a member of CONF-NO. If the membership list is not fully prefetched and the membership can't be found inlyskom-membership, a blocking call to the server is made." (or (lyskom-try-get-membership conf-no) (and (not (lyskom-membership-is-read)) (let ((membership (blocking-do 'query-read-texts lyskom-pers-no conf-no))) (if (and membership (lyskom-visible-membership membership)) (lyskom-add-membership membership conf-no)) membership)))) ;;;; ================================================================ ;;;; Scrolling and text insertion. (defun lyskom-trim-buffer () "Trim the size of a lyskom buffer to lyskom-max-buffer-size" (save-excursion (if (and kom-max-buffer-size (> (buffer-size) kom-max-buffer-size)) (let ((delchars (- (buffer-size) kom-max-buffer-size)) (inhibit-read-only t)) (goto-char (point-min)) (while (< (point) delchars) (forward-line 1)) (delete-region (point-min) (point)))))) (defun lyskom-scroll () "Scroll screen if necessary. The position lyskom-last-viewed will always remain visible." ;; Find a window to scroll. Scroll the selected window if that shows LysKOM. ;; Otherwise scroll any window currently showing LysKOM. (let ((win (cond ((eq (window-buffer (selected-window)) (current-buffer)) (selected-window)) (t ;(get-buffer-window (current-buffer)) nil)))) (if (and win ;Do nothing if no window showed LysKOM. (not (pos-visible-in-window-p (point-max)))) (progn (goto-char (point-max)) (recenter -1) (if (not (pos-visible-in-window-p lyskom-last-viewed)) (progn (set-window-start win lyskom-last-viewed) (move-to-window-line -1) (vertical-motion 1) (when (not (pos-visible-in-window-p)) (forward-char -1) (when (> (current-column) (window-width)) (backward-char (+ (- (current-column) (window-width)) 2))) ))))))) ;;; ;;; Thanks to the stupid danish fool who wrote the widget package, we ;;; have to do it this way, because w3 uses widgets, and because ;;; widgets use overlays, and because overlays aren't copied between ;;; buffers. If the idiot danish flaming asshole had used text ;;; properties or something equally sensible instead, we could have ;;; managed without this shit. ;;; ;;; (Me, upset? Why would you think *that*?) ;;; (defsubst lyskom-do-insert (string) (let ((start (point))) (insert string) (let ((bounds (next-text-property-bounds 1 (max 1 (1- start)) 'special-insert)) (next (make-marker)) (fn nil)) (while bounds (set-marker next (cdr bounds)) (setq fn (get-text-property (car bounds) 'special-insert)) (remove-text-properties (car bounds) (cdr bounds) '(special-insert)) (funcall fn (car bounds) (cdr bounds)) (setq start next) (setq bounds (next-text-property-bounds 1 start 'special-insert))))) ) (defun lyskom-insert (string) "Insert STRING last in current buffer. Leaves the point at the end of the buffer if possible without scrolling past lyskom-last-viewed (generally the most recent prompt.) Leaves the point at the end of the window if not possible. If buffer is not on screen then doesn't move point. The text is converted according to the value of kom-emacs-knows-iso-8859-1." (let ((was-at-max (= (save-excursion (end-of-line) (point)) (point-max)))) (save-excursion (goto-char (point-max)) (let ((inhibit-read-only t)) (lyskom-do-insert string)) (lyskom-trim-buffer)) (let ((window (get-buffer-window (current-buffer)))) (if (and window was-at-max) (if (pos-visible-in-window-p (point-max) window) (goto-char (point-max)) (and kom-continuous-scrolling (lyskom-scroll))))))) (defun lyskom-insert-at-point (string) "Insert STRING in the current buffer at point. The text is converted according to the value of kom-emacs-knows-iso-8859-1." (let ((inhibit-read-only t)) (lyskom-do-insert string)) (lyskom-trim-buffer)) (defun lyskom-insert-before-prompt (string) "Insert STRING just before the prompt of if no prompt then just buffers. If prompt on screen then do the scroll if necessary. The strings buffered are printed before the prompt by lyskom-update-prompt." ;; ;; This is the policy for moving point: ;; ;; old-point-max is the point-max before the text is inserted ;; new-point-max is the point-max after the text is inserted ;; ;; If point /= old-point-max, leave the point where it is, and don't ;; scroll the window. ;; ;; If point = old-point-max, set it to new-point-max, and if the ;; buffer is in a window, make sure that point is visible. ;; (cond ((and lyskom-executing-command (not (eq lyskom-is-waiting t))) ;; Don't insert the string until the current command is finished. (if (null lyskom-to-be-printed-before-prompt) (setq lyskom-to-be-printed-before-prompt (lyskom-queue-create))) (lyskom-queue-enter lyskom-to-be-printed-before-prompt (list string))) (t ;; For some reaseon save-excursion doesn't work as expected (let ((oldpoint (point-marker))) (goto-char (point-max)) (beginning-of-line) (let ((inhibit-read-only t)) (lyskom-do-insert string)) (goto-char oldpoint)) (let ((window (get-buffer-window (current-buffer)))) (if (and window (not (pos-visible-in-window-p (point) window))) ;; This mease that the prompt has been pushed off the bottom (save-selected-window (select-window window) (recenter -1))))))) (defun lyskom-message (format-string &rest args) "Like message, but converts iso-8859/1 texts to swascii if necessary. Args: FORMAT-STRING &rest ARGS" (let ((str (apply 'format format-string args))) (message "%s" str))) (defun lyskom-error (format-string &rest args) "Like error, but converts iso-8859/1 texts to swascii if necessary. Args: FORMAT-STRING &rest ARGS" (let ((str (apply 'format format-string args))) (error "%s" str))) (defun lyskom-set-last-viewed () (save-excursion (vertical-motion 0) (setq lyskom-last-viewed (point)))) ;;; ================================================================ ;;; Extended string formatting ;;; Author: David Byers ;;; Original code: Inge Wallin (defvar lyskom-format-format "%\\(=\\)?\\(-?[0-9]+\\)?\\(#\\([0-9]+\\)\\)?\\(:\\)?\\([][@MmPpnrtsdoxcCSD]\\)" "regexp matching format string parts.") (defun lyskom-insert-string (atom) "Find the string corresponding to ATOM and insert it into the LysKOM buffer." (lyskom-insert (lyskom-get-string atom))) ;;(defun lyskom-get-string (atom &optional assoc-list) ;; "Get the string corresponding to ATOM and return it." ;; (if (stringp atom) ;; atom ;; (let ((format-pair (assoc atom (or assoc-list lyskom-strings)))) ;; (if (null format-pair) ;; (signal 'lyskom-internal-error ;; (list 'lyskom-get-string ;; (list atom ": string not found"))) ;; (cdr format-pair))))) (defun lyskom-format (format-string &rest argl) (format-state->result (lyskom-do-format format-string argl))) (defun lyskom-format-insert (format-string &rest argl) "Format and insert a string according to FORMAT-STRING. The string is inserted at the end of the buffer with `lyskom-insert'." (let* ((state (lyskom-do-format format-string argl t)) ;; We have to use a marker, because lyskom-insert may trim ;; the buffer size. (start (point-max-marker)) (deferred (format-state->delayed-content state))) (lyskom-insert (format-state->result state)) (while deferred (let ((defer-info (car deferred)) (m (make-marker))) (set-marker m (+ start (defer-info->pos defer-info))) (set-defer-info->pos defer-info m) (lyskom-defer-insertion defer-info) (setq deferred (cdr deferred)))) (set-marker start nil))) (defun lyskom-format-insert-at-point (format-string &rest argl) "Format and insert a string according to FORMAT-STRING. The string is inserted at point." (let* ((state (lyskom-do-format format-string argl t)) (start (point)) (deferred (format-state->delayed-content state))) (lyskom-insert-at-point (format-state->result state)) (while deferred (let ((defer-info (car deferred)) (m (make-marker))) (set-marker m (+ start (defer-info->pos defer-info))) (set-defer-info->pos defer-info m) (lyskom-defer-insertion defer-info) (setq deferred (cdr deferred)))))) (defun lyskom-format-insert-before-prompt (format-string &rest argl) "Format and insert a string according to FORMAT-STRING. The string is inserted just before the prompt, and if the prompt is not currently visible the text is queued to be inserted when the prompt reappears. Note that it is not allowed to use deferred insertions in the text." (lyskom-insert-before-prompt (format-state->result (lyskom-do-format format-string argl)))) (defun lyskom-do-format (format-string &optional argl allow-defer) "Do the actual formatting and return the resulting format-state." (let ((fmt (cond ((stringp format-string) format-string) ((symbolp format-string) (lyskom-get-string format-string)))) (state nil)) (if (null fmt) (signal 'lyskom-internal-error (list 'lyskom-format-insert ": bad format string")) (save-excursion (if (and (boundp 'lyskom-buffer) lyskom-buffer) (set-buffer lyskom-buffer)) (condition-case error (setq state (lyskom-format-aux (make-format-state fmt 0 argl "") allow-defer)) (lyskom-format-error (error "LysKOM internal error formatting %s: %s%s" format-string (nth 1 error) (nth 2 error)))))) state)) ;;; ;;; If you add a format letter, for goodness' sake, don't forget to ;;; att it to the regexp above too! ;;; (defun lyskom-format-aux (format-state allow-defer) (let ((format-length (length (format-state->format-string format-state))) (arg-no nil) (pad-length nil) (format-letter nil) (colon-flag nil) (equals-flag nil) (abort-format nil)) ;; ;; Eat the format string bit by bit ;; (while (and (not abort-format) (< (format-state->start format-state) format-length)) ;; ;; Look for a format letter. If there is none, finish up, ;; otherwise handle each letter separately ;; (if (null (string-match lyskom-format-format (format-state->format-string format-state) (format-state->start format-state))) (progn (set-format-state->result format-state (concat (format-state->result format-state) (substring (format-state->format-string format-state) (format-state->start format-state)))) (set-format-state->start format-state (length (format-state->format-string format-state)))) ;; ;; A format letter has been found ;; (set-format-state->result format-state (concat (format-state->result format-state) (substring (format-state->format-string format-state) (format-state->start format-state) (match-beginning 0)))) (set-format-state->start format-state (match-end 0)) (setq equals-flag (match-beginning 1) pad-length (if (match-beginning 2) (string-to-int (substring (format-state->format-string format-state) (match-beginning 2) (match-end 2))) nil) arg-no (if (match-beginning 4) (string-to-int (substring (format-state->format-string format-state) (match-beginning 4) (match-end 4))) nil) colon-flag (match-beginning 5) format-letter (if (match-beginning 6) (aref (format-state->format-string format-state) (match-beginning 6)) (signal 'lyskom-internal-error (list 'lyskom-format-aux (format-state->format-string format-state))))) ;; ;; If the format letter is an end-of-group letter, abort ;; formatting and return to the caller. ;; (if (= ?\] format-letter) (progn (setq abort-format t) (set-format-state->start format-state (match-end 0))) (setq format-state (lyskom-format-aux-help format-state pad-length arg-no format-letter equals-flag colon-flag (if (and (match-beginning 2) (eq (aref (format-state->format-string format-state) (match-beginning 2)) ?0)) ?0 ? ) allow-defer)))))) (lyskom-tweak-format-state format-state)) (defun lyskom-format-aux-help (format-state pad-length arg-no format-letter equals-flag colon-flag pad-letter allow-defer) (let ((arg nil) (result nil) (propl nil) (prop-adjust-start 0) (prop-adjust-end 0) (oldpos (length (format-state->result format-state))) (abs-length (cond ((null pad-length) nil) ((< pad-length 0) (- 0 pad-length)) (t pad-length)))) (if (and arg-no (< (format-state->args-length format-state) arg-no)) (signal 'lyskom-format-error (list 'lyskom-format ": too few arguments"))) (if arg-no (setq arg (nth (1- arg-no) (format-state->args format-state)))) (if (format-props-p arg) (setq propl (format-props->propl arg) arg (format-props->arg arg))) (cond ;; ;; Format a string or symbol by simply inserting it into the ;; result list ;; ((= format-letter ?s) (setq result (cond ((stringp arg) arg) ((symbolp arg) (symbol-name arg)) (t (signal 'lyskom-format-error (list 'lyskom-format ": argument error")))))) ;; ;; Format a number by conferting it to a string and inserting ;; it into the result list ;; ((or (= format-letter ?d) (= format-letter ?o) (= format-letter ?x)) (setq result (if (integerp arg) (format (format "%%%c" format-letter) arg) (signal 'lyskom-internal-error (list 'lyskom-format ": argument error"))))) ;; ;; Format a character by converting it to a string and inserting ;; it into the result list ;; ((= format-letter ?c) (setq result (if (integerp arg) (char-to-string arg) (signal 'lyskom-internal-error (list 'lyskom-format ": argument error"))))) ;; ;; Format a literal percent character by inserting a string ;; containing it into the result list ;; ((= format-letter ?%) (setq result "%")) ;; ;; Format a command name somewhat specially ;; ((= format-letter ?C) (setq result (cond ((stringp arg) arg) ((vectorp arg) (mapconcat 'single-key-description (append arg nil) " ")) ((and arg (symbolp arg)) (if (memq arg lyskom-commands) (lyskom-command-name arg) (prin1-to-string arg t))) (t (format "(%S)" arg))))) ;; ;; Format a sexp by princing it. Sort of. ;; ((= format-letter ?S) (setq result (format "%S" arg))) ;; ;; Format a text property array indicator by retreiving the ;; properties from the argument list and adding a start of ;; new properties to the format state ;; ((= format-letter ?@) (set-format-state->delayed-propl format-state (cons (cons (length (format-state->result format-state)) arg) (format-state->delayed-propl format-state)))) ;; ;; Format a subformat list by recursively formatting the contents ;; of the list, augmenting the result and format state ;; ;; Idea: If this code used lyskom-do-format instead, we could ;; use it to truncate a complex format by using a format string ;; such as: "%17[ %#1s will be truncated %]" ;; ;; This could be useful for faster response when deferring ;; printing. But this function would become more complex and ;; slower. ;; ((= format-letter ?\[) (setq format-state (lyskom-format-aux format-state allow-defer) result nil)) ;; ;; Format a conference or person name by retreiving information ;; about the conference or person and inserting it as a button ;; (unless the colon flag is set) ;; ((or (= format-letter ?M) (= format-letter ?P)) (setq result (cond ;; The string is already supplied ((stringp arg) arg) ;; Conference 0 does not exist, and person 0 means anonymous ((and (integerp arg) (zerop arg)) (setq colon-flag t) (lyskom-format (cond ((= format-letter ?P) (or lyskom-default-pers-string 'person-is-anonymous)) ((= format-letter ?M) (or lyskom-default-conf-string 'conference-does-not-exist))) arg) ) ;; Delay the printing ((and allow-defer kom-deferred-printing (integerp arg)) (let ((tmp (cache-get-conf-stat arg))) (if (null tmp) (let* ((format-element (concat "%#2@%" (if equals-flag "=" "") (if pad-length (int-to-string pad-length)) "#1" (if colon-flag ":" "") (char-to-string format-letter))) (defer-info (lyskom-create-defer-info 'get-conf-stat arg 'lyskom-deferred-insert-conf oldpos (if pad-length (if equals-flag (abs pad-length) (max (length lyskom-defer-indicator) (abs pad-length))) (length lyskom-defer-indicator)) format-element lyskom-default-conf-string))) (set-format-state->delayed-content format-state (cons defer-info (format-state->delayed-content format-state))) lyskom-defer-indicator) (setq arg tmp) (conf-stat->name arg)))) ;; Find the name and return it ((integerp arg) (let ((conf-stat (blocking-do 'get-conf-stat arg))) (if (null conf-stat) (lyskom-format (if (= format-letter ?P) 'person-does-not-exist 'conference-does-not-exist) arg) (conf-stat->name conf-stat)))) ;; We got a conf-stat, and can use it directly ((lyskom-conf-stat-p arg) (conf-stat->name arg)) ;; Something went wrong (t (signal 'lyskom-internal-error (list 'lyskom-format ": argument error"))))) (if (and (not colon-flag) (or (lyskom-conf-stat-p arg) (numberp arg))) (setq propl (append (lyskom-default-button (if (= format-letter ?P) 'pers 'conf) arg) propl)))) ;; ;; Format a conference or person number the same way as names, ;; but insert the number rather than the name ;; ((or (= format-letter ?m) (= format-letter ?p)) (setq result (cond ((integerp arg) (int-to-string arg)) ((lyskom-conf-stat-p arg) (int-to-string (conf-stat->conf-no arg))) (t (signal 'lyskom-internal-error (list 'lyskom-format ": argument error"))))) (if (not colon-flag) (setq propl (append (lyskom-default-button (if (= format-letter ?p) 'pers 'conf) arg) propl)))) ;; ;; Format an integer or text-stat as a text number by adding the ;; by inserting a button (unless the colon flag is set) ;; ((= format-letter ?n) (setq result (cond ((integerp arg) (int-to-string arg)) ((lyskom-text-stat-p arg) (int-to-string (text-stat->text-no arg))) (t (signal 'lyskom-internal-error (list 'lyskom-format ": argument error"))))) (if (not colon-flag) (setq propl (append (lyskom-default-button 'text arg) propl)))) ;; ;; Format a subject line by adding the subject face to the text ;; properties and the subject to the result list ;; ((= format-letter ?r) (setq result (cond ((stringp arg) (lyskom-button-transform-text arg)) (t (signal 'lyskom-internal-error (list 'lyskom-format ": argument error"))))) (if (and (not colon-flag) (not (lyskom-face-default-p 'kom-subject-face))) (setq propl (append (list 'face 'kom-subject-face) propl)))) ;; ;; Format a LysKOM text body. Currently this does nothing. It ;; should parse the text for buttons ;; ((= format-letter ?t) ;; +++ One would want to do this before or after, but then ;; buttons will not be visible and other highlighting will ;; disappear. ;; (if (not colon-flag) ;; (setq propl (append (list 'face 'kom-text-face) propl))) (setq result (cond ((stringp arg) (lyskom-format-text-body arg)) ((lyskom-text-p arg) (lyskom-format-text-body (text->text-mass arg))) (t (signal 'lyskom-internal-error (list 'lyskom-format ": argument error")))))) ;; ;; Insert some deferred text ;; ((= format-letter ?D) (setq result (cond ((stringp arg) arg) (t (let ((format-element (concat "%" (if equals-flag "=" "") (if pad-length (int-to-string pad-length)) "#1" (if colon-flag ":" "") "s"))) (set-defer-info->pos arg oldpos) (set-defer-info->del-chars arg (if pad-length (if equals-flag (abs pad-length) (max (length lyskom-defer-indicator) (abs pad-length))) (length lyskom-defer-indicator))) (set-defer-info->format arg format-element)) (set-format-state->delayed-content format-state (cons arg (format-state->delayed-content format-state))) lyskom-defer-indicator)))) ;; ;; The format letter was unknown ;; (t (signal 'lyskom-internal-error (list 'lyskom-format-help format-letter)))) ;; ;; Pad the result to the appropriate length ;; Fix flags so text props go in the right places anyway ;; (cond ((or (null pad-length) (null result)) nil) ((> abs-length (length result)) (let ((padstring (make-string (- abs-length (length result)) pad-letter))) (if (< pad-length 0) ; LEFT justify (progn (setq prop-adjust-end (- (- abs-length (length result)))) (setq result (concat result padstring))) (progn (setq prop-adjust-start (- abs-length (length result))) (setq result (concat padstring result)))))) ((and equals-flag (< abs-length (length result))) (setq result (substring result 0 abs-length)))) (if result (progn (set-format-state->result format-state (concat (format-state->result format-state) result)))) (if (and propl kom-text-properties) (add-text-properties (+ oldpos prop-adjust-start) (+ (length (format-state->result format-state)) prop-adjust-end) propl (format-state->result format-state)))) format-state) (defun lyskom-tweak-format-state (format-state) (let ((dp (format-state->delayed-propl format-state))) (while dp (add-text-properties (car (car dp)) (length (format-state->result format-state)) (cdr (car dp)) (format-state->result format-state)) (setq dp (cdr dp))) (set-format-state->delayed-propl format-state nil)) format-state) ;;; ================================================================ ;;; Text body formatting ;;; Author: David K}gedal ;;; This should be considered an experiment (lyskom-external-function w3-fetch) (lyskom-external-function w3-region) (defun lyskom-format-text-body (text) "Format a text for insertion. Does parsing of special markers in the text." (string-match "^\\(\\S-+\\):" text) (let* ((sym (and (match-beginning 1) (intern (match-string 1 text)))) (fn (cdr (assq sym lyskom-format-special))) (formatted (and fn (funcall fn text)))) (cond (formatted formatted) (kom-text-properties (lyskom-button-transform-text (lyskom-fill-message text))) (t (lyskom-fill-message text))))) (defun lyskom-signal-reformatted-text (how) "Signal that the last text was reformatted HOW, which should be a string in lyskom-messages." (setq lyskom-last-text-format-flags how)) (defun lyskom-w3-region (start end) (unwind-protect (condition-case nil (progn (narrow-to-region start end) (save-excursion (let ((case-fold-search t)) (goto-char start) (while (re-search-forward "]*>" end t) (replace-match "")))) (w3-region start end) (w3-finish-drawing) (add-text-properties (point-min) (point-max) '(end-closed nil))) (error nil)))) (defun lyskom-format-html (text) (when (condition-case e (progn (require 'w3) t) (error nil)) (add-text-properties 0 (length text) '(special-insert lyskom-w3-region) text) (lyskom-signal-reformatted-text 'reformat-html) (substring text 5))) ;;;(defun lyskom-format-html (text) ;;; (condition-case e (require 'w3) (error nil)) ;;; (let ((tmpbuf (lyskom-get-buffer-create 'lyskom-html " lyskom-html" t))) ;;; (unwind-protect ;;; (save-excursion ;;; (set-buffer tmpbuf) ;;; (insert (substring text 5)) ;;; (insert " ") ; So we can adjust the extents ;;; (w3-region (point-max) (point-min)) ;;; (let ((tmp nil)) ;;; (map-extents ;;; (lambda (e x) ;;; (if (zerop (- (extent-start-position e) ;;; (extent-end-position e))) ;;; (set-extent-endpoints e (extent-start-position e) ;;; (1+ (extent-end-position e)))) ;;; (progn ;;; (set-extent-property e 'duplicable t) ;;; (set-extent-property e 'replicable t)) ;;; nil)) ;;; (setq tmp (buffer-string)) ;;; (add-text-properties 0 (length tmp) '(end-closed nil) tmp) ;;; tmp))))) (defun lyskom-format-enriched (text) (if (not (fboundp 'format-decode-buffer)) nil (let ((tmpbuf (lyskom-generate-new-buffer "lyskom-enriched"))) (unwind-protect (save-excursion (set-buffer tmpbuf) (insert (substring text 10)) (format-decode-buffer) (lyskom-signal-reformatted-text 'reformat-enriched) (lyskom-button-transform-text (buffer-string)) ;; (substring (buffer-string) 0 -1) ; Remove the \n ) (kill-buffer tmpbuf))))) ;;; ============================================================ ;;; lyskom-fill-message ;;; Author: David Byers ;;; ;;; Wrap the lines of a message with long lines so they're a little easier ;;; to read. Try to ignore what looks like preformatted text. ;;; ;;; Scan the text line by line, and decide whether to fill or not on a ;;; paragraph by paragraph basis. ;;; ;;; An empty line ends the current paragraph. ;;; ;;; An indented line followed by an unindented line ends the current ;;; paragraph and starts a new one. An indented line followed by the ;;; end of the buffer is also considered a paragraph if we have ;;; started a new paragraph based on indentation at least once before. ;;; ;;; A line that starts with a minus or plus starts a new paragraph. ;;; ;;; An indented line followed by another line indented the same way ;;; starts a new paragraph if we're not already scanning a paragraph. ;;; ;;; Any text seen when not scanning a paragraph starts a new ;;; paragraph. ;;; ;;; When a paragraph is started, filling may be enabled or disabled or ;;; set in a "maybe" state. ;;; ;;; A line that does not look like it belongs to the current paragraph ;;; because it is inndented incorrectly or because it starts with a ;;; strange character disables filling for the entire paragraph. ;;; ;;; A line that is wider than the window enables filling for the ;;; paragraph, unless filling has been disabled earlier. ;;; ;;; Any line containing three whitespace characters in a row, a space ;;; followed by a tab, or a tab followed by a space, or two tabs in a ;;; row, or the beginning or end of a C comment or four hyphens ;;; disables filling for the entire paragraph. ;;; ;;; A paragraph is not filled if filling has been disabled, or if the ;;; difference in line lengths from paragraph to paragraph is ;;; constant. ;;; (defconst lyskom-minimum-triagle-size 3 "Minimum number of lines in a triangle or suchlike.") (defconst lyskom-minimum-brick-size 2 "Minimum number of lines in a brick.") (defun lyskom-fill-message-initial-wrap (current-line-length pos) (cond ((not (aref lyskom-line-start-chars (char-to-int (char-after pos)))) nil) ((> current-line-length fill-column) t) (t 'maybe))) (defsubst lyskom-fill-message-colon-line () "Return non-nil if the current line starts with a colon-like thing." (save-match-data (looking-at "\\S-+\\s-*:"))) (defun lyskom-fill-region (start end &optional justify nosqueeze to-eop) "Fill a region of text, compensating for bugs in Emacs." (save-match-data (let ((fill-column (if nosqueeze (1- fill-column) fill-column))) (when nosqueeze (condition-case nil (save-excursion (goto-char (match-beginning 0)) (backward-char 1) (delete-horizontal-space)) (error nil))) (fill-region start end justify nosqueeze to-eop)))) (defun lyskom-fill-message (text) "Try to reformat a message." (cond ((null kom-autowrap) text) ((and (numberp kom-autowrap) (> (length text) kom-autowrap)) text) (t (save-excursion (set-buffer (lyskom-get-buffer-create 'lyskom-text " lyskom-text" t)) (erase-buffer) (insert text) (goto-char (point-min)) (let ((start (point)) (in-paragraph nil) (wrap-paragraph 'maybe) (length-difference nil) (constant-length nil) (all-lines-colons t) (current-line-length nil) (last-line-length nil) (paragraph-length 0) (eol-point nil) (have-indented-paragraphs nil) (fill-column (cond ((not (integerp fill-column)) (- (window-width) 5)) ((> fill-column (- (window-width) 5)) (- (window-width) 5)) (t fill-column))) (fill-prefix nil) (single-line-regexp "\\(\\S-\\)")) ;; ;; Scan each line ;; (while (not (eobp)) (setq current-line-length (lyskom-fill-message-line-length)) ;; ;; Do some work on checking for constant differences ;; (cond ((null length-difference) (when (and current-line-length last-line-length) (setq length-difference (- current-line-length last-line-length)))) ((eq constant-length 'maybe-not) (setq constant-length nil)) (constant-length (unless (= (- current-line-length last-line-length) length-difference) (setq constant-length 'maybe-not)))) (cond ;; ;; An empty line signifies a new paragraph. If we were scanning ;; a paragraph and it was to be filled, fill it. ;; ((looking-at "^\\s-*$") (when (and in-paragraph (not all-lines-colons) (eq wrap-paragraph t) (or (null constant-length) (and (eq 0 length-difference) (< paragraph-length lyskom-minimum-brick-size)) (and (not (eq 0 length-difference)) (< paragraph-length lyskom-minimum-triagle-size)))) (lyskom-fill-region start (1- (match-beginning 0)) nil t) (lyskom-signal-reformatted-text 'reformat-filled)) (setq start (match-end 0) in-paragraph nil all-lines-colons t wrap-paragraph 'maybe)) ;; ;; We're in a paragraph, but wait! This looks like ;; a LysKOM text! ;; ((looking-at (concat "^" (regexp-quote (lyskom-get-string 'subject)) ".*\n----")) (setq wrap-paragraph nil)) ;; ;; We're in a paragraph, but we see indentation, a dash or ;; something that looks like the end of a LysKOM text. ;; This has to mean something... ;; ((and in-paragraph (looking-at "^\\s-+\\([^\n]*\\)\\(\n\\S-\\|\\'\\)") (or (not (eq (point-max) (match-beginning 2))) have-indented-paragraphs)) (setq have-indented-paragraphs t) (when (and (eq wrap-paragraph t) (not all-lines-colons) (or (and (eq 0 length-difference) (< paragraph-length lyskom-minimum-brick-size)) (and (not (eq 0 length-difference)) (< paragraph-length lyskom-minimum-triagle-size)) (null constant-length))) (lyskom-fill-region start (match-beginning 0) nil t) (lyskom-signal-reformatted-text 'reformat-filled)) (setq start (match-beginning 0) in-paragraph t paragraph-length 0 constant-length t length-difference nil last-line-length nil all-lines-colons (lyskom-fill-message-colon-line) single-line-regexp "\\(\\S-\\)" fill-prefix nil start (match-beginning 0) wrap-paragraph (lyskom-fill-message-initial-wrap current-line-length (match-beginning 1)))) ((and in-paragraph (looking-at "^\\s-*\\(-+\\|\\++\\)\\s-*\\S-")) (when (and (eq wrap-paragraph t) (not all-lines-colons) (or (and (eq 0 length-difference) (< paragraph-length lyskom-minimum-brick-size)) (and (not (eq 0 length-difference)) (< paragraph-length lyskom-minimum-triagle-size)) (null constant-length))) (lyskom-fill-region start (match-beginning 0) nil t) (lyskom-signal-reformatted-text 'reformat-filled)) (setq start (match-beginning 0) in-paragraph t paragraph-length 0 constant-length t length-difference nil all-lines-colons (lyskom-fill-message-colon-line) last-line-length nil single-line-regexp "\\(\\S-\\)" fill-prefix nil start (match-beginning 0) wrap-paragraph (lyskom-fill-message-initial-wrap current-line-length (match-beginning 1)))) ;; ;; Here's a tricky one... We're not in a paragraph, and we ;; see what looks like an indented paragraph. Take care with ;; this one! ;; ((and (not in-paragraph) (looking-at "\\(\\s-+\\)\\S-") (looking-at (concat "\\(\\s-+\\)[^\n]*\n" (match-string 1) "\\(\\S-\\)"))) (setq in-paragraph t paragraph-length 0 constant-length 0 length-difference nil last-line-length nil all-lines-colons (lyskom-fill-message-colon-line) start (match-beginning 0) fill-prefix (match-string 1) single-line-regexp (concat (match-string 1) "\\(\\S-\\)") wrap-paragraph (lyskom-fill-message-initial-wrap current-line-length (match-beginning 2)))) ;; ;; Not in a paragraph, but here comes some text. Let's start ;; a paragraph, shall we? ;; ((and (not in-paragraph) (looking-at "\\s-*\\(\\S-\\)")) (setq in-paragraph t paragraph-length 0 all-lines-colons (lyskom-fill-message-colon-line) constant-length t length-difference nil last-line-length nil start (match-beginning 0) fill-prefix nil single-line-regexp "\\(\\S-\\)" wrap-paragraph (lyskom-fill-message-initial-wrap current-line-length (match-beginning 1)))) ;; ;; We're in a paragraph, but the line looks kind of strange ;; ((and in-paragraph (or (not (looking-at single-line-regexp)) (not (aref lyskom-line-start-chars (char-to-int (char-after (match-beginning 1))))))) (setq wrap-paragraph nil)) ;; ;; We're in a paragraph, the line looks OK, but is long. That ;; means we should probably be filling the paragraph later ;; ((and in-paragraph wrap-paragraph (> current-line-length fill-column)) (setq wrap-paragraph t)) ) ;; ;; Check if the line starts with Foo: ;; (when (and in-paragraph all-lines-colons (not (lyskom-fill-message-colon-line))) (setq all-lines-colons nil)) ;; ;; Certain things are guaranteed to disqualify the ;; current paragraph from wrapping, no matter what. ;; This is where we look for those. ;; (when (and in-paragraph wrap-paragraph) (setq eol-point (save-excursion (end-of-line) (point))) (when (re-search-forward "\ \\(\\S-[ \t][ \t][ \t]+\\S-\ \\|\\S-[ \t]* \t[ \t]*\\S-\ \\|[ \t]*\t [ \t]*\ \\|\\S-\\s-*\t\t\\s-*\\S-\ \\|----\ \\|/\\*\ \\|\\*/\ \\|[^:]//\ \\)" eol-point t) (setq wrap-paragraph nil))) (setq last-line-length current-line-length) (end-of-line) (setq paragraph-length (1+ paragraph-length)) (unless (eobp) (forward-line 1) (beginning-of-line))) ;; ;; We've seen the end of buffer. Fill any unfilled junk. ;; (when (and in-paragraph (not all-lines-colons) (eq wrap-paragraph t) (or (and (eq 0 length-difference) (< paragraph-length lyskom-minimum-brick-size)) (and (not (eq 0 length-difference)) (< paragraph-length lyskom-minimum-triagle-size)) (not (eq constant-length t)))) (lyskom-fill-region start (point) nil t) (lyskom-signal-reformatted-text 'reformat-filled))) ;; ;; Kill off unwanted whitespace at the end of the message ;; (let ((tmp (buffer-string))) (if (string-match "[ \t\n]+\\'" tmp) (substring tmp 0 (match-beginning 0)) tmp)))))) (defun lyskom-fill-message-line-length () (- (save-excursion (end-of-line) (skip-chars-backward " \t") (point)) (point))) ;;; ============================================================ ;;; Beeping and feeping ;;; Faces and colors ;;; (defun lyskom-beep (arg) "Beep. ARG is how to beep. nil means don't beep. t means beep once. A number means beep that number of times (.1 second delay between beeps). A string means start the command kom-audio-player with the string as argument. A symbol other than t means call it as a function." (cond ((null arg)) ((eq t arg) (ding t)) ((numberp arg) (while (> arg 0) (ding t) (sit-for kom-ding-pause-amount) (setq arg (1- arg)))) ((stringp arg) (start-process "audio" nil kom-audio-player arg)) ((and (symbolp arg) (fboundp arg)) (condition-case nil (funcall arg) (error (message "Error in beep function") (beep)))) (t (beep)))) (defun lyskom-face-default-p (f1) "Return t if f1 is undefined or the default face." (lyskom-xemacs-or-gnu (or (not (find-face f1)) (face-equal (find-face f1) (find-face 'default))) (or (not (facep f1)) (face-equal f1 'default)))) ;;;; ================================================================ ;;;; Running in buffer ;;; Author: Linus (defun backward-text (&optional arg) "Searches backwards for a text start and recenters with that text at the top." (interactive "p") (let ((paragraph-start lyskom-text-start) (paragraph-ignore-fill-prefix t)) (backward-paragraph arg)) (beginning-of-line)) (defun forward-text (&optional arg) "Searches forward for a text start and recenters with that text at the top." (interactive "p") (let ((paragraph-start lyskom-text-start) (paragraph-ignore-fill-prefix t)) (forward-paragraph arg))) (defun kom-save-text (&optional arg) "Saves/appends the article before point to a file. The article is determined by a search-backward the same as backward-text and then a forward-text. With an argument ARG the search is done over that number of texts. The name of the file is read using the minibuffer and the default is kom-text." (interactive "p") (let ((buf (lyskom-get-buffer-create 'temp " *kom*-text")) (lyskom-print-complex-dates nil) (list-of-texts nil) (kom-deferred-printing nil) (name nil)) (unwind-protect (save-excursion (while (> arg 0) (backward-text 1) (if (looking-at "\\([0-9]+\\)\\s-") (setq list-of-texts (cons (string-to-int (match-string 1)) list-of-texts) arg (1- arg)) (setq arg 0))) (set-buffer buf) (mapcar (function (lambda (n) (lyskom-view-text n) (goto-char (point-max)) (insert "\n"))) list-of-texts) (setq name (read-file-name (lyskom-format 'save-on-file-q (file-name-nondirectory lyskom-saved-file-name)) (file-name-directory lyskom-saved-file-name) lyskom-saved-file-name nil)) (when (file-directory-p name) (setq name (concat (file-name-as-directory name) (file-name-nondirectory lyskom-saved-file-name)))) (append-to-file (point-min) (point-max) (expand-file-name name)) (setq lyskom-saved-file-name name)) ; (kill-buffer buf) ))) ;;; ================================================================ ;;; Some useful abstractions (defsubst lyskom-membership-highest-index () "Return the number of conferences the user is a member of minus 1. This is the highest index in lyskom-membership that contains data, if positions are counted from 0, as they are." (1- (length lyskom-membership))) ;;; ================================================================ ;;; To-do (defun lyskom-update-prompt (&optional force-prompt-update) "Print prompt if the client knows which command will be default. Set lyskom-current-prompt accordingly. Tell server what I am doing." (if (or lyskom-executing-command (and lyskom-current-prompt lyskom-dont-change-prompt)) nil (let ((to-do (lyskom-what-to-do)) (prompt nil)) (setq lyskom-command-to-do to-do) (cond ((eq to-do 'next-pri-conf) (setq prompt 'go-to-pri-conf-prompt) (or (eq lyskom-current-prompt prompt) (lyskom-beep kom-ding-on-priority-break))) ((eq to-do 'next-pri-text) (setq prompt 'read-pri-text-conf) (or (eq lyskom-current-prompt prompt) (lyskom-beep kom-ding-on-priority-break))) ((eq to-do 'next-text) (setq prompt (let ((read-info (read-list->first lyskom-reading-list))) (cond ((eq 'REVIEW (read-info->type read-info)) 'review-next-text-prompt) ((eq 'REVIEW-TREE (read-info->type read-info)) 'review-next-comment-prompt) ((eq 'REVIEW-MARK (read-info->type read-info)) 'review-next-marked-prompt) ;; The following is not really correct. The text to be ;; read might be in another conference. ((= lyskom-current-conf lyskom-pers-no) 'read-next-letter-prompt) ((eq 'FOOTN-IN (read-info->type read-info)) 'read-next-footnote-prompt) ((eq 'COMM-IN (read-info->type read-info)) 'read-next-comment-prompt) (t 'read-next-text-prompt))))) ((eq to-do 'next-conf) (setq prompt (cond ((eq 'REVIEW-MARK (read-info->type (read-list->first lyskom-to-do-list))) 'go-to-conf-of-marked-prompt) ((/= lyskom-pers-no (conf-stat->conf-no (read-info->conf-stat (read-list->first lyskom-to-do-list)))) 'go-to-next-conf-prompt) (t 'go-to-your-mailbox-prompt)))) ((eq to-do 'when-done) (if (not lyskom-is-writing) (lyskom-tell-server kom-mercial)) (setq prompt (let ((command (lyskom-what-to-do-when-done t))) (cond ((lyskom-command-name command)) ((and (stringp command) (lyskom-command-name (key-binding command)))) (t (lyskom-format 'the-command command)))))) ((eq to-do 'unknown) ;Pending replies from server. (setq prompt nil)) (t (signal 'lyskom-internal-error '(lyskom-update-prompt)))) (when (or force-prompt-update (not (equal prompt lyskom-current-prompt))) (let ((inhibit-read-only t) (prompt-text (if prompt (lyskom-modify-prompt (cond ((symbolp prompt) (lyskom-get-string prompt)) (t prompt))) "")) (was-at-max (eq (point) (point-max)))) (save-excursion ;; Insert the new prompt (goto-char (point-max)) (beginning-of-line) (when lyskom-slow-mode (add-text-properties 0 (length prompt-text) '(read-only t) prompt-text)) (insert-string prompt-text) ;; Delete the old prompt (if lyskom-current-prompt (delete-region (point) (point-max)))) (if was-at-max (goto-char (point-max))) (setq lyskom-current-prompt prompt) (setq lyskom-current-prompt-text prompt-text)))) (lyskom-set-mode-line))) (defun lyskom-modify-prompt (s &optional executing) (lyskom-format-prompt (cond (lyskom-is-administrator (if executing kom-enabled-prompt-format-executing kom-enabled-prompt-format)) (t (if executing kom-user-prompt-format-executing kom-user-prompt-format))) s)) ;(defun lyskom-modify-prompt (s) ; "Modify the LysKOM prompt to reflect the current state of LysKOM." ; (let ((format-string (or kom-prompt-format "%s"))) ; (if (symbolp s) (setq s (lyskom-get-string s))) ; (if lyskom-ansaphone-messages ; (if (> (length lyskom-ansaphone-messages) 0) ; (setq format-string ; (format (lyskom-get-string 'prompt-modifier-messages) ; format-string ; (length lyskom-ansaphone-messages))))) ; (if kom-ansaphone-on ; (setq format-string ; (format (lyskom-get-string 'prompt-modifier-ansaphone) ; format-string))) ; (format format-string s))) (defun lyskom-format-prompt (fmt command) (let ((start 0) (len (length fmt)) (result nil) (tmp nil) (format-letter nil) (messages (length lyskom-ansaphone-messages))) (while (< start len) (setq tmp (string-match "%[][cm Sswp#]" fmt start)) (if tmp (progn (if (> tmp start) (setq result (cons (substring fmt start tmp) result))) (setq format-letter (elt fmt (1- (match-end 0)))) (setq start (match-end 0)) (setq result (cons (cond ((eq format-letter ?\[) (if kom-ansaphone-on "[" "")) ((eq format-letter ?\]) (if kom-ansaphone-on "]" "")) ((eq format-letter ?c) command) ((eq format-letter ?w) (or (conf-stat->name (cache-get-conf-stat lyskom-current-conf)) (lyskom-format 'conference-no lyskom-current-conf))) ((eq format-letter ?S) lyskom-server-name) ((eq format-letter ?s) (or (cdr (assoc lyskom-server-name kom-server-aliases)) lyskom-server-name)) ((eq format-letter ?p) (or (conf-stat->name (cache-get-conf-stat lyskom-pers-no)) (lyskom-format 'person-no lyskom-pers-no))) ((eq format-letter ?#) (number-to-string lyskom-session-no)) ((eq format-letter ?m) (cond ((< messages 1) "") ((= messages 1) (format (lyskom-get-string 'prompt-single-message) messages)) ((> messages 1) (format (lyskom-get-string 'prompt-several-messages) messages)))) ((eq format-letter ?%) "%") ((eq format-letter ?\ ) 'SPC)) result))) (progn (setq result (cons (substring fmt start) result)) (setq start len)))) (lyskom-build-prompt (nreverse result)))) (defun lyskom-build-prompt (data) (let ((result "") (separate nil)) (while data (cond ((stringp (car data)) (cond ((and separate (string-match "\\S-$" result) (string-match "^\\S-" (car data))) (setq result (concat result " " (car data)))) (t (setq result (concat result (car data))))) (setq separate nil)) ((eq (car data) 'SPC) (setq separate t))) (setq data (cdr data))) result)) (defun lyskom-what-to-do () "Check what is to be done. Return an atom as follows: next-pri-text There is a text with higher priority to be read. next-pri-conf There is a conference with higher priority to be read. next-text There are texts on lyskom-reading-list. next-conf There are texts on lyskom-to-do-list. when-done There are no unread texts. unknown There are pending replies." (cond ((and kom-higher-priority-breaks (not (read-list-isempty lyskom-reading-list)) (not (read-list-isempty lyskom-to-do-list)) (let ((type (read-info->type (read-list->first lyskom-reading-list)))) (or (eq kom-higher-priority-breaks 'express) (eq type 'CONF) (eq type 'REVIEW) (eq type 'REVIEW-MARK))) (> (read-info->priority (read-list->first lyskom-to-do-list)) (read-info->priority (read-list->first lyskom-reading-list)))) (if (> (text-list->length (read-info->text-list (read-list->first lyskom-to-do-list))) 1) 'next-pri-conf 'next-pri-text)) ((not (read-list-isempty lyskom-reading-list)) 'next-text) ((not (read-list-isempty lyskom-to-do-list)) 'next-conf) ;; This is not really true. The pretech may still be fetching the ;; membership. One possible way is to test for a non-numeric, ;; non-nil value. Or even better, introduce a test function to ;; isolate the test. (lyskom-membership-is-read 'when-done) (t 'unknown))) (defun lyskom-what-to-do-when-done (&optional nochange) "Returns a command, the next command to do from the kom-do-when-done. If optional argument NOCHANGE is non-nil then the list wont be altered." (condition-case nil (let* ((now (cdr lyskom-do-when-done)) (all (car lyskom-do-when-done)) (next (cond ((and now (eq now all) (cdr all)) (cdr all)) (t all))) (command (cond ((commandp (car now)) (car now)) ((and (car next) (listp (car next)) (not (eq (car (car next)) 'lambda))) (car (setq now (car next)))) (t (or (car (setq now next)) 'kom-display-time))))) (if nochange nil (setq lyskom-do-when-done (cons next (cdr now)))) command) (error (lyskom-insert-before-prompt (lyskom-get-string 'error-in-kom-do-when-done)) (lyskom-beep t) (setq lyskom-do-when-done '((kom-customize kom-display-time) . (kom-edit-options kom-display-time))) 'kom-display-time))) (defun lyskom-prefetch-and-print-prompt () "Prefetch info if needed. Print prompt if not already printed." ;; (if (< (lyskom-known-texts) ;; lyskom-prefetch-conf-tresh) ;; (lyskom-prefetch-conf)) ;; (lyskom-prefetch-text) (if (and lyskom-is-waiting (listp lyskom-is-waiting) (eval lyskom-is-waiting)) (progn (setq lyskom-is-waiting nil) ;;(beep) ;;(lyskom-end-of-command) ;;(if (read-list-isempty lyskom-reading-list) ;; (kom-go-to-next-conf)) ;;(kom-next-command) )) (lyskom-update-prompt)) (defun lyskom-known-texts () "Count how many unread texts the user have, that the client knows about." (apply '+ (mapcar '(lambda (x) (1- (length (read-info->text-list x)))) (read-list->all-entries lyskom-to-do-list)))) ;; ;; Called from among others kom-list-news. ;; ;;(defun lyskom-prefetch-all-confs (num-arg continuation) ;; "Gets all conferences using prefetch. Calls itself recursively. ;;When all confs are fetched then the function in the argument ;;CONTINUATION is called." ;; ;; If all conf-stats are fetched, run the continuation function ;; (if (>= lyskom-last-conf-fetched ;; (1- (length lyskom-membership))) ;; (lyskom-run 'main 'lyskom-run 'prefetch continuation num-arg) ;; ;; ...otherwise fetch next conf-stat. ;; (let ((lyskom-prefetch-conf-tresh lyskom-max-int) ;; (lyskom-prefetch-confs lyskom-max-int)) ;; (lyskom-prefetch-conf)) ;; (lyskom-run 'main 'lyskom-prefetch-all-confs num-arg continuation))) ;; (defun lyskom-prefetch-all-confs () ;; "Gets all conferences using prefetch." ;; (while (not (lyskom-prefetch-done)) ;; (let ((lyskom-prefetch-conf-tresh lyskom-max-int) ;; (lyskom-prefetch-confs lyskom-max-int)) ;; (lyskom-prefetch-conf)) ;; (accept-process-output nil lyskom-apo-timeout-s lyskom-apo-timeout-ms))) ;; +++PREFETCH (defun lyskom-wait-for-membership () "Give a message and wait for it to be prefetched. If the full membership hase been read do nothing." (let ((total (pers-stat->no-of-confs (blocking-do 'get-pers-stat lyskom-pers-no)))) (while (not (lyskom-membership-is-read)) (lyskom-message (lyskom-get-string 'waiting-for-membership) lyskom-membership-is-read total) (sit-for 0) (accept-process-output lyskom-proc 1)))) (defun lyskom-prefetch-all-confs () "Gets all conferences using prefetch." (lyskom-wait-for-membership)) ;; (defun lyskom-list-unread (map membership) ;; "Args: MAP MEMBERSHIP. Return a list of unread texts. ;; The list consists of text-nos." ;; (let ((res nil) ;; (last-read (membership->last-text-read membership)) ;; (read (membership->read-texts membership)) ;; (first (map->first-local map)) ;; (i (length (map->text-nos map))) ;; (the-map (map->text-nos map))) ;; (while (> i 0) ;; (-- i) ;; (cond ;; ((zerop (elt the-map i))) ;Deleted text - do nothing. ;; ((<= (+ first i) last-read)) ;Already read - do nothing. ;; ((lyskom-vmemq (+ i first) read)) ;Already read - do nothing. ;; (t ;Unread - add to list. ;; (setq res (cons ;; (elt the-map i) ;; res))))) ;; res)) ;; (defun lyskom-list-unread (map membership) ;; "Args: MAP MEMBERSHIP. Return a list of unread texts. ;; The list consists of text-nos." ;; (let ((read (membership->read-texts membership)) ;; (first (map->first-local map)) ;; (i (length (map->text-nos map))) ;; (the-map (map->text-nos map))) ;; (while (> i 0) ;; (-- i) ;; ;; The server always send the read texts in sorted order. This ;; ;; means that we can use binary search to look for read texts. ;; (when (lyskom-vmemq (+ i first) read) ;; (aset the-map i 0))) ;; (delq 0 (listify-vector the-map)))) ;; (defun lyskom-list-unread (map membership) ;; "Args: MAP MEMBERSHIP. Return a list of unread texts. ;; The list consists of text-nos." ;; (let ((the-map (map->text-nos map))) ;; (delq 0 (listify-vector the-map)))) (defun lyskom-list-unread (map membership) "Args: MAP MEMBERSHIP. Return a list of unread texts. The list consists of text-nos." (let ((read (membership->read-texts membership)) (first (map->first-local map)) (i (length (map->text-nos map))) (the-map (map->text-nos map))) (when (not (null read)) (while (> i 0) (-- i) ;; The server always send the read texts in sorted order. This ;; means that we can use binary search to look for read texts. ;; It might be a good idea to check for zero, and not do a ;; sarch in that case, but it depends on how big holes there ;; are in the map. In general the extra test is probably a ;; slowdow, but when reading the initial part of the I]M map ;; it would most likely help a lot. (when (lyskom-binsearch (+ i first) read) (aset the-map i 0)))) (delq 0 (listify-vector the-map)))) ;; (defun lyskom-conf-fetched-p (conf-no) ;; "Return t if CONF-NO has been prefetched." ;; (let ((n lyskom-last-conf-received) ;; (result nil)) ;; (while (and (not result) ;; (>= n 0)) ;; (if (= (membership->conf-no (elt lyskom-membership n)) ;; conf-no) ;; (setq result t)) ;; (-- n)) ;; result)) ;;;; ================================================================ (defun lyskom-vmemq (elt vector) "Return t if ELT is a member of (present in) VECTOR." (let ((found nil) (i (length vector))) (while (and (> i 0) (not found)) (-- i) (if (eq elt (aref vector i)) (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 (or first 0) (or last+1 (length vector)))) (defun lyskom-binsearch-internal (num vector first last+1) "Return the index if ELT is a member of the sorted vector VECTOR." (let* ((split (/ (+ first last+1) 2)) (splitval (aref 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) ;; Search the left subtree ((< num splitval) (lyskom-binsearch-internal num vector first split)) ;; Search the left subtree (t (lyskom-binsearch-internal num vector split last+1))))) (defun lyskom-read-num-range (low high &optional prompt show-range default) "Read a number from the minibuffer. Args: LOW HIGH &optional PROMPT SHOW-RANGE with default value DEFAULT. The read number must be within the range [LOW HIGH]. If SHOW-RANGE is non-nil, the prompt will include the range for information to the user." (let ((number (1- low))) (while (or (< number low) (> number high)) (setq number (lyskom-read-number (concat (if prompt prompt (lyskom-get-string 'give-a-number)) (if show-range (format "(%d-%d) " low high) "")) default))) number)) (defun lyskom-read-number (&optional prompt default history) "Read a number from the minibuffer. Optional arguments: PROMPT DEFAULT If DEFAULT is non-nil, it is written within parenthesis after the prompt. DEFAULT could also be of the type which (interactive P) generates. If quit is typed it executes lyskom-end-of-command." (let ((numdefault (cond ((null default) nil) ((integerp default) default) ((listp default) (car default)) (t nil))) (number nil) (numstr nil)) (while (not number) (setq numstr (prog1 (lyskom-read-string (concat (if prompt prompt (lyskom-get-string 'give-a-number)) (if numdefault (format " (%d) " numdefault) " ")) nil history))) (cond ((and (string= numstr "") numdefault) (setq number numdefault)) ((string-match "\\`[0-9]+\\'" numstr) (setq number (string-to-int numstr))) (t (beep)))) number)) (defun lyskom-read-string (prompt &optional initial history) "Read a string from the minibuffer. Arguments: PROMPT INITIAL" (read-string prompt initial history)) (defun ja-or-nej-p (prompt &optional initial-input) "Same as yes-or-no-p but language-dependent. Uses lyskom-message, lyskom-read-string to do interaction and lyskom-get-string to retrieve regexps for answer and string for repeated query." (let ((answer "") (nagging nil)) (while (not (or (string-match (lyskom-get-string 'yes-regexp) answer) (string-match (lyskom-get-string 'no-regexp) answer))) (if nagging (progn (lyskom-message "%s" (lyskom-get-string 'yes-or-no-nag)) (sit-for 2))) (setq answer (lyskom-read-string (concat prompt (lyskom-get-string 'yes-or-no)) initial-input t)) (setq nagging t)) (not (string-match (lyskom-get-string 'no-regexp) answer)))) ;;; ;;; j-or-n-p is similar to y-or-n-p. If optional argument QUITTABLE is ;;; non-nil C-g will abort. ;;; (defun j-or-n-p (prompt &optional quittable) "Same as y-or-n-p but language-dependent. Uses lyskom-message, lyskom-read-string to do interaction and lyskom-get-string to retrieve regexps for answer and string for repeated query." (let ((input-char 0) (cursor-in-echo-area t) (nagging nil)) (while (and (not (char-in-string input-char (lyskom-get-string 'y-or-n-instring))) (not (and (or (eq input-char 7) (eq 'keyboard-quit (lyskom-lookup-key (current-local-map) input-char t))) quittable))) (lyskom-message "%s" (concat (if nagging (lyskom-get-string 'j-or-n-nag) "") prompt (lyskom-get-string 'j-or-n))) (if nagging (beep)) ;; ;; Workaround for Emacs whose read-char does not accept C-g ;; (setq input-char (let ((inhibit-quit t)) (prog1 (read-char) (setq quit-flag nil)))) ;; ;; Redisplay prompt on C-l ;; (if (or (eq input-char 12) (eq 'recenter (lyskom-lookup-key (current-local-map) input-char t))) (setq nagging nil) (setq nagging t))) (if (and quittable (eq input-char 7)) (keyboard-quit)) (char-in-string input-char (lyskom-get-string 'y-instring)))) ;;; lyskom-j-or-n-p, lyskom-ja-or-no-p ;;; These versions no longer perform lyskom-end-of-command ;; Author: Linus Tolke (defun lyskom-j-or-n-p (prompt &optional quittable) "Same as j-or-n-p but performs lyskom-end-of-command if quit." (condition-case nil (j-or-n-p prompt quittable) (quit (signal 'quit "In lyskom-j-or-n-p")))) (defun lyskom-ja-or-nej-p (prompt &optional initial-input) "Same as ja-or-nej-p but performs lyskom-end-of-command if quit." (condition-case nil (ja-or-nej-p prompt initial-input) (quit (signal 'quit "In lyskom-ja-or-nej-p")))) (defun lyskom-membership-< (a b) "Retuns t if A has a higher priority than B. A and B are memberships." (> (membership->priority a) (membership->priority b))) (defun impl () (error "Not implemented")) (defun lyskom-call-hook (hook-name &rest args) "Calls a hook with parameters. If HOOK-NAME is bound, it is either a function name or a list of functions to apply to the ARGS." (if (and (boundp hook-name) (eval hook-name)) (if (listp (eval hook-name)) (mapcar '(lambda (fn) (apply fn args)) (eval hook-name)) (apply (eval hook-name) args)))) ;;; Priority filtering (defun lyskom-visible-membership (membership) "Is this conference visible? Return t is MEMBERSHIPs priority is higher than or equal to lyskom-session-priority and nil otherwise. If MEMBERSHIPs prioriy is 0, it always returns nil." (let ((priority (membership->priority membership))) (and (> priority 0) (>= priority lyskom-session-priority)))) ;;; The filter. (defun lyskom-filter (proc output) "Receive replies from LysKOM server." ; (sit-for 0) ; Why? [Doesn't work in XEmacs 19.14] ; (setq lyskom-apo-timeout-log ; (cons lyskom-apo-timeout lyskom-apo-timeout-log)) (lyskom-reset-apo-timeout) ; Reset accept-process-output timeout (let ((old-match-data (match-data)) ;; lyskom-filter-old-buffer is also changed when starting to edit ;; in function lyskom-edit-text. (lyskom-filter-old-buffer (current-buffer))) (unwind-protect (condition-case nil (progn (setq lyskom-quit-flag nil) (if lyskom-debug-communications-to-buffer (save-excursion (set-buffer (get-buffer-create "*kom*-replies")) (goto-char (point-max)) (princ output (current-buffer)))) (if lyskom-debug-communications-to-buffer (if (not lyskom-debug-what-i-am-doing) (if (not (and (eq ?: (elt output 0)) (eq ?5 (elt output 1)))) (lyskom-debug-insert proc "-----> " output)) (lyskom-debug-insert proc "-----> " output))) (set-buffer (process-buffer proc)) (princ output lyskom-unparsed-marker) ;;+++lyskom-string-skip-whitespace (if quit-flag ; We are allowed to break here. (setq inhibit-quit nil)) ; This will break ; instantly. ;; Keep inhibit-quit set to t (cond ((and (> lyskom-string-bytes-missing 0) (< (length output) lyskom-string-bytes-missing)) (setq lyskom-string-bytes-missing (- lyskom-string-bytes-missing (length output)))) ;; This test makes e.g. startup a lot faster. At least ;; it does when the maps are read in one chunk, which ;; they usually aren't anymore. ((not (string-match "\n" output))) ((null lyskom-is-parsing) ;Parse one reply at a time. (let ((lyskom-is-parsing t)) (unwind-protect (condition-case nil (lyskom-parse-unparsed) ;; Incomplete answers are normal. (lyskom-parse-incomplete)) ;; In case it was changed by the handler. (set-buffer (process-buffer proc))))))) ;; condition-case handler (quit (setq lyskom-quit-flag t)) ;; (lyskom-protocol-error ;; (lyskom-message "%s" (lyskom-get-string 'protocol-error) err)) ) (setq lyskom-quit-flag (or lyskom-quit-flag quit-flag)) (setq quit-flag nil) ;; Restore selected buffer and match data. (store-match-data old-match-data) (when (buffer-live-p lyskom-filter-old-buffer) (set-buffer lyskom-filter-old-buffer))) (sit-for 0))) ;;; The sentinel (defun lyskom-sentinel (proc sentinel) "Handles changes in the lyskom-process." (setq lyskom-sessions-with-unread (delq proc lyskom-sessions-with-unread)) (set-buffer (process-buffer proc)) (lyskom-start-of-command (lyskom-get-string 'process-signal) t) (lyskom-format-insert 'closed-connection sentinel (current-time-string)) (setq mode-line-process (lyskom-get-string 'mode-line-down)) (beep) (lyskom-scroll)) ;;; ================================================================ ;;; Debug buffer (defun lyskom-debug-insert (proc prefix string) (let* ((buf (get-buffer-create lyskom-debug-communications-to-buffer-buffer)) (win (get-buffer-window buf 'visible))) (if win (save-excursion (save-selected-window (select-window win) (let ((move (eobp))) (save-excursion (goto-char (point-max)) (insert "\n" (format "%s" proc) prefix string)) (if move (goto-char (point-max)))))) (save-excursion (set-buffer buf) (goto-char (point-max)) (insert "\n" (format "%s" proc) prefix string))))) ;;; For serious bugs (defun lyskom-really-serious-bug () (let ((debug-on-error t)) (error "Congratulations! You found a serious bug in lyskom.el. Press q to leave this buffer, and please run M-x kom-bug-report afterwards."))) ;;; ================================================================ ;;; Formatting functions for different data types (defun lyskom-format-objects (&rest args) "Arguments: (&rest ARGS). Format ARGS to correct format to send to server. Strings are converted to Hollerith strings. Other objects are converted correctly." (apply 'concat (mapcar 'lyskom-format-object args))) (defun lyskom-format-object (object) (concat " " (cond ((stringp object) (lyskom-format-string object)) ((integerp object) (int-to-string object)) ((null object) "0") ((listp object) (cond ((eq (car object) 'MISC-LIST) (lyskom-format-misc-list (cdr object))) ((eq (car object) 'CONF-TYPE) (lyskom-format-conf-type object)) ((eq (car object) 'PRIVS) (lyskom-format-privs object)) ((eq (car object) 'LIST) (lyskom-format-simple-list (cdr object))) (t (signal 'lyskom-internal-error (list 'lyskom-format-object ": no support for object " object))))) ((eq object t) "1") (t (signal 'lyskom-internal-error (list 'lyskom-format-object ": no support for object " object)))))) (defun lyskom-format-conf-type (conf-type) "Format a CONF-TYPE for output to the server." (concat (lyskom-format-bool (conf-type->rd_prot conf-type)) (lyskom-format-bool (conf-type->original conf-type)) (lyskom-format-bool (conf-type->secret conf-type)) (lyskom-format-bool (conf-type->letterbox conf-type)) (if lyskom-long-conf-types-flag (concat (lyskom-format-bool (conf-type->anarchy conf-type)) (lyskom-format-bool (conf-type->rsv1 conf-type)) (lyskom-format-bool (conf-type->rsv2 conf-type)) (lyskom-format-bool (conf-type->rsv3 conf-type))) ""))) (defun lyskom-format-privs (privs) "Format PRIVS for output to the server." (concat (lyskom-format-bool (privs->wheel privs)) (lyskom-format-bool (privs->admin privs)) (lyskom-format-bool (privs->statistic privs)) (lyskom-format-bool (privs->create_pers privs)) (lyskom-format-bool (privs->create_conf privs)) (lyskom-format-bool (privs->change_name privs)) (lyskom-format-bool (privs->flg7 privs)) (lyskom-format-bool (privs->flg8 privs)) (lyskom-format-bool (privs->flg9 privs)) (lyskom-format-bool (privs->flg10 privs)) (lyskom-format-bool (privs->flg11 privs)) (lyskom-format-bool (privs->flg12 privs)) (lyskom-format-bool (privs->flg13 privs)) (lyskom-format-bool (privs->flg14 privs)) (lyskom-format-bool (privs->flg15 privs)) (lyskom-format-bool (privs->flg16 privs)))) (defun lyskom-format-bool (bool) "Format a BOOL for output to the server." (if bool 1 0)) (defun lyskom-format-misc-list (misc-list) "Format a misc-list for output to the server." (let ((result (format "%d {" (length misc-list)))) (while (not (null misc-list)) (setq result (concat result " " (lyskom-format-misc-item (car misc-list)))) (setq misc-list (cdr misc-list))) (setq result (concat result " }\n")))) (defun lyskom-format-misc-item (misc-item) "Format a misc-item for output to the server." (format "%d %d" (cond ((eq (car misc-item) 'recpt) 0) ((eq (car misc-item) 'cc-recpt) 1) ((eq (car misc-item) 'comm-to) 2) ((eq (car misc-item) 'footn-to) 4) ((eq (car misc-item) 'bcc-recpt) (if lyskom-bcc-flag 15 1))) (cdr misc-item))) (defun lyskom-format-simple-list (list) "Format some kind of list to send to server." (apply 'concat (list (format "%d {" (length list)) (apply 'lyskom-format-objects list) " }\n"))) (defun lyskom-format-string (string) (concat (format "%d" (length string)) "H" string)) ;;;; ================================================================ ;;;; Utility routines. ;;; silent-read was ;; Written by Lars Willf|r ;; Copyright and copyleft Lars Willf|r. ;; Last modified jun 93 by Linus Tolke (defun silent-read (prompt-str) "Read a string in the minibuffer without echoing. One parameter - the prompt string." (interactive "sPrompt string: ") (lyskom-message "%s" prompt-str) (let ((input-string "") (input-char) (cursor-in-echo-area t)) (set-buffer-multibyte nil) (while (not (or (eq (setq input-char (condition-case err (read-char) (error (if (string= "Non-character input-event" (car (cdr err))) ?\r (signal (car err) (cdr err)))))) ?\r) (eq input-char ?\n))) (progn (lyskom-message "%s" prompt-str) (setq input-string (cond ((eq input-char ?\C-?) (if (equal (length input-string) 0) "" (substring input-string 0 -1))) ((eq input-char ?\C-u) "") (t (concat input-string (char-to-string input-char))))))) (message "") input-string)) ;;; This really is a strange thing to do but... ;; (defun lyskom-mode-name-from-host () "Calculate what to identify the buffer with." (let ((server (process-name (get-buffer-process (current-buffer))))) (or (cdr (assoc server kom-server-aliases)) (format "LysKOM(%s)" server)))) ;;; Validation of kom-tell-phrases ;;; ;;; Author: Roger Mikael Adolfsson ;;; This code removed (lyskom-tell-phrases-validate) ;; (if lyskom-is-loaded nil (lyskom-set-language lyskom-language) ;; Build the menus ;; (lyskom-build-menus) (or (memq 'lyskom-unread-mode-line global-mode-string) (setq global-mode-string (append '("" lyskom-unread-mode-line) global-mode-string))) (setq lyskom-unread-mode-line (list (list 'lyskom-sessions-with-unread (lyskom-get-string 'mode-line-unread)) (list 'lyskom-sessions-with-unread-letters (lyskom-get-string 'mode-line-letters)) " ")) ;;; ;;; Set up lyskom-line-start-chars. The reason we do it here is that ;;; char-to-int may not be defined until compatibility.el has been ;;; loaded. ;;; ;;; Should work for emacs-20.3. Doesn't seem to. ;;; string-to-vector is a 20-ism. /mr ;;(setq lyskom-line-start-chars ;; (string-to-vector lyskom-line-start-chars-string)) (if (fboundp 'multibyte-char-to-unibyte) (setq lyskom-line-start-chars (let ((tmp (make-vector 256 nil))) (mapcar (function (lambda (x) (aset tmp (multibyte-char-to-unibyte x) t))) lyskom-line-start-chars-string) tmp)) (setq lyskom-line-start-chars (let ((tmp (make-vector 256 nil))) (mapcar (function (lambda (x) (aset tmp (char-to-int x) t))) lyskom-line-start-chars-string) tmp))) ;;; Formely lyskom-swascii-commands ;;(lyskom-define-language 'lyskom-command 'swascii ;; (mapcar ;; (function (lambda (pair) ;; (cons (car pair) (iso-8859-1-to-swascii (cdr pair))))) ;; (lyskom-get-strings lyskom-commands 'lyskom-command))) ;;(setq lyskom-swascii-header-separator ;; (iso-8859-1-to-swascii lyskom-header-separator)) ;;(setq lyskom-swascii-header-subject ;; (iso-8859-1-to-swascii lyskom-header-subject)) ;;(setq lyskom-swascii-filter-actions ;; (mapcar ;; (function (lambda (pair) ;; (cons (car pair) (iso-8859-1-to-swascii (cdr pair))))) ;; lyskom-filter-actions)) ;;(setq lyskom-swascii-filter-what ;; (mapcar ;; (function (lambda (pair) ;; (cons (car pair) (iso-8859-1-to-swascii (cdr pair))))) ;; lyskom-filter-what)) ;; Setup the queue priorities (lyskom-set-queue-priority 'blocking 9) (lyskom-set-queue-priority 'main 9) (lyskom-set-queue-priority 'sending 9) (lyskom-set-queue-priority 'follow 9) (lyskom-set-queue-priority 'deferred 6) (lyskom-set-queue-priority 'background 6) (lyskom-set-queue-priority 'modeline 6) (lyskom-set-queue-priority 'async 3) (lyskom-set-queue-priority 'prefetch 0) ;;; This should be the very last lines of lyskom.el Everything should ;;; be loaded now, so it's time to run the lyskom-after-load-hook. (run-hooks 'lyskom-after-load-hook) (setq lyskom-is-loaded t)) (lyskom-end-of-compilation) ;;; Local Variables: ;;; eval: (put 'lyskom-traverse 'lisp-indent-hook 2) ;;; end: