mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-01 11:14:55 +00:00
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.
This commit is contained in:
parent
da3e101634
commit
9604f9cd33
73
lisp/xdg.el
73
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
|
||||
|
3
test/data/xdg/test.desktop
Normal file
3
test/data/xdg/test.desktop
Normal file
@ -0,0 +1,3 @@
|
||||
# this is a comment
|
||||
[Desktop Entry]
|
||||
Name=Test
|
2
test/data/xdg/wrong.desktop
Normal file
2
test/data/xdg/wrong.desktop
Normal file
@ -0,0 +1,2 @@
|
||||
# the first section must be "Desktop Entry"
|
||||
[Why]
|
71
test/lisp/xdg-tests.el
Normal file
71
test/lisp/xdg-tests.el
Normal file
@ -0,0 +1,71 @@
|
||||
;;; xdg-tests.el --- tests for xdg.el -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2017 Free Software Foundation, Inc.
|
||||
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
|
||||
;; Author: Mark Oteiza <mvoteiza@udel.edu>
|
||||
|
||||
;; 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
|
Loading…
Reference in New Issue
Block a user