X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Friece-ndcc.el;h=821308979d1a88dfe071e37ef9cdea21c690bcba;hb=94c4b47d3d9593927fe36cbd5d804d54db8be0d9;hp=dd0553a6f5b0bc0eaf663ae983a8f2ea766aa539;hpb=9174f38ace6e8cd879b41adc4d6aa4b5b727f7ea;p=riece diff --git a/lisp/riece-ndcc.el b/lisp/riece-ndcc.el index dd0553a..8213089 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 @@ -18,19 +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 'riece-globals) (require 'riece-options) -(require 'riece-display) - -(require 'calc) (defgroup riece-ndcc nil - "Elisp native DCC implementation" + "DCC written in elisp." :prefix "riece-" :group 'riece) @@ -45,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) @@ -92,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) @@ -111,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)))))) @@ -187,9 +194,10 @@ 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))) @@ -222,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