[Emacs-diffs] master 9604f9c: Add XDG desktop file parsing and tests

[Mark Oteiza]

branch: master
commit 9604f9cd33bcbc921fd18e894fdd8a98012fd09d
Author: Mark Oteiza <address@hidden>
Commit: Mark Oteiza <address@hidden>

    Add XDG desktop file parsing and tests
    
    * lisp/xdg.el: Add support for Desktop Entry Specification.
    (xdg--user-dirs-parse-line): Check if file is readable.
    (xdg-desktop-group-regexp, xdg-desktop-entry-regexp): New variables.
    (xdg--desktop-parse-line, xdg-desktop-read-file, xdg-desktop-strings):
    New functions.
    * test/lisp/xdg-tests.el:
    * test/data/xdg/test.desktop:
    * test/data/xdg/wrong.desktop: New files.
---
 lisp/xdg.el                 | 73 ++++++++++++++++++++++++++++++++++++++++-----
 test/data/xdg/test.desktop  |  3 ++
 test/data/xdg/wrong.desktop |  2 ++
 test/lisp/xdg-tests.el      | 71 +++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 142 insertions(+), 7 deletions(-)

diff --git a/lisp/xdg.el b/lisp/xdg.el
index 916de00..4b25542 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -29,9 +29,13 @@
 ;; - XDG Base Directory Specification
 ;; - Thumbnail Managing Standard
 ;; - xdg-user-dirs configuration
+;; - Desktop Entry Specification
 
 ;;; Code:
 
+(eval-when-compile
+  (require 'subr-x))
+
 
 ;; XDG Base Directory Specification
 ;; https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
@@ -128,13 +132,14 @@ This should be called at the beginning of a line."
 (defun xdg--user-dirs-parse-file (filename)
   "Return alist of xdg-user-dirs from FILENAME."
   (let (elt res)
-    (with-temp-buffer
-      (insert-file-contents filename)
-      (goto-char (point-min))
-      (while (not (eobp))
-        (setq elt (xdg--user-dirs-parse-line))
-        (when (consp elt) (push elt res))
-        (forward-line)))
+    (when (file-readable-p filename)
+      (with-temp-buffer
+        (insert-file-contents filename)
+        (goto-char (point-min))
+        (while (not (eobp))
+          (setq elt (xdg--user-dirs-parse-line))
+          (when (consp elt) (push elt res))
+          (forward-line))))
     res))
 
 (defun xdg-user-dir (name)
@@ -147,6 +152,60 @@ This should be called at the beginning of a line."
   (let ((dir (cdr (assoc name xdg-user-dirs))))
     (when dir (expand-file-name dir))))
 
+
+;; Desktop Entry Specification
+;; 
https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-1.1.html
+
+(defconst xdg-desktop-group-regexp
+  (rx "[" (group-n 1 (+? (in " -Z\\^-~"))) "]")
+  "Regexp matching desktop file group header names.")
+
+;; TODO Localized strings left out intentionally, as Emacs has no
+;; notion of l10n/i18n
+(defconst xdg-desktop-entry-regexp
+  (rx (group-n 1 (+ (in "A-Za-z0-9-")))
+      (* blank) "=" (* blank)
+      (group-n 2 (* nonl)))
+  "Regexp matching desktop file entry key-value pairs.")
+
+(defun xdg--desktop-parse-line ()
+  (skip-chars-forward "[:blank:]")
+  (when (/= (following-char) ?#)
+    (cond
+     ((looking-at xdg-desktop-entry-regexp)
+      (cons (match-string 1) (match-string 2)))
+     ((looking-at xdg-desktop-group-regexp)
+      (match-string 1)))))
+
+(defun xdg-desktop-read-file (filename)
+  "Return \"Desktop Entry\" contents of desktop file FILENAME as a hash table."
+  (let ((res (make-hash-table :test #'equal))
+        elt group)
+    (with-temp-buffer
+      (save-match-data
+        (insert-file-contents-literally filename)
+        (goto-char (point-min))
+        (while (or (= (following-char) ?#)
+                   (string-blank-p (buffer-substring (point) (point-at-eol))))
+          (forward-line))
+        (unless (equal (setq group (xdg--desktop-parse-line)) "Desktop Entry")
+          (error "Wrong first section: %s" group))
+        (while (not (eobp))
+          (when (consp (setq elt (xdg--desktop-parse-line)))
+            (puthash (car elt) (cdr elt) res))
+          (forward-line))))
+    res))
+
+(defun xdg-desktop-strings (value)
+  "Partition VALUE into elements delimited by unescaped semicolons."
+  (let (res)
+    (save-match-data
+      (setq value (string-trim-left value))
+      (dolist (x (split-string (replace-regexp-in-string "\\\\;" "\0" value) 
";"))
+        (push (replace-regexp-in-string "\0" ";" x) res)))
+    (when (null (string-match-p "[^[:blank:]]" (car res))) (pop res))
+    (nreverse res)))
+
 (provide 'xdg)
 
 ;;; xdg.el ends here
diff --git a/test/data/xdg/test.desktop b/test/data/xdg/test.desktop
new file mode 100644
index 0000000..b6dda62
--- /dev/null
+++ b/test/data/xdg/test.desktop
@@ -0,0 +1,3 @@
+# this is a comment
+[Desktop Entry]
+Name=Test
diff --git a/test/data/xdg/wrong.desktop b/test/data/xdg/wrong.desktop
new file mode 100644
index 0000000..e0b4c22
--- /dev/null
+++ b/test/data/xdg/wrong.desktop
@@ -0,0 +1,2 @@
+# the first section must be "Desktop Entry"
+[Why]
diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el
new file mode 100644
index 0000000..e7e122b
--- /dev/null
+++ b/test/lisp/xdg-tests.el
@@ -0,0 +1,71 @@
+;;; xdg-tests.el --- tests for xdg.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017  Free Software Foundation, Inc.
+
+;; Maintainer: address@hidden
+
+;; Author: Mark Oteiza <address@hidden>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'xdg)
+
+(defconst xdg-tests-data-dir
+  (expand-file-name "test/data/xdg" source-directory))
+
+(ert-deftest xdg-match-data ()
+  "Ensure public functions do not mangle match data."
+  (let ((data '(1 9)))
+    (save-match-data
+      (set-match-data data)
+      (xdg-user-dir "DOCUMENTS")
+      (should (equal (match-data) data))))
+  (let ((data '(2 9)))
+    (save-match-data
+      (set-match-data data)
+      (xdg-desktop-read-file (expand-file-name "test.desktop" 
xdg-tests-data-dir))
+      (should (equal (match-data) data))))
+  (let ((data '(3 9)))
+    (save-match-data
+      (set-match-data data)
+      (xdg-desktop-strings "a;b")
+      (should (equal (match-data) data)))))
+
+(ert-deftest xdg-desktop-parsing ()
+  "Test `xdg-desktop-read-file' parsing of .desktop files."
+  (let ((tab (xdg-desktop-read-file
+              (expand-file-name "test.desktop" xdg-tests-data-dir))))
+    (should (equal (gethash "Name" tab) "Test")))
+  (should-error
+   (xdg-desktop-read-file
+    (expand-file-name "wrong.desktop" xdg-tests-data-dir))))
+
+(ert-deftest xdg-desktop-strings-type ()
+  "Test desktop \"string(s)\" type: strings delimited by \";\"."
+  (should (equal (xdg-desktop-strings " a") '("a")))
+  (should (equal (xdg-desktop-strings "a;b") '("a" "b")))
+  (should (equal (xdg-desktop-strings "a;b;") '("a" "b")))
+  (should (equal (xdg-desktop-strings "\\;") '(";")))
+  (should (equal (xdg-desktop-strings ";") '("")))
+  (should (equal (xdg-desktop-strings " ") nil))
+  (should (equal (xdg-desktop-strings "a; ;") '("a" " "))))
+
+;;; xdg-tests.el ends here