From 8321b7af6f5249009bd1b76c0ccbf81b5dff70fb Mon Sep 17 00:00:00 2001 From: Raimon Grau 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 ("" 1 url "mailto:foo@example.com") - ("" 1 url "ftp://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