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 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