;;; icb.el 0.3 ;;; emacs client for icb ;;; Matt Rhoten ;;; mrhoten@cs.stanford.edu ;;; 0.1: Jan 26 1993 ;;; 0.2: Jan 28 1993 ;;; 0.3: Feb 03 1993 ;;; ;;; There's no warranty of any kind on this code; I'm not guaranteeing ;;; it'll work at all. If I had to bet money, I'd guess it didn't work in ;;; some important way. Use at your own risk. I am not an elisp hacker. ;;; ;;; Some of this code is stolen from JoeFeedback's mud.el. Cope. ;;; ;;; Comments (and bug fixes) welcome. ;;; ;;; known bugs: Connected times displayed in time() values. ;;; (emacs 18 cannot represent integers as big as current time_t ;;; values. Nor can the server be told to send something other than; ;;; really big integers. Were either of these things to change, the ;;; connected-time display could be fixed. Users with a knowledge ;;; of perl will be able to hack in a properly functional if somewhat ;;; resource-intensive display.) ;;; ;;; history: ;;; 0.1 initial version. ;;; 0.2 genericized handler functions, added status changes, ping, ;;; server version query, fixed a few stupidities in the variable ;;; decls. ;;; 0.3 / command interface, fixed long packets (sort of). Look at ;;; icb-command-map for command names. long packets won't get sent ;;; now, since I'm truncating 'em. (defvar icb-process-commands t "if non-nil, will look for commands in messages simply typed in.") (defvar icb-command-char ?/ "lines sent with this prefix character will be interpreted as commands. Command interpretation allows for escaping of control character. See documentation for icb-command-map for more.") (defvar icb-command-map '(("m" . (icb-privstr t)) ("motd" . (icb-motd nil)) ("version" . (icb-version nil)) ("nick" . (icb-nick t)) ("boot" . (icb-boot t)) ("echo" . (icb-echo t)) ("who" . (icb-who t)) ("w" . (icb-who t)) ("topic" . (icb-topic t)) ("status" . (icb-status t)) ("group" . (icb-group t)) ("g" . (icb-group t)) ("cancel" . (icb-cancel t)) ("invite" . (icb-invite t)) ("pass" . (icb-pass t)) ("boot" . (icb-boot t)) ("beep" . (icb-beep t)) ("quit" . (icb-quit nil)) ("q" . (icb-quit nil)) ) "Command mapping. Maps command string (prefixed with command char) to an icb user command to call." ) (defvar icb-initial-group "" "The group this tries to log you into.") (defvar icb-server "crater.unm.edu" "icb server to try to log into.") ;;; no nickname variable necessary - this uses ICBNAME and FORUMNAME ;;; environment variables. (global-set-key "\C-Ci" 'icb) ; You might want to undo this. Might not. This is a handy thing to put ; in .emacs, anyway. Also something of the form: ; (autoload 'icb (expand-file-name "~/pub/icb.el") "ICB for emacs" t) ; (or wherever your icb.el is stored) (defvar icb-pending-output "" "Stores pending icb output.") (defvar icb-nul (char-to-string 0) "NUL char. Used in protocol.") ; OK, emacs is stupid (specifically, format and process-send-string ; are stupid) about NUL, so I append it twice in a lot of places in ; order to get things to work. Appending it twice right before sending ; didn't work, either. Pending output (incomplete packets) are stored ; in the other variable until fullness is achieved. Aum Shiva. (defvar icb-beeps-are-ok t "if this is non-nil, then beeps will make emacs beep. If it is nil, then emacs will not beep at you [but you will still get a message for beeps].") (defvar icb-mode-map (let ((map (make-sparse-keymap))) (define-key map "\n" 'icb-pubstr) (define-key map "\r" 'icb-pubstr) (define-key map "\^i" 'dabbrev-expand) (define-key map "\^c\^b" 'icb-beep) (define-key map "\^c\^c" 'icb-quit) (define-key map "\^c\^w" 'icb-who) (define-key map "\^c\^g" 'icb-group) (define-key map "\^c\^n" 'icb-nick) (define-key map "\^c\^e" 'icb-echo) (define-key map "\^c\^s" 'icb-status) (define-key map "\^c\^t" 'icb-topic) (define-key map "\^c\^m" 'icb-motd) (define-key map "\^c\^p" 'icb-privstr) ; RSN: ; (define-key map "\^c\^y" 'icb-send-kill) ; (define-key map "\ep" 'icb-previous-command) ; (define-key map "\en" 'icb-next-command) map) "Keymap for icb interactive mode.") ; naturally you might want to change these to suit your preferences. (defvar icb-login-type ?a) (defvar icb-public-type ?b) (defvar icb-private-type ?c) (defvar icb-status-type ?d) (defvar icb-error-type ?e) (defvar icb-important-type ?f) (defvar icb-exit-type ?g) (defvar icb-command-type ?h) (defvar icb-cmdout-type ?i) (defvar icb-proto-type ?j) (defvar icb-beep-type ?k) (defvar icb-ping-type ?l) (defvar icb-pong-type ?m) (defvar icb-funcs '((?a . (icb-ignore 0)) (?b . (icb-handle-public 2)) (?c . (icb-handle-private 2)) (?d . (icb-handle-status 2)) (?e . (icb-handle-error 1)) (?f . (icb-handle-important 2)) (?g . (icb-handle-exit 0)) (?h . (icb-handle-command 0)) (?i . (icb-handle-command 0)) (?j . (icb-ignore 0)) (?k . (icb-handle-beep 1)) (?l . (icb-handle-ping 0)) (?m . (icb-ignore 0)) ) "Maps icb packet types onto a function to handle them. Some are ignored (with icb-ignore). Genericized passing expected args or 0 for no argument count checking.") (defun icb-split-string-low (str start cur max ch) "This is the nasty iterative routine to split strings based on any ^As in the string - Wrapper function for icb-split-string." (cond ((>= cur max) (list (substring str start cur))) (t (progn (setq cur1 cur) (while (and (< cur1 max) (/= (elt str cur1) ch)) (setq cur1 (1+ cur1)) ) (if (>= cur1 max) (list (substring str start cur1)) (cons (substring str start cur1) (icb-split-string-low str (1+ cur1) (1+ cur1) max ch) ) ) ) ) ) ) (defun icb-split-string (str) "splits the string up according to its ^As and returns them in a list Sorta like lisp strtok with ^A as the sole tokenizing character." (icb-split-string-low str 0 0 (length str) ?\^A) ) (defun icb-get-word (str n) "returns the nth word in a string. 0-based. Multiple wide whitespace causes it to have empty words in list." (elt (icb-split-string-low str 0 0 (length str) 32) n) ) (defun icb-idle (secs) (cond ((>= secs 86400) (concat (int-to-string (/ secs 86400)) "d" (icb-idle (% secs 86400)))) ((>= secs 3600) (concat (int-to-string (/ secs 3600)) "h" (icb-idle (% secs 3600)))) ((>= secs 60) (concat (int-to-string (/ secs 60)) "m" (icb-idle (% secs 60)))) (t "") ) ) (defun icb-idle-time (secs-str) "takes a of seconds, returns something in the form 12d6h48m; If below one minute, returns -" (let ((res (icb-idle (string-to-int secs-str)))) (if (/= (length res) 0) res "-"))) (defun icb-pre-handler (proc str funs) "generic handler wrapper - does the normal save/restore stuff funs is the assoc entry. This makes it easier to write handlers." (let ((start (point)) (split (icb-split-string (substring str 2 (length str)))) (num (nth 2 funs)) (thefun (nth 1 funs))) (if (or (= num 0) (eq (length split) num)) (funcall thefun proc split) (insert-before-markers (format " Bad packet (%c)'%s'\n" (elt str 1) split))) (let ((end (point))) (goto-char start) (beginning-of-line)) ) ) (defun icb-handle-ping (proc str) "the handler for ping msgs in icb." (icb-send-packet icb-pong-type (concat "" icb-nul))) (defun icb-handle-public (proc str) "the handler for public messages in icb." (insert-before-markers (format "<%s> %s\n" (elt str 0) (elt str 1)))) (defun icb-handle-private (proc str) "the handler for private messages in icb." (insert-before-markers (format "<*%s*> %s\n" (elt str 0) (elt str 1)))) (defun icb-handle-beep (proc str) "the beep handler in icb." (progn (if icb-beeps-are-ok (beep)) (insert-before-markers (format "[%s] %s sent you a beep!\n" (elt str 0) (elt str 0))) ) ) (defun icb-handle-status (proc str) "handler for status messages in icb." (insert-before-markers (format "[%s] %s\n" (elt str 0) (elt str 1)))) (defun icb-handle-error (proc str) "handler for error messages in icb." (insert-before-markers (format "[Error] %s\n" (car str)))) (defun icb-handle-important (proc str) "handler for important! messages in icb." (insert-before-markers (format "!!! [%s] %s\n" (elt str 0) (elt str 1)))) (defun icb-handle-exit (proc str) "handler for server-exited messages in icb." (progn (insert-before-markers (format "Exiting. (%s)\n" str)) (delete-process proc) ) ) (defun command-insert (str) (insert-before-markers (format "%s\n" str))) (defun icb-handle-command (proc strs) "command-output handler. This conditions on the kind of output so as to make somewhat intelligible who listings." (cond ((null strs) '()) ((equal (car strs) "wl") (insert-before-markers (format " %s%-12s %-7s %s %s@%s %s\n" (if (equal (elt strs 1) "m") "*" " ") (elt strs 2) (icb-idle-time (elt strs 3)) (elt strs 5) (elt strs 6) (elt strs 7) (elt strs 8) ))) ((equal (car strs) "gh") (insert-before-markers (format "Group ## S Moderator Topic\n"))) (t (mapcar 'command-insert (cdr strs))) ) ) (defun icb-ignore (proc str) "This handler is for messages we don't grok yet." proc) (defun icb-send-packet (type str) "The interface to icb's protocol. Note that due to NUL bogosity we append one here and (usually) one previous. I don't know why, except that this is what works. This routine does not send such an extra NUL; icb-send-packet-n does." (process-send-string "icb" (format "%c%c%s" (+ 1 (length str)) type str) )) (defun icb-send-packet-n (type str) "see icb-send-packet." (process-send-string "icb" (concat (format "%c%c%s" (+ 1 (length str)) type str) icb-nul) )) (defun icb-find-input () (end-of-line 1) (let ((end (point))) (beginning-of-line) end)) (defun icb-filter (proc str) "filter function for icb's process output." (let ((where (string-match "" str))) (if where (let ((thestr (concat icb-pending-output (substring str 0 (1+ where))))) (save-excursion (setq icb-pending-output "") ; debugging code. Handy but spammy. ; (set-buffer (get-buffer-create "*ICB PACKETS*")) ; (goto-char (point-max)) ; (insert "\n\n<<") ; (insert str) ; (insert ">>") ; (insert "\n**") ; (insert thestr) ; (insert "**") (set-buffer (process-buffer proc)) (goto-char (marker-position (process-mark proc))) (beginning-of-line) (icb-pre-handler proc thestr (assoc (elt thestr 1) icb-funcs)) ) (icb-filter proc (substring str (1+ where) (length str))) ) (setq icb-pending-output (concat icb-pending-output str)) ) ) ) ;;; User commands are here. (defun icb-pubsome (s) (let ((nchar (length s))) (if (/= nchar 0) (if (>= nchar 240) (icb-send-packet icb-public-type (substring s 0 239)) (icb-send-packet icb-public-type s) ) ) ) ) (defun icb-do-command (s) (let ((com (assoc (icb-get-word s 0) icb-command-map))) (if com (let ((where (string-match " " s))) (if where (funcall (elt com 1) (substring s (1+ where) (length s))) (if (elt com 2) (funcall (elt com 1) "") (funcall (elt com 1)) ) ) ) (message "Can't find function %s" (icb-get-word s 0)) ) ) ) (defun icb-pubstr () "send a line of text to icb. Gross hacky stuff in place to make strings longer than 255 character be sent properly. Possibly calls other command if icb-process-commands is set, based on icb-command-char. icb-command-char if used twice will simply be escaped." (interactive) (let ((end (icb-find-input))) (let ((thestr (buffer-substring (point) end))) (if (/= (length thestr) 0) (if icb-process-commands (if (eq (elt thestr 0) icb-command-char) (if (eq (elt thestr 1) icb-command-char) (icb-pubsome (substring thestr 1 (length thestr))) (icb-do-command (substring thestr 1 (length thestr))) ) (icb-pubsome thestr) ) (icb-pubsome thestr) ) '() ) ) ) (goto-char (point-max)) (insert "\n") (set-marker (process-mark (get-buffer-process "*icb*")) (point-max)) ) (defun icb-motd () "read icb's message of the day." (interactive) (icb-send-packet-n icb-command-type (concat "motd" icb-nul)) ) (defun icb-version () "read icb's server version info." (interactive) (icb-send-packet-n icb-command-type (concat "v" icb-nul)) ) (defun icb-nick (n) "see or change your nickname." (interactive "sNew nickname: ") (icb-send-packet-n icb-command-type (concat (format "name%s" n) icb-nul)) ) (defun icb-boot (n) "kick someone out of a group." (interactive "sBoot whom: ") (icb-send-packet-n icb-command-type (concat (format "boot%s" n) icb-nul)) ) (defun icb-echo (yn) "turn echoing on or off. valid things to type are 'on' and 'off'." (interactive "sEcho: ['on' or 'off'] ") (icb-send-packet-n icb-command-type (concat (format "echoback%s" yn) icb-nul)) ) (defun icb-who (g) "Sees who's in various groups on icb. Just press to see all groups. Enter . to see your group. Enter a group name to see that group." (interactive "sWho for what group: [just for all] ") (icb-send-packet-n icb-command-type (concat (format "w%s" g) icb-nul)) ) (defun icb-privstr (str) "send a message to someone. Type the username, a space, and the text you want to send them, when prompted." (interactive "sEnter username and message: ") (icb-send-packet-n icb-command-type (concat (format "m%s" str) icb-nul)) ) (defun icb-topic (g) "Change or see the topic in a group." (interactive "sTopic: ") (icb-send-packet-n icb-command-type (concat (format "topic%s" g) icb-nul)) ) (defun icb-status (c) "see/set the status for the group. things to type at the prompt include [mpr][iv][lq] for mod/public/restricted, invisible/visible, loud/quiet." (interactive "sStatus change: [ for status report] ") (icb-send-packet-n icb-command-type (concat (format "status%s" c) icb-nul)) ) (defun icb-group (g) "see or change your current group." (interactive "sGroup: ") (icb-send-packet-n icb-command-type (concat (format "g%s" g) icb-nul)) ) (defun icb-cancel (n) "cancel an invite." (interactive "sCancel whom: ") (icb-send-packet-n icb-command-type (concat (format "cancel%s" n) icb-nul)) ) (defun icb-invite (n) "invite someone to your group." (interactive "sInvite whom: ") (icb-send-packet-n icb-command-type (concat (format "invite%s" n) icb-nul)) ) (defun icb-pass (n) "pass the mod." (interactive "sPass to whom: [ for none] ") (icb-send-packet-n icb-command-type (concat (format "pass%s" n) icb-nul)) ) (defun icb-boot (n) "kick someone out." (interactive "sBoot whom: ") (icb-send-packet-n icb-command-type (concat (format "boot%s" n) icb-nul)) ) (defun icb-beep (u) "beep someone." (interactive "sBeep whom: ") (icb-send-packet-n icb-command-type (concat (format "beep%s" u) icb-nul)) ) (defun icb-quit () "quit icb." (interactive) (save-excursion (set-buffer "*icb*") (insert-before-markers "[Quitting]\n") (delete-process "icb") ) ) (defun icb-login (g) "logs you onto icb - you pick the group." (interactive "sInitial group: [ for group 1] ") (open-network-stream "icb" (get-buffer-create "*icb*") icb-server 7326) (set-process-filter (get-buffer-process "*icb*") 'icb-filter) (icb-send-packet icb-login-type (format "%s%s%s%s%s%s%d" (user-login-name) (let ((icbname (getenv "ICBNAME")) (forumname (getenv "FORUMNAME"))) (if icbname icbname (if forumname forumname (user-login-name)))) ;;; all that crap is nickname icb-initial-group ;;; group "login" ;;; command "" ;;; pass "" ;;; status 0 ;;; proto ) ) (switch-to-buffer "*icb*") (set-marker (process-mark (get-buffer-process "*icb*")) (point-max)) (use-local-map (copy-keymap icb-mode-map)) ) (defun icb () "logs you onto group 1 of icb." (interactive) (icb-login "") ) (defun icb-yow () (interactive) (let ((yowtext (yow))(cur 0)(thetext "")) (progn (while (< cur (length yowtext)) (if (eq (elt yowtext cur) ?\n) (setq thetext (concat thetext " ")) (setq thetext (concat thetext (char-to-string (elt yowtext cur))))) (setq cur (1+ cur)) ) (icb-send-packet icb-public-type thetext) ) ) )