Allow numbers with different radixes to be yanked.

* lisp/calc/calc-yank.el (calc-yank): Allow radixes besides the
default base 10.

2 files changed, 93 insertions, 17 deletions

diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index c5a837d326..8d97bc69a2 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 5694a4e56a..c93b64b643 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