kopia lustrzana https://gitlab.com/sane-project/backends
Removed because these emacs-lisp scripts haven't been used for some time now.
Use sane-desc.c instead.merge-requests/1/head
Henning Geinitz
rodzic
ac15bc78b3
commit
fce2bc531c
|
|
@ -8,6 +8,9 @@
|
|||
* doc/descriptions.txt: Explained the new status values. Removed
|
||||
reference to emacs-lisp code for generation of HTML
|
||||
files. Explained unsupported.desc.
|
||||
* tools/sane-desc.el.in tools/sane-desc-ext.el: Removed because
|
||||
these emacs-lisp scripts haven't been used for some time now.
|
||||
Use sane-desc.c instead.
|
||||
|
||||
2003-06-15 Henning Meier-Geinitz <henning@meier-geinitz.de>
|
||||
|
||||
|
|
|
|||
|
|
@ -1,595 +0,0 @@
|
|||
;;
|
||||
;; Some handy elisp stuff to automagically generate descriptive
|
||||
;; SANE webpages from backend .desc files for external backends.
|
||||
;;
|
||||
;; Basic usage:
|
||||
;; M-x sane-desc-parse-directory to parse .desc files in a directory
|
||||
;; M-x sane-desc-generate-backend-page to write out some HTML
|
||||
;; or, even easier,
|
||||
;; M-x sane-desc-regenerate-backend-page do both of the above
|
||||
;;
|
||||
;;
|
||||
;; Copyright (C) 1998 Matthew Marjanovic
|
||||
;; 2001, 2002 Henning Meier-Geinitz
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, 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 General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, 675 Massachusettes Ave,
|
||||
;; Cambridge, MA 02139, USA.
|
||||
|
||||
|
||||
(defconst sane-desc-descfile-regex ".*\.desc$"
|
||||
"Regular expression for finding .desc files.")
|
||||
|
||||
(defconst sane-desc-valid-devtypes '(:scanner :api :meta :stillcam :vidcam)
|
||||
"List of allowed device-type keywords")
|
||||
|
||||
(defvar sane-desc-status-codes
|
||||
'(
|
||||
(:alpha . ("alpha" "bb0000"
|
||||
"means it must do something, but is not very well
|
||||
tested, probably has bugs, and may even crash your
|
||||
system, etc., etc."))
|
||||
(:beta . ("beta" "806000"
|
||||
"means it works pretty well, and looks stable and
|
||||
functional, but not bullet-proof."))
|
||||
(:stable . ("stable" "008000"
|
||||
"means someone is pulling your leg."))
|
||||
)
|
||||
"An assoc list with one pair for each valid :status keyword.
|
||||
The associated data is a list with three elements, consisting of
|
||||
the print name of the status, the color to use, and a description.")
|
||||
|
||||
;;; HTML formatting variables
|
||||
|
||||
(defvar sane-desc-backend-page-name "sane-backends-external.html"
|
||||
"Default name for the Backends HTML page.")
|
||||
|
||||
|
||||
(defvar sane-desc-backend-html-title "External Backends (Drivers)"
|
||||
"Title used for the Backends page.")
|
||||
|
||||
;(defvar sane-desc-base-url "http://www.mostang.com/sane/backends.html"
|
||||
; "Base URL for generated HTML.
|
||||
;This is put into a BASE tag, and will be used as the root
|
||||
;of all relative references.
|
||||
;This will also be used for SANE home page references.")
|
||||
|
||||
(defvar sane-desc-home-url "http://www.mostang.com/sane/"
|
||||
"URL for the SANE homepage.")
|
||||
|
||||
(defvar sane-desc-sane-logo "http://www.mostang.com/sane/sane.png"
|
||||
"URL for SANE logo.")
|
||||
|
||||
(defvar sane-desc-backend-html-bgcolor "FFFFFF"
|
||||
"Background color on Backends page.")
|
||||
|
||||
(defvar sane-desc-table-head-bgcolor "E0E0FF"
|
||||
"Background color for header of Backends table.")
|
||||
|
||||
(defvar sane-desc-email-address "sane-devel@mostang.com"
|
||||
"Address of the SANE developer's mailing list.")
|
||||
|
||||
(defvar sane-desc-manpage-url-format
|
||||
"http://www.mostang.com/sane/man/%s.5.html"
|
||||
"Format used for creating URL's for on-line manpages.")
|
||||
|
||||
(defvar sane-desc-additional-links
|
||||
"<p>There are special tables for <a
|
||||
href=\"http://www.buzzard.org.uk/jonathan/scanners.html\">parallel port</a>
|
||||
and <a href=\"http://www.buzzard.org.uk/jonathan/scanners-usb.html\">USB</a>
|
||||
scanners from <a href=\"mailto:jonathan@buzzard.org.uk\">Jonathan Buzzard</a>.
|
||||
"
|
||||
"Links to additional sources of information near the top of the page.")
|
||||
|
||||
|
||||
|
||||
; why doesn't elisp have a normal format? (beats me.)
|
||||
|
||||
(defmacro sane-desc-pformat (stream &rest args)
|
||||
`(princ (format ,@args) ,stream))
|
||||
|
||||
|
||||
|
||||
; structures for elements of the database
|
||||
|
||||
(defmacro sane-desc-getval (alist key)
|
||||
`(cdr (assq ,key ,alist)))
|
||||
|
||||
(defmacro sane-desc-putval (alist key val)
|
||||
`(setcdr (assq ,key ,alist) ,val))
|
||||
|
||||
(defmacro sane-desc-tack-on (lst item)
|
||||
`(setq ,lst (nconc ,lst (list ,item))))
|
||||
|
||||
(defmacro sane-desc-tack-on-val (alst key item)
|
||||
`(sane-desc-putval ,alst ,key
|
||||
(nconc (sane-desc-getval ,alst ,key) (list ,item))))
|
||||
|
||||
|
||||
(defun sane-desc-make-db ()
|
||||
(copy-alist '((:backends . nil) ;why copy? seems to be constant otherwise
|
||||
(:mfgs . nil)
|
||||
(:devices . nil))))
|
||||
|
||||
(defun sane-desc-make-backend ()
|
||||
(copy-alist '((:name . nil)
|
||||
(:version . nil)
|
||||
(:status . nil)
|
||||
(:manpage . nil)
|
||||
(:url . nil)
|
||||
(:comment . nil)
|
||||
(:devlist . nil)
|
||||
(:mfglist . nil))))
|
||||
|
||||
(defun sane-desc-make-mfg ()
|
||||
(copy-alist '((:name . nil)
|
||||
(:url . nil)
|
||||
(:comment . nil)
|
||||
(:devlist . nil))))
|
||||
|
||||
(defun sane-desc-make-dev ()
|
||||
(copy-alist '((:type . nil)
|
||||
(:desc . nil)
|
||||
(:mfg . nil)
|
||||
(:url . nil)
|
||||
(:interface . nil)
|
||||
(:comment . nil))))
|
||||
|
||||
|
||||
(defvar sane-desc-database (sane-desc-make-db)
|
||||
"The 'database' of results from parsing SANE .desc files.
|
||||
This is a assoc list containing lists of backends, manufacturers,
|
||||
and devices.")
|
||||
|
||||
|
||||
|
||||
(defun sane-desc-error-repeat (token)
|
||||
(error "Oops! %s specified twice" token))
|
||||
|
||||
|
||||
; add-to-list
|
||||
|
||||
(defun sane-desc-parse-file (filename)
|
||||
(interactive "fParse desc file: ")
|
||||
(let ((pbuff (find-file filename))
|
||||
result)
|
||||
(setq result (sane-desc-parse-buffer pbuff))
|
||||
(kill-buffer pbuff)
|
||||
result
|
||||
))
|
||||
|
||||
|
||||
(defun sane-desc-parse-buffer (pbuff-name)
|
||||
(interactive "bParse desc buffer: ")
|
||||
(let ((pbuff (get-buffer pbuff-name))
|
||||
(bk (sane-desc-make-backend))
|
||||
mfg-list
|
||||
dev-list
|
||||
current-devtype
|
||||
current-mfg
|
||||
token
|
||||
latest
|
||||
)
|
||||
(if (not (bufferp pbuff)) (error "No such buffer: %s" pbuff-name))
|
||||
(save-excursion
|
||||
(set-buffer pbuff)
|
||||
(goto-char (point-min))
|
||||
;;magic do loop -- read objects until EOF
|
||||
(while (condition-case nil
|
||||
(progn
|
||||
(setq token (read pbuff))
|
||||
t)
|
||||
((end-of-file nil))
|
||||
)
|
||||
(cond
|
||||
;; Top-level backend descriptive elements
|
||||
;; ... :backend (required)
|
||||
((eq token :backend)
|
||||
(if (sane-desc-getval bk :name) (sane-desc-error-repeat token))
|
||||
(sane-desc-putval bk :name (read pbuff))
|
||||
(setq latest bk)
|
||||
)
|
||||
;; ... :version
|
||||
((eq token :version)
|
||||
(if (sane-desc-getval bk :version) (sane-desc-error-repeat token))
|
||||
(sane-desc-putval bk :version (read pbuff))
|
||||
)
|
||||
;; ... :status
|
||||
((eq token :status)
|
||||
(if (sane-desc-getval bk :status) (sane-desc-error-repeat token))
|
||||
(sane-desc-putval bk :status (read pbuff))
|
||||
(if (not (assq (sane-desc-getval bk :status) sane-desc-status-codes))
|
||||
(error "Not a valid status keyword: %s" (sane-desc-getval bk :status)))
|
||||
)
|
||||
;; ... :manpage
|
||||
((eq token :manpage)
|
||||
(if (sane-desc-getval bk :manpage) (sane-desc-error-repeat token))
|
||||
(sane-desc-putval bk :manpage (read pbuff))
|
||||
)
|
||||
;; ... :devicetype -> signifies that device descriptions follow.
|
||||
((eq token :devicetype)
|
||||
(setq current-devtype (read pbuff))
|
||||
(if (not (memq current-devtype sane-desc-valid-devtypes))
|
||||
(error "Invalid device-type: %s" current-devtype))
|
||||
)
|
||||
;; Device descriptive elements
|
||||
;; ... :mfg -> signal a new manufacturer, start a list
|
||||
((eq token :mfg)
|
||||
(let ((name (read pbuff)))
|
||||
(setq current-mfg (sane-desc-make-mfg))
|
||||
(sane-desc-putval current-mfg :name name)
|
||||
(setq mfg-list (nconc mfg-list (list current-mfg)))
|
||||
(setq latest current-mfg)
|
||||
))
|
||||
;; ... :model -> name a model, assign to current mfg list
|
||||
((eq token :model)
|
||||
(let ((name (read pbuff)))
|
||||
(setq current-dev (sane-desc-make-dev))
|
||||
(sane-desc-putval current-dev :desc name)
|
||||
(sane-desc-putval current-dev :type current-devtype)
|
||||
(if current-mfg
|
||||
(sane-desc-putval current-dev :mfg current-mfg)
|
||||
(error "Device %s needs a mfg" name))
|
||||
(sane-desc-tack-on dev-list current-dev)
|
||||
(sane-desc-tack-on-val current-mfg :devlist current-dev)
|
||||
(setq latest current-dev)
|
||||
))
|
||||
;; ... :desc -> describe a software device (null mfg)
|
||||
((eq token :desc)
|
||||
(let ((desc (read pbuff)))
|
||||
(setq current-mfg (sane-desc-make-mfg))
|
||||
(setq mfg-list (nconc mfg-list (list current-mfg)))
|
||||
(setq current-dev (sane-desc-make-dev))
|
||||
(sane-desc-putval current-dev :desc desc)
|
||||
(sane-desc-putval current-dev :type current-devtype)
|
||||
(sane-desc-putval current-dev :mfg current-mfg)
|
||||
(sane-desc-tack-on dev-list current-dev)
|
||||
(sane-desc-tack-on-val current-mfg :devlist current-dev)
|
||||
(setq latest current-dev)
|
||||
(setq current-mfg nil)
|
||||
))
|
||||
;; Extraneous elements (apply to latest object)
|
||||
;; ... :url
|
||||
((eq token :url)
|
||||
(let ((url (read pbuff)))
|
||||
(if latest
|
||||
(sane-desc-putval latest :url url)
|
||||
(error "Assign :url %s to what?" url)
|
||||
)))
|
||||
;; ... :comment
|
||||
((eq token :comment)
|
||||
(let ((comment (read pbuff)))
|
||||
(if latest
|
||||
(sane-desc-putval latest :comment comment)
|
||||
(error "Assign :comment %s to what?" comment)
|
||||
)))
|
||||
;; ... :interface
|
||||
((eq token :interface)
|
||||
(let ((interface (read pbuff)))
|
||||
(if latest
|
||||
(sane-desc-putval latest :interface interface)
|
||||
(error "Assign :interface %s to what?" interface)
|
||||
)))
|
||||
;; What could possibly be left???
|
||||
(t (error "Unknown token during parse: %s" token))
|
||||
))
|
||||
(if (not (sane-desc-getval bk :name))
|
||||
(error "Missing :backend specifier!"))
|
||||
(sane-desc-putval bk :devlist dev-list)
|
||||
(sane-desc-putval bk :mfglist mfg-list)
|
||||
(message "Parsed out: %s (v%s, %s)"
|
||||
(sane-desc-getval bk :name) (sane-desc-getval bk :version) (sane-desc-getval bk :status))
|
||||
)
|
||||
(list bk mfg-list dev-list)
|
||||
))
|
||||
|
||||
|
||||
(defun sane-desc-parse-directory (dirname)
|
||||
(interactive "DParse all desc files in: ")
|
||||
(let ((files (directory-files dirname t sane-desc-descfile-regex))
|
||||
bklist
|
||||
mfglist
|
||||
devlist
|
||||
res
|
||||
(count 0))
|
||||
(setq bklist
|
||||
(mapcar '(lambda (filename)
|
||||
(message "Parsing %s" filename)
|
||||
(setq res (sane-desc-parse-file filename))
|
||||
(setq mfglist (append mfglist (nth 1 res)))
|
||||
(setq devlist (append devlist (nth 2 res)))
|
||||
(setq count (1+ count))
|
||||
(nth 0 res) ; return the bk
|
||||
)
|
||||
files))
|
||||
(sane-desc-putval sane-desc-database :backends bklist)
|
||||
(sane-desc-putval sane-desc-database :mfgs mfglist)
|
||||
(sane-desc-putval sane-desc-database :devices devlist)
|
||||
(message "Parsed %d files" count)
|
||||
nil
|
||||
))
|
||||
|
||||
|
||||
;;;;----------------------------------------------------------
|
||||
|
||||
|
||||
(defun sane-desc-generate-backend-page (filename)
|
||||
(interactive (list (read-file-name "Generate Backends HTML listing in: "
|
||||
default-directory nil nil
|
||||
sane-desc-backend-page-name)))
|
||||
(if (not (sane-desc-getval sane-desc-database :backends))
|
||||
(error "No backends in database!"))
|
||||
(message "creating file %s" filename)
|
||||
(let ((pbuff (create-file-buffer filename))
|
||||
)
|
||||
;;; (save-excursion
|
||||
(set-buffer pbuff)
|
||||
(goto-char (point-min))
|
||||
(switch-to-buffer pbuff)
|
||||
;; Write the heading...
|
||||
(sane-desc-pformat pbuff "
|
||||
<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
|
||||
<html> <head>
|
||||
<title>SANE: %s</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor=%s>
|
||||
<div align=center>
|
||||
<img src=\"%s\" alt=\"SANE\">
|
||||
<h1>%s</h1>
|
||||
</div>
|
||||
<hr>
|
||||
<p>The following table summarizes the backends/drivers that have not yet
|
||||
been included in the SANE distribution, and the hardware or software they
|
||||
support.
|
||||
|
||||
<p>This is only a summary!
|
||||
Please consult the author-supplied webpages for more detailed (and usually
|
||||
important) information concerning each backend.
|
||||
|
||||
%s
|
||||
|
||||
<p>If you have new information or corrections, please send e-mail
|
||||
to <a href=\"mailto:%s\">%s</a>.
|
||||
|
||||
<p>(For an explanation of the table, see the <a href=\"#legend\">legend</a>.)
|
||||
|
||||
<p>
|
||||
"
|
||||
;;;<base href=\"%s\">
|
||||
;;; sane-desc-base-url
|
||||
sane-desc-backend-html-title
|
||||
sane-desc-backend-html-bgcolor
|
||||
sane-desc-sane-logo
|
||||
sane-desc-backend-html-title
|
||||
sane-desc-additional-links
|
||||
sane-desc-email-address
|
||||
sane-desc-email-address)
|
||||
;; Write the table (w/ legend)...
|
||||
(sane-desc-generate-backend-table pbuff)
|
||||
;; Write the footer...
|
||||
(sane-desc-pformat pbuff "
|
||||
<hr>
|
||||
<a href=\"%s\">[Back]</a>
|
||||
<address>
|
||||
<a href=\"mailto:%s\">%s</a> / SANE Development mailing list
|
||||
</address>
|
||||
<font size=-1>
|
||||
This page was lasted updated on %s
|
||||
</font>
|
||||
</body> </html>
|
||||
"
|
||||
sane-desc-home-url
|
||||
sane-desc-email-address
|
||||
sane-desc-email-address
|
||||
(current-time-string)
|
||||
)
|
||||
;;; (set-visited-file-name sane-desc-backend-page-name)
|
||||
;;; )
|
||||
(write-file filename nil)
|
||||
(goto-char (point-min))
|
||||
nil
|
||||
))
|
||||
|
||||
|
||||
(defun sane-desc-generate-backend-table (buff)
|
||||
(sane-desc-pformat buff "
|
||||
<div align=center>
|
||||
<table border=1>
|
||||
<tr bgcolor=%s>
|
||||
<th align=center rowspan=2>Backend</th>
|
||||
<th align=center rowspan=2>Status</th>
|
||||
<th align=center colspan=4>Supported Devices</th>
|
||||
</tr>
|
||||
<tr bgcolor=%s>
|
||||
<th align=center>Manufacturer</th>
|
||||
<th align=center>Model</th>
|
||||
<th align=center>Interface</th>
|
||||
<th align=center>Comment</th>
|
||||
</tr>
|
||||
|
||||
"
|
||||
sane-desc-table-head-bgcolor
|
||||
sane-desc-table-head-bgcolor)
|
||||
(let ((bks (sane-desc-getval sane-desc-database :backends)))
|
||||
(while bks
|
||||
(message "Generating for %s" (sane-desc-getval (car bks) :name))
|
||||
(sane-desc-gen-backend-rows (car bks) buff)
|
||||
(setq bks (cdr bks))
|
||||
))
|
||||
(princ "
|
||||
|
||||
</table>
|
||||
</div>
|
||||
" buff)
|
||||
;; Print the Legend
|
||||
(sane-desc-pformat buff "
|
||||
<font size=-1>
|
||||
<h3><a name=\"legend\">Legend:</a></h3>
|
||||
<blockquote>
|
||||
<dl>
|
||||
<dt><b>Backend:</b></dt>
|
||||
<dd>Name of the backend, with a link to more extensive and detailed
|
||||
information, if it exists, or the email address of the author or maintainer.</dd>
|
||||
|
||||
<dt><b>Status:</b></dt>
|
||||
<dd>A vague indication of robustness and reliability.
|
||||
<ul>"
|
||||
)
|
||||
(mapcar '(lambda (item)
|
||||
(sane-desc-pformat buff "<li><font color=\"%s\">%s</font> %s\n"
|
||||
(nth 1 (cdr item))
|
||||
(nth 0 (cdr item))
|
||||
(nth 2 (cdr item)))
|
||||
nil)
|
||||
sane-desc-status-codes)
|
||||
(sane-desc-pformat buff "
|
||||
</ul>
|
||||
</dd>
|
||||
|
||||
<dt><b>Supported Devices:</b></dt>
|
||||
<dd>Which hardware the backend supports.</dd>
|
||||
|
||||
</dl>
|
||||
|
||||
</blockquote>
|
||||
</font>
|
||||
"
|
||||
)
|
||||
)
|
||||
|
||||
;; two passes: first to count various row-spans,
|
||||
;; second to actually write stuff.
|
||||
(defun sane-desc-gen-backend-rows (bk buff)
|
||||
(let ((bkspan 0)
|
||||
(mfgspan nil))
|
||||
; first, count the row-spans, per mfs and for the whole backend
|
||||
(setq mfgspan
|
||||
(mapcar '(lambda (mfg)
|
||||
(let ((span (length (sane-desc-getval mfg :devlist))))
|
||||
(if (zerop span)
|
||||
(setq span 1))
|
||||
(setq bkspan (+ bkspan span))
|
||||
(cons mfg span)
|
||||
))
|
||||
(sane-desc-getval bk :mfglist)))
|
||||
(let ((mfglist (sane-desc-getval bk :mfglist)))
|
||||
;; First row...
|
||||
(sane-desc-pformat buff "\n<tr>\n")
|
||||
;; ...name of backend (+ url, if any)
|
||||
(sane-desc-pformat buff " <td align=left rowspan=%d>" bkspan)
|
||||
(sane-desc-pformat-name-with-url buff (sane-desc-getval bk :name) (sane-desc-getval bk :url))
|
||||
(sane-desc-pformat buff "</td>\n")
|
||||
;; ...status (in CoLoR)
|
||||
(let* ((status (sane-desc-getval bk :status))
|
||||
(stuff (cdr (assq status sane-desc-status-codes))))
|
||||
(if (nth 1 stuff)
|
||||
(sane-desc-pformat buff
|
||||
" <td align=center rowspan=%d><font color=%s>%s</font></td>\n"
|
||||
bkspan
|
||||
(nth 1 stuff)
|
||||
(nth 0 stuff))
|
||||
(sane-desc-pformat buff " <td align=center rowspan=%d>%s</td>\n"
|
||||
bkspan (or (nth 0 stuff) "?"))
|
||||
))
|
||||
;; ...*first* mfg, and *first* dev of that mfg
|
||||
(if mfglist
|
||||
(sane-desc-pformat-mfg-and-first-dev buff (car mfglist) mfgspan)
|
||||
(sane-desc-pformat buff " <td align=center colspan=3>?</td>\n"))
|
||||
|
||||
;; Now, go on and remaining rows...
|
||||
;; ...do remaining devs of first mfg...
|
||||
(sane-desc-pformat-cdr-devs buff (sane-desc-getval (car mfglist) :devlist))
|
||||
;; ...do remaining mfgs...
|
||||
(sane-desc-pformat-cdr-mfgs buff mfglist mfgspan)
|
||||
)
|
||||
))
|
||||
|
||||
|
||||
(defun sane-desc-pformat-mfg-and-first-dev (buff mfg mfgspan)
|
||||
;; mfg name + device, or description
|
||||
(if (sane-desc-getval mfg :name)
|
||||
(progn
|
||||
;; ...name of mfg (+ url, if any)
|
||||
(sane-desc-pformat buff "<td align=center rowspan=%d>"
|
||||
(cdr (assq mfg mfgspan)))
|
||||
(sane-desc-pformat-name-with-url buff (sane-desc-getval mfg :name) (sane-desc-getval mfg :url))
|
||||
(sane-desc-pformat buff "</td>\n")
|
||||
;; ...name of first dev
|
||||
(sane-desc-pformat-dev buff (car (sane-desc-getval mfg :devlist)))
|
||||
)
|
||||
(sane-desc-pformat-dev buff (car (sane-desc-getval mfg :devlist)) t)
|
||||
))
|
||||
|
||||
|
||||
(defun sane-desc-pformat-dev (buff dev &optional no-mfg)
|
||||
(if no-mfg
|
||||
(progn
|
||||
(sane-desc-pformat buff "<td align=center colspan=2>")
|
||||
(sane-desc-pformat-name-with-url buff (sane-desc-getval dev :desc) (sane-desc-getval dev :url)))
|
||||
(progn
|
||||
(sane-desc-pformat buff "<td>")
|
||||
(sane-desc-pformat-name-with-url buff (sane-desc-getval dev :desc) (sane-desc-getval dev :url)))
|
||||
)
|
||||
(sane-desc-pformat buff "</td>\n")
|
||||
(if (sane-desc-getval dev :interface)
|
||||
(sane-desc-pformat buff "<td>%s</td>\n" (sane-desc-getval dev :interface))
|
||||
(sane-desc-pformat buff "<td> </td>\n"))
|
||||
(sane-desc-pformat buff "</td>\n")
|
||||
(if (sane-desc-getval dev :comment)
|
||||
(sane-desc-pformat buff "<td>%s</td>\n" (sane-desc-getval dev :comment))
|
||||
(sane-desc-pformat buff "<td> </td>\n"))
|
||||
)
|
||||
|
||||
|
||||
(defun sane-desc-pformat-cdr-devs (buff devlist)
|
||||
(setq devlist (cdr devlist))
|
||||
(while devlist
|
||||
(sane-desc-pformat buff "<tr>")
|
||||
(sane-desc-pformat-dev buff (car devlist))
|
||||
(sane-desc-pformat buff "</tr>\n")
|
||||
(setq devlist (cdr devlist)))
|
||||
)
|
||||
|
||||
(defun sane-desc-pformat-cdr-mfgs (buff mfglist mfgspan)
|
||||
(setq mfglist (cdr mfglist))
|
||||
(while mfglist
|
||||
(sane-desc-pformat buff "<tr>")
|
||||
(sane-desc-pformat-mfg-and-first-dev buff (car mfglist) mfgspan)
|
||||
(sane-desc-pformat buff "</tr>\n")
|
||||
(sane-desc-pformat-cdr-devs buff (sane-desc-getval (car mfglist) :devlist))
|
||||
(setq mfglist (cdr mfglist))
|
||||
))
|
||||
|
||||
(defun sane-desc-pformat-name-with-url (buff name url)
|
||||
(if (and name url)
|
||||
(sane-desc-pformat buff "<a href=\"%s\">%s</a>" url name)
|
||||
(sane-desc-pformat buff "%s" (or name "?"))
|
||||
))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(defun sane-desc-regenerate-backend-page ()
|
||||
(interactive)
|
||||
(call-interactively 'sane-desc-parse-directory)
|
||||
(call-interactively 'sane-desc-generate-backend-page)
|
||||
)
|
||||
|
||||
|
||||
(defun sane-desc-doit ()
|
||||
(interactive)
|
||||
(sane-desc-parse-directory ".")
|
||||
(sane-desc-generate-backend-page "../../doc/sane-backends-external.html"))
|
||||
|
|
@ -1,618 +0,0 @@
|
|||
;;
|
||||
;; Some handy elisp stuff to automagically generate descriptive
|
||||
;; SANE webpages from backend .desc files.
|
||||
;;
|
||||
;; Basic usage:
|
||||
;; M-x sane-desc-parse-directory to parse .desc files in a directory
|
||||
;; M-x sane-desc-generate-backend-page to write out some HTML
|
||||
;; or, even easier,
|
||||
;; M-x sane-desc-regenerate-backend-page do both of the above
|
||||
;;
|
||||
;;
|
||||
;; Copyright (C) 1998 Matthew Marjanovic
|
||||
;; 2001, 2002 Henning Meier-Geinitz
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, 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 General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, 675 Massachusettes Ave,
|
||||
;; Cambridge, MA 02139, USA.
|
||||
|
||||
|
||||
(defconst sane-desc-descfile-regex ".*\.desc$"
|
||||
"Regular expression for finding .desc files.")
|
||||
|
||||
(defconst sane-desc-valid-devtypes '(:scanner :api :meta :stillcam :vidcam)
|
||||
"List of allowed device-type keywords")
|
||||
|
||||
(defvar sane-desc-status-codes
|
||||
'((:new . ("NEW!" "000080"
|
||||
"means brand-new to the current release of SANE."))
|
||||
(:alpha . ("alpha" "bb0000"
|
||||
"means it must do something, but is not very well
|
||||
tested, probably has bugs, and may even crash your
|
||||
system, etc., etc."))
|
||||
(:beta . ("beta" "806000"
|
||||
"means it works pretty well, and looks stable and
|
||||
functional, but not bullet-proof."))
|
||||
(:stable . ("stable" "008000"
|
||||
"means someone is pulling your leg."))
|
||||
)
|
||||
"An assoc list with one pair for each valid :status keyword.
|
||||
The associated data is a list with three elements, consisting of
|
||||
the print name of the status, the color to use, and a description.")
|
||||
|
||||
;;; HTML formatting variables
|
||||
|
||||
(defvar sane-desc-backend-page-name "sane-backends.html"
|
||||
"Default name for the Backends HTML page.")
|
||||
|
||||
|
||||
(defvar sane-desc-backend-html-title "Backends (Drivers)"
|
||||
"Title used for the Backends page.")
|
||||
|
||||
;(defvar sane-desc-base-url "http://www.mostang.com/sane/backends.html"
|
||||
; "Base URL for generated HTML.
|
||||
;This is put into a BASE tag, and will be used as the root
|
||||
;of all relative references.
|
||||
;This will also be used for SANE home page references.")
|
||||
|
||||
(defvar sane-desc-home-url "http://www.mostang.com/sane/"
|
||||
"URL for the SANE homepage.")
|
||||
|
||||
(defvar sane-desc-sane-logo "http://www.mostang.com/sane/sane.png"
|
||||
"URL for SANE logo.")
|
||||
|
||||
(defvar sane-desc-backend-html-bgcolor "FFFFFF"
|
||||
"Background color on Backends page.")
|
||||
|
||||
(defvar sane-desc-table-head-bgcolor "E0E0FF"
|
||||
"Background color for header of Backends table.")
|
||||
|
||||
(defvar sane-desc-email-address "sane-devel@mostang.com"
|
||||
"Address of the SANE developer's mailing list.")
|
||||
|
||||
(defvar sane-desc-manpage-url-format
|
||||
"http://www.mostang.com/sane/man/%s.5.html"
|
||||
"Format used for creating URL's for on-line manpages.")
|
||||
|
||||
(defvar sane-desc-additional-links
|
||||
"<p>There are special tables for <a
|
||||
href=\"http://www.buzzard.org.uk/jonathan/scanners.html\">parallel port</a>
|
||||
and <a href=\"http://www.buzzard.org.uk/jonathan/scanners-usb.html\">USB</a>
|
||||
scanners from <a href=\"mailto:jonathan@buzzard.org.uk\">Jonathan Buzzard</a>.
|
||||
"
|
||||
"Links to additional sources of information near the top of the page.")
|
||||
|
||||
|
||||
|
||||
; why doesn't elisp have a normal format? (beats me.)
|
||||
|
||||
(defmacro sane-desc-pformat (stream &rest args)
|
||||
`(princ (format ,@args) ,stream))
|
||||
|
||||
|
||||
|
||||
; structures for elements of the database
|
||||
|
||||
(defmacro sane-desc-getval (alist key)
|
||||
`(cdr (assq ,key ,alist)))
|
||||
|
||||
(defmacro sane-desc-putval (alist key val)
|
||||
`(setcdr (assq ,key ,alist) ,val))
|
||||
|
||||
(defmacro sane-desc-tack-on (lst item)
|
||||
`(setq ,lst (nconc ,lst (list ,item))))
|
||||
|
||||
(defmacro sane-desc-tack-on-val (alst key item)
|
||||
`(sane-desc-putval ,alst ,key
|
||||
(nconc (sane-desc-getval ,alst ,key) (list ,item))))
|
||||
|
||||
|
||||
(defun sane-desc-make-db ()
|
||||
(copy-alist '((:backends . nil) ;why copy? seems to be constant otherwise
|
||||
(:mfgs . nil)
|
||||
(:devices . nil))))
|
||||
|
||||
(defun sane-desc-make-backend ()
|
||||
(copy-alist '((:name . nil)
|
||||
(:version . nil)
|
||||
(:status . nil)
|
||||
(:manpage . nil)
|
||||
(:url . nil)
|
||||
(:comment . nil)
|
||||
(:devlist . nil)
|
||||
(:mfglist . nil))))
|
||||
|
||||
(defun sane-desc-make-mfg ()
|
||||
(copy-alist '((:name . nil)
|
||||
(:url . nil)
|
||||
(:comment . nil)
|
||||
(:devlist . nil))))
|
||||
|
||||
(defun sane-desc-make-dev ()
|
||||
(copy-alist '((:type . nil)
|
||||
(:desc . nil)
|
||||
(:mfg . nil)
|
||||
(:url . nil)
|
||||
(:interface . nil)
|
||||
(:comment . nil))))
|
||||
|
||||
|
||||
(defvar sane-desc-database (sane-desc-make-db)
|
||||
"The 'database' of results from parsing SANE .desc files.
|
||||
This is a assoc list containing lists of backends, manufacturers,
|
||||
and devices.")
|
||||
|
||||
|
||||
|
||||
(defun sane-desc-error-repeat (token)
|
||||
(error "Oops! %s specified twice" token))
|
||||
|
||||
|
||||
; add-to-list
|
||||
|
||||
(defun sane-desc-parse-file (filename)
|
||||
(interactive "fParse desc file: ")
|
||||
(let ((pbuff (find-file filename))
|
||||
result)
|
||||
(setq result (sane-desc-parse-buffer pbuff))
|
||||
(kill-buffer pbuff)
|
||||
result
|
||||
))
|
||||
|
||||
|
||||
(defun sane-desc-parse-buffer (pbuff-name)
|
||||
(interactive "bParse desc buffer: ")
|
||||
(let ((pbuff (get-buffer pbuff-name))
|
||||
(bk (sane-desc-make-backend))
|
||||
mfg-list
|
||||
dev-list
|
||||
current-devtype
|
||||
current-mfg
|
||||
token
|
||||
latest
|
||||
)
|
||||
(if (not (bufferp pbuff)) (error "No such buffer: %s" pbuff-name))
|
||||
(save-excursion
|
||||
(set-buffer pbuff)
|
||||
(goto-char (point-min))
|
||||
;;magic do loop -- read objects until EOF
|
||||
(while (condition-case nil
|
||||
(progn
|
||||
(setq token (read pbuff))
|
||||
t)
|
||||
((end-of-file nil))
|
||||
)
|
||||
(cond
|
||||
;; Top-level backend descriptive elements
|
||||
;; ... :backend (required)
|
||||
((eq token :backend)
|
||||
(if (sane-desc-getval bk :name) (sane-desc-error-repeat token))
|
||||
(sane-desc-putval bk :name (read pbuff))
|
||||
(setq latest bk)
|
||||
)
|
||||
;; ... :version
|
||||
((eq token :version)
|
||||
(if (sane-desc-getval bk :version) (sane-desc-error-repeat token))
|
||||
(sane-desc-putval bk :version (read pbuff))
|
||||
)
|
||||
;; ... :status
|
||||
((eq token :status)
|
||||
(if (sane-desc-getval bk :status) (sane-desc-error-repeat token))
|
||||
(sane-desc-putval bk :status (read pbuff))
|
||||
(if (not (assq (sane-desc-getval bk :status) sane-desc-status-codes))
|
||||
(error "Not a valid status keyword: %s" (sane-desc-getval bk :status)))
|
||||
)
|
||||
;; ... :manpage
|
||||
((eq token :manpage)
|
||||
(if (sane-desc-getval bk :manpage) (sane-desc-error-repeat token))
|
||||
(sane-desc-putval bk :manpage (read pbuff))
|
||||
)
|
||||
;; ... :devicetype -> signifies that device descriptions follow.
|
||||
((eq token :devicetype)
|
||||
(setq current-devtype (read pbuff))
|
||||
(if (not (memq current-devtype sane-desc-valid-devtypes))
|
||||
(error "Invalid device-type: %s" current-devtype))
|
||||
)
|
||||
;; Device descriptive elements
|
||||
;; ... :mfg -> signal a new manufacturer, start a list
|
||||
((eq token :mfg)
|
||||
(let ((name (read pbuff)))
|
||||
(setq current-mfg (sane-desc-make-mfg))
|
||||
(sane-desc-putval current-mfg :name name)
|
||||
(setq mfg-list (nconc mfg-list (list current-mfg)))
|
||||
(setq latest current-mfg)
|
||||
))
|
||||
;; ... :model -> name a model, assign to current mfg list
|
||||
((eq token :model)
|
||||
(let ((name (read pbuff)))
|
||||
(setq current-dev (sane-desc-make-dev))
|
||||
(sane-desc-putval current-dev :desc name)
|
||||
(sane-desc-putval current-dev :type current-devtype)
|
||||
(if current-mfg
|
||||
(sane-desc-putval current-dev :mfg current-mfg)
|
||||
(error "Device %s needs a mfg" name))
|
||||
(sane-desc-tack-on dev-list current-dev)
|
||||
(sane-desc-tack-on-val current-mfg :devlist current-dev)
|
||||
(setq latest current-dev)
|
||||
))
|
||||
;; ... :desc -> describe a software device (null mfg)
|
||||
((eq token :desc)
|
||||
(let ((desc (read pbuff)))
|
||||
(setq current-mfg (sane-desc-make-mfg))
|
||||
(setq mfg-list (nconc mfg-list (list current-mfg)))
|
||||
(setq current-dev (sane-desc-make-dev))
|
||||
(sane-desc-putval current-dev :desc desc)
|
||||
(sane-desc-putval current-dev :type current-devtype)
|
||||
(sane-desc-putval current-dev :mfg current-mfg)
|
||||
(sane-desc-tack-on dev-list current-dev)
|
||||
(sane-desc-tack-on-val current-mfg :devlist current-dev)
|
||||
(setq latest current-dev)
|
||||
(setq current-mfg nil)
|
||||
))
|
||||
;; Extraneous elements (apply to latest object)
|
||||
;; ... :url
|
||||
((eq token :url)
|
||||
(let ((url (read pbuff)))
|
||||
(if latest
|
||||
(sane-desc-putval latest :url url)
|
||||
(error "Assign :url %s to what?" url)
|
||||
)))
|
||||
;; ... :comment
|
||||
((eq token :comment)
|
||||
(let ((comment (read pbuff)))
|
||||
(if latest
|
||||
(sane-desc-putval latest :comment comment)
|
||||
(error "Assign :comment %s to what?" comment)
|
||||
)))
|
||||
;; ... :interface
|
||||
((eq token :interface)
|
||||
(let ((interface (read pbuff)))
|
||||
(if latest
|
||||
(sane-desc-putval latest :interface interface)
|
||||
(error "Assign :interface %s to what?" interface)
|
||||
)))
|
||||
;; What could possibly be left???
|
||||
(t (error "Unknown token during parse: %s" token))
|
||||
))
|
||||
(if (not (sane-desc-getval bk :name))
|
||||
(error "Missing :backend specifier!"))
|
||||
(sane-desc-putval bk :devlist dev-list)
|
||||
(sane-desc-putval bk :mfglist mfg-list)
|
||||
(message "Parsed out: %s (v%s, %s)"
|
||||
(sane-desc-getval bk :name) (sane-desc-getval bk :version) (sane-desc-getval bk :status))
|
||||
)
|
||||
(list bk mfg-list dev-list)
|
||||
))
|
||||
|
||||
|
||||
(defun sane-desc-parse-directory (dirname)
|
||||
(interactive "DParse all desc files in: ")
|
||||
(let ((files (directory-files dirname t sane-desc-descfile-regex))
|
||||
bklist
|
||||
mfglist
|
||||
devlist
|
||||
res
|
||||
(count 0))
|
||||
(setq bklist
|
||||
(mapcar '(lambda (filename)
|
||||
(message "Parsing %s" filename)
|
||||
(setq res (sane-desc-parse-file filename))
|
||||
(setq mfglist (append mfglist (nth 1 res)))
|
||||
(setq devlist (append devlist (nth 2 res)))
|
||||
(setq count (1+ count))
|
||||
(nth 0 res) ; return the bk
|
||||
)
|
||||
files))
|
||||
(sane-desc-putval sane-desc-database :backends bklist)
|
||||
(sane-desc-putval sane-desc-database :mfgs mfglist)
|
||||
(sane-desc-putval sane-desc-database :devices devlist)
|
||||
(message "Parsed %d files" count)
|
||||
nil
|
||||
))
|
||||
|
||||
|
||||
;;;;----------------------------------------------------------
|
||||
|
||||
|
||||
(defun sane-desc-generate-backend-page (filename)
|
||||
(interactive (list (read-file-name "Generate Backends HTML listing in: "
|
||||
default-directory nil nil
|
||||
sane-desc-backend-page-name)))
|
||||
(if (not (sane-desc-getval sane-desc-database :backends))
|
||||
(error "No backends in database!"))
|
||||
(message "creating file %s" filename)
|
||||
(let ((pbuff (create-file-buffer filename))
|
||||
)
|
||||
;;; (save-excursion
|
||||
(set-buffer pbuff)
|
||||
(goto-char (point-min))
|
||||
(switch-to-buffer pbuff)
|
||||
;; Write the heading...
|
||||
(sane-desc-pformat pbuff "
|
||||
<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
|
||||
<html> <head>
|
||||
<title>SANE: %s</title>
|
||||
</head>
|
||||
|
||||
<body bgcolor=%s>
|
||||
<div align=center>
|
||||
<img src=\"%s\" alt=\"SANE\">
|
||||
<h1>%s</h1>
|
||||
</div>
|
||||
<hr>
|
||||
<p>The following table summarizes the backends/drivers distributed with
|
||||
sane-backends-@VERSION@, and the hardware or software they support.
|
||||
|
||||
<p>
|
||||
There is also a table for <a href=\"sane-backends-external.html\">backends
|
||||
that are not yet included</a> in the SANE distribution.
|
||||
|
||||
<p>This is only a summary!
|
||||
Please consult the manpages and the author-supplied webpages for more
|
||||
detailed (and usually important) information concerning each backend.
|
||||
|
||||
%s
|
||||
|
||||
<p>If you have new information or corrections, please send e-mail
|
||||
to <a href=\"mailto:%s\">%s</a>.
|
||||
|
||||
<p>(For an explanation of the table, see the <a href=\"#legend\">legend</a>.)
|
||||
|
||||
<p>
|
||||
"
|
||||
;;;<base href=\"%s\">
|
||||
;;; sane-desc-base-url
|
||||
sane-desc-backend-html-title
|
||||
sane-desc-backend-html-bgcolor
|
||||
sane-desc-sane-logo
|
||||
sane-desc-backend-html-title
|
||||
sane-desc-additional-links
|
||||
sane-desc-email-address
|
||||
sane-desc-email-address)
|
||||
;; Write the table (w/ legend)...
|
||||
(sane-desc-generate-backend-table pbuff)
|
||||
;; Write the footer...
|
||||
(sane-desc-pformat pbuff "
|
||||
<hr>
|
||||
<a href=\"%s\">[Back]</a>
|
||||
<address>
|
||||
<a href=\"mailto:%s\">%s</a> / SANE Development mailing list
|
||||
</address>
|
||||
<font size=-1>
|
||||
This page was lasted updated on %s
|
||||
</font>
|
||||
</body> </html>
|
||||
"
|
||||
sane-desc-home-url
|
||||
sane-desc-email-address
|
||||
sane-desc-email-address
|
||||
(current-time-string)
|
||||
)
|
||||
;;; (set-visited-file-name sane-desc-backend-page-name)
|
||||
;;; )
|
||||
(write-file filename nil)
|
||||
(goto-char (point-min))
|
||||
nil
|
||||
))
|
||||
|
||||
|
||||
(defun sane-desc-generate-backend-table (buff)
|
||||
(sane-desc-pformat buff "
|
||||
<div align=center>
|
||||
<table border=1>
|
||||
<tr bgcolor=%s>
|
||||
<th align=center rowspan=2>Backend</th>
|
||||
<th align=center rowspan=2>Version</th>
|
||||
<th align=center rowspan=2>Status</th>
|
||||
<th align=center colspan=4>Supported Devices</th>
|
||||
<th align=center rowspan=2>Manual Page</th>
|
||||
</tr>
|
||||
<tr bgcolor=%s>
|
||||
<th align=center>Manufacturer</th>
|
||||
<th align=center>Model</th>
|
||||
<th align=center>Interface</th>
|
||||
<th align=center>Comment</th>
|
||||
</tr>
|
||||
|
||||
"
|
||||
sane-desc-table-head-bgcolor
|
||||
sane-desc-table-head-bgcolor)
|
||||
(let ((bks (sane-desc-getval sane-desc-database :backends)))
|
||||
(while bks
|
||||
(message "Generating for %s" (sane-desc-getval (car bks) :name))
|
||||
(sane-desc-gen-backend-rows (car bks) buff)
|
||||
(setq bks (cdr bks))
|
||||
))
|
||||
(princ "
|
||||
|
||||
</table>
|
||||
</div>
|
||||
" buff)
|
||||
;; Print the Legend
|
||||
(sane-desc-pformat buff "
|
||||
<font size=-1>
|
||||
<h3><a name=\"legend\">Legend:</a></h3>
|
||||
<blockquote>
|
||||
<dl>
|
||||
<dt><b>Backend:</b></dt>
|
||||
<dd>Name of the backend, with a link to more extensive and detailed
|
||||
information, if it exists, or the email address of the author or maintainer.</dd>
|
||||
|
||||
<dt><b>Version:</b></dt>
|
||||
<dd>Version of backend/driver distributed in the lastest SANE release.
|
||||
Newer versions may be available from their home sites.</dd>
|
||||
|
||||
<dt><b>Status:</b></dt>
|
||||
<dd>A vague indication of robustness and reliability.
|
||||
<ul>"
|
||||
)
|
||||
(mapcar '(lambda (item)
|
||||
(sane-desc-pformat buff "<li><font color=\"%s\">%s</font> %s\n"
|
||||
(nth 1 (cdr item))
|
||||
(nth 0 (cdr item))
|
||||
(nth 2 (cdr item)))
|
||||
nil)
|
||||
sane-desc-status-codes)
|
||||
(sane-desc-pformat buff "
|
||||
</ul>
|
||||
</dd>
|
||||
|
||||
<dt><b>Supported Devices:</b></dt>
|
||||
<dd>Which hardware the backend supports.</dd>
|
||||
|
||||
<dt><b>Manual Page:</b></dt>
|
||||
<dd>A link to the man-page on-line, if it exists.</dd>
|
||||
</dl>
|
||||
|
||||
</blockquote>
|
||||
</font>
|
||||
"
|
||||
)
|
||||
)
|
||||
|
||||
;; two passes: first to count various row-spans,
|
||||
;; second to actually write stuff.
|
||||
(defun sane-desc-gen-backend-rows (bk buff)
|
||||
(let ((bkspan 0)
|
||||
(mfgspan nil))
|
||||
; first, count the row-spans, per mfs and for the whole backend
|
||||
(setq mfgspan
|
||||
(mapcar '(lambda (mfg)
|
||||
(let ((span (length (sane-desc-getval mfg :devlist))))
|
||||
(if (zerop span)
|
||||
(setq span 1))
|
||||
(setq bkspan (+ bkspan span))
|
||||
(cons mfg span)
|
||||
))
|
||||
(sane-desc-getval bk :mfglist)))
|
||||
(let ((mfglist (sane-desc-getval bk :mfglist)))
|
||||
;; First row...
|
||||
(sane-desc-pformat buff "\n<tr>\n")
|
||||
;; ...name of backend (+ url, if any)
|
||||
(sane-desc-pformat buff " <td align=left rowspan=%d>" bkspan)
|
||||
(sane-desc-pformat-name-with-url buff (sane-desc-getval bk :name) (sane-desc-getval bk :url))
|
||||
(sane-desc-pformat buff "</td>\n")
|
||||
;; ...version
|
||||
(sane-desc-pformat buff " <td align=center rowspan=%d>%s</td>\n"
|
||||
bkspan (or (sane-desc-getval bk :version) "?"))
|
||||
;; ...status (in CoLoR)
|
||||
(let* ((status (sane-desc-getval bk :status))
|
||||
(stuff (cdr (assq status sane-desc-status-codes))))
|
||||
(if (nth 1 stuff)
|
||||
(sane-desc-pformat buff
|
||||
" <td align=center rowspan=%d><font color=%s>%s</font></td>\n"
|
||||
bkspan
|
||||
(nth 1 stuff)
|
||||
(nth 0 stuff))
|
||||
(sane-desc-pformat buff " <td align=center rowspan=%d>%s</td>\n"
|
||||
bkspan (or (nth 0 stuff) "?"))
|
||||
))
|
||||
;; ...*first* mfg, and *first* dev of that mfg
|
||||
(if mfglist
|
||||
(sane-desc-pformat-mfg-and-first-dev buff (car mfglist) mfgspan)
|
||||
(sane-desc-pformat buff " <td align=center colspan=3>?</td>\n"))
|
||||
|
||||
;; ...man-page
|
||||
(sane-desc-pformat buff "<td align=center rowspan=%d>" bkspan)
|
||||
(sane-desc-pformat-name-with-url buff
|
||||
(sane-desc-getval bk :manpage)
|
||||
(format sane-desc-manpage-url-format
|
||||
(sane-desc-getval bk :manpage)))
|
||||
(sane-desc-pformat buff "</td>\n")
|
||||
|
||||
;; Now, go on and remaining rows...
|
||||
;; ...do remaining devs of first mfg...
|
||||
(sane-desc-pformat-cdr-devs buff (sane-desc-getval (car mfglist) :devlist))
|
||||
;; ...do remaining mfgs...
|
||||
(sane-desc-pformat-cdr-mfgs buff mfglist mfgspan)
|
||||
)
|
||||
))
|
||||
|
||||
|
||||
(defun sane-desc-pformat-mfg-and-first-dev (buff mfg mfgspan)
|
||||
;; mfg name + device, or description
|
||||
(if (sane-desc-getval mfg :name)
|
||||
(progn
|
||||
;; ...name of mfg (+ url, if any)
|
||||
(sane-desc-pformat buff "<td align=center rowspan=%d>"
|
||||
(cdr (assq mfg mfgspan)))
|
||||
(sane-desc-pformat-name-with-url buff (sane-desc-getval mfg :name) (sane-desc-getval mfg :url))
|
||||
(sane-desc-pformat buff "</td>\n")
|
||||
;; ...name of first dev
|
||||
(sane-desc-pformat-dev buff (car (sane-desc-getval mfg :devlist)))
|
||||
)
|
||||
(sane-desc-pformat-dev buff (car (sane-desc-getval mfg :devlist)) t)
|
||||
))
|
||||
|
||||
|
||||
(defun sane-desc-pformat-dev (buff dev &optional no-mfg)
|
||||
(if no-mfg
|
||||
(progn
|
||||
(sane-desc-pformat buff "<td align=center colspan=2>")
|
||||
(sane-desc-pformat-name-with-url buff (sane-desc-getval dev :desc) (sane-desc-getval dev :url)))
|
||||
(progn
|
||||
(sane-desc-pformat buff "<td>")
|
||||
(sane-desc-pformat-name-with-url buff (sane-desc-getval dev :desc) (sane-desc-getval dev :url)))
|
||||
)
|
||||
(sane-desc-pformat buff "</td>\n")
|
||||
(if (sane-desc-getval dev :interface)
|
||||
(sane-desc-pformat buff "<td>%s</td>\n" (sane-desc-getval dev :interface))
|
||||
(sane-desc-pformat buff "<td> </td>\n"))
|
||||
(sane-desc-pformat buff "</td>\n")
|
||||
(if (sane-desc-getval dev :comment)
|
||||
(sane-desc-pformat buff "<td>%s</td>\n" (sane-desc-getval dev :comment))
|
||||
(sane-desc-pformat buff "<td> </td>\n"))
|
||||
)
|
||||
|
||||
|
||||
(defun sane-desc-pformat-cdr-devs (buff devlist)
|
||||
(setq devlist (cdr devlist))
|
||||
(while devlist
|
||||
(sane-desc-pformat buff "<tr>")
|
||||
(sane-desc-pformat-dev buff (car devlist))
|
||||
(sane-desc-pformat buff "</tr>\n")
|
||||
(setq devlist (cdr devlist)))
|
||||
)
|
||||
|
||||
(defun sane-desc-pformat-cdr-mfgs (buff mfglist mfgspan)
|
||||
(setq mfglist (cdr mfglist))
|
||||
(while mfglist
|
||||
(sane-desc-pformat buff "<tr>")
|
||||
(sane-desc-pformat-mfg-and-first-dev buff (car mfglist) mfgspan)
|
||||
(sane-desc-pformat buff "</tr>\n")
|
||||
(sane-desc-pformat-cdr-devs buff (sane-desc-getval (car mfglist) :devlist))
|
||||
(setq mfglist (cdr mfglist))
|
||||
))
|
||||
|
||||
(defun sane-desc-pformat-name-with-url (buff name url)
|
||||
(if (and name url)
|
||||
(sane-desc-pformat buff "<a href=\"%s\">%s</a>" url name)
|
||||
(sane-desc-pformat buff "%s" (or name "?"))
|
||||
))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(defun sane-desc-regenerate-backend-page ()
|
||||
(interactive)
|
||||
(call-interactively 'sane-desc-parse-directory)
|
||||
(call-interactively 'sane-desc-generate-backend-page)
|
||||
)
|
||||
|
||||
|
||||
(defun sane-desc-doit ()
|
||||
(interactive)
|
||||
(sane-desc-parse-directory ".")
|
||||
(sane-desc-generate-backend-page "../../doc/sane-backends.html"))
|
||||
Ładowanie…
Reference in New Issue