Coverage report: /home/ellis/comp/core/lib/dat/ini.lisp

Kind	Covered	All	%
expression	0	361	0.0
branch	0	28	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; ini.lisp --- INI Format

2

3

;; https://en.wikipedia.org/wiki/INI_file

4

5

;;; Code:

6

(in-package :dat/ini)

7

8

(defclass ini-object (ast) ())

9

(defclass ini-document (ini-object) ())

10

(defclass ini-section (ini-object) ())

11

;; (defun ini-write (value &optional stream))

12

13

(defmethod print-object ((self ini-object) stream)

14

(print-unreadable-object (self stream :type t)

15

(format stream "~A" (car (ast self)))))

16

17

(defun ini-peek-char (stream expected &key skip-ws)

18

(when (equal (peek-char skip-ws stream nil) expected)

19

(read-char stream)))

20

21

(defun ini-read-char (stream expected &key skip-ws)

22

(declare (optimize (speed 3) (debug 0)))

23

(if (ini-peek-char stream expected :skip-ws skip-ws)

24

t

25

(error "INI error: unexpected ~s~%expected ~A" (read-char stream) expected)))

26

27

(defun ini-read (stream &optional (eof-error-p t) eof-value)

28

(let ((c (peek-char t stream eof-error-p :eof)))

29

(case c

30

(:eof eof-value)

31

(#\[ (ini-read-section stream))

32

(#\# (ini-read-comment stream) (ini-read stream eof-error-p eof-value))

33

(t (ini-read-pair stream)))))

34

35

(defun ini-key-char-p (c)

36

(or (digit-char-p c) (sb-unicode:alphabetic-p c) (char= #\- c) (char= #\_ c)))

37

38

(defun ini-peek-key-char (stream)

39

(let ((c (peek-char t stream nil nil)))

40

(when (and c (ini-key-char-p c))

41

c)))

42

43

(defun ini-read-key (stream)

44

(with-output-to-string (s)

45

(loop for c = (peek-char t stream nil nil)

46

while (and c (ini-key-char-p c))

47

do (write-char (read-char stream) s))

48

s))

49

50

(defun ini-read-pair (stream)

51

(let ((line (split-sequence #\= (read-line stream) :count 2)))

52

(unless (sequence:emptyp (car line))

53

(let ((l (mapcar 'trim line)))

54

(cons (car l) (cadr l))))))

55

56

(defun ini-read-section (stream)

57

(ini-read-char stream #\[ :skip-ws t)

58

(let ((ret (list (ini-read-key stream))))

59

(ini-read-char stream #\] :skip-ws t)

60

(loop while (or (ini-read-comment stream) (ini-peek-key-char stream))

61

do (push (ini-read-pair stream) ret))

62

(make-instance 'ini-section

63

:ast (nreverse ret))))

64

65

(defun ini-read-comment (stream)

66

(loop while (ini-peek-char stream #\# :skip-ws t)

67

do (read-line stream)))

68

69

(defun ini-read-document (stream)

70

(make-instance 'ini-document

71

:ast

72

(loop for x = (ini-read stream nil nil)

73

while x

74

collect x)))

75

76

;;; Serde

77

(defmethod deserialize ((from stream) (format (eql :ini)) &key)

78

(ini-read-document from))

79

80

(defmethod deserialize ((from string) (format (eql :ini)) &key)

81

(with-input-from-string (s from)

82

(ini-read-document s)))

83

84

(defmethod deserialize ((from pathname) (format (eql :ini)) &key)

85

(with-open-file (f from)

86

(ini-read-document f)))

87

88

;;; Desktop Entry

89

(defclass desktop-entry (ini-document)

90

((name :accessor name)

91

(type)

92

(exec :accessor exec)

93

(categories :initform nil)

94

(no-display :type boolean)

95

generic-name

96

comment

97

startup-wm-class

98

keywords

99

mime-type

100

try-exec

101

icon

102

(terminal :type boolean)))

103

104

(defmethod print-object ((self desktop-entry) stream)

105

(format stream "(desktop-entry :name ~S :categories ~S :no-display ~S)"

106

(name self) (slot-value self 'categories) (slot-value self 'no-display)))

107

108

(defmethod load-ast ((self desktop-entry))

109

(when-let ((props (cdr (ast (car (ast self))))))

110

(flet ((dget (n) (cdr (assoc n props :key 'string-downcase :test 'equal)))

111

(bool (x) (when (equal (trim (string-downcase x)) "true") t)))

112

(setf (name self) (dget "name")

113

(slot-value self 'type) (dget "type")

114

(exec self) (dget "exec")

115

(slot-value self 'terminal) (bool (dget "terminal"))

116

             (slot-value self 'categories) (when-let ((cats (dget "categories"))) (ssplit #\; cats))

117

(slot-value self 'no-display) (bool (dget "nodisplay"))

118

(slot-value self 'generic-name) (dget "genericname")

119

(slot-value self 'comment) (dget "comment")

120

(slot-value self 'startup-wm-class) (dget "startupwmclass")

121

(slot-value self 'keywords) (when-let ((kws (dget "keywords"))) (ssplit #\; kws))

122

(slot-value self 'mime-type) (when-let ((mts (dget "mimetype"))) (ssplit #\; mts))

123

(slot-value self 'try-exec) (dget "tryexec")

124

(slot-value self 'icon) (dget "icon"))

125

self)))

126

127

(defmethod deserialize ((from t) (format (eql :desktop-entry)) &key)

128

(load-ast (change-class (deserialize from :ini) 'desktop-entry)))

129

130

(defmethod equiv:equiv ((a desktop-entry) (b desktop-entry))

131

(and (string= (name a) (name b))

132

(string= (slot-value a 'type) (slot-value b 'type))

133

(string= (slot-value a 'exec) (slot-value b 'exec))))

134

135

(defmethod equiv:eqv ((a desktop-entry) (b desktop-entry))

136

(and (string= (name a) (name b))

137

(string= (slot-value a 'type) (slot-value b 'type))

138

(string= (slot-value a 'exec) (slot-value b 'exec))

139

(equalp (slot-value a 'categories) (slot-value b 'categories))

140

(equalp (slot-value a 'no-display) (slot-value b 'no-display))

141

(equalp (slot-value a 'only-show-in) (slot-value b 'only-show-in))

142

(equalp (slot-value a 'terminal) (slot-value b 'terminal))))

143

144

(defun desktop-entry-in-categories-p (entry seq)

145

(every #'(lambda (c)

146

(some #'(lambda (e) (string= c e))

147

(slot-value entry 'categories)))

148

seq))

149

150

(defvar *desktop-entry-main-categories*

151

(list

152

"AudioVideo"

153

"Audio"

154

"Video"

155

"Development"

156

"Education"

157

"Game"

158

"Graphics"

159

"Network"

160

"Office"

161

"Settings"

162

"System"

163

"Utility"))

164

(defvar *desktop-entry-favorite-category* "Favorite")

165

(defvar *desktop-entry-paths*

166

'(#P"/usr/share/applications"

167

#P"~/.local/share/applications"))