* eword-encode.el (make-ew-rword, ew-rword-text, ew-rword-charset)

(ew-rword-encoding, ew-rword-type)
* hmac-def.el (define-hmac-function)
* md4.el (md4-make-step)
* sha1-el.el (sha1-F0, sha1-F1, sha1-F2, sha1-F3, sha1-S1)
(sha1-S5, sha1-S30, sha1-OP, sha1-add-to-H)
* hex-util.el (hex-char-to-num, num-to-hex-char): Revert last changes.

diff --git a/ChangeLog b/ChangeLog
index cbf58e4..9a354a5 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2007-09-05  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * eword-encode.el (make-ew-rword, ew-rword-text, ew-rword-charset)
+       (ew-rword-encoding, ew-rword-type)
+       * hmac-def.el (define-hmac-function)
+       * md4.el (md4-make-step)
+       * sha1-el.el (sha1-F0, sha1-F1, sha1-F2, sha1-F3, sha1-S1)
+       (sha1-S5, sha1-S30, sha1-OP, sha1-add-to-H)
+       * hex-util.el (hex-char-to-num, num-to-hex-char): Revert last changes.
+
 2007-09-04  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * eword-encode.el (make-ew-rword, ew-rword-text, ew-rword-charset)

diff --git a/eword-encode.el b/eword-encode.el
index db0c739..06f5be5 100644 (file)
--- a/eword-encode.el
+++ b/eword-encode.el
@@ -164,15 +164,15 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
 ;;;
 
 (defmacro make-ew-rword (text charset encoding type)
-  `(list ,text ,charset ,encoding ,type))
+  (` (list (, text)(, charset)(, encoding)(, type))))
 (defmacro ew-rword-text (rword)
-  `(car ,rword))
+  (` (car (, rword))))
 (defmacro ew-rword-charset (rword)
-  `(car (cdr ,rword)))
+  (` (car (cdr (, rword)))))
 (defmacro ew-rword-encoding (rword)
-  `(car (cdr (cdr ,rword))))
+  (` (car (cdr (cdr (, rword))))))
 (defmacro ew-rword-type (rword)
-  `(car (cdr (cdr (cdr ,rword)))))
+  (` (car (cdr (cdr (cdr (, rword)))))))
 
 (defun ew-find-charset-rule (charsets)
   (if charsets

diff --git a/hex-util.el b/hex-util.el
index ed93a3e..09fca4a 100644 (file)
--- a/hex-util.el
+++ b/hex-util.el
@@ -28,14 +28,14 @@
 
 (eval-when-compile
   (defmacro hex-char-to-num (chr)
-    `(let ((chr ,chr))
-       (cond
-       ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10))
-       ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10))
-       ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
-       (t (error "Invalid hexadecimal digit `%c'" chr)))))
+    (` (let ((chr (, chr)))
+        (cond
+         ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10))
+         ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10))
+         ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
+         (t (error "Invalid hexadecimal digit `%c'" chr))))))
   (defmacro num-to-hex-char (num)
-    `(aref "0123456789abcdef" ,num)))
+    (` (aref "0123456789abcdef" (, num)))))
 
 (defun decode-hex-string (string)
   "Decode hexadecimal STRING to octet string."
@@ -43,9 +43,9 @@
         (dst (make-string (/ len 2) 0))
         (idx 0)(pos 0))
     (while (< pos len)
-      ;; logior and lsh are not byte-coded.
-      ;;  (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4)
-      ;;                           (hex-char-to-num (aref string (1+ pos)))))
+;;; logior and lsh are not byte-coded.
+;;;  (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4)
+;;;                        (hex-char-to-num (aref string (1+ pos)))))
       (aset dst idx (+ (* (hex-char-to-num (aref string pos)) 16)
                       (hex-char-to-num (aref string (1+ pos)))))
       (setq idx (1+ idx)
@@ -58,11 +58,11 @@
         (dst (make-string (* len 2) 0))
         (idx 0)(pos 0))
     (while (< pos len)
-      ;; logand and lsh are not byte-coded.
-      ;; (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15)))
+;;; logand and lsh are not byte-coded.
+;;;  (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15)))
       (aset dst idx (num-to-hex-char (/ (aref string pos) 16)))
       (setq idx (1+ idx))
-      ;;  (aset dst idx (num-to-hex-char (logand (aref string pos) 15)))
+;;;  (aset dst idx (num-to-hex-char (logand (aref string pos) 15)))
       (aset dst idx (num-to-hex-char (% (aref string pos) 16)))
       (setq idx (1+ idx)
             pos (1+ pos)))

diff --git a/hmac-def.el b/hmac-def.el
index 4b62b20..9b599d5 100644 (file)
--- a/hmac-def.el
+++ b/hmac-def.el
@@ -39,46 +39,46 @@ a string and return a digest of it (in binary form).
 B is a byte-length of a block size of H. (B=64 for both SHA1 and MD5.)
 L is a byte-length of hash outputs. (L=16 for MD5, L=20 for SHA1.)
 If BIT is non-nil, truncate output to specified bits."
-  `(defun ,name (text key)
-     ,(concat "Compute "
-             (upcase (symbol-name name))
-             " over TEXT with KEY.")
-     (let ((key-xor-ipad (make-string ,B ?\x36))
-          (key-xor-opad (make-string ,B ?\x5C))
-          (len (length key))
-          (pos 0))
-       (unwind-protect
-          (progn
-            ;; if `key' is longer than the block size, apply hash function
-            ;; to `key' and use the result as a real `key'.
-            (if (> len ,B)
-                (setq key (,H key)
-                      len ,L))
-            (while (< pos len)
-              (aset key-xor-ipad pos (logxor (aref key pos) ?\x36))
-              (aset key-xor-opad pos (logxor (aref key pos) ?\x5C))
-              (setq pos (1+ pos)))
-            (setq key-xor-ipad (unwind-protect
-                                   (concat key-xor-ipad text)
-                                 (fillarray key-xor-ipad 0))
-                  key-xor-ipad (unwind-protect
-                                   (,H key-xor-ipad)
-                                 (fillarray key-xor-ipad 0))
-                  key-xor-opad (unwind-protect
-                                   (concat key-xor-opad key-xor-ipad)
-                                 (fillarray key-xor-opad 0))
-                  key-xor-opad (unwind-protect
-                                   (,H key-xor-opad)
-                                 (fillarray key-xor-opad 0)))
-            ;; now `key-xor-opad' contains
-            ;; H(KEY XOR opad, H(KEY XOR ipad, TEXT)).
-            ,(if (and bit (< (/ bit 8) L))
-                 `(substring key-xor-opad 0 ,(/ bit 8))
-               ;; return a copy of `key-xor-opad'.
-               `(concat key-xor-opad)))
-        ;; cleanup.
-        (fillarray key-xor-ipad 0)
-        (fillarray key-xor-opad 0)))))
+  (` (defun (, name) (text key)
+       (, (concat "Compute "
+                 (upcase (symbol-name name))
+                 " over TEXT with KEY."))
+       (let ((key-xor-ipad (make-string (, B) ?\x36))
+            (key-xor-opad (make-string (, B) ?\x5C))
+            (len (length key))
+            (pos 0))
+        (unwind-protect
+            (progn
+              ;; if `key' is longer than the block size, apply hash function
+              ;; to `key' and use the result as a real `key'.
+              (if (> len (, B))
+                  (setq key ((, H) key)
+                        len (, L)))
+              (while (< pos len)
+                (aset key-xor-ipad pos (logxor (aref key pos) ?\x36))
+                (aset key-xor-opad pos (logxor (aref key pos) ?\x5C))
+                (setq pos (1+ pos)))
+              (setq key-xor-ipad (unwind-protect
+                                     (concat key-xor-ipad text)
+                                   (fillarray key-xor-ipad 0))
+                    key-xor-ipad (unwind-protect
+                                     ((, H) key-xor-ipad)
+                                   (fillarray key-xor-ipad 0))
+                    key-xor-opad (unwind-protect
+                                     (concat key-xor-opad key-xor-ipad)
+                                   (fillarray key-xor-opad 0))
+                    key-xor-opad (unwind-protect
+                                     ((, H) key-xor-opad)
+                                   (fillarray key-xor-opad 0)))
+              ;; now `key-xor-opad' contains
+              ;; H(KEY XOR opad, H(KEY XOR ipad, TEXT)).
+              (, (if (and bit (< (/ bit 8) L))
+                     (` (substring key-xor-opad 0 (, (/ bit 8))))
+                   ;; return a copy of `key-xor-opad'.
+                   (` (concat key-xor-opad)))))
+          ;; cleanup.
+          (fillarray key-xor-ipad 0)
+          (fillarray key-xor-opad 0))))))
 
 (provide 'hmac-def)
 

diff --git a/md4.el b/md4.el
index adfc5ec..43af2ae 100644 (file)
--- a/md4.el
+++ b/md4.el
@@ -88,10 +88,11 @@ bytes long.  N is required to handle strings containing character 0."
 (defsubst md4-H (x y z) (logxor x y z))
 
 (defmacro md4-make-step (name func)
-  `(defun ,name (a b c d xk s ac)
+  (`
+   (defun (, name) (a b c d xk s ac)
      (let*
-         ((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac)))
-          (l1 (+ (cdr a) (,func (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac)))
+         ((h1 (+ (car a) ((, func) (car b) (car c) (car d)) (car xk) (car ac)))
+          (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac)))
           (h2 (logand 65535 (+ h1 (lsh l1 -16))))
           (l2 (logand 65535 l1))
          ;; cyclic shift of 32 bits integer
@@ -101,7 +102,7 @@ bytes long.  N is required to handle strings containing character 0."
           (l3 (logand 65535 (if (> s 15)
                                 (+ (lsh l2 (- s 32)) (lsh h2 (- s 16)))
                               (+ (lsh l2 s) (lsh h2 (- s 16)))))))
-       (cons h3 l3))))
+       (cons h3 l3)))))
 
 (md4-make-step md4-round1 md4-F)
 (md4-make-step md4-round2 md4-G)

diff --git a/sha1-el.el b/sha1-el.el
index dbb9e07..82657b8 100644 (file)
--- a/sha1-el.el
+++ b/sha1-el.el
@@ -123,93 +123,93 @@ If this variable is set to nil, use internal function only."
   (defconst sha1-K3-high 51810)                ; (string-to-number "CA62" 16)
   (defconst sha1-K3-low  49622)                ; (string-to-number "C1D6" 16)
 
-  ;; original definition of sha1-F0.
-  ;; (defmacro sha1-F0 (B C D)
-  ;;   `(logior (logand ,B ,C)
-  ;;        (logand (lognot ,B) ,D)))
-  ;; a little optimization from GnuPG/cipher/sha1.c.
+;;; original definition of sha1-F0.
+;;; (defmacro sha1-F0 (B C D)
+;;;   (` (logior (logand (, B) (, C))
+;;;         (logand (lognot (, B)) (, D)))))
+;;; a little optimization from GnuPG/cipher/sha1.c.
   (defmacro sha1-F0 (B C D)
-    `(logxor ,D (logand ,B (logxor ,C ,D))))
+    (` (logxor (, D) (logand (, B) (logxor (, C) (, D))))))
   (defmacro sha1-F1 (B C D)
-    `(logxor ,B ,C ,D))
-  ;; original definition of sha1-F2.
-  ;; (defmacro sha1-F2 (B C D)
-  ;;   `(logior (logand ,B ,C)
-  ;;        (logand ,B ,D)
-  ;;        (logand ,C ,D)))
-  ;; a little optimization from GnuPG/cipher/sha1.c.
+    (` (logxor (, B) (, C) (, D))))
+;;; original definition of sha1-F2.
+;;; (defmacro sha1-F2 (B C D)
+;;;   (` (logior (logand (, B) (, C))
+;;;         (logand (, B) (, D))
+;;;         (logand (, C) (, D)))))
+;;; a little optimization from GnuPG/cipher/sha1.c.
   (defmacro sha1-F2 (B C D)
-    `(logior (logand ,B ,C)
-            (logand ,D (logior ,B ,C))))
+    (` (logior (logand (, B) (, C))
+              (logand (, D) (logior (, B) (, C))))))
   (defmacro sha1-F3 (B C D)
-    `(logxor ,B ,C ,D))
+    (` (logxor (, B) (, C) (, D))))
 
   (defmacro sha1-S1  (W-high W-low)
-    `(let ((W-high ,W-high)
-          (W-low  ,W-low))
-       (setq S1W-high (+ (% (* W-high 2) 65536)
-                        (/ W-low ,(/ 65536 2))))
-       (setq S1W-low (+ (/ W-high ,(/ 65536 2))
-                       (% (* W-low 2) 65536)))))
+    (` (let ((W-high (, W-high))
+            (W-low  (, W-low)))
+        (setq S1W-high (+ (% (* W-high 2) 65536)
+                          (/ W-low (, (/ 65536 2)))))
+        (setq S1W-low (+ (/ W-high (, (/ 65536 2)))
+                         (% (* W-low 2) 65536))))))
   (defmacro sha1-S5  (A-high A-low)
-    `(progn
-       (setq S5A-high (+ (% (* ,A-high 32) 65536)
-                        (/ ,A-low ,(/ 65536 32))))
-       (setq S5A-low  (+ (/ ,A-high ,(/ 65536 32))
-                        (% (* ,A-low 32) 65536)))))
+    (` (progn
+        (setq S5A-high (+ (% (* (, A-high) 32) 65536)
+                          (/ (, A-low) (, (/ 65536 32)))))
+        (setq S5A-low  (+ (/ (, A-high) (, (/ 65536 32)))
+                          (% (* (, A-low) 32) 65536))))))
   (defmacro sha1-S30 (B-high B-low)
-    `(progn
-       (setq S30B-high (+ (/ ,B-high 4)
-                         (* (% ,B-low 4) ,(/ 65536 4))))
-       (setq S30B-low  (+ (/ ,B-low 4)
-                         (* (% ,B-high 4) ,(/ 65536 4))))))
+    (` (progn
+        (setq S30B-high (+ (/ (, B-high) 4)
+                           (* (% (, B-low) 4) (, (/ 65536 4)))))
+        (setq S30B-low  (+ (/ (, B-low) 4)
+                           (* (% (, B-high) 4) (, (/ 65536 4))))))))
 
   (defmacro sha1-OP (round)
-    `(progn
-       (sha1-S5 sha1-A-high sha1-A-low)
-       (sha1-S30 sha1-B-high sha1-B-low)
-       (setq sha1-A-low (+ (,(intern (format "sha1-F%d" round))
-                           sha1-B-low sha1-C-low sha1-D-low)
-                          sha1-E-low
-                          ,(symbol-value
-                            (intern (format "sha1-K%d-low" round)))
-                          (aref block-low idx)
-                          (progn
-                            (setq sha1-E-low sha1-D-low)
-                            (setq sha1-D-low sha1-C-low)
-                            (setq sha1-C-low S30B-low)
-                            (setq sha1-B-low sha1-A-low)
-                            S5A-low)))
-       (setq carry (/ sha1-A-low 65536))
-       (setq sha1-A-low (% sha1-A-low 65536))
-       (setq sha1-A-high (% (+ (,(intern (format "sha1-F%d" round))
-                               sha1-B-high sha1-C-high sha1-D-high)
-                              sha1-E-high
-                              ,(symbol-value
-                                (intern (format "sha1-K%d-high" round)))
-                              (aref block-high idx)
-                              (progn
-                                (setq sha1-E-high sha1-D-high)
-                                (setq sha1-D-high sha1-C-high)
-                                (setq sha1-C-high S30B-high)
-                                (setq sha1-B-high sha1-A-high)
-                                S5A-high)
-                              carry)
-                           65536))))
+    (` (progn
+        (sha1-S5 sha1-A-high sha1-A-low)
+        (sha1-S30 sha1-B-high sha1-B-low)
+        (setq sha1-A-low (+ ((, (intern (format "sha1-F%d" round)))
+                             sha1-B-low sha1-C-low sha1-D-low)
+                            sha1-E-low
+                            (, (symbol-value
+                                (intern (format "sha1-K%d-low" round))))
+                            (aref block-low idx)
+                            (progn
+                              (setq sha1-E-low sha1-D-low)
+                              (setq sha1-D-low sha1-C-low)
+                              (setq sha1-C-low S30B-low)
+                              (setq sha1-B-low sha1-A-low)
+                              S5A-low)))
+        (setq carry (/ sha1-A-low 65536))
+        (setq sha1-A-low (% sha1-A-low 65536))
+        (setq sha1-A-high (% (+ ((, (intern (format "sha1-F%d" round)))
+                                 sha1-B-high sha1-C-high sha1-D-high)
+                                sha1-E-high
+                                (, (symbol-value
+                                    (intern (format "sha1-K%d-high" round))))
+                                (aref block-high idx)
+                                (progn
+                                  (setq sha1-E-high sha1-D-high)
+                                  (setq sha1-D-high sha1-C-high)
+                                  (setq sha1-C-high S30B-high)
+                                  (setq sha1-B-high sha1-A-high)
+                                  S5A-high)
+                                carry)
+                             65536)))))
 
   (defmacro sha1-add-to-H (H X)
-    `(progn
-       (setq ,(intern (format "sha1-%s-low" H))
-            (+ ,(intern (format "sha1-%s-low" H))
-               ,(intern (format "sha1-%s-low" X))))
-       (setq carry (/ ,(intern (format "sha1-%s-low" H)) 65536))
-       (setq ,(intern (format "sha1-%s-low" H))
-            (% ,(intern (format "sha1-%s-low" H)) 65536))
-       (setq ,(intern (format "sha1-%s-high" H))
-            (% (+ ,(intern (format "sha1-%s-high" H))
-                  ,(intern (format "sha1-%s-high" X))
-                  carry)
-               65536))))
+    (` (progn
+        (setq (, (intern (format "sha1-%s-low" H)))
+              (+ (, (intern (format "sha1-%s-low" H)))
+                 (, (intern (format "sha1-%s-low" X)))))
+        (setq carry (/ (, (intern (format "sha1-%s-low" H))) 65536))
+        (setq (, (intern (format "sha1-%s-low" H)))
+              (% (, (intern (format "sha1-%s-low" H))) 65536))
+        (setq (, (intern (format "sha1-%s-high" H)))
+              (% (+ (, (intern (format "sha1-%s-high" H)))
+                    (, (intern (format "sha1-%s-high" X)))
+                    carry)
+                 65536)))))
   )
 
 ;;; buffers (H0 H1 H2 H3 H4).
@@ -433,7 +433,8 @@ hash of a portion of OBJECT.
 If BINARY is non-nil, return a string in binary form."
   (if (stringp object)
       (sha1-string object binary)
-    (with-current-buffer object
+    (save-excursion
+      (set-buffer object)
       (sha1-region (or beg (point-min)) (or end (point-max)) binary))))
 
 (provide 'sha1-el)