bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#32372: [PATCH] Add "uuid" to thing-at-point.el


From: Raimon Grau
Subject: bug#32372: [PATCH] Add "uuid" to thing-at-point.el
Date: Mon, 06 Aug 2018 00:24:02 +0100

Raimon Grau <address@hidden> writes:

> Hi,
>
> I've added UUID to thing-at-point.  I think it's a standard enough
> format that makes sense to have it in the core. It's my 2nd
> contribution, so still getting used to the tools and standards.
>
> The implementation relies on a regular expression to accept the
> different versions of uuids (versions 1 to 5), and also the "Nil UUID".
>
> I'm using rx as it makes clearer the intent of what we're parsing at
> each point. I hope it's ok to use it (I don't see it used a lot in emacs
> itself).
>
> If there are any comments or fixes to do, point them out and I'll make
> the changes accordingly.
>
> Thanks,
>
> Raimon Grau

Hi again,

Sending here an updated patch with improved comment message.

Sorry for the noise, hope this one is ok!

Raimon Grau

>From 8321b7af6f5249009bd1b76c0ccbf81b5dff70fb Mon Sep 17 00:00:00 2001
From: Raimon Grau <address@hidden>
Date: Sun, 5 Aug 2018 22:47:30 +0100
Subject: [PATCH] Add uuid as allowed thingatpt symbol

* lisp/thingatpt.el (thing-at-point-uuid-regexp): Add regexp for uuid.
* test/lisp/thingatpt-tests.el: Add tests for uuid at point.
---
 etc/NEWS                     |  6 ++++++
 lisp/thingatpt.el            | 41 ++++++++++++++++++++++++++++++++++++++---
 test/lisp/thingatpt-tests.el | 11 ++++++++++-
 3 files changed, 54 insertions(+), 4 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index a1c12a6..ee94572 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -96,6 +96,12 @@ option 'vc-hg-symbolic-revision-styles' to the value 
'("{rev}")'.
 ---
 ** shadowfile.el has been rewritten to support Tramp file names.
 
+---
+** thingatpt.el supports a new "thing" called 'uuid'.
+
+A symbol 'uuid' can be passed to thing-at-point and it returns the
+uuid at point.
+
 
 * New Modes and Packages in Emacs 26.2
 
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 6a978fe..ca8a5bd 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -58,7 +58,7 @@ forward-thing
   "Move forward to the end of the Nth next THING.
 THING should be a symbol specifying a type of syntactic entity.
 Possibilities include `symbol', `list', `sexp', `defun',
-`filename', `url', `email', `word', `sentence', `whitespace',
+`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
 `line', and `page'."
   (let ((forward-op (or (get thing 'forward-op)
                        (intern-soft (format "forward-%s" thing)))))
@@ -73,7 +73,7 @@ bounds-of-thing-at-point
   "Determine the start and end buffer locations for the THING at point.
 THING should be a symbol specifying a type of syntactic entity.
 Possibilities include `symbol', `list', `sexp', `defun',
-`filename', `url', `email', `word', `sentence', `whitespace',
+`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
 `line', and `page'.
 
 See the file `thingatpt.el' for documentation on how to define a
@@ -131,7 +131,7 @@ thing-at-point
   "Return the THING at point.
 THING should be a symbol specifying a type of syntactic entity.
 Possibilities include `symbol', `list', `sexp', `defun',
-`filename', `url', `email', `word', `sentence', `whitespace',
+`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
 `line', `number', and `page'.
 
 When the optional argument NO-PROPERTIES is non-nil,
@@ -554,6 +554,41 @@ thing-at-point-email-regexp
 (put 'buffer 'end-op (lambda () (goto-char (point-max))))
 (put 'buffer 'beginning-op (lambda () (goto-char (point-min))))
 
+;; UUID
+
+(defvar thing-at-point-uuid-regexp
+  (rx (and bow
+           (or
+            "00000000-0000-0000-0000-000000000000"
+            (and
+             (repeat 8 hex-digit) "-"
+             (repeat 4 hex-digit) "-"
+             (or "1" "2" "3" "4" "5")
+             (repeat 3 hex-digit) "-"
+             (or "8" "9" "a" "b" "A" "B")
+             (repeat 3 hex-digit) "-"
+             (repeat 12 hex-digit)))
+           eow))
+  "A regular expression matching a UUID from versions 1 to 5.
+
+  More info on uuid's format in
+  https://tools.ietf.org/html/rfc4122."; )
+(put 'uuid 'bounds-of-thing-at-point
+     (lambda ()
+       (let ((thing (thing-at-point-looking-at
+                     thing-at-point-uuid-regexp 500)))
+         (if thing
+             (let ((beginning (match-beginning 0))
+                   (end (match-end 0)))
+               (cons beginning end))))))
+
+(put 'uuid 'thing-at-point
+     (lambda ()
+       (let ((boundary-pair (bounds-of-thing-at-point 'uuid)))
+         (if boundary-pair
+             (buffer-substring-no-properties
+              (car boundary-pair) (cdr boundary-pair))))))
+
 ;;  Aliases
 
 (defun word-at-point ()
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index cfb57de..e8e9b6e 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -65,7 +65,16 @@ thing-at-point-test-data
     ("http://example.com/ab)c" 4 url "http://example.com/ab)c")
     ;; URL markup, lacking schema
     ("<url:address@hidden>" 1 url "mailto:address@hidden";)
-    ("<url:ftp.example.net/abc/>" 1 url "ftp://ftp.example.net/abc/";))
+    ("<url:ftp.example.net/abc/>" 1 url "ftp://ftp.example.net/abc/";)
+    ;; UUID
+    ("12345678-1234-1234-8123-123456789012" 1 uuid 
"12345678-1234-1234-8123-123456789012")
+    ("12345678-1234-2234-9123-123456789012" 1 uuid 
"12345678-1234-2234-9123-123456789012")
+    ("12345678-1234-3234-a123-123456789012" 1 uuid 
"12345678-1234-3234-a123-123456789012")
+    ("12345678-1234-4234-b123-123456789012" 1 uuid 
"12345678-1234-4234-b123-123456789012")
+    ("12345678-1234-5234-b123-123456789012" 1 uuid 
"12345678-1234-5234-b123-123456789012")
+    ("00000000-0000-0000-0000-000000000000" 1 uuid 
"00000000-0000-0000-0000-000000000000")
+    ("12345678-1234-4234-1123-123456789012" 1 uuid nil)
+    ("12345678-1234-6aaa-1123-123456789012" 1 uuid nil))
   "List of thing-at-point tests.
 Each list element should have the form
 
-- 
2.7.4


reply via email to

[Prev in Thread] Current Thread [Next in Thread]