X-Git-Url: http://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-ndcc.el;h=1cf4cb7719636f00b89f1f32c66b9199ae2158d0;hp=ca9244ce92a3775b52597e3fecd0e73400aa59c2;hb=9fef09b977aaf04b431355dac2b4978af0e39f7e;hpb=a0a7f54b2c805f1c2cf3063e4bcd26be621d0439 diff --git a/lisp/riece-ndcc.el b/lisp/riece-ndcc.el index ca9244c..1cf4cb7 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) -*- lexical-binding: t -*- ;; Copyright (C) 1998-2003 Daiki Ueno ;; Author: Daiki Ueno @@ -18,15 +18,20 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; NOTE: This is an add-on module for Riece. ;;; Code: -(require 'calc) +(require 'riece-globals) +(require 'riece-options) (defgroup riece-ndcc nil - "Elisp native DCC implementation" + "DCC written in elisp." :prefix "riece-" :group 'riece) @@ -41,28 +46,33 @@ 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]+\\)$" address) (error "% is not an IP address" address)) - (let ((calc-number-radix 10)) - (calc-eval (format "%s * (2 ** 24) + %s * (2 **16) + %s * (2 ** 8) + %s" - (match-string 1 address) - (match-string 2 address) - (match-string 3 address) - (match-string 4 address))))) + (let ((string (number-to-string + (+ (* (float (string-to-number (match-string 1 address))) + 16777216) + (* (float (string-to-number (match-string 2 address))) + 65536) + (* (float (string-to-number (match-string 3 address))) + 256) + (float (string-to-number (match-string 4 address))))))) + (if (string-match "\\." string) + (substring string 0 (match-beginning 0)) + string))) (defun riece-ndcc-decode-address (address) - (format "%d.%d.%d.%d" - (floor (string-to-number - (calc-eval (format "(%s / (2 ** 24)) %% 256" address)))) - (floor (string-to-number - (calc-eval (format "(%s / (2 ** 16)) %% 256" address)))) - (floor (string-to-number - (calc-eval (format "(%s / (2 ** 8)) %% 256" address)))) - (floor (string-to-number - (calc-eval (format "%s %% 256" address)))))) + (let ((float-address (string-to-number (concat address ".0")))) + (format "%d.%d.%d.%d" + (floor (mod (/ float-address 16777216) 256)) + (floor (mod (/ float-address 65536) 256)) + (floor (mod (/ float-address 256) 256)) + (floor (mod float-address 256))))) (defun riece-ndcc-server-sentinel (process status) (when (string-match "^open from " status) @@ -88,9 +98,9 @@ Only used for sending files." (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) @@ -107,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)))))) @@ -169,7 +180,7 @@ Only used for sending files." "DCC" " *DCC*" (riece-ndcc-decode-address (nth 2 request)) (nth 3 request)))) - (setq riece-rdcc-requests (delq request riece-rdcc-requests)) + (setq riece-ndcc-requests (delq request riece-ndcc-requests)) (with-current-buffer (process-buffer process) (set-buffer-multibyte nil) (buffer-disable-undo) @@ -183,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 - (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) @@ -219,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