[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 15357f6 1/2: Add a new function `buffer-hash'
From: |
Lars Ingebrigtsen |
Subject: |
[Emacs-diffs] master 15357f6 1/2: Add a new function `buffer-hash' |
Date: |
Mon, 28 Mar 2016 17:08:53 +0000 |
branch: master
commit 15357f6d1f90b03719f650823ac6531a305a9818
Author: Lars Magne Ingebrigtsen <address@hidden>
Commit: Lars Magne Ingebrigtsen <address@hidden>
Add a new function `buffer-hash'
* doc/lispref/text.texi (Checksum/Hash): Document `buffer-hash'.
* src/fns.c (Fbuffer_hash): New function.
(make_digest_string): Refactored out into its own function.
(secure_hash): Use it.
* test/src/fns-tests.el (fns-tests-hash-buffer): New tests.
---
doc/lispref/text.texi | 14 ++++++++++
etc/NEWS | 4 +++
src/fns.c | 68 +++++++++++++++++++++++++++++++++++++++++--------
test/src/fns-tests.el | 16 +++++++++++
4 files changed, 91 insertions(+), 11 deletions(-)
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 4c3a1a0..5e47316 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4468,6 +4468,20 @@ using the specified or chosen coding system. However, if
coding instead.
@end defun
address@hidden buffer-hash &optional buffer-or-name
+Return a hash of @var{buffer-or-name}. If @code{nil}, this defaults
+to the current buffer. As opposed to @code{secure-hash}, this
+function computes the hash based on the internal representation of the
+buffer, disregarding any coding systems. It's therefore only useful
+when comparing two buffers running in the same Emacs, and is not
+guaranteed to return the same hash between different Emacs versions.
+It should be somewhat more efficient on larger buffers than
address@hidden is, and should not allocate more memory.
address@hidden Note that we do not document what hashing function we're using,
or
address@hidden even whether it's a cryptographic hash, since that may change
address@hidden according to what we find useful.
address@hidden defun
+
@node Parsing HTML/XML
@section Parsing HTML and XML
@cindex parsing html
diff --git a/etc/NEWS b/etc/NEWS
index ce21532..0a36371 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -53,6 +53,10 @@ has been added. They are: 'file-attribute-type',
'file-attribute-modes', 'file-attribute-inode-number', and
'file-attribute-device-number'
++++
+** The new function `buffer-hash' has been added, and can be used to
+compute a fash, non-consing hash of the contents of a buffer.
+
---
** The locale language name 'ca' is now mapped to the language
environment 'Catalan', which has been added.
diff --git a/src/fns.c b/src/fns.c
index 0e3fc27..9513387 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4737,6 +4737,22 @@ returns nil, then (funcall TEST x1 x2) also returns nil.
*/)
#include "sha256.h"
#include "sha512.h"
+Lisp_Object
+make_digest_string (Lisp_Object digest, int digest_size)
+{
+ unsigned char *p = SDATA (digest);
+ int i;
+
+ for (i = digest_size - 1; i >= 0; i--)
+ {
+ static char const hexdigit[16] = "0123456789abcdef";
+ int p_i = p[i];
+ p[2 * i] = hexdigit[p_i >> 4];
+ p[2 * i + 1] = hexdigit[p_i & 0xf];
+ }
+ return digest;
+}
+
/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
static Lisp_Object
@@ -4936,17 +4952,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object,
Lisp_Object start,
SSDATA (digest));
if (NILP (binary))
- {
- unsigned char *p = SDATA (digest);
- for (i = digest_size - 1; i >= 0; i--)
- {
- static char const hexdigit[16] = "0123456789abcdef";
- int p_i = p[i];
- p[2 * i] = hexdigit[p_i >> 4];
- p[2 * i + 1] = hexdigit[p_i & 0xf];
- }
- return digest;
- }
+ return make_digest_string (digest, digest_size);
else
return make_unibyte_string (SSDATA (digest), digest_size);
}
@@ -4997,6 +5003,45 @@ If BINARY is non-nil, returns a string in binary form.
*/)
{
return secure_hash (algorithm, object, start, end, Qnil, Qnil, binary);
}
+
+DEFUN ("buffer-hash", Fbuffer_hash, Sbuffer_hash, 0, 1, 0,
+ doc: /* Return a hash of the contents of BUFFER-OR-NAME.
+This hash is performed on the raw internal format of the buffer,
+disregarding any coding systems.
+If nil, use the current buffer." */ )
+ (Lisp_Object buffer_or_name)
+{
+ Lisp_Object buffer;
+ struct buffer *b;
+ struct sha1_ctx ctx;
+ Lisp_Object digest = make_uninit_string (SHA1_DIGEST_SIZE * 2);
+
+ if (NILP (buffer_or_name))
+ buffer = Fcurrent_buffer ();
+ else
+ buffer = Fget_buffer (buffer_or_name);
+ if (NILP (buffer))
+ nsberror (buffer_or_name);
+
+ b = XBUFFER (buffer);
+ sha1_init_ctx (&ctx);
+
+ /* Process the first part of the buffer. */
+ sha1_process_bytes (BUF_BEG_ADDR (b),
+ BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b),
+ &ctx);
+
+ /* If the gap is before the end of the buffer, process the last half
+ of the buffer. */
+ if (BUF_GPT_BYTE (b) < BUF_Z_BYTE (b))
+ sha1_process_bytes (BUF_GAP_END_ADDR (b),
+ BUF_Z_ADDR (b) - BUF_GAP_END_ADDR (b),
+ &ctx);
+
+ sha1_finish_ctx (&ctx, SSDATA (digest));
+ return make_digest_string (digest, SHA1_DIGEST_SIZE);
+}
+
void
syms_of_fns (void)
@@ -5156,6 +5201,7 @@ this variable. */);
defsubr (&Sbase64_decode_string);
defsubr (&Smd5);
defsubr (&Ssecure_hash);
+ defsubr (&Sbuffer_hash);
defsubr (&Slocale_info);
hashtest_eq.name = Qeq;
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 688ff1f..8485896 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -219,3 +219,19 @@
(should (equal (func-arity (eval (lambda (x &optional y)) nil)) '(1 . 2)))
(should (equal (func-arity (eval (lambda (x &optional y)) t)) '(1 . 2)))
(should (equal (func-arity 'let) '(1 . unevalled))))
+
+(ert-deftest fns-tests-hash-buffer ()
+ (should (equal (sha1 "foo") "0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33"))
+ (should (equal (with-temp-buffer
+ (insert "foo")
+ (buffer-hash))
+ (sha1 "foo")))
+ ;; This tests whether the presence of a gap in the middle of the
+ ;; buffer is handled correctly.
+ (should (equal (with-temp-buffer
+ (insert "foo")
+ (goto-char 2)
+ (insert " ")
+ (backward-delete-char 1)
+ (buffer-hash))
+ (sha1 "foo"))))