X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-ndcc.el;h=cd553ae63b3313188085b08f150eefd5b463a2fe;hp=0ae4b85a259209cf86da9bb5b0e763a15fe0465c;hb=587bd93a160b3df9204ff1581132c30fd1abb344;hpb=4c5e0920f4f7e4a3140e15ac50b3302a07df6555 diff --git a/lisp/riece-ndcc.el b/lisp/riece-ndcc.el index 0ae4b85..cd553ae 100644 --- a/lisp/riece-ndcc.el +++ b/lisp/riece-ndcc.el @@ -1,4 +1,4 @@ -;;; riece-ndcc.el --- elisp native DCC add-on +;;; riece-ndcc.el --- DCC file sending protocol support (written in elisp) ;; Copyright (C) 1998-2003 Daiki Ueno ;; Author: Daiki Ueno @@ -21,12 +21,19 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. +;;; Commentary: + +;; NOTE: This is an add-on module for Riece. + ;;; Code: +(require 'riece-globals) +(require 'riece-options) + (require 'calc) (defgroup riece-ndcc nil - "Elisp native DCC implementation" + "DCC written in elisp." :prefix "riece-" :group 'riece) @@ -41,6 +48,9 @@ Only used for sending files." (defvar riece-ndcc-request-user nil) (defvar riece-ndcc-request-size nil) +(defconst riece-ndcc-description + "DCC file sending protocol support (written in elisp.)") + (defun riece-ndcc-encode-address (address) (unless (string-match "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" @@ -71,7 +81,6 @@ Only used for sending files." (substring (process-name process) 0 (match-beginning 0))))) (save-excursion (set-buffer (process-buffer (get-process parent-name))) - (delete-process parent-name) (goto-char (point-min)) (while (not (eobp)) (process-send-region process @@ -80,18 +89,18 @@ Only used for sending files." (message "Sending %s...(%d/%d)" (buffer-file-name) (1- (point)) (buffer-size))) (message "Sending %s...done" - (buffer-file-name)))) - (kill-buffer (process-buffer process)) - (delete-process process))) + (buffer-file-name))) + (kill-buffer (process-buffer (get-process parent-name)))) + (kill-buffer (process-buffer process)))) (defun riece-command-dcc-send (user file) (interactive (let ((completion-ignore-case t)) (unless riece-ndcc-server-address (error "Set riece-ndcc-server-address to your host")) - (list (completing-read + (list (riece-completing-read-identity "User: " - (mapcar #'list (riece-get-users-on-server))) + (riece-get-users-on-server (riece-current-server-name))) (expand-file-name (read-file-name "File: "))))) (let* (selective-display (coding-system-for-read 'binary) @@ -108,7 +117,8 @@ Only used for sending files." :sentinel 'riece-ndcc-server-sentinel)) (riece-send-string (format "PRIVMSG %s :\1DCC SEND %s %s %d %d\1\r\n" - user (file-name-nondirectory file) + (riece-identity-prefix user) + (file-name-nondirectory file) (riece-ndcc-encode-address riece-ndcc-server-address) (nth 1 (process-contact process)) (nth 7 (file-attributes file)))))) @@ -152,7 +162,8 @@ Only used for sending files." (car (car requests)) (nth 1 (car requests)) (nth 4 (car requests)))) - (setq requests (cdr requests))))) + (setq index (1+ index) + requests (cdr requests))))) (let ((number (read-string "Request#: "))) (unless (string-match "^[0-9]+$" number) (error "Not a number")) @@ -169,6 +180,7 @@ Only used for sending files." "DCC" " *DCC*" (riece-ndcc-decode-address (nth 2 request)) (nth 3 request)))) + (setq riece-ndcc-requests (delq request riece-ndcc-requests)) (with-current-buffer (process-buffer process) (set-buffer-multibyte nil) (buffer-disable-undo) @@ -182,17 +194,17 @@ Only used for sending files." (defun riece-handle-dcc-request (prefix target message) (let ((case-fold-search t)) - (when (string-match - "SEND \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" - message) + (when (and (get 'riece-ndcc 'riece-addon-enabled) + (string-match + "SEND \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" + message)) (let ((file (match-string 1 message)) (address (match-string 2 message)) (port (string-to-number (match-string 3 message))) (size (string-to-number (match-string 4 message))) (buffer (if (riece-channel-p target) - (cdr (riece-identity-assoc-no-server - (riece-make-identity target) - riece-channel-buffer-alist)))) + (riece-channel-buffer (riece-make-identity + target riece-server-name)))) (user (riece-prefix-nickname prefix))) (setq riece-ndcc-requests (cons (list user file address port size) @@ -218,10 +230,21 @@ Only used for sending files." (defvar riece-dialogue-mode-map) (defun riece-ndcc-insinuate () - (add-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request) + (unless (fboundp 'make-network-process) + (error "This Emacs does not have make-network-process")) + (add-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request)) + +(defun riece-ndcc-uninstall () + (remove-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request)) + +(defun riece-ndcc-enable () (define-key riece-dialogue-mode-map "\C-ds" 'riece-command-dcc-send) (define-key riece-dialogue-mode-map "\C-dr" 'riece-command-dcc-receive)) +(defun riece-ndcc-disable () + (define-key riece-dialogue-mode-map "\C-ds" nil) + (define-key riece-dialogue-mode-map "\C-dr" nil)) + (provide 'riece-ndcc) ;;; riece-ndcc.el ends here