X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Friece-yank.el;h=914d05f02ca48a7ed83d1f92632e42bcd1f813f9;hb=8052c56a80af6ecf101643ed060e6ea0afc8aa3a;hp=fdb5b34535b1273222a52614987a6d758d0cfac6;hpb=ed265c45e422c89d72d162e42d41756ccd9b9b66;p=elisp%2Friece.git diff --git a/lisp/riece-yank.el b/lisp/riece-yank.el index fdb5b34..914d05f 100644 --- a/lisp/riece-yank.el +++ b/lisp/riece-yank.el @@ -1,4 +1,4 @@ -;;; riece-kill.el --- enter the element in kill-ring +;;; riece-yank.el --- enter the element of kill-ring ;; Copyright (C) 2004 Masatake YAMATO ;; Author: Masatake YAMATO @@ -16,20 +16,18 @@ ;; 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: -;; -;; In riece's command buffer, you can send the top element of kill-ring -;; by C-c y. -;; Don't forget do (riece-command-enable-addon 'riece-yank). -;; + +;; NOTE: This is an add-on module for Riece. + ;;; Code: (require 'riece-commands) (defgroup riece-yank nil - "Enter the element of `kill-ring'" + "Enter the element of kill-ring." :tag "Yank" :prefix "riece-" :group 'riece) @@ -45,56 +43,59 @@ before/after the first/last non-blank line." :type 'boolean :group 'riece-yank) -(defvar riece-yank-enabled nil) +(defconst riece-yank-description + "Enter the element of kill-ring.") (defun riece-yank-insinuate () ) +(defvar riece-command-mode-map) (defun riece-yank-enable () - (define-key riece-command-mode-map "\C-cy" 'riece-command-yank) - (setq riece-yank-enabled t)) + (define-key riece-command-mode-map "\C-cy" 'riece-command-yank)) (defun riece-yank-disable () - (define-key riece-command-mode-map "\C-cy" 'undefined) - (setq riece-yank-enabled nil)) + (define-key riece-command-mode-map "\C-cy" 'undefined)) + +(defun riece-yank-strip-space (string) + (with-temp-buffer + (insert string) + (untabify (point-min) (point-max)) + ;; Delete blank lines before the first non-blank line. + (goto-char (point-min)) + (while (looking-at " *$") + (delete-region (point) (progn (forward-line) (point)))) + ;; Delete blank lines after the last non-blank line. + (goto-char (point-max)) + (while (progn (beginning-of-line) (looking-at " *$")) + (delete-region (point) (progn (end-of-line 0) (point)))) + ;; Delete common spaces in front of lines. + (let ((space-width (point-max))) + (while (looking-at " +") + (setq space-width (min space-width (length (match-string 0)))) + (forward-line)) + (goto-char (point-min)) + (while (not (eobp)) + (delete-char space-width) + (forward-line))) + (buffer-string))) -(defun riece-command-yank (prefix) - (interactive "sPrefix: ") +(defun riece-command-yank (arg prefix) + (interactive "P\nsPrefix: ") (when (or (not prefix) (string= prefix "")) (setq prefix " ")) (let* ((kill (current-kill 0)) - msg space-width) + msg) (unless kill (error "Nothing to send in kill-ring")) (if riece-yank-strip-space - (with-temp-buffer - (insert kill) - (untabify (point-min) (point-max)) - ;; Delete blank lines before the first non-blank line. - (goto-char (point-min)) - (while (looking-at " *$") - (delete-region (point) (progn (forward-line) (point)))) - ;; Delete blank lines after the last non-blank line. - (goto-char (point-max)) - (while (progn (beginning-of-line) (looking-at " *$")) - (delete-region (point) (progn (end-of-line 0) (point)))) - ;; Delete common spaces in front of lines. - (setq space-width (point-max)) - (while (looking-at " +") - (setq space-width (min space-width (length (match-string 0)))) - (forward-line)) - (goto-char (point-min)) - (while (not (eobp)) - (delete-char space-width) - (forward-line)) - (setq kill (buffer-string)))) + (setq kill (riece-yank-strip-space kill))) (setq msg (split-string kill "\n")) (when (y-or-n-p (format "Send \"%s\"\n? " kill)) (mapcar (lambda (x) - (riece-command-send-message (concat prefix x) nil) + (riece-command-send-message (concat prefix x) arg) ;; Without next line, you will be kicked out from ircd. - ;; It may means "Don't send much data at once." + ;; It may mean "Don't send much data at once." (sit-for riece-yank-tick)) msg))))