File: swank-motd.lisp

package info (click to toggle)
slime 1:20080223.dfsg-1
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 2,600 kB
  • ctags: 3,345
  • sloc: lisp: 30,707; sh: 163; makefile: 119; awk: 10
file content (66 lines) | stat: -rw-r--r-- 3,300 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
(in-package :swank)

(defun parse-changelog (changelog-pathname)
  (with-open-file (stream changelog-pathname :direction :input)
    (labels ((entry-line-p (line)
               (and (<= 10 (length line))
                    (digit-char-p (aref line 0))
                    (digit-char-p (aref line 1))
                    (digit-char-p (aref line 2))
                    (digit-char-p (aref line 3))
                    (char= #\- (aref line 4))
                    (digit-char-p (aref line 5))
                    (digit-char-p (aref line 6))
                    (char= #\- (aref line 7))
                    (digit-char-p (aref line 8))
                    (digit-char-p (aref line 9))))
             (read-next-entry ()
               ;; don't use with-output-to-string to avoid sbcl
               ;; compiler warnings
               (with-output-to-string (entry-text)
                 (loop
                    for changelog-line = (read-line stream nil stream nil)
                    when (eq changelog-line stream)
                      do (return-from read-next-entry
                           (values (get-output-stream-string entry-text) nil))
                    when (entry-line-p changelog-line)
                      do (return-from read-next-entry
                           (values (get-output-stream-string entry-text) changelog-line))
                    do (write-line changelog-line entry-text)))))
      (let ((this-author-line (nth-value 1 (read-next-entry)))
            (entries '()))
        (loop
           (multiple-value-bind (text next-author-line)
               (read-next-entry)
             (with-output-to-string (text+author)
               (write-line this-author-line text+author)
               (write-string text text+author)
               (push (list (encode-universal-time 0 0 0
                                                  (parse-integer this-author-line :start 8 :end 10)
                                                  (parse-integer this-author-line :start 5 :end 7)
                                                  (parse-integer this-author-line :start 0 :end 4))
                           (get-output-stream-string text+author))
                     entries))
             (if (null next-author-line)
                 (return-from parse-changelog entries)
                 (setf this-author-line next-author-line))))))))

(defun read-motd (motd-pathname)
  (handler-case
      (let ((entries (mapcar #'second
                             (remove-if (lambda (date/entry-text)
                                          (< (first date/entry-text) (- (get-universal-time) (* 60 60 24 7))))
                                        (parse-changelog motd-pathname)))))
        
        (when entries
          (with-output-to-string (motd-for-emacs)
            (format motd-for-emacs ";; MOTD read from ~S.~%" motd-pathname)
            (dolist (entry entries)
              (with-input-from-string (stream entry)
                (loop
                  for line = (read-line stream nil stream nil)
                  until (eq line stream)
                  do (write-string ";; " motd-for-emacs)
                  do (write-line line motd-for-emacs)))))))
    (error (c)
      (format nil ";; ERROR ~S OPENING MOTD ~S.~%" c motd-pathname))))