Commit 6fc7b8b0 authored by David Kågedal's avatar David Kågedal
Browse files

Ett gäng bugfixar

parent af3b61f8
No preview for this file type
......@@ -60,7 +60,8 @@ don't send a reply.
If none of the elements match, KOM-ANSAPHONE-DEFAULT-REPLY is sent.")
(defvar lyskom-ansaphone-messages nil
"Messages collected by the automatic reply facility.")
"Messages collected by the automatic reply facility.
The most recent message is the first message in the list.")
(defvar lyskom-ansaphone-when-set (current-time-string)
"Time when the auto-reply facility was enabled.")
......@@ -114,7 +115,7 @@ If none of the elements match, KOM-ANSAPHONE-DEFAULT-REPLY is sent.")
(elt msg 2)
(elt msg 3)
'nobeep)))
lyskom-ansaphone-messages)
(reverse lyskom-ansaphone-messages))
(lyskom-format-insert (lyskom-get-string 'ansaphone-message-list-end)))))
......@@ -161,7 +162,9 @@ See kom-ansaphone-on"
(let ((reply (lyskom-ansaphone-find-reply
message-type
(conf-stat->conf-no sender)
(conf-stat->conf-no recipient)
;; Could this be the problem /davidk
(cond ((numberp recipient) recipient)
(t (conf-stat->conf-no recipient)))
text)))
(if (and reply (elt reply 4))
(progn
......
......@@ -205,7 +205,8 @@ this function shall be with current-buffer the BUFFER."
(conf-stat->name conf-stat)))))
(cond
(kom-presence-messages-in-buffer
(lyskom-format-insert-before-prompt 'has-entered-r conf-stat))))
(lyskom-format-insert-before-prompt 'has-entered-r conf-stat
'(face kom-presence-face)))))
(defun lyskom-show-logged-out-person (conf-stat session-no)
......@@ -217,7 +218,8 @@ this function shall be with current-buffer the BUFFER."
(conf-stat->name conf-stat)))))
(cond
(kom-presence-messages-in-buffer
(lyskom-format-insert-before-prompt 'has-left-r conf-stat))))
(lyskom-format-insert-before-prompt 'has-left-r conf-stat
'(face kom-presence-face)))))
(defun lyskom-show-changed-person (personconfstat conf-num doing)
......@@ -252,7 +254,8 @@ this function shall be with current-buffer the BUFFER."
(defun lyskom-is-in-minibuffer ()
"Returns non-nil if I am using the minibuffer for some reading."
(not (zerop (minibuffer-depth))))
(or lyskom-inhibit-minibuffer-messages
(not (zerop (minibuffer-depth)))))
(defun lyskom-show-personal-message (sender recipient message
......@@ -313,7 +316,11 @@ Non-nil NOBEEP means don't beep."
(setq when (substring when 4 19))
(setq when (substring when 11 19)))
(cond ((eq recipient 0) ; Public message
(cond ((or (null recipient) ; Have been seen to be nil when
; listing recorded
; messages. Should it be?
; /davidk
(eq recipient 0)) ; Public message
(lyskom-beep (if (not nobeep) kom-ding-on-common-messages 0))
(lyskom-format 'message-broadcast
(cond
......
......@@ -296,9 +296,11 @@ Ask for the name of the person, the conference to add him/her to."
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."
;; This could be optimized with David Byers multi-hack.
(let ((result (lyskom-try-add-member (blocking-do 'get-conf-stat conf-no)
(blocking-do 'get-conf-stat pers-no)
(blocking-do 'get-pers-stat pers-no))))
(let* ((whereto (blocking-do 'get-conf-stat conf-no))
(who (blocking-do 'get-conf-stat pers-no))
(pers-stat (blocking-do 'get-pers-stat pers-no))
(result (lyskom-try-add-member whereto who pers-stat)))
(lyskom-add-member-answer result whereto who)
(if thendo
(apply thendo data))
result))
......@@ -1042,16 +1044,17 @@ member of."
(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-fixup-and-go-to-conf (conf-stat->conf-no conf))
(lyskom-do-go-to-conf conf
(lyskom-member-p (conf-stat->conf-no conf)))
(lyskom-insert-string 'nope))
(lyskom-insert-string 'no-ok)))))))
(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)))
;; 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)
......
......@@ -663,24 +663,49 @@ on one line."
(if (read-list-isempty lyskom-reading-list)
(lyskom-insert-string 'have-to-be-in-conf-with-unread)
(let ((time (blocking-do 'get-time))
(texts (text-list->texts
(read-info->text-list
(let ((list (read-list->all-entries lyskom-reading-list))
(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))))))
;; Then starts fetching all text-stats and text to list them.
(lyskom-list-summary
(text-list->texts
(read-info->text-list
(let ((list (read-list->all-entries lyskom-reading-list))
(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)))
;; Start fetching all text-stats and text to list them.
(lyskom-insert (format "%-8s%-6s%5s%s%s\n"
(lyskom-get-string 'Texts)
(lyskom-get-string 'Date)
......@@ -696,11 +721,11 @@ on one line."
;; We could do som optimization here.
;; We really don't need the whole text.
)
(lyskom-list-summary text-stat text text-no
(time->year time) (time->yday time)))))))
(lyskom-print-summary-line text-stat text text-no
(time->year time) (time->yday time))))))
(defun lyskom-list-summary (text-stat text text-no year day)
(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.
......@@ -1071,16 +1096,17 @@ Format is 23:29 if the text is written today. Otherwise 04-01."
(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)))
(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)))
(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."
......
......@@ -75,7 +75,7 @@ If EMPTY is non-nil then the empty string is allowed (returns 0).
INITIAL is the initial contents of the input field."
(let (read)
(while (and (string= (setq read
(lyskom-read-conf-name prompt type t initial))
(lyskom-read-conf-name prompt type nil initial))
"")
(not empty)))
(if (string= read "")
......
;;;;;
;;;;; $Id$
;;;;; Copyright (C) 1991 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 1, 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.
;;;;;
;;;; $Id$
;;;; This file contains some miscellaneous string functions
;;;;
;;;; Copyright (C) 1991 Inge Wallin
;;;;
;; Copyright (C) 1991-1995 Free Software Foundation
;; Author: Sebastian Kremer <sk@thp.Uni-Koeln.DE>
;; Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se>
;; 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 1, or (at your option)
;;;; 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,
......@@ -39,66 +23,76 @@
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with GNU Emacs; see the file COPYING. If not, write to
;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;; 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.
;;; 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.
;;;
(provide 'elib-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 elib-string-replace-match (regexp string newtext
&optional literal global)
(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 ( ).
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."
(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))))))
(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 ()
......@@ -135,27 +129,32 @@ Optional arg GLOBAL means to replace all matches instead of only the first."
expanded-newtext))
(defun elib-string-split (pattern string &optional limit)
(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* ((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)))
(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
......@@ -157,7 +157,7 @@ Email-address:\n\nOther:\t")
(retrying-tcp . "Retrying.")
; From parse.el:
; No entries.
(protocol-error . "protocol error: %s")
; From services.el:
(interrupted . "Interrupted\n")
......@@ -436,6 +436,11 @@ The message you were sending to %#1s was:
(Subject . " Subject")
(could-not-read . "You couldn't read the article (%#1d).\n")
(multiple-choice . "There are several alternatives.")
(what-mark-to-list . "List which mark: ")
(you-have-marks . "You have %#1s texts marked with %#2s.\n")
(you-have-marks-all . "You have %#1s marked texts.\n")
(does-not-exist . "Unknown command.") ; Only people fixing bugs or recieving bug-reports should change these:
; Only people fixing bugs or recieving bugg-reports should change these:
......@@ -833,6 +838,7 @@ Text:
(kom-list-persons "List users")
(kom-list-news "List news")
(kom-membership "List subscriptions")
(kom-list-marks "List marks")
(kom-postpone "Postpone reading")
(kom-set-session-priority "Set reading level")
(kom-prioritize "Prioritize conferences")
......@@ -1359,53 +1365,3 @@ Users are encouraged to use their best sense of humor.")
(defun kom-list-files ()
(interactive)
(list-directory "/ftp@ftp.lysator.liu.se:/open"))
(defmacro lyskom-make-face (name &rest body)
(` (if (memq (, name) (face-list))
nil
(,@ body))))
(if (and (eq window-system 'x)
(x-display-color-p))
(progn
(lyskom-make-face 'kom-active-face
(copy-face 'default 'kom-active-face)
(set-face-foreground 'kom-active-face "blue4"))
(lyskom-make-face 'kom-url-face
(copy-face 'default 'kom-url-face)
(set-face-foreground 'kom-url-face "BlueViolet"))
(lyskom-make-face 'kom-me-face
(copy-face 'bold 'kom-me-face)
(set-face-foreground 'kom-me-face "yellow")
(set-face-background 'kom-me-face "black"))
(lyskom-make-face 'kom-highlight-face
(copy-face 'highlight 'kom-highlight-face)
(set-face-foreground 'kom-highlight-face
"midnight blue"))
(lyskom-make-face 'kom-text-face
(copy-face 'default 'kom-text-face))
(lyskom-make-face 'kom-subject-face
(copy-face 'kom-text-face 'kom-subject-face)
(set-face-foreground 'kom-subject-face
"dark green"))
(lyskom-make-face 'kom-text-no-face
(copy-face 'kom-text-face 'kom-text-no-face)))
(progn
(lyskom-make-face 'kom-active-face
(copy-face 'underline 'kom-active-face))
(lyskom-make-face 'kom-url-face
(copy-face 'kom-active-face 'kom-url-face))
(lyskom-make-face 'kom-me-face
(copy-face 'highlight 'kom-me-face))
(lyskom-make-face 'kom-highlight-face
(copy-face 'highlight 'kom-highlight-face))
(lyskom-make-face 'kom-subject-face
(copy-face 'default 'kom-subject-face))
(lyskom-make-face 'kom-text-face
(copy-face 'default 'kom-subject-face))
(lyskom-make-face 'kom-text-no-face
(copy-face 'default 'kom-subject-face))))
......@@ -133,7 +133,9 @@
(mapcar (function cdr)
lyskom-other-clients-user-areas))
; (concat common-block "----------\n" elisp-block)
(lyskom-create-misc-list) optbuf)))))
(lyskom-create-misc-list) optbuf)))
(t
(lyskom-edit-options-done t (current-buffer)))))
(defun lyskom-edit-options-send (text-no optbuf)
......
No preview for this file type
......@@ -135,6 +135,25 @@ Value returned is always nil."
"Decrement the variable VAR and return the value."
(list 'setq var (list '1- var)))
(defmacro when (expr 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)
(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 skip-first-zeros (list)
(while (and list (zerop (car list)))
(setq list (cdr list)))
list)
;; Multiple blocking read from server
......@@ -184,6 +203,7 @@ All the forms in BIND-LIST are evaluated before and symbols are bound."
(put 'blocking-do-multiple 'edebug-form-spec
'(sexp body))
;;; Local Variables:
;;; eval: (put 'lyskom-traverse 'lisp-indent-hook 2)
;;; end:
......@@ -107,7 +107,7 @@ on the value of PLACE. If PLACE is nil, 'after is assumed."
lyskom-personal-message-handlers)))
(t (setcdr (nthcdr (1- (length lyskom-personal-message-handlers))
lyskom-personal-message-handlers)
(cons handlers nil)))))
(cons handler nil)))))
lyskom-personal-message-handlers)))
......
......@@ -822,24 +822,21 @@ functions and variables that are connected with the lyskom-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))
(normal-exit nil))
(unwind-protect
(progn
(let ((inhibit-quit nil))
(cond
((eq key ?=) ;The call succeeded.
(lyskom-parse-success (lyskom-parse-num) lyskom-buffer))
((eq key ?%) ;The call was not successful.
(lyskom-parse-error (lyskom-parse-num) lyskom-buffer))
((eq key ?:) ;An asynchronous message.
(lyskom-parse-async (lyskom-parse-num) lyskom-buffer))))
(setq normal-exit t))
;; In case the command changes buffer.
;; One reply is now parsed. Check if there is yet
;; another reply to parse.
(if normal-exit
(delete-region (point-min) lyskom-parse-pos)))
(key (lyskom-parse-nonwhite-char)))
(condition-case err
(let ((inhibit-quit nil))
(cond
((eq key ?=) ;The call succeeded.
(lyskom-parse-success (lyskom-parse-num) lyskom-buffer))
((eq key ?%) ;The call was not successful.
(lyskom-parse-error (lyskom-parse-num) lyskom-buffer))
((eq 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) (1+ lyskom-parse-pos))
(signal 'lyskom-protocol-error err)))
(goto-char (point-min))
(while (looking-at "[ \t\n\r]")