From: Kaushal Modi Date: Sat, 10 Oct 2015 23:36:51 +0000 (-0500) Subject: Allow numbers with different radixes to be yanked. X-Git-Tag: emacs-25.0.90~1170 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ec0d4d24fd11b5040de9f7657b486c3b1e743071;p=emacs.git Allow numbers with different radixes to be yanked. * lisp/calc/calc-yank.el (calc-yank): Allow radixes besides the default base 10. --- diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index c5a837d3260..8d97bc69a2d 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1287,7 +1287,7 @@ Redefine the corresponding command." (setq rpt-count (if rpt-count (prefix-numeric-value rpt-count) 1000000)) (let* ((count 0) (parts nil) - (body (vector) ) + (body (vector)) (open last-command-event) (counter initial) ch) @@ -1300,7 +1300,7 @@ Redefine the corresponding command." (if (eq ch ?Z) (progn (setq ch (read-event) - body (vconcat body (vector ?Z ch) )) + body (vconcat body (vector ?Z ch))) (cond ((memq ch '(?\< ?\( ?\{)) (setq count (1+ count))) ((memq ch '(?\> ?\) ?\})) diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index 5694a4e56ae..c93b64b6436 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -111,25 +111,101 @@ ;; otherwise it just parses the yanked string. ;; Modified to use Emacs 19 extended concept of kill-ring. -- daveg 12/15/96 ;;;###autoload -(defun calc-yank () - (interactive) +(defun calc-yank (radix) + "Yank a value into the Calculator buffer. + +Valid numeric prefixes for RADIX: 0, 2, 6, 8 +No radix notation is prepended for any other numeric prefix. + +If RADIX is 2, prepend \"2#\" - Binary. +If RADIX is 8, prepend \"8#\" - Octal. +If RADIX is 0, prepend \"10#\" - Decimal. +If RADIX is 6, prepend \"16#\" - Hexadecimal. + +If RADIX is a non-nil list (created using \\[universal-argument]), the user +will be prompted to enter the radix in the minibuffer. + +If RADIX is nil or if the yanked string already has a calc radix prefix, the +yanked string will be passed on directly to the Calculator buffer without any +alteration." + (interactive "P") (calc-wrapper (calc-pop-push-record-list 0 "yank" - (let ((thing (if (fboundp 'current-kill) - (current-kill 0 t) - (car kill-ring-yank-pointer)))) + (let* (radix-num + radix-notation + valid-num-regexp + (thing-raw + (if (fboundp 'current-kill) + (current-kill 0 t) + (car kill-ring-yank-pointer))) + (thing + (if (or (null radix) + ;; Match examples: -2#10, 10\n(10#10,01) + (string-match-p "^[-(]*[0-9]\\{1,2\\}#" thing-raw)) + thing-raw + (progn + (if (listp radix) + (progn + (setq radix-num + (read-number + "Set radix for yanked content (2-36): ")) + (when (not (and (integerp radix-num) + (<= 2 radix-num) + (>= 36 radix-num))) + (error (concat "The radix has to be an " + "integer between 2 and 36.")))) + (setq radix-num + (cond ((eq radix 2) 2) + ((eq radix 8) 8) + ((eq radix 0) 10) + ((eq radix 6) 16) + (t (message + (concat "No radix prepended " + "for invalid *numeric* " + "prefix %0d.") + radix) + nil)))) + (if radix-num + (progn + (setq radix-notation + (concat (number-to-string radix-num) "#")) + (setq valid-num-regexp + (cond + ;; radix 2 to 10 + ((and (<= 2 radix-num) + (>= 10 radix-num)) + (concat "[0-" + (number-to-string (1- radix-num)) + "]+")) + ;; radix 11 + ((= 11 radix-num) "[0-9aA]+") + ;; radix 12+ + (t + (concat "[0-9" + "a-" (format "%c" (+ (- ?a 11) radix-num)) + "A-" (format "%c" (+ (- ?A 11) radix-num)) + "]+")))) + ;; Ensure that the radix-notation is prefixed + ;; correctly even for multi-line yanks like below, + ;; 111 + ;; 1111 + (replace-regexp-in-string + valid-num-regexp + (concat radix-notation "\\&") + thing-raw)) + thing-raw))))) (if (eq (car-safe calc-last-kill) thing) - (cdr calc-last-kill) - (if (stringp thing) - (let ((val (math-read-exprs (calc-clean-newlines thing)))) - (if (eq (car-safe val) 'error) - (progn - (setq val (math-read-exprs thing)) - (if (eq (car-safe val) 'error) - (error "Bad format in yanked data") - val)) - val)))))))) + (cdr calc-last-kill) + (if (stringp thing) + (let ((val (math-read-exprs (calc-clean-newlines thing)))) + (if (eq (car-safe val) 'error) + (progn + (setq val (math-read-exprs thing)) + (if (eq (car-safe val) 'error) + (error "Bad format in yanked data") + val)) + val)))))))) ;;; The Calc set- and get-register commands are modified versions of functions ;;; in register.el