;;;;; -*-coding: iso-8859-1;-*- ;;;;; ;;;;; $Id$ ;;;;; 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$\n")) (eval-when-compile (require 'lyskom-command "command")) ;;; ================================================================ ;;; 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) "Delete a text. Argument: TEXT-NO" (interactive (list (lyskom-read-text-no-prefix-arg 'what-text-to-delete))) (if text-no (let* ((do-delete t) (text-stat (blocking-do 'get-text-stat text-no)) (num-marks (text-stat->no-of-marks text-stat)) (is-marked-by-me (cache-text-is-marked text-no))) (cond ((null text-stat) (lyskom-report-command-answer nil) (setq do-delete nil)) ((> (text-stat->no-of-marks text-stat) 0) (setq do-delete (lyskom-j-or-n-p (lyskom-format 'delete-marked-text (if (> num-marks 0) (if is-marked-by-me (if (= num-marks 1) (lyskom-get-string 'delete-marked-by-you) (lyskom-format 'delete-marked-by-you-and-others (1- num-marks))) (lyskom-format 'delete-marked-by-several num-marks)))))))) (when do-delete (lyskom-format-insert 'deleting-text text-no) (when (lyskom-report-command-answer (blocking-do 'delete-text text-no)) (when is-marked-by-me (lyskom-unmark-text text-no))))) (lyskom-insert 'confusion-what-to-delete))) ;;; ================================================================ ;;; ]terse presentation - Review the presentation ;;; for a person or a conference ;;; Author: Inge Wallin (def-kom-command kom-review-presentation (&optional who) "Review the presentation for a person or a conference." (interactive) (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))))) ;;; ================================================================ ;;; Återse det kommenterade - View commented text ;;; Author: Inge Wallin ;;; Modified by: David Kågedal, Johan Sundström (def-kom-command kom-view-commented-text (text-no) "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. If the optional arg TEXT-NO is present review the text that text commented instead." (interactive (list (lyskom-read-text-no-prefix-arg 'review-commented-q))) (if text-no (progn (lyskom-tell-internat 'kom-tell-read) (lyskom-view-commented-text (blocking-do 'get-text-stat text-no))) (lyskom-insert-string 'confusion-what-to-view))) (def-kom-command kom-view-previous-commented-text (text-no) "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 (list (lyskom-read-text-no-prefix-arg 'review-commented-q nil lyskom-previous-text))) (cond (text-no (lyskom-tell-internat 'kom-tell-read) (lyskom-view-commented-text (blocking-do 'get-text-stat lyskom-previous-text))) (t (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) nil nil nil nil nil nil t)) (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 (if (lyskom-get-membership tono) (lyskom-create-misc-list 'recpt tono) (lyskom-create-misc-list 'recpt tono 'recpt lyskom-pers-no)) "" ""))))) (quit (signal 'quit nil)))) ;;; ================================================================ ;;; 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 nil nil t) 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)) (mship (lyskom-get-membership (conf-stat->conf-no whereto) t))) ;; Fake kom-membership-default-priority if this is a passive membership ;; This will suppress the normal "which priority" question. Ugly hack. (let ((kom-membership-default-priority (if (and mship (membership-type->passive (membership->type mship))) (membership->priority mship) kom-membership-default-priority))) (lyskom-add-member-answer (lyskom-try-add-member whereto who pers-stat nil nil t) whereto who)))) (def-kom-command kom-change-priority (&optional conf) "Change the priority of a conference." (interactive) (let* ((conf-stat (if conf (blocking-do 'get-conf-stat conf) (lyskom-read-conf-stat (lyskom-get-string 'change-priority-for-q) '(all) nil "" t))) (mship (lyskom-get-membership (conf-stat->conf-no conf-stat) t))) (blocking-do-multiple ((who (get-conf-stat lyskom-pers-no)) (pers-stat (get-pers-stat lyskom-pers-no))) (cond ((null mship) (lyskom-format-insert 'not-member-of-conf conf)) (t (lyskom-add-member-answer (lyskom-try-add-member conf-stat who pers-stat nil 'change-priority-for t) conf-stat 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 nil nil t))) (lyskom-add-member-answer result whereto who) (if thendo (apply thendo data)) (car result)))) (defun lyskom-try-add-member (conf-conf-stat pers-conf-stat pers-stat membership-type &optional message-string need-extra-information) "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. Optional MESSAGE-STRING is the message to print before making server call. Returns t if it was possible, otherwise nil. If optional NEED-EXTRA-INFORMATION is non-nil, the return value will be a list where the first element is the result of add-member and the second is the position where the membership was placed." (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)) (lyskom-read-num-range 0 255 (lyskom-get-string 'priority-q) nil 100) (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)))))))) ;; ;; Adding ourselves. Adjust where so the membership ;; list remains sorted. Find the closest position to ;; where at which we can put the membership and keep ;; the membership lsit sorted. ;; (when (eq lyskom-pers-no (conf-stat->conf-no pers-conf-stat)) (let ((mship-list lyskom-membership) (mship nil) (index 0) (found nil)) (while mship-list (setq mship (car mship-list) mship-list (cdr mship-list)) (cond ((> (membership->priority mship) priority)) ((< (membership->priority mship) priority) (setq where index mship-list nil found t)) ((and (= (membership->priority mship) priority) (= index where)) (setq mship-list nil found t)) ((and (= (membership->priority mship) priority) (> index where)) (setq where index mship-list nil found t))) (setq index (1+ index)) (unless found (setq where (1+ index)))))) (when (null membership-type) (setq membership-type (lyskom-create-membership-type nil nil nil nil nil nil nil nil))) (if message-string (lyskom-format-insert message-string pers-conf-stat conf-conf-stat) (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))) (lyskom-ignoring-async (18 lyskom-pers-no (conf-stat->conf-no conf-conf-stat)) (let ((res (blocking-do 'add-member (conf-stat->conf-no conf-conf-stat) (conf-stat->conf-no pers-conf-stat) priority where membership-type))) (if need-extra-information (list res where) res)))))) (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." (let ((pos (if (consp answer) (elt answer 1) nil)) (answer (if (consp answer) (elt answer 0) answer))) (if (null answer) (progn (lyskom-insert-string 'nope) (let* ((errno lyskom-errno) (is-supervisor (lyskom-is-supervisor (conf-stat->conf-no conf-conf-stat) lyskom-pers-no)) (is-member (lyskom-is-member (conf-stat->conf-no conf-conf-stat) (conf-stat->conf-no pers-conf-stat))) (rd-prot (conf-type->rd_prot (conf-stat->conf-type conf-conf-stat)))) (cond (is-member (lyskom-format-insert 'add-already-member pers-conf-stat conf-conf-stat)) ((and rd-prot is-supervisor) (lyskom-format-insert 'error-code (lyskom-get-error-text errno))) (rd-prot (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)))) (t (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) (let ((mship (blocking-do 'query-read-texts lyskom-pers-no (conf-stat->conf-no conf-conf-stat)))) (unless (membership->position mship) (set-membership->position mship pos)) (lyskom-add-membership mship (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-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 (null lyskom-current-conf) (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)) (mship (and self kom-unsubscribe-makes-passive (lyskom-get-membership (conf-stat->conf-no conf)))) (passivate (and mship (lyskom-have-call 102) ; set-membership-type (not (membership-type->passive (membership->type mship)))))) (cond ((null pers) (lyskom-insert-string 'error-fetching-person)) ((null conf) (lyskom-insert-string 'error-fetching-conf)) (passivate (lyskom-prefetch-cancel-prefetch-map (conf-stat->conf-no conf)) (lyskom-format-insert 'unsubscribe-to conf) (set-membership-type->passive (membership->type mship) t) (setq reply (blocking-do 'set-membership-type (conf-stat->conf-no pers) (conf-stat->conf-no conf) (membership->type mship))) (if (not reply) (lyskom-format-insert 'unsubscribe-failed (lyskom-get-string 'You) conf) (lyskom-insert-string 'done) (lyskom-format-insert 'passivate-done conf) (when (= (conf-stat->conf-no conf) lyskom-current-conf) (lyskom-leave-current-conf)) (read-list-delete-read-info (conf-stat->conf-no conf) lyskom-to-do-list))) (t (when self (lyskom-prefetch-cancel-prefetch-map (conf-stat->conf-no conf))) (if self (lyskom-format-insert 'unsubscribe-to conf) (lyskom-format-insert 'exclude-from pers conf)) (lyskom-ignoring-async (8 (conf-stat->conf-no 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))) (if (not reply) (lyskom-format-insert 'unsubscribe-failed (if self (lyskom-get-string 'You) (conf-stat->name pers)) conf) (lyskom-insert-string 'done) (when (and self (= (conf-stat->conf-no conf) lyskom-current-conf)) (lyskom-leave-current-conf)) (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)) (secmem (and (lyskom-have-feature long-conf-types) (not (lyskom-j-or-n-p (lyskom-get-string 'secret-members-allowed) t)))) (conf-no (blocking-do 'create-conf conf-name (lyskom-create-conf-type (not open) (not orig) secret nil anarchy secmem 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: ??? ;;; FIXME: Does not use def-kom-command (defun kom-write-comment (text-no) "Write a comment to a text. If optional arg TEXT-NO is present write a comment to that text instead." (interactive (list (let ((lyskom-current-command 'kom-write-comment)) (lyskom-read-text-no-prefix-arg 'what-comment-no)))) (lyskom-start-of-command (concat (lyskom-command-name 'kom-write-comment) (if text-no (lyskom-format " (%#1n)" text-no) ""))) (unwind-protect (if text-no (blocking-do-multiple ((text (get-text text-no)) (text-stat (get-text-stat text-no))) (when (or (null (text-stat-find-aux text-stat 4)) (lyskom-j-or-n-p (lyskom-get-string 'no-comments-q))) (if (and (text-stat-find-aux text-stat 5) (lyskom-j-or-n-p (lyskom-get-string 'private-answer-q))) (lyskom-private-answer-soon text-stat text text-no) (lyskom-write-comment-soon text-stat text text-no 'comment)))) (lyskom-insert-string 'confusion-who-to-reply-to)) (lyskom-end-of-command))) (def-kom-command kom-write-footnote (text-no) "Write a footnote to a text. If optional arg TEXT-NO is present write a footnote to that text instead." (interactive (list (lyskom-read-text-no-prefix-arg 'what-footnote-no nil 'last-seen-written))) (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 (text-no) "Write a comment to previously viewed text." (interactive (list (lyskom-read-text-no-prefix-arg 'what-comment-no nil lyskom-previous-text))) (if text-no (blocking-do-multiple ((text-stat (get-text-stat text-no)) (text (get-text text-no))) (when (or (null text-stat) (null text) (null (text-stat-find-aux text-stat 4)) (lyskom-j-or-n-p (lyskom-get-string 'no-comments-q))) (if (and (text-stat-find-aux text-stat 5) (lyskom-j-or-n-p (lyskom-get-string 'private-answer-q))) (lyskom-private-answer-soon text-stat text text-no) (lyskom-write-comment-soon text-stat text text-no '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." (let ((str (and text-stat text (text->decoded-text-mass text text-stat)))) (cond ;; Text not found? ((or (null text-stat) (null text)) (lyskom-format-insert 'cant-read-textno text-no)) ;; Give header. ((string-match "\n" str) (lyskom-write-comment text-stat (substring str 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)) (confno (conf-stat->conf-no conf-stat)) (commno (if (eq type 'footnote) confno (conf-stat->comm-conf conf-stat)))) (if (memq commno recpts) nil (setq recver (append recver (list (cons (cond ((memq confno ccrep) 'cc-recpt) ((memq confno bccrep) 'bcc-recpt) (t 'recpt)) commno)))) (if (lyskom-get-membership commno) (setq member t)) (setq recpts (cons commno 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 nil)))) ;;; ================================================================ ;;; Personligt svar - personal answer ;;; Author: ??? ;;; Rewritten using blocking-do by: Linus Tolke (def-kom-command kom-private-answer (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 (lyskom-read-text-no-prefix-arg 'what-private-no))) (if text-no (blocking-do-multiple ((text-stat (get-text-stat text-no)) (text (get-text text-no))) (when (or (null (text-stat-find-aux text-stat 4)) (lyskom-j-or-n-p (lyskom-get-string 'no-comments-q))) (lyskom-private-answer-soon text-stat text 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) (let ((str (text->decoded-text-mass text text-stat))) (if (string-match "\n" str) (lyskom-private-answer text-stat (substring str 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 (text-no) "Write a private answer to previously viewed text." (interactive (list (lyskom-read-text-no-prefix-arg 'what-private-no nil lyskom-previous-text))) (if text-no (blocking-do-multiple ((text-stat (get-text-stat text-no)) (text (get-text text-no))) (when (or (null (text-stat-find-aux text-stat 4)) (lyskom-j-or-n-p (lyskom-get-string 'no-comments-q))) (lyskom-private-answer-soon text-stat text text-no))) (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." (let ((str (text->decoded-text-mass text text-stat))) (if (string-match "\n" str) (lyskom-private-answer text-stat (substring str 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) (lyskom-remove-unread-buffer lyskom-buffer) (set-process-sentinel lyskom-proc nil) (delete-process lyskom-proc) (lyskom-insert-string (lyskom-get-string-sol '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) t) (= lyskom-pers-no (conf-stat->conf-no conf-stat))) (blocking-do-multiple ((text-stat (get-text-stat (conf-stat->presentation conf-stat))) (text-mass (get-text (cond ((eq type 'pres) (conf-stat->presentation conf-stat)) ((eq type 'motd) (conf-stat->msg-of-day conf-stat)))))) (let ((str (and text-mass (text->decoded-text-mass text-mass text-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 text-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) (if (and text-mass (string-match "\n" str)) (substring str (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) t)) ;; 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)))) (when (lyskom-check-go-to-conf conf) (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) t))) (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) t)) (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 (&optional arg) "write a text." (interactive "P") (let ((recpt nil)) (cond ((consp arg) (setq recpt (lyskom-read-conf-no (lyskom-get-string 'who-send-text-to) '(all) nil nil t))) ((numberp arg) (setq recpt arg)) (t (setq recpt lyskom-current-conf))) (if (or (null recpt) (zerop recpt)) (lyskom-insert-string 'no-in-conf) (lyskom-tell-internat 'kom-tell-write-text) (lyskom-edit-text lyskom-proc (lyskom-create-misc-list 'recpt recpt) "" "")))) ;;; ================================================================ ;;; Lista Personer - List persons ;;; Author: ceder ;;; Rewritten: linus (def-kom-command kom-list-persons (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-pers)))) (let ((result (blocking-do 'lookup-z-name match 1 0))) (if result (if (conf-z-info-list->conf-z-infos result) (lyskom-traverse info (conf-z-info-list->conf-z-infos result) (lyskom-list-pers-print info)) (lyskom-format-insert 'no-matching-perss match)) (lyskom-insert (lyskom-current-error))))) (defun lyskom-list-pers-print (conf-z) "Print name of the person CONF-NO for kom-list-persons." (lyskom-format-insert "%[%#1@%4#2:p %#2P%]\n" (lyskom-default-button 'pers (conf-z-info->conf-no conf-z)) conf-z)) ;;; ================================================================ ;;; 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)))) (let ((result (blocking-do 'lookup-z-name match 0 1))) (if result (if (conf-z-info-list->conf-z-infos result) (lyskom-traverse info (conf-z-info-list->conf-z-infos result) (lyskom-list-conf-print info)) (lyskom-format-insert 'no-matching-confs match)) (lyskom-insert (lyskom-current-error))))) (def-kom-command kom-list-created-conferences (arg) "List all conferences created by some person." (interactive "P") (let* ((tmp (blocking-do 'get-uconf-stat lyskom-pers-no)) (pers-no (lyskom-read-conf-no (if arg 'list-pers-confs-created-by 'list-confs-created-by) '(pers) nil (if (cache-get-uconf-stat lyskom-pers-no) (cons (conf-stat->name (cache-get-conf-stat lyskom-pers-no)) 0)1 nil) t))) (lyskom-message (lyskom-get-string (if arg 'getting-all-pers-confs 'getting-all-confs))) (let ((result (blocking-do 'lookup-z-name "" (if arg 1 0) 1))) (lyskom-message (lyskom-get-string (if arg 'getting-all-pers confs-done 'getting-all-confs-done))) (if result (if (conf-z-info-list->conf-z-infos result) (let ((counter (cons 1 (length (conf-z-info-list->conf-z-infos result))))) (lyskom-traverse conf-z (conf-z-info-list->conf-z-infos result) (initiate-get-conf-stat 'main 'lyskom-list-created-conferences-2 (conf-z-info->conf-no conf-z) counter pers-no arg ) ) (lyskom-wait-queue 'main)) (lyskom-insert (lyskom-get-string (if arg 'no-pers-confs-exist 'no-confs-exist)))) (lyskom-format-insert (lyskom-current-error)))))) (defun lyskom-list-created-conferences-2 (cs counter pers-no arg) (setcar counter (1+ (car counter))) (lyskom-message (lyskom-format (if arg 'finding-created-pers-confs 'finding-created-confs) (car counter) (cdr counter))) (when (and cs (or (eq (conf-stat->creator cs) pers-no) (eq (conf-stat->supervisor cs) pers-no) (eq (conf-stat->super-conf cs) pers-no))) (lyskom-format-insert "%[%#1@%4#2:m %#3c %4#4s %#2M%]\n" (lyskom-default-button 'conf (conf-stat->conf-no cs)) cs (if (lyskom-get-membership (conf-stat->conf-no cs)) ?\ (if (lyskom-get-membership (conf-stat->conf-no cs) t) ?- ?*)) (concat (if (eq pers-no (conf-stat->creator cs)) "C" " ") (if (eq pers-no (conf-stat->supervisor cs)) "O" " ") (if (eq pers-no (conf-stat->super-conf cs)) "S" " "))))) (defun lyskom-list-conf-print (conf-z) "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 %#2M%]\n" (lyskom-default-button 'conf (conf-z-info->conf-no conf-z)) conf-z (if (lyskom-get-membership (conf-z-info->conf-no conf-z)) ?\ (if (lyskom-get-membership (conf-z-info->conf-no conf-z) t) ?- ?*)))) ;;; ================================================================ ;;; 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))) (if conf-list (if (conf-z-info-list->conf-z-infos conf-list) (lyskom-traverse czi (conf-z-info-list->conf-z-infos conf-list) (lyskom-format-insert "%[%#1@%4#2:m %#3c %#2:M%]\n" (lyskom-default-button 'conf (conf-z-info->conf-no czi)) czi (if (conf-type->letterbox (conf-z-info->conf-type czi)) ?P ?M) )) (lyskom-format-insert 'no-matching-anys regexp)) (lyskom-format-insert (lyskom-current-error))))) ;;; ================================================================ ;;; [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) (progn (lyskom-format-insert 'change-name-done name (lyskom-default-button 'conf conf-stat)) (cache-del-conf-stat (conf-stat->conf-no conf-stat))) (lyskom-format-insert 'change-name-nope name (lyskom-get-error-text lyskom-errno) lyskom-errno)))))) ;;; ================================================================ ;;; [ndra parentes - Change parenthesis ;;; Author: Per Cederqvist (template stolen from kom-change-name) (def-kom-command kom-change-parenthesis () "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) (if (string-match "^\\([^(]*\\)(\\(.*\\))$" (conf-stat->name conf-stat)) (let* ((non-paren (match-string 1 (conf-stat->name conf-stat))) (old-paren (match-string 2 (conf-stat->name conf-stat))) (paren (lyskom-read-string (lyskom-get-string 'new-paren) old-paren)) (name (concat non-paren "(" paren ")"))) (if (blocking-do 'change-name (conf-stat->conf-no conf-stat) name) (progn (lyskom-format-insert 'change-name-done name (lyskom-default-button 'conf conf-stat)) (cache-del-conf-stat (conf-stat->conf-no conf-stat))) (lyskom-format-insert 'change-name-nope name (lyskom-get-error-text lyskom-errno) lyskom-errno))) (lyskom-insert-string 'no-paren-in-name))))) ;;; ================================================================ ;;; [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 ;;; Modified by: Linus Tolke, Johan Sundström (def-kom-command kom-mark-text (&optional text-no) "Mark the text TEXT-NO." (interactive (list (lyskom-read-text-no-prefix-arg 'text-to-mark))) (if text-no (lyskom-mark-text text-no) (lyskom-insert 'confusion-what-to-mark))) (def-kom-command kom-unmark-text (&optional text-no) "Unmark the text TEXT-NO." (interactive (list (lyskom-read-text-no-prefix-arg 'text-to-unmark))) (if text-no (lyskom-unmark-text text-no) (lyskom-insert 'confusion-what-to-unmark))) (defun lyskom-unmark-text (text-no) "Do the actual unmarking of the text TEXT-NO." (lyskom-format-insert 'unmarking-textno text-no) (if (blocking-do 'unmark-text text-no) (progn (lyskom-insert-string 'done) (cache-del-marked-text text-no)) (lyskom-insert-string 'nope)) ;+++ lyskom-errno? (cache-del-text-stat text-no)) (defun lyskom-mark-text (text-no &optional mark) "Mark TEXT-NO using kom-default-mark (if non-nil) or prompt the user for what mark to use." (let ((mark (or mark kom-default-mark (lyskom-read-num-range 0 255 (lyskom-get-string 'what-mark) t)))) (lyskom-format-insert 'marking-textno text-no) (if (blocking-do 'mark-text text-no mark) (progn (lyskom-insert-string 'done) (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 0 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 nil)) (defun lyskom-review-marked-texts (mark-no) "Review all marked texts with the mark equal to MARK-NO. If MARK-NO is nil, 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 (null mark-no) (eq mark-no (mark->mark-type mark)))) (setq text-list (cons (mark->text-no mark) text-list)))) (setq mark-list (cdr mark-list))) (if (eq (length text-list) 0) (lyskom-insert (if (null mark-no) (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 (lyskom-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)))) (lyskom-external-function calendar-iso-from-absolute) (lyskom-external-function calendar-absolute-from-gregorian) (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) (weekno nil)) (lyskom-format-insert (if kom-show-week-number (condition-case nil (progn (require 'calendar) (require 'cal-iso) (setq weekno (car (calendar-iso-from-absolute (calendar-absolute-from-gregorian (list (1+ (time->mon time)) (time->mday time) (+ 1900 (time->year time))))))) 'time-is-week) (error 'time-is)) '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) "") weekno) ;; 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 ((null dlist) nil) ((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 negative, invisible sessions are also shown. If the prefix is 0, all visible sessions are shown." (interactive "P") (condition-case nil (if (lyskom-have-feature dynamic-session-info) (lyskom-who-is-on-9 arg) (lyskom-who-is-on-8)) (lyskom-no-users (lyskom-insert (lyskom-get-string 'null-who-info))))) ;;; ================================================================ ;;; Vilka ({r inloggade i) möte - Who is on in a conference? ;;; Author: petli (def-kom-command kom-who-is-on-in-conference (&optional arg) "Display a list of all connected users in CONF. The prefix arg controls the idle limit of the sessions showed. If the prefix is negative, invisible sessions are also shown. If the prefix is 0, all visible sessions are shown." (interactive "P") (let ((conf-stat (lyskom-read-conf-stat (lyskom-get-string 'who-is-on-in-what-conference) '(all) nil nil t))) (condition-case nil (if (lyskom-have-feature dynamic-session-info) (lyskom-who-is-on-9 arg conf-stat) (lyskom-who-is-on-8 conf-stat)) (lyskom-no-users (lyskom-insert (lyskom-get-string 'null-who-info)))))) (defun lyskom-who-is-on-8 (&optional conf-stat) "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 (if conf-stat (lyskom-who-is-on-check-membership-8 who-info-list conf-stat) (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 'unknown-person)) (if conf-stat (lyskom-format-insert 'who-is-active-and-member conf-stat)) (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) 1) ?-) "\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) 1) ?-) "\n")) (lyskom-insert (lyskom-format 'total-visible-users total-users (lyskom-client-date-string 'time-format-exact))))) (defun lyskom-who-is-on-9 (arg &optional conf-stat) "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 (if conf-stat (lyskom-who-is-on-check-membership-9 who-info-list conf-stat) (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")) (format-string-3 (lyskom-info-line-format-string session-width "D" "s")) (lyskom-default-conf-string 'not-present-anywhere) (lyskom-default-pers-string 'unknown-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))) (if conf-stat (lyskom-format-insert 'who-is-active-and-member conf-stat)) (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))) (if kom-show-since-and-when (lyskom-format-insert format-string-3 "" (lyskom-get-string 'connection-time) (lyskom-get-string 'active-last))) (lyskom-insert (concat (make-string (- (lyskom-window-width) 1) ?-) "\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) ")")))) (if kom-show-since-and-when (let ((active (if (< (dynamic-session-info->idle-time who-info) 60) (lyskom-get-string 'active) (lyskom-format-secs (dynamic-session-info->idle-time who-info)))) defer-info static since) (cond (kom-deferred-printing (setq static (cache-get-static-session-info session-no)) (if static (setq since (upcase-initials (lyskom-format-time (static-session-info->connection-time static)))) (setq defer-info (lyskom-create-defer-info 'get-static-session-info session-no 'lyskom-insert-deferred-session-info-since (make-marker) (length lyskom-defer-indicator) "%#1s")) (setq since defer-info))) (t (setq static (blocking-do 'get-static-session-info session-no)) (setq since (upcase-initials (lyskom-format-time (static-session-info->connection-time static)))))) (lyskom-format-insert format-string-3 "" since active))) (setq who-list (cdr who-list)))) (lyskom-insert (concat (make-string (- (lyskom-window-width) 1) ?-) "\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 (lyskom-client-date-string 'time-format-exact))))) (defun lyskom-who-is-on-check-membership-8 (who-info-list conf-stat) "Returns a list of those in WHO-INFO-LIST which is member in CONF-STAT." (let ((members (blocking-do 'get-members (conf-stat->conf-no conf-stat) 0 (conf-stat->no-of-members conf-stat))) (len (length who-info-list)) (i 0) (res nil)) (while (< i len) (if (lyskom-member-list-find-member (who-info->pers-no (aref who-info-list i)) members) (setq res (cons (aref who-info-list i) res))) (setq i (1+ i))) res)) (defun lyskom-who-is-on-check-membership-9 (who-info-list conf-stat) "Returns a list of those in WHO-INFO-LIST which is member in CONF-STAT." (let ((members (blocking-do 'get-members (conf-stat->conf-no conf-stat) 0 (conf-stat->no-of-members conf-stat))) (len (length who-info-list)) (i 0) (res nil)) (while (< i len) (if (lyskom-member-list-find-member (dynamic-session-info->person (aref who-info-list i)) members) (setq res (cons (aref who-info-list i) res))) (setq i (1+ i))) res)) (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 ""))) (defun lyskom-insert-deferred-session-info-since (session-info defer-info) (if session-info (lyskom-replace-deferred defer-info (upcase-initials (lyskom-format-time (static-session-info->connection-time 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 (lyskom-client-date-string 'time-format-exact))))) (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)) (width (- (lyskom-window-width) plen 2))) (concat "%" (int-to-string plen) "#1s" "%=-" (int-to-string (/ width 2)) "#2" type1 " %=-" (int-to-string (+ (/ width 2) (% width 2))) "#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) (lyskom-string= (downcase sent) (downcase gott)) (lyskom-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 (lyskom-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-have-feature dynamic-session-info) (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 and Johan Sundström ;;; Based on code by Inge Wallin ;(macroexpand '(lyskom-sub-recipient 1 2)) (defmacro lyskom-defmacro-lyskom-add-sub-rcpt (name action description) "Defines a macro lyskom-NAME (text-no conf) for calling lyskom-add-sub-recipient in a more readable fashion." `(defmacro ,(intern (concat "lyskom-" (symbol-name name))) (text-no conf) ,(concat description " a text TEXT-NO.") (list 'lyskom-add-sub-recipient text-no ',action conf))) (lyskom-defmacro-lyskom-add-sub-rcpt add-recipient 'add-rcpt "Add a recipient CONF to") (lyskom-defmacro-lyskom-add-sub-rcpt sub-recipient 'sub "Subtract a recipient (of any type) CONF from") (lyskom-defmacro-lyskom-add-sub-rcpt add-copy 'add-copy "Add a cc (carbon copy) recipient CONF to") (lyskom-defmacro-lyskom-add-sub-rcpt add-bcc 'add-bcc "Add a bcc (blind carbon copy) recipient CONF to") (def-kom-command kom-add-recipient (text-no) "Add a recipient to a text." (interactive (list (lyskom-read-text-no-prefix-arg 'text-to-add-recipient))) (let ((conf (blocking-do 'get-conf-stat lyskom-last-added-rcpt))) (lyskom-add-recipient text-no conf))) (def-kom-command kom-add-copy (text-no) "Add a cc (carbon copy) recipient to a text." (interactive (list (lyskom-read-text-no-prefix-arg 'text-to-add-copy))) (let ((conf (blocking-do 'get-conf-stat lyskom-last-added-ccrcpt))) (lyskom-add-copy text-no conf))) (def-kom-command kom-add-bcc (text-no) "Add a bcc (blind carbon copy) recipient to a text." (interactive (list (lyskom-read-text-no-prefix-arg 'text-to-add-bcc))) (let ((conf (blocking-do 'get-conf-stat lyskom-last-added-bccrcpt))) (lyskom-add-bcc text-no conf))) (def-kom-command kom-sub-recipient (text-no) "Subtract a recipient from a text." (interactive (list (lyskom-read-text-no-prefix-arg 'text-to-delete-recipient))) (let ((conf (blocking-do 'get-conf-stat lyskom-current-conf))) (lyskom-sub-recipient text-no conf))) (def-kom-command kom-move-text (text-no) "Subtract a recipient from a text and add another." (interactive (list (lyskom-read-text-no-prefix-arg 'text-to-move))) (let* ((text-stat (blocking-do 'get-text-stat text-no)) default-recpt found) (lyskom-traverse misc-item (text-stat->misc-info-list text-stat) (when (memq (misc-info->type misc-item) '(RECPT CC-RECPT BCC-RECPT)) (when (not found) (setq default-recpt (misc-info->recipient-no misc-item) found (eq (misc-info->type misc-item) 'RECPT))) (when (eq (misc-info->recipient-no misc-item) lyskom-current-conf) (setq default-recpt lyskom-current-conf found t)))) (cond ((null text-stat) (lyskom-format-insert 'no-such-text-no text-no)) ((null default-recpt) (lyskom-format-insert 'text-has-no-recipients-r text-no)) (t (blocking-do-multiple ((default-from (get-conf-stat default-recpt)) (default-to (get-conf-stat (or lyskom-last-added-rcpt lyskom-current-conf)))) (lyskom-add-sub-recipient text-no 'move default-to default-from)))))) (defvar lyskom-add-sub-recipient-action) (defvar lyskom-add-sub-recipient-source-conf) (defvar lyskom-add-sub-recipient-target-conf) (defun lyskom-verify-add-recipient () "Make sure the user really does mean to add a recipient conference instead of just adding a carbon copy as he most likely ought to. Useful as a lyskom-add-sub-recipient-hook only." (when (and (eq lyskom-add-sub-recipient-action 'add-rcpt) lyskom-add-sub-recipient-target-conf (not (lyskom-j-or-n-p (lyskom-format 'really-add-as-recpt-q lyskom-add-sub-recipient-target-conf) t))) (setq lyskom-add-sub-recipient-action 'add-copy))) ;;; NOTE: If you add an action you need to add a foo-action-name ;;; string to the strings files. (defun lyskom-add-sub-recipient (text-no action conf &optional conf2) "Add or remove a recipient. TEXT-NO is the text being operated on; ACTION is what to do (one of add-rcpt, add-copy, add-bcc, sub or move), CONF is the conference to add, remove or move from, CONF2 is the conference to move to (for move)." (if text-no (let* ((text-stat (blocking-do 'get-text-stat text-no)) (was-read (lyskom-text-read-p text-stat)) ;; Only for moving (lyskom-add-sub-recipient-source-conf (when (eq action 'move) (lyskom-read-conf-stat (lyskom-get-string 'who-to-move-from-q) '(all) nil (cons (if conf2 (conf-stat->name conf2) "") 0) t))) (lyskom-add-sub-recipient-target-conf (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 'add-bcc) 'who-to-add-bcc-q) ((eq action 'sub) 'who-to-sub-q) ((eq action 'move) 'who-to-move-to-q) (t (lyskom-error "internal error")))) '(all) nil (cons (if conf (conf-stat->name conf) "") 0) t)) (lyskom-add-sub-recipient-action action) (result nil)) ; hooks for doing nasty questions like "really sure about adding conf?" (run-hooks 'lyskom-add-sub-recipients-hook) (setq result (cond ((eq lyskom-add-sub-recipient-action 'add-rcpt) (lyskom-format-insert 'adding-name-as-recipient lyskom-add-sub-recipient-target-conf text-stat) (setq lyskom-last-added-rcpt (conf-stat->conf-no lyskom-add-sub-recipient-target-conf)) (blocking-do 'add-recipient text-no (conf-stat->conf-no lyskom-add-sub-recipient-target-conf) 'recpt)) ((eq lyskom-add-sub-recipient-action 'add-copy) (lyskom-format-insert 'adding-name-as-copy lyskom-add-sub-recipient-target-conf text-stat) (setq lyskom-last-added-ccrcpt (conf-stat->conf-no lyskom-add-sub-recipient-target-conf)) (blocking-do 'add-recipient text-no (conf-stat->conf-no lyskom-add-sub-recipient-target-conf) 'cc-recpt)) ((eq lyskom-add-sub-recipient-action 'add-bcc) (lyskom-format-insert 'adding-name-as-copy lyskom-add-sub-recipient-target-conf text-stat) (setq lyskom-last-added-bccrcpt (conf-stat->conf-no lyskom-add-sub-recipient-target-conf)) (blocking-do 'add-recipient text-no (conf-stat->conf-no lyskom-add-sub-recipient-target-conf) 'bcc-recpt)) ((eq lyskom-add-sub-recipient-action 'sub) (lyskom-format-insert 'remove-name-as-recipient lyskom-add-sub-recipient-target-conf text-stat) (blocking-do 'sub-recipient text-no (conf-stat->conf-no lyskom-add-sub-recipient-target-conf))) ((eq lyskom-add-sub-recipient-action 'move) (lyskom-format-insert 'moving-name lyskom-add-sub-recipient-source-conf lyskom-add-sub-recipient-target-conf text-stat) (setq lyskom-last-added-rcpt (conf-stat->conf-no lyskom-add-sub-recipient-target-conf)) (blocking-do-multiple ((add (add-recipient text-no (conf-stat->conf-no lyskom-add-sub-recipient-target-conf) 'recpt)) (sub (sub-recipient text-no (conf-stat->conf-no lyskom-add-sub-recipient-source-conf)))) (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)) (lyskom-format-insert 'confusion-what-to-add-sub-recipient (lyskom-get-string (intern (concat (symbol-name action) "-action-name")))))) ;;; ================================================================ ;;; 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 (let ((current-prefix-arg text-no-arg)) (lyskom-read-text-no-prefix-arg prompt nil lyskom-current-text)))) (if text-no (let* ((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))) (lyskom-format-insert (if do-add 'confusion-what-to-add-comment-to 'confusion-what-to-sub-comment-from))))) (def-kom-command kom-add-footnote (text-no-arg) "Add a text as a footnote to another text." (interactive "P") (lyskom-add-sub-footnote text-no-arg (lyskom-get-string 'text-to-add-footnote-to) t)) (def-kom-command kom-sub-footnote (text-no-arg) "Remove a footnote from a text." (interactive "P") (lyskom-add-sub-footnote text-no-arg (lyskom-get-string 'text-to-delete-footnote-from) nil)) (defun lyskom-add-sub-footnote (text-no-arg prompt do-add) "Get the number of the text that is going to have a footnote 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 footnote should be subtracted. Otherwise a footnote is added" (let ((text-no (let ((current-prefix-arg text-no-arg)) (lyskom-read-text-no-prefix-arg prompt nil lyskom-current-text)))) (if text-no (let* ((footnote-text-no (lyskom-read-number (lyskom-get-string (if do-add 'text-to-add-footn-q 'text-to-remove-footn-q)) (if (eq text-no lyskom-current-text) nil lyskom-current-text)))) (lyskom-format-insert (if do-add 'add-footnote-to 'sub-footnote-to) footnote-text-no text-no) (cache-del-text-stat text-no) (cache-del-text-stat footnote-text-no) (lyskom-report-command-answer (blocking-do (if do-add 'add-footnote 'sub-footnote) footnote-text-no text-no))) (lyskom-insert (if do-add 'confusion-what-to-add-footnote-to 'confusion-what-to-sub-footnote-from))))) ;;; ================================================================ ;;; Local Variables: ;;; eval: (put 'lyskom-traverse 'lisp-indent-hook 2) ;;; end: