;;; @Package     linux-proc-apm.scm
;;; @Subtitle    Linux /proc/apm APM Data Access in Scheme
;;; @HomePage    http://www.neilvandyke.org/linux-proc-apm-scm/
;;; @Author      Neil W. Van Dyke
;;; @AuthorEmail neil@@neilvandyke.org
;;; @Version     0.2
;;; @Date        2005-04-08

;; $Id: linux-proc-apm.scm,v 1.27 2005/04/08 12:53:38 neil Exp $

;;; @legal
;;; Copyright @copyright{} 2004 - 2005 Neil W. Van Dyke.  This program is Free
;;; Software; you can redistribute it and/or modify it under the terms of the
;;; GNU Lesser General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at your option) any
;;; later version.  This program 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 Lesser
;;; General Public License [LGPL] for details.  For other license options and
;;; consulting, contact the author.
;;; @end legal

(define-syntax %linux-proc-apm:testeez
  (syntax-rules () ((_ x ...)
                    ;; (testeez x ...)
                    (error "Tests disabled.")
                    )))

;;; @section Introduction
;;;
;;; This Scheme library is used to access Linux APM (Advanced Power Management)
;;; power information.  It can be used for reporting battery status
;;; information, for monitoring battery charge and taking action when the
;;; charge is low, for ensuring that a laptop is on line power before
;;; performing a disk-intensive batch job, etc.
;;;
;;; This library works by parsing the string format of the @code{/proc/apm}
;;; file interface.  Information about the format was gleaned from the Linux
;;; kernel source files [apm.c] and [apm_bios.h], and from the usermode
;;; programs of [apmd].  It does not support ACPI, nor is it a more generalized
;;; power data interface.
;;;
;;; This library is currently slightly specific to PLT Scheme, but was written
;;; in such a manner as to make easy the porting to other Scheme
;;; implementations.

;;; @section Data Format

;;; The @dfn{linux-proc-apm-data} abstract data type can be thought of as
;;; having nine attributes, with the accessors described in this section.
;;; Unless specified otherwise in the examples, @code{d} is sample APM data,
;;; such as might be yielded by @code{(define d (linux-proc-apm-data))}.

;;; @defproc  linux-proc-apm-data:driver-version data
;;; @defprocx linux-proc-apm-data:bios-version   data
;;;
;;; Yield the APM kernel driver version number and the APM BIOS version number,
;;; respectively, as a strings.
;;;
;;; @lisp
;;; (linux-proc-apm-data:driver-version d) @result{} "1.16"
;;; (linux-proc-apm-data:bios-version   d) @result{} "1.2"
;;; @end lisp

;;; @defproc linux-proc-apm-data:apm-flags data
;;;
;;; Yields the APM flags as a list of any subset of the symbols @code{bits16},
;;; @code{bits32}, @code{idle-slows-clock}, @code{disabled}, and
;;; @code{disengaged}.  For example:
;;;
;;; @lisp
;;; (linux-proc-apm-data:apm-flags d) @result{} (bits16 bits32)
;;; @end lisp

;;; @defproc linux-proc-apm-data:ac-line-status data
;;;
;;; Yields the AC line power status as the symbol @code{off}, @code{on}, or
;;; @code{backup}, or @code{#f} if unknown.  For example:
;;;
;;; @lisp
;;; (linux-proc-apm-data:ac-line-status d) @result{} off
;;; @end lisp

;;; @defproc linux-proc-apm-data:battery-status data
;;;
;;; Yields the battery status as the symbol @code{high}, @code{low},
;;; @code{critical}, @code{charging}, or @code{absent}, or @code{#f} if
;;; unknown.  For example:
;;;
;;; @lisp
;;; (linux-proc-apm-data:battery-status d) @result{} high
;;; @end lisp

;;; @defproc linux-proc-apm-data:battery-flags data
;;;
;;; Yields APM battery flags as a list of any subset of the symbols
;;; @code{high}, @code{low}, @code{critical}, @code{charging}, and
;;; @code{absent}.  For example:
;;;
;;; @lisp
;;; (linux-proc-apm-data:battery-flags d) @result{} (high charging)
;;; @end lisp

;;; @defproc linux-proc-apm-data:battery-percent data
;;;
;;; Yields the estimated battery charge percentage as an integer, or @code{#f}
;;; if unknown.
;;;
;;; @lisp
;;; (linux-proc-apm-data:battery-percent d) @result{} 99
;;; @end lisp

;;; @defproc  linux-proc-apm-data:battery-time       data
;;; @defprocx linux-proc-apm-data:battery-time-units data
;;;
;;; This pair of procedures yield, respectively, the estimated remaining
;;; battery charge as an integer and a string representing the units.  The
;;; units string is likely to be @code{"min"}.  Either or both value can be
;;; @code{#f} if unknown.
;;;
;;; @lisp
;;; (linux-proc-apm-data:battery-time       d) @result{} 335
;;; (linux-proc-apm-data:battery-time-units d) @result{} "min"
;;; @end lisp

(define (linux-proc-apm-data:driver-version     d) (vector-ref d 0))
(define (linux-proc-apm-data:bios-version       d) (vector-ref d 1))
(define (linux-proc-apm-data:apm-flags          d) (vector-ref d 2))
(define (linux-proc-apm-data:ac-line-status     d) (vector-ref d 3))
(define (linux-proc-apm-data:battery-status     d) (vector-ref d 4))
(define (linux-proc-apm-data:battery-flags      d) (vector-ref d 5))
(define (linux-proc-apm-data:battery-percent    d) (vector-ref d 6))
(define (linux-proc-apm-data:battery-time       d) (vector-ref d 7))
(define (linux-proc-apm-data:battery-time-units d) (vector-ref d 8))

;;; @defproc linux-proc-apm-data:kludged-battery-percent data
;;;
;;; Yields the estimated battery charge percentage as an integer, or @code{#f}
;;; if all fails.  This works by first attempting to use APM's estimated
;;; percentage, but if that is unavailable, falling back to to a very crude
;;; fake percentage based on the @dfn{battery-status} or @code{battery-flags}
;;; attribute.  This procedure is of questionable utility, yet may still find
;;; use in, say, a noncritical display of approximate battery charge.
;;;
;;; @lisp
;;; (define d (parse-linux-proc-apm-string
;;;            "1.16 1.2 0x03 0x01 0x03 0x09 -1% -1 ?"))
;;; (linux-proc-apm-data:battery-percent         d) @result{} #f
;;; (linux-proc-apm-data:kludged-battery-percent d) @result{} 90
;;; @end lisp

(define linux-proc-apm-data:kludged-battery-percent
  (let ((sym-kludge-percent
         (lambda (sym)
           ;; TODO: Maybe get better numbers for here.
           (case sym
             ((high)     90)
             ((low)      20)
             ((critical) 0)
             (else       #f)))))
    (lambda (data)
      (or (linux-proc-apm-data:battery-percent data)
          (sym-kludge-percent (linux-proc-apm-data:battery-status data))
          (let loop ((lst (linux-proc-apm-data:battery-flags data)))
            (if (null? lst)
                #f
                (or (sym-kludge-percent (car lst))
                    (loop (cdr lst)))))))))

;;; @section Parsing

;;; These procedures are concerned with parsing the data, and are not normally
;;; used directly.

;;; @defproc parse-linux-proc-apm-string str
;;;
;;; Yields the APM data parsed from string @var{str}, or @code{#f} if the
;;; string could not be parsed.

(define parse-linux-proc-apm-string
  (let ((make-flags-parser
         (lambda (alist)
           (lambda (str)
             (let ((num (string->number str 16)))
               (let loop ((alist alist))
                 (cond ((null? alist) '())
                       ((zero? (bitwise-and num (caar alist)))
                        (loop (cdr alist)))
                       (else (cons (cdar alist) (loop (cdr alist))))))))))
        (make-status-parser
         (lambda (alist)
           (lambda (str)
             (cond ((assoc str alist) => cdr)
                   (else #f))))))
    (let* ((parse-apm-flags (make-flags-parser '((#x01 . bits16)
                                                 (#x02 . bits32)
                                                 (#x04 . idle-slows-clock)
                                                 (#x10 . disabled)
                                                 (#x20 . disengaged))))
           (parse-ac-status (make-status-parser '(("00" . off)
                                                  ("01" . on)
                                                  ("02" . backup)
                                                  ("ff" . #f))))
           (parse-bat-status (make-status-parser '(("00" . high)
                                                   ("01" . low)
                                                   ("02" . critical)
                                                   ("03" . charging)
                                                   ("04" . absent)
                                                   ("ff" . #f))))
           (parse-bat-flags (make-flags-parser '((#x01 . high)
                                                 (#x02 . low)
                                                 (#x04 . critical)
                                                 (#x08 . charging)
                                                 (#x80 . absent))))
           (parse-nonnegint (lambda (str)
                              (let ((n (string->number str)))
                                (if (< n 0) #f n))))
           (rx (regexp (string-append
                        "^([0-9.]+)"
                        " +([0-9.]+)"
                        " +0x([0-9a-f][0-9a-f])"
                        " +0x([0-9a-f][0-9a-f])"
                        " +0x([0-9a-f][0-9a-f])"
                        " +0x([0-9a-f][0-9a-f])"
                        " +(-?[0-9]+)%"
                        " +(-?[0-9]+)"
                        " +([^ \n]+)")))
           (explode (lambda (whole
                             driver-ver
                             bios-ver
                             apm-flags
                             ac-status
                             bat-status
                             bat-flags
                             bat-percent
                             bat-time
                             bat-units)
                      (vector driver-ver
                              bios-ver
                              (parse-apm-flags  apm-flags)
                              (parse-ac-status  ac-status)
                              (parse-bat-status bat-status)
                              (parse-bat-flags  bat-flags)
                              (parse-nonnegint  bat-percent)
                              (parse-nonnegint  bat-time)
                              (if (equal? bat-units "?") #f bat-units)))))
      (lambda (str)
        (let ((match-result (regexp-match rx str)))
          (if match-result
              (apply explode match-result)
              #f))))))

;;; @defproc parse-linux-proc-apm-file filename
;;;
;;; Yields the APM data from file @var{filename}, or @code{#f} if the data is
;;; unavailable (e.g., the file could not be accessed, or the data could not be
;;; parsed).

(define parse-linux-proc-apm-file
  (let ((parse-linux-proc-apm-line
         (lambda (port)
           (let ((line (read-line port 'any)))
             (if (eof-object? line)
                 #f
                 (parse-linux-proc-apm-string line))))))
    (lambda (file)
      (with-handlers ((exn:fail? (lambda (exn) #f)))
        (let ((port (open-input-file file)))
          (let ((result (parse-linux-proc-apm-line port)))
            (close-input-port port)
            result))))))

;;; @section Data Access

;;; The normal procedure for acquiring APM data is @code{linux-proc-apm-data}.

;;; @defparam current-linux-proc-apm-file
;;;
;;; Parameter for the file name of the default APM data file, defaulting to
;;; @code{"/proc/apm"}, surprisingly enough.

(define current-linux-proc-apm-file (make-parameter "/proc/apm"))

;;; @defproc linux-proc-apm-data
;;;
;;; Yields the APM data from the file given by the
;;; @code{current-linux-proc-apm-file} parameter, or @code{#f} if the data is
;;; unavailable.

(define (linux-proc-apm-data)
  (parse-linux-proc-apm-file (current-linux-proc-apm-file)))

;;; @section Tests

;;; The @code{linux-proc-apm.scm} test suite can be enabled by editing the
;;; source code file and loading [Testeez]; the test suite is disabled by
;;; default.

(define (%linux-proc-apm:test)
  (%linux-proc-apm:testeez
   "linux-proc-apm.scm"

   (test/equal
    ""
    (parse-linux-proc-apm-string "1.13 1.2 0x03 0x00 0x00 0x01 27% 20 min")
    '#("1.13" "1.2" (bits16 bits32) off high (high) 27 20 "min"))

   (test/equal
    ""
    (parse-linux-proc-apm-string "1.13 1.2 0x03 0x00 0x00 0x01 94% 73 min")
    '#("1.13" "1.2" (bits16 bits32) off high (high) 94 73 "min"))

   (test/equal
    ""
    (parse-linux-proc-apm-string "1.16 1.2 0x03 0x00 0x00 0x01 100% 410 min")
    '#("1.16" "1.2" (bits16 bits32) off high (high) 100 410 "min"))

   (test/equal
    ""
    (parse-linux-proc-apm-string "1.16 1.2 0x03 0x00 0x00 0x01 98% 78 min")
    '#("1.16" "1.2" (bits16 bits32) off high (high) 98 78 "min"))

   (test/equal
    ""
    (parse-linux-proc-apm-string "1.16 1.2 0x03 0x00 0x00 0x01 99% 1792 min")
    '#("1.16" "1.2" (bits16 bits32) off high (high) 99 1792 "min"))

   (test/equal
    ""
    (parse-linux-proc-apm-string "1.16 1.2 0x03 0x01 0x03 0x09 100% -1 ?")
    '#("1.16" "1.2" (bits16 bits32) on charging (high charging) 100 #f #f))

   (test/equal
    ""
    (parse-linux-proc-apm-string "1.16 1.2 0x03 0x01 0x03 0x09 95% -1 ?")
    '#("1.16" "1.2" (bits16 bits32) on charging (high charging) 95 #f #f))

   (test/equal
    ""
    (parse-linux-proc-apm-string "1.16 1.2 0x03 0x01 0xff 0x80 -1% -1 ?")
    '#("1.16" "1.2" (bits16 bits32) on #f (absent) #f #f #f))

   ))

;;; @unnumberedsec History
;;;
;;; @table @asis
;;;
;;; @item Version 0.2 --- 2005-04-08
;;; Added Testeez-based test suite.  Minor documentation changes.
;;; Changed to @code{not-break-exn?} use to PLT 3xx @code{exn:fail?}.
;;;
;;; @item Version 0.1 --- 2004-08-03
;;; Initial version.
;;;
;;; @end table

;;; @unnumberedsec References
;;;
;;; @table @asis
;;;
;;; @item [apm.c]
;;; @uref{http://lxr.linux.no/source/arch/i386/kernel/apm.c?v=2.4.26}
;;;
;;; @item [apm_bios.h]
;;; @uref{http://lxr.linux.no/source/include/linux/apm_bios.h?v=2.4.26}
;;;
;;; @item [apmd]
;;; @uref{http://www.worldvisions.ca/~apenwarr/apmd/}
;;;
;;; @item [LGPL]
;;; Free Software Foundation, ``GNU Lesser General Public License,'' Version
;;; 2.1, 1999-02, 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.@*
;;; @uref{http://www.gnu.org/copyleft/lesser.html}
;;;
;;; @item [Testeez]
;;; Neil W. Van Dyke, ``Testeez: Simple Test Mechanism for Scheme,'' Version
;;; 0.1.@*
;;; @uref{http://www.neilvandyke.org/testeez/}
;;;
;;; @end table