src/clfswm-autodoc.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Auto documentation tools
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2012 Philippe Brochard <pbrochard@common-lisp.net>
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software
  22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23 ;;;
  24 ;;; --------------------------------------------------------------------------
  25
  26 (in-package :clfswm)
  27
  28
  29 (defun is-string-keysym (k)
  30   (when (stringp k)
  31     (or (parse-integer k :junk-allowed t)
  32         (intern (string-upcase k)))))
  33
  34
  35 (defun produce-doc-html (hash-table-key-list &optional (stream t))
  36   "Produce an html doc from a hash-table key"
  37   (labels ((clean-string (str)
  38              (cond ((string-equal str "#\\:") ":")
  39                    ((string-equal str "#\\#") "#")
  40                    ((string-equal str "#\\\\") "\\")
  41                    (t (substitute #\Space #\#
  42                                   (substitute #\Space #\\
  43                                               (substitute #\Space #\: str))))))
  44            (produce-keys (hk)
  45              `("table class=\"ex\" cellspacing=\"5\" border=\"0\" width=\"100%\""
  46                (tr ("th align=\"right\" width=\"10%\"" "Modifiers")
  47                    ("th align=\"center\" width=\"10%\"" "Key/Button")
  48                    ("th align=\"left\"" "Function"))
  49                ,@(let ((acc nil))
  50                       (maphash #'(lambda (k v)
  51                                    (when (consp k)
  52                                      (push `(tr
  53                                              ("td align=\"right\" style=\"color:#FF0000\" nowrap"
  54                                               ,(clean-string (format nil "~{~@(~S ~)~}" (state->modifiers (second k)))))
  55                                              ("td align=\"center\" nowrap"
  56                                               ,(clean-string (format nil "~@(~S~)"
  57                                                                      (or (is-string-keysym (first k)) (first k)))))
  58                                              ("td style=\"color:#0000FF\" nowrap" ,(documentation (or (first v) (third v)) 'function)))
  59                                            acc)))
  60                                hk)
  61                       (nreverse acc)))))
  62     (produce-html
  63      `(html
  64        (head
  65         (title "CLFSWM Keys"))
  66        (body
  67         (h1 "CLFSWM Keys")
  68         (p (small "Note: Mod-1 is the Meta or Alt key"))
  69         ,@(let ((acc nil))
  70                (dolist (hk hash-table-key-list)
  71                  (push `(h3 (u ,(gethash 'name hk))) acc)
  72                  (push (produce-keys hk) acc))
  73                (nreverse acc))
  74         (p (small "This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-doc-html-in-file or
  75 the produce-all-docs function from the Lisp REPL."))
  76         (p (small "Something like this:<br>
  77 LISP> (in-package :clfswm)<br>
  78 CLFSWM> (produce-doc-html-in-file \"my-keys.html\")<br>
  79 or<br> CLFSWM> (produce-all-docs)"))))
  80      0 stream)))
  81
  82
  83 (defun produce-doc-html-in-file (filename)
  84   (format t "Producing html keys documentation in ~S " filename)
  85   (with-open-file (stream filename :direction :output
  86                           :if-exists :supersede :if-does-not-exist :create)
  87     (produce-doc-html (list *main-keys* *main-mouse* *second-keys* *second-mouse*
  88                             *info-keys* *info-mouse* *circulate-keys* *expose-keys* *expose-mouse*)
  89                       stream))
  90   (format t " done~%"))
  91
  92
  93
  94 (defun produce-doc (hash-table-key-list &optional (stream t) (display-producing-doc t))
  95   "Produce a text doc from a hash-table key"
  96   (format stream "    * CLFSWM Keys *~%")
  97   (format stream "      -----------~%")
  98   (format stream "~%Note: Mod-1 is the Meta or Alt key~%")
  99   (dolist (hk hash-table-key-list)
 100     (format stream "~2&~A:~%" (gethash 'name hk))
 101     (dotimes (i (length (gethash 'name hk)))
 102       (format stream "-"))
 103     (format stream "~2%")
 104     (maphash #'(lambda (k v)
 105                  (when (consp k)
 106                    (format stream "~&  ~20@<~{~@(~A~) ~}~> ~13@<~@(~A~)~>   ~A~%"
 107                            (state->modifiers (second k))
 108                            (remove #\# (remove #\\ (format nil "~S" (or (is-string-keysym (first k)) (first k)))))
 109                            (documentation (or (first v) (third v)) 'function))))
 110              hk)
 111     (format stream "~2&"))
 112   (when display-producing-doc
 113     (format stream "~2%This documentation was produced with the CLFSWM auto-doc functions.
 114 To reproduce it, use the produce-doc-in-file or the produce-all-docs
 115 function from the Lisp REPL.
 116
 117 Something like this:
 118 LISP> (in-package :clfswm)
 119 CLFSWM> (produce-doc-in-file \"my-keys.txt\")
 120 or
 121 CLFSWM> (produce-all-docs)~2%")))
 122
 123
 124
 125 (defun produce-doc-in-file (filename)
 126   (format t "Producing text keys documentation in ~S " filename)
 127   (with-open-file (stream filename :direction :output
 128                           :if-exists :supersede :if-does-not-exist :create)
 129     (produce-doc (list *main-keys* *main-mouse* *second-keys* *second-mouse*
 130                        *info-keys* *info-mouse* *circulate-keys* *expose-keys* *expose-mouse*)
 131                  stream))
 132   (format t " done~%"))
 133
 134
 135
 136
 137
 138 ;;; Menu autodoc functions
 139 (defun produce-menu-doc (&optional (stream t))
 140   (labels ((rec (base)
 141              (format stream "~2&~:(~A~)~%" (menu-name base))
 142              (dolist (item (menu-item base))
 143                (typecase item
 144                  (menu (format stream "~A: ~A~%" (menu-name item) (menu-doc item)))
 145                  (menu-item (aif (menu-item-key item)
 146                                  (format stream "~A: ~A~%" it
 147                                          (typecase (menu-item-value item)
 148                                            (menu (format nil "< ~A >" (menu-doc (menu-item-value item))))
 149                                            (t (documentation (menu-item-value item) 'function))))
 150                                  (format stream "~A~%" (menu-item-value item))))))
 151              (dolist (item (menu-item base))
 152                (typecase item
 153                  (menu (rec item))
 154                  (menu-item (when (menu-p (menu-item-value item))
 155                               (rec (menu-item-value item))))))))
 156     (format stream "Here is the map of the CLFSWM menu:~%")
 157     (format stream "(By default it is bound on second-mode + m)~%")
 158     (rec *menu*)
 159     (format stream "~2%This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-menu-doc-in-file or
 160 the produce-all-docs function from the Lisp REPL.
 161
 162 Something like this:
 163 LISP> (in-package :clfswm)
 164 CLFSWM> (produce-menu-doc-in-file \"my-menu.txt\")
 165 or
 166 CLFSWM> (produce-all-docs)~2%")))
 167
 168
 169
 170 (defun produce-menu-doc-in-file (filename)
 171   (format t "Producing text menus documentation in ~S " filename)
 172   (with-open-file (stream filename :direction :output
 173                           :if-exists :supersede :if-does-not-exist :create)
 174     (produce-menu-doc stream))
 175   (format t " done~%"))
 176
 177
 178
 179
 180 (defun produce-menu-doc-html (&optional (stream t))
 181   (let ((menu-list nil))
 182     (labels ((rec (base parent)
 183                (push `(h3 ,(format nil "<a name=\"~A\"></a><a href=\"#~A\">~:(~A~)</a>"
 184                                    (menu-name base)
 185                                    (if parent (menu-name parent) "Top")
 186                                    (menu-name base))) menu-list)
 187                (dolist (item (menu-item base))
 188                  (typecase item
 189                    (menu (push `(p ,(format nil "~A: ~A" (menu-name item) (menu-doc item))) menu-list))
 190                    (menu-item (push `(p ,(aif (menu-item-key item)
 191                                               (format nil "~A: ~A" it
 192                                                       (typecase (menu-item-value item)
 193                                                         (menu (format nil "<a href=\"#~A\">< ~A ></a>"
 194                                                                       (menu-name (menu-item-value item))
 195                                                                       (menu-doc (menu-item-value item))))
 196                                                         (t (documentation (menu-item-value item) 'function))))
 197                                               (format nil "~A" (menu-item-value item))))
 198                                     menu-list))))
 199                (push '<hr> menu-list)
 200                (dolist (item (menu-item base))
 201                  (typecase item
 202                    (menu (rec item base))
 203                    (menu-item (when (menu-p (menu-item-value item))
 204                                 (rec (menu-item-value item) base)))))))
 205       (rec *menu* nil)
 206       (produce-html `(html
 207                       (head
 208                        (title "CLFSWM Menu"))
 209                       (body
 210                        (h1 ("a name=\"Top\"" "CLFSWM Menu"))
 211                        (p "Here is the map of the CLFSWM menu:"
 212                           "(By default it is bound on second-mode + m)")
 213                        ,@(nreverse menu-list)
 214                        (p (small "This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-menu-doc-html-in-file or
 215 the produce-all-docs function from the Lisp REPL."))
 216                        (p (small "Something like this:<br>
 217 LISP> (in-package :clfswm)<br>
 218 CLFSWM> (produce-menu-doc-html-in-file \"my-menu.html\")<br>
 219 or<br> CLFSWM> (produce-all-docs)"))))
 220                     0 stream))))
 221
 222
 223 (defun produce-menu-doc-html-in-file (filename)
 224   (format t "Producing html menus documentation in ~S " filename)
 225   (with-open-file (stream filename :direction :output
 226                           :if-exists :supersede :if-does-not-exist :create)
 227     (produce-menu-doc-html stream))
 228   (format t " done~%"))
 229
 230
 231
 232 ;;; Corner autodoc functions
 233 (defun produce-corner-doc (&optional (stream t))
 234   (labels ((print-doc (corner-list)
 235              (format stream "~2&~:(~A~):~%" corner-list)
 236              (dolist (corner (symbol-value corner-list))
 237                (format stream "  ~:(~A:~) ~A~%" (first corner)
 238                        (if (fboundp (second corner))
 239                            (documentation (second corner) 'function)
 240                            "---")))))
 241     (format stream "Here are the actions associated to screen corners in CLFSWM:")
 242     (dolist (corner '(*corner-main-mode-left-button* *corner-main-mode-middle-button* *corner-main-mode-right-button*
 243                       *corner-second-mode-left-button* *corner-second-mode-middle-button* *corner-second-mode-right-button*))
 244       (print-doc corner))
 245     (format stream "~2%This documentation was produced with the CLFSWM auto-doc functions.
 246 To reproduce it, use the produce-corner-doc-in-file or
 247 the produce-all-docs function from the Lisp REPL.
 248
 249 Something like this:
 250 LISP> (in-package :clfswm)
 251 CLFSWM> (produce-corner-doc-in-file \"my-corner.txt\")
 252 or
 253 CLFSWM> (produce-all-docs)~2%")))
 254
 255
 256 (defun produce-corner-doc-in-file (filename)
 257   (format t "Producing text corner documentation in ~S " filename)
 258   (with-open-file (stream filename :direction :output
 259                           :if-exists :supersede :if-does-not-exist :create)
 260     (produce-corner-doc stream))
 261   (format t " done~%"))
 262
 263
 264
 265 (defun produce-corner-doc-html (&optional (stream t))
 266   (let ((corner-html nil))
 267     (labels ((one-corner (corner-list)
 268                (push `(h3 ,corner-list) corner-html)
 269                (push `("table class=\"ex\" cellspacing=\"5\" border=\"0\" width=\"100%\""
 270                        ,@(loop :for corner :in (symbol-value corner-list)
 271                             :collect `(tr ("td align=\"left\" width=\"1%\" style=\"color:#FF0000\" nowrap"
 272                                            ,(format nil "~:(~A~):" (first corner)))
 273                                           ("td style=\"color:#0000FF\" nowrap"
 274                                            ,(if (fboundp (second corner))
 275                                                 (documentation (second corner) 'function)
 276                                                 "---")))))
 277                      corner-html))
 278              (fill-corner-list ()
 279                (dolist (corner '(*corner-main-mode-left-button* *corner-main-mode-middle-button* *corner-main-mode-right-button*
 280                                  *corner-second-mode-left-button* *corner-second-mode-middle-button* *corner-second-mode-right-button*))
 281                  (one-corner corner))))
 282       (fill-corner-list)
 283       (produce-html `(html
 284                       (head
 285                        (title "CLFSWM Corners"))
 286                       (body
 287                        (h1 ("a name=\"Top\"" "CLFSWM Corners"))
 288                        (p "Here are the actions associated to screen corners in CLFSWM:")
 289                        ,@(nreverse corner-html)
 290                        (p (small "This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-corner-doc-html-in-file or
 291 the produce-all-docs function from the Lisp REPL."))
 292                        (p (small "Something like this:<br>
 293 LISP> (in-package :clfswm)<br>
 294 CLFSWM> (produce-corner-doc-html-in-file \"my-corner.html\")<br>
 295 or<br> CLFSWM> (produce-all-docs)"))))
 296                     0 stream))))
 297
 298
 299 (defun produce-corner-doc-html-in-file (filename)
 300   (format t "Producing html corner documentation in ~S " filename)
 301   (with-open-file (stream filename :direction :output
 302                           :if-exists :supersede :if-does-not-exist :create)
 303     (produce-corner-doc-html stream))
 304   (format t " done~%"))
 305
 306
 307
 308 ;;; Configuration variables autodoc functions
 309 (defun produce-conf-var-doc (stream &optional (group t) (title t) (footnote t))
 310   (when title
 311     (format stream "    * CLFSWM Configuration variables *~%")
 312     (format stream "      ------------------------------~2%"))
 313   (format stream "<= ~A =>~2%" (if (equal group t) ""
 314                                      (config-group->string group)))
 315   (maphash (lambda (key val)
 316              (when (or (equal group t)
 317                        (equal group (configvar-group val)))
 318                (format stream "  ~A = ~S~%    ~A~%" key (symbol-value key)
 319                        (documentation key 'variable))))
 320            *config-var-table*)
 321   (when footnote
 322     (format stream "~2& Those variables can be changed in clfswm.
 323 Maybe you'll need to restart clfswm to take care of new values")
 324     (format stream "~2%This documentation was produced with the CLFSWM auto-doc functions.
 325 To reproduce it, use the produce-conf-var-doc-in-file or
 326 the produce-all-docs function from the Lisp REPL.
 327
 328 Something like this:
 329 LISP> (in-package :clfswm)
 330 CLFSWM> (produce-conf-var-doc-in-file \"my-variables.txt\")
 331 or
 332 CLFSWM> (produce-all-docs)~2%"))
 333   (format stream "~2%"))
 334
 335 (defun produce-conf-var-doc-in-file (filename)
 336   (format t "Producing text config variables documentation in ~S " filename)
 337   (with-open-file (stream filename :direction :output
 338                           :if-exists :supersede :if-does-not-exist :create)
 339     (let* ((title t)
 340            (all-groups (config-all-groups))
 341            (last-group (first (last all-groups))))
 342       (dolist (group all-groups)
 343         (produce-conf-var-doc stream group title
 344                                              (equal group last-group))
 345         (setf title nil))))
 346   (format t " done~%"))
 347
 348
 349 (defun produce-conf-var-doc-html (&optional (stream t))
 350   (let ((all-groups (config-all-groups)))
 351     (labels ((conf-var-group ()
 352                `((h3 ("a name='TOP'" "Configuration variables groups:"))
 353                  (ul ,@(loop for group in all-groups
 354                           collect `(li (,(format nil "a href='#~A'" group) ,(config-group->string group)))))))
 355              (colorize-line (group list)
 356                (let ((acc nil))
 357                  (dolist (line list)
 358                    (cond ((search "* =" line)
 359                           (let ((pos (position #\= line)))
 360                             (push `("font color='#FF0000'" ,(format nil "&nbsp;&nbsp;~(~A~)" (subseq line 0 (1- pos)))) acc)
 361                             (push `("font color='#0000FF'" ,(format nil "~A<br>" (subseq line (1- pos)))) acc)))
 362                          ((search "<=" line)
 363                           (push `(p (,(format nil "a name='~A' href='#TOP'" group) ,(escape-html line))) acc))
 364                          ((not (string= line " "))
 365                           (push (format nil "&nbsp; &nbsp; &nbsp; &nbsp; ~A<br>~%" line) acc))))
 366                  (nreverse acc)))
 367              (conf-var (group)
 368                (colorize-line group
 369                               (split-string (append-newline-space
 370                                              (with-output-to-string (stream)
 371                                                (produce-conf-var-doc stream group nil nil)))
 372                                             #\Newline)))
 373              (all-conf-var ()
 374                (let ((acc nil))
 375                  (dolist (group all-groups)
 376                    (setf acc (nconc acc (conf-var group))))
 377                  acc)))
 378       (produce-html `(html
 379                       (head
 380                        (title "CLFSWM - Configuration variables"))
 381                       (body
 382                        (h1 ("a name='Top'" "CLFSWM - Configuration variables"))
 383                        (p "Here are the variables you can configure in CLFSWM with the configuration file or the configuration menu:")
 384                        ,@(conf-var-group)
 385                        ,@(all-conf-var)
 386                        (p (small "This documentation was produced with the CLFSWM auto-doc functions. To reproduce it, use the produce-conf-var-doc-html-in-file or
 387 the produce-all-docs function from the Lisp REPL."))
 388                        (p (small "Something like this:<br>
 389 LISP> (in-package :clfswm)<br>
 390 CLFSWM> (produce-conf-var-doc-html-in-file \"my-variables.html\")<br>
 391 or<br> CLFSWM> (produce-all-docs)"))))
 392                     0 stream))))
 393
 394
 395 (defun produce-conf-var-doc-html-in-file (filename)
 396   (format t "Producing html configuration variables documentation in ~S " filename)
 397   (with-open-file (stream filename :direction :output
 398                           :if-exists :supersede :if-does-not-exist :create)
 399     (produce-conf-var-doc-html stream))
 400   (format t " done~%"))
 401
 402
 403
 404
 405
 406
 407
 408
 409 (defun produce-all-docs ()
 410   "Produce all docs in keys.html and keys.txt"
 411   (produce-doc-in-file "doc/keys.txt")
 412   (produce-doc-html-in-file "doc/keys.html")
 413   (produce-menu-doc-in-file "doc/menu.txt")
 414   (produce-menu-doc-html-in-file "doc/menu.html")
 415   (produce-corner-doc-in-file "doc/corner.txt")
 416   (produce-corner-doc-html-in-file "doc/corner.html")
 417   (produce-conf-var-doc-in-file "doc/variables.txt")
 418   (produce-conf-var-doc-html-in-file "doc/variables.html"))
 419
 420
 421
 422
 423