Coverage report: /home/ellis/comp/core/lib/organ/element/headline.lisp

KindCoveredAll%
expression134157 85.4
branch1018 55.6
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; lib/organ/element/headline.lisp --- Org Headline
2
 
3
 ;; Headlines
4
 
5
 ;;; Code:
6
 
7
 (in-package :organ)
8
 
9
 (define-org-element todo-keyword
10
     ((todo-type :accessor todo-keyword-type :initarg :type :initform "" :type string)))
11
 
12
 (define-org-parser (todo-keyword :from string)
13
   (when-let ((kw (org-todo-keyword-p input)))
14
     (org-create :todo-keyword :type kw)))
15
 
16
 (define-org-element priority
17
   ((level :accessor org-priority-level :initarg :level :type character)))
18
 
19
 (define-org-parser (priority :from string)
20
   (with-lexer-environment (input)
21
     (when (and (char= #\[ (peek))
22
                (consume)
23
                (char= #\# (peek))
24
                (consume)
25
                (not (char= #\] (peek))))
26
       (when-let ((c (consume)))
27
         (when (and (characterp (peek)) 
28
                    (char= #\] (peek))) ;; kludge
29
           (org-create :priority :level c))))))
30
 
31
 (defun org-parse-todo-keyword-and-priority (input)
32
   "Parse INPUT returning the following values: 
33
 
34
 (TODO-KEYWORD PRIORITY REST)"
35
   (let (kw prio rest)
36
     (multiple-value-bind (match subs)
37
         ;; scan for todo-keyword
38
         (scan-to-strings org-todo-keyword-rx input)
39
       (if match
40
           (let ((k (aref subs 0)))
41
             (if-let ((%kw (org-parse :todo-keyword k)))
42
               (let* ((next (aref subs 1))
43
                      (prio? (org-parse :priority next)))
44
                 (setq kw %kw
45
                       prio prio?
46
                       rest (if prio? (trim (subseq next 4)) next)))
47
               (setq rest (trim match))))
48
           ;; no kw found
49
           (let* ((next (trim input))
50
                  (prio? (org-parse :priority next)))
51
             (setq kw nil ;; kw always comes before priority.
52
                   prio (org-parse :priority next)
53
                   rest (if prio? (subseq next 4) next)))))
54
     (values kw prio rest)))
55
 
56
 (define-org-element tag
57
     ((name :initform "" :initarg :name :type string)))
58
 
59
 (define-org-parser (tag :from string)
60
   (org-create type :name input))
61
 
62
 ;;; Headline
63
 ;; when level=0, headline is uninitialized
64
 (define-org-element headline
65
     ((stars :initarg :stars :accessor hl-stars :initform 0)
66
      (keyword :initarg :kw :accessor hl-kw :initform nil)
67
      (priority :initarg :priority :accessor hl-priority :initform nil)
68
      (title :initarg :title :accessor hl-title :initform "")
69
      (tags :initarg :tags :accessor hl-tags :initform nil))
70
   :documentation "Org Headline object without connection to other
71
   elements. This is a deviation from the org-element specification in
72
   the name of utility. Properties, Logbook, and Body objects are
73
   defined separately too, so a complete Heading object can be
74
   summarized as a list of at most four elements: The headline,
75
   properties, logbook and body.")
76
 
77
 (defmethod org-parse ((type (eql :headline)) (input string))
78
   (let ((res (org-create type)))
79
     (with-input-from-string (s input)
80
       ;; first we parse 'just' the headline
81
       (when (peek-char #\* s) 
82
         (let ((line (read-line s)))
83
           (multiple-value-bind (start _ reg-start reg-end)
84
               ;; scan for headline
85
               (cl-ppcre:scan org-headline-rx line)
86
             (declare (ignore _))
87
             (when start
88
               (loop for rs across reg-start
89
                     for re across reg-end
90
                     for i from 0
91
                     do
92
                        (if (= i 0)
93
                            (setf (hl-stars res) (- re rs))
94
                            (multiple-value-bind (kw prio title) 
95
                                (org-parse-todo-keyword-and-priority (subseq line rs))
96
                              (setf (hl-kw res) kw
97
                                    (hl-priority res) prio
98
                                    (hl-title res) title))))))
99
           ;; scan for tags, modifies title slot
100
           (let ((tag-str (cl-ppcre:scan-to-strings org-tag-rx (hl-title res))))
101
             (when tag-str
102
               (setf (hl-tags res) (apply #'vector (mapcar (lambda (x) (org-create :tag :name x)) (org-tag-split tag-str)))
103
                     ;;  Q 2023-12-27: should we preserve whitespace here?
104
                     (hl-title res) (string-right-trim
105
                                     *whitespaces* 
106
                                     (subseq (hl-title res) 0 (- (length (hl-title res)) 1 (length tag-str)))))))))
107
       ;; TODO 2023-07-24: cookies,priority,comment,footnote,archive
108
       res)))