ini.lisp

   1 ;;; PHOROS -- Photogrammetric Road Survey
   2 ;;; Copyright (C) 2010, 2011 Bert Burgemeister
   3 ;;;
   4 ;;; This program is free software; you can redistribute it and/or modify
   5 ;;; it under the terms of the GNU General Public License as published by
   6 ;;; the Free Software Foundation; either version 2 of the License, or
   7 ;;; (at your option) any later version.
   8 ;;;
   9 ;;; This program is distributed in the hope that it will be useful,
  10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;;; GNU General Public License for more details.
  13 ;;;
  14 ;;; You should have received a copy of the GNU General Public License along
  15 ;;; with this program; if not, write to the Free Software Foundation, Inc.,
  16 ;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17
  18
  19 (defun nice-name (string)
  20   (string-trim " 
      " string))
  21
  22 (defun nice-keyword (string)
  23   (s-sql:from-sql-name (nice-name string)))
  24
  25 (defun read-from-string-maybe (string)
  26   (handler-case
  27       (let ((token (read-from-string string)))
  28         (if (numberp token) token string))
  29     (error () string)))
  30
  31 (defun groupname (line)
  32   "Return group name if any, or nil."
  33   (let* ((groupname-start (position #\[ line))
  34          (groupname-end
  35           (and groupname-start (position #\] line :start groupname-start))))
  36     (when groupname-end
  37       (nice-keyword (subseq line (1+ groupname-start) groupname-end)))))
  38
  39 (defun key-value-pair (line)
  40   "Return a key/value pair if any, or nil."
  41   (let ((equal-sign-position (position #\= line)))
  42     (when equal-sign-position
  43       (list (nice-keyword (subseq line 0 equal-sign-position))
  44             (read-from-string-maybe
  45              (nice-name (subseq line (1+ equal-sign-position))))))))
  46
  47 (defun discard-comment (line)
  48   (let ((half-cleaned (subseq line 0 (position #\# line))))
  49     (subseq half-cleaned 0 (position #\; half-cleaned))))
  50
  51
  52 (defun ini (path)
  53   "Read the ini file from path.  Return an alist of plists."
  54   (with-open-file (stream path)
  55     (let ((ini (list (cons nil nil))))  ;group of the groupless
  56       (loop
  57          for line = (discard-comment (read-line stream nil))
  58          while line do
  59            (let ((groupname (groupname line)))
  60              (if groupname
  61                  (setf ini (append ini (list (cons groupname nil))))
  62                  (let ((key-value-pair (key-value-pair line)))
  63                    (when key-value-pair
  64                      (setf (cdar (last ini))
  65                            (append (cdar (last ini)) key-value-pair)))))))
  66       ini)))