src/clfswm-info.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Info function (see the end of this file for user definition
   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 (defstruct info window gc font list ilw ilh x y max-x max-y)
  29
  30
  31 (defparameter *info-selected-item* nil)
  32
  33
  34 (defun leave-info-mode (info)
  35   "Leave the info mode"
  36   (declare (ignore info))
  37   (setf *info-selected-item* nil)
  38   (throw 'exit-info-loop nil))
  39
  40 (defun leave-info-mode-and-valid (info)
  41   "Leave the info mode and valid the selected item"
  42   (declare (ignore info))
  43   (throw 'exit-info-loop nil))
  44
  45 (defun mouse-leave-info-mode (window root-x root-y info)
  46   "Leave the info mode"
  47   (declare (ignore window root-x root-y info))
  48   (setf *info-selected-item* nil)
  49   (throw 'exit-info-loop nil))
  50
  51
  52
  53 (defun find-info-item-from-mouse (root-x root-y info)
  54   (if (< (x-drawable-x (info-window info)) root-x
  55          (+ (x-drawable-x (info-window info))
  56             (x-drawable-width (info-window info))))
  57       (truncate (/ (- (+ (- root-y (x-drawable-y (info-window info)))
  58                          (xlib:max-char-ascent (info-font info))
  59                          (info-y info)) (info-ilh info)) (info-ilh info)))
  60       nil))
  61
  62
  63 (defun set-info-item-form-mouse (root-x root-y info)
  64   (setf *info-selected-item* (find-info-item-from-mouse root-x root-y info)))
  65
  66
  67 (defun info-y-display-coords (info posy)
  68   (- (+ (* (info-ilh info) posy) (info-ilh info)) (info-y info)))
  69
  70 (defun incf-info-selected-item (info n)
  71   (setf *info-selected-item*
  72         (min (if *info-selected-item*
  73                  (+ *info-selected-item* n)
  74                  0)
  75              (1- (or (length (info-list info)) 1)))))
  76
  77 (defun decf-info-selected-item (info n)
  78   (declare (ignore info))
  79   (setf *info-selected-item*
  80         (max (if *info-selected-item*
  81                  (- *info-selected-item* n)
  82                  0)
  83              0)))
  84
  85
  86
  87 (defun draw-info-window (info)
  88   (labels ((print-line (line posx posy &optional (color *info-foreground*))
  89              (xlib:with-gcontext ((info-gc info) :foreground (get-color color)
  90                                   :background (if (equal posy *info-selected-item*)
  91                                                   (get-color *info-selected-background*)
  92                                                   (get-color *info-background*)))
  93                (funcall (if (equal posy *info-selected-item*)
  94                             #'xlib:draw-image-glyphs
  95                             #'xlib:draw-glyphs)
  96                         *pixmap-buffer* (info-gc info)
  97                         (- (+ (info-ilw info) (* posx (info-ilw info))) (info-x info))
  98                         (info-y-display-coords info posy)
  99                         (format nil "~A" line)))
 100              (+ posx (length line))))
 101     (clear-pixmap-buffer (info-window info) (info-gc info))
 102     (loop for line in (info-list info)
 103        for y from 0
 104        do (typecase line
 105             (cons (typecase (first line)
 106                     (cons (let ((posx 0))
 107                             (dolist (l line)
 108                               (typecase l
 109                                 (cons (setf posx (print-line (first l) posx y (second l))))
 110                                 (t (setf posx (print-line l posx y)))))))
 111                     (t (print-line (first line) 0 y (second line)))))
 112             (t (print-line line 0 y))))
 113     (copy-pixmap-buffer (info-window info) (info-gc info))))
 114
 115
 116
 117
 118
 119 ;;;,-----
 120 ;;;| Key binding
 121 ;;;`-----
 122
 123 (add-hook *binding-hook* 'init-*info-keys* 'init-*info-mouse*)
 124
 125 (defun set-default-info-keys ()
 126   (define-info-key (#\q) 'leave-info-mode)
 127   (define-info-key ("Return") 'leave-info-mode-and-valid)
 128   (define-info-key ("KP_Enter" :mod-2) 'leave-info-mode-and-valid)
 129   (define-info-key ("space") 'leave-info-mode-and-valid)
 130   (define-info-key ("Escape") 'leave-info-mode)
 131   (define-info-key ("g" :control) 'leave-info-mode)
 132   (define-info-key ("twosuperior")
 133       (defun info-banish-pointer (info)
 134         "Move the pointer to the lower right corner of the screen"
 135         (declare (ignore info))
 136         (banish-pointer)))
 137   (define-info-key ("Down")
 138       (defun info-next-line (info)
 139         "Move one line down"
 140         (incf-info-selected-item info 1)
 141         (when (> (info-y-display-coords info *info-selected-item*)
 142                  (+ (x-drawable-y (info-window info))
 143                     (x-drawable-height (info-window info))))
 144           (setf (info-y info) (min (+ (info-y info) (info-ilh info)) (info-max-y info))))
 145         (draw-info-window info)))
 146   (define-info-key ("Up")
 147       (defun info-previous-line (info)
 148         "Move one line up"
 149         (decf-info-selected-item info 1)
 150         (when (< (info-y-display-coords info *info-selected-item*)
 151                  (+ (x-drawable-y (info-window info))
 152                     (info-ilh info)))
 153           (setf (info-y info) (max (- (info-y info) (info-ilh info)) 0)))
 154         (draw-info-window info)))
 155   (define-info-key ("Left")
 156       (defun info-previous-char (info)
 157         "Move one char left"
 158         (setf (info-x info) (max (- (info-x info) (info-ilw info)) 0))
 159         (draw-info-window info)))
 160   (define-info-key ("Right")
 161       (defun info-next-char (info)
 162         "Move one char right"
 163         (setf (info-x info) (min (+ (info-x info) (info-ilw info)) (info-max-x info)))
 164         (draw-info-window info)))
 165   (define-info-key ("Home")
 166       (defun info-first-line (info)
 167         "Move to first line"
 168         (setf (info-x info) 0
 169               (info-y info) 0)
 170         (setf *info-selected-item* 0)
 171         (draw-info-window info)))
 172   (define-info-key ("End")
 173       (defun info-end-line (info)
 174         "Move to last line"
 175         (setf (info-x info) 0
 176               (info-y info) (- (* (length (info-list info)) (info-ilh info)) (x-drawable-height (info-window info))))
 177         (setf *info-selected-item* (1- (or (length (info-list info)) 1)))
 178         (draw-info-window info)))
 179   (define-info-key ("Page_Down")
 180       (defun info-next-ten-lines (info)
 181         "Move ten lines down"
 182         (incf-info-selected-item info 10)
 183         (when (> (info-y-display-coords info *info-selected-item*)
 184                  (+ (x-drawable-y (info-window info))
 185                     (x-drawable-height (info-window info))))
 186           (setf (info-y info) (min (+ (info-y info) (* (info-ilh info) 10)) (info-max-y info))))
 187         (draw-info-window info)))
 188   (define-info-key ("Page_Up")
 189       (defun info-previous-ten-lines (info)
 190         "Move ten lines up"
 191         (decf-info-selected-item info 10)
 192         (when (< (info-y-display-coords info *info-selected-item*)
 193                  (+ (x-drawable-y (info-window info))
 194                     (info-ilh info)))
 195           (setf (info-y info) (max (- (info-y info) (* (info-ilh info) 10)) 0)))
 196         (draw-info-window info))))
 197
 198 (add-hook *binding-hook* 'set-default-info-keys)
 199
 200
 201
 202
 203 (defparameter *info-start-grab-x* nil)
 204 (defparameter *info-start-grab-y* nil)
 205
 206
 207 (defun info-begin-grab (window root-x root-y info)
 208   "Begin grab text"
 209   (declare (ignore window))
 210   (setf *info-start-grab-x* (min (max (+ root-x (info-x info)) 0) (info-max-x info))
 211         *info-start-grab-y* (min (max (+ root-y (info-y info)) 0) (info-max-y info)))
 212   (draw-info-window info))
 213
 214 (defun info-end-grab (window root-x root-y info)
 215   "End grab"
 216   (declare (ignore window))
 217   (setf (info-x info) (min (max (- *info-start-grab-x* root-x) 0) (info-max-x info))
 218         (info-y info) (min (max (- *info-start-grab-y* root-y) 0) (info-max-y info))
 219         *info-start-grab-x* nil
 220         *info-start-grab-y* nil)
 221   (draw-info-window info))
 222
 223 (defun info-mouse-next-line (window root-x root-y info)
 224   "Move one line down"
 225   (declare (ignore window))
 226   (setf (info-y info) (min (+ (info-y info) (info-ilh info)) (info-max-y info)))
 227   (set-info-item-form-mouse root-x root-y info)
 228   (draw-info-window info))
 229
 230 (defun info-mouse-previous-line (window root-x root-y info)
 231   "Move one line up"
 232   (declare (ignore window))
 233   (setf (info-y info) (max (- (info-y info) (info-ilh info)) 0))
 234   (set-info-item-form-mouse root-x root-y info)
 235   (draw-info-window info))
 236
 237
 238 (defun info-mouse-motion-drag (window root-x root-y info)
 239   "Grab text"
 240   (declare (ignore window))
 241   (when (and *info-start-grab-x* *info-start-grab-y*)
 242     (setf (info-x info) (min (max (- *info-start-grab-x* root-x) 0) (info-max-x info))
 243           (info-y info) (min (max (- *info-start-grab-y* root-y) 0) (info-max-y info)))
 244     (draw-info-window info)))
 245
 246
 247
 248
 249
 250
 251
 252 (defun info-mouse-select-item (window root-x root-y info)
 253   (declare (ignore window))
 254   (set-info-item-form-mouse root-x root-y info)
 255   (leave-info-mode-and-valid info))
 256
 257 (defun info-mouse-motion-click (window root-x root-y info)
 258   (declare (ignore window))
 259   (let ((last *info-selected-item*))
 260     (set-info-item-form-mouse root-x root-y info)
 261     (unless (equal last *info-selected-item*)
 262       (draw-info-window info))))
 263
 264
 265
 266 (defun set-default-info-mouse ()
 267   (if *info-click-to-select*
 268       (define-info-mouse (1) nil 'info-mouse-select-item)
 269       (define-info-mouse (1) 'info-begin-grab 'info-end-grab))
 270   (define-info-mouse (2) 'mouse-leave-info-mode)
 271   (define-info-mouse (3) 'mouse-leave-info-mode)
 272   (define-info-mouse (4) 'info-mouse-previous-line)
 273   (define-info-mouse (5) 'info-mouse-next-line)
 274   (if *info-click-to-select*
 275       (define-info-mouse ('motion) 'info-mouse-motion-click nil)
 276       (define-info-mouse ('motion) 'info-mouse-motion-drag nil)))
 277
 278 (add-hook *binding-hook* 'set-default-info-mouse)
 279
 280
 281
 282 (let (info)
 283   (define-handler info-mode :key-press (code state)
 284     (funcall-key-from-code *info-keys* code state info))
 285
 286   (define-handler info-mode :motion-notify (window root-x root-y)
 287     (unless (compress-motion-notify)
 288       (funcall-button-from-code *info-mouse* 'motion (modifiers->state *default-modifiers*)
 289                                 window root-x root-y *fun-press* (list info))))
 290
 291   (define-handler info-mode :button-press (window root-x root-y code state)
 292     (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-press* (list info)))
 293
 294   (define-handler info-mode :button-release (window root-x root-y code state)
 295     (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-release* (list info)))
 296
 297
 298
 299   (defun info-mode (info-list &key (width nil) (height nil))
 300     "Open the info mode. Info-list is a list of info: One string per line
 301 Or for colored output: a list (line_string color)
 302 Or ((1_word color) (2_word color) 3_word (4_word color)...)"
 303     (when info-list
 304       (setf *info-selected-item* 0)
 305       (labels ((compute-size (line)
 306                  (typecase line
 307                    (cons (typecase (first line)
 308                            (cons (let ((val 0))
 309                                    (dolist (l line val)
 310                                      (incf val (typecase l
 311                                                  (cons (length (first l)))
 312                                                  (t (length l)))))))
 313                            (t (length (first line)))))
 314                    (t (length line)))))
 315         (let* ((font (xlib:open-font *display* *info-font-string*))
 316                (ilw (xlib:max-char-width font))
 317                (ilh (+ (xlib:max-char-ascent font) (xlib:max-char-descent font) 1))
 318                (width (or width
 319                           (min (* (+ (loop for l in info-list maximize (compute-size l)) 2) ilw)
 320                                (xlib:screen-width *screen*))))
 321                (height (or height
 322                            (min (round (+ (* (length info-list) ilh) (/ ilh 2)))
 323                                 (xlib:screen-height *screen*)))))
 324           (with-placement (*info-mode-placement* x y width height)
 325             (let* ((window (xlib:create-window :parent *root*
 326                                                :x x :y y
 327                                                :width width
 328                                                :height height
 329                                                :background (get-color *info-background*)
 330                                                :colormap (xlib:screen-default-colormap *screen*)
 331                                                :border-width *border-size*
 332                                                :border (get-color *info-border*)
 333                                                :event-mask '(:exposure)))
 334                    (gc (xlib:create-gcontext :drawable window
 335                                              :foreground (get-color *info-foreground*)
 336                                              :background (get-color *info-background*)
 337                                              :font font
 338                                              :line-style :solid)))
 339               (setf info (make-info :window window :gc gc :x 0 :y 0 :list info-list
 340                                     :font font :ilw ilw :ilh ilh
 341                                     :max-x (* (loop for l in info-list maximize (compute-size l)) ilw)
 342                                     :max-y (* (length info-list) ilh)))
 343               (setf (window-transparency window) *info-transparency*)
 344               (map-window window)
 345               (draw-info-window info)
 346               (wait-no-key-or-button-press)
 347               (with-grab-keyboard-and-pointer (68 69 66 67)
 348                 (generic-mode 'info-mode 'exit-info-loop
 349                               :loop-function (lambda ()
 350                                                (raise-window (info-window info)))
 351                               :original-mode '(main-mode)))
 352               (xlib:free-gcontext gc)
 353               (xlib:destroy-window window)
 354               (xlib:close-font font)
 355               (xlib:display-finish-output *display*)
 356               (display-all-frame-info)
 357               (wait-no-key-or-button-press)
 358               *info-selected-item*)))))))
 359
 360
 361
 362 (defun info-mode-menu (item-list &key (width nil) (height nil))
 363   "Open an info help menu.
 364 Item-list is: '((key function) separator (key function))
 365 or with explicit docstring: '((key function \"documentation 1\") (key function \"bla bla\") (key function))
 366 key is a character, a keycode or a keysym
 367 Separator is a string or a symbol (all but a list)
 368 Function can be a function or a list (function color) for colored output"
 369   (let ((info-list nil)
 370         (action nil)
 371         (old-info-keys (copy-hash-table *info-keys*)))
 372     (labels ((define-key (key function)
 373                (define-info-key-fun (list key)
 374                    (lambda (&optional args)
 375                      (declare (ignore args))
 376                      (setf action function)
 377                      (leave-info-mode nil)))))
 378       (dolist (item item-list)
 379         (typecase item
 380           (cons (destructuring-bind (key function explicit-doc) (ensure-n-elems item 3)
 381                   (typecase function
 382                     (cons (push (list (list (format nil "~A" key) *menu-color-menu-key*)
 383                                       (list (format nil ": ~A" (or explicit-doc (documentation (first function) 'function)))
 384                                             (second function)))
 385                                 info-list)
 386                           (define-key key (first function)))
 387                     (t (push (list (list (format nil "~A" key) *menu-color-key*)
 388                                    (format nil ": ~A" (or explicit-doc (documentation function 'function))))
 389                              info-list)
 390                        (define-key key function)))))
 391           (t (push (list (format nil "-=- ~A -=-" item) *menu-color-comment*) info-list))))
 392       (let ((selected-item (info-mode (nreverse info-list) :width width :height height)))
 393         (setf *info-keys* old-info-keys)
 394         (when selected-item
 395           (awhen (nth selected-item item-list)
 396             (when (consp it)
 397               (destructuring-bind (key function explicit-doc) (ensure-n-elems it 3)
 398                 (declare (ignore key explicit-doc))
 399                 (typecase function
 400                   (cons (setf action (first function)))
 401                   (t (setf action function)))))))
 402         (typecase action
 403           (function (funcall action))
 404           (symbol (when (fboundp action)
 405                     (funcall action))))))))
 406
 407
 408
 409
 410
 411 (defun keys-from-list (list)
 412   "Produce a key menu based on list item"
 413   (loop for l in list
 414      for i from 0
 415      collect (list (number->char i) l)))
 416
 417
 418 ;;;,-----
 419 ;;;| CONFIG - Info mode functions
 420 ;;;`-----
 421 (defun key-binding-colorize-line (list)
 422   (loop :for line :in list
 423      :collect (cond ((search "* CLFSWM Keys *" line) (list line *info-color-title*))
 424                     ((search "---" line) (list line *info-color-underline*))
 425                     ((begin-with-2-spaces line)
 426                      (list (list (subseq line 0 22) *info-color-second*)
 427                            (list (subseq line 22 35) *info-color-first*)
 428                            (subseq line 35)))
 429                     (t line))))
 430
 431
 432 (defun show-key-binding (&rest hash-table-key)
 433   "Show the binding of each hash-table-key.
 434 Pass the :no-producing-doc symbol to remove the producing doc"
 435   (info-mode (key-binding-colorize-line
 436               (split-string (append-newline-space
 437                              (with-output-to-string (stream)
 438                                (produce-doc (remove :no-producing-doc hash-table-key)
 439                                             stream
 440                                             (not (member :no-producing-doc hash-table-key)))))
 441                             #\Newline))))
 442
 443
 444 (defun show-global-key-binding ()
 445   "Show all key binding"
 446   (show-key-binding *main-keys* *main-mouse* *second-keys* *second-mouse*
 447                     *info-keys* *info-mouse*))
 448
 449 (defun show-main-mode-key-binding ()
 450   "Show the main mode binding"
 451   (show-key-binding *main-keys* *main-mouse*))
 452
 453 (defun show-second-mode-key-binding ()
 454   "Show the second mode key binding"
 455   (show-key-binding *second-keys* *second-mouse*))
 456
 457 (defun show-circulate-mode-key-binding ()
 458   "Show the circulate mode key binding"
 459   (show-key-binding *circulate-keys*))
 460
 461 (defun show-expose-window-mode-key-binding ()
 462   "Show the expose window mode key binding"
 463   (show-key-binding *expose-keys* *expose-mouse*))
 464
 465
 466 (defun show-first-aid-kit ()
 467   "Show the first aid kit key binding"
 468   (labels ((add-key (hash symbol &optional (hashkey *main-keys*))
 469              (multiple-value-bind (k v)
 470                  (find-in-hash symbol hashkey)
 471                (setf (gethash k hash) v))))
 472     (let ((hash (make-hash-table :test #'equal))
 473           (hash-second (make-hash-table :test #'equal)))
 474       (setf (gethash 'name hash) "First aid kit - Main mode key binding"
 475             (gethash 'name hash-second) "First aid kit - Second mode key binding")
 476       (add-key hash 'select-next-child)
 477       (add-key hash 'select-previous-child)
 478       (add-key hash 'select-next-brother)
 479       (add-key hash 'select-previous-brother)
 480       (add-key hash 'select-previous-level)
 481       (add-key hash 'select-next-level)
 482       (add-key hash 'enter-frame)
 483       (add-key hash 'leave-frame)
 484       (add-key hash 'second-key-mode)
 485       (add-key hash 'expose-windows-mode)
 486       (add-key hash 'expose-all-windows-mode)
 487       (add-key hash 'present-clfswm-terminal)
 488       (add-key hash-second 'leave-second-mode *second-keys*)
 489       (add-key hash-second 'open-menu *second-keys*)
 490       (add-key hash-second 'run-program-from-query-string *second-keys*)
 491       (add-key hash-second 'eval-from-query-string *second-keys*)
 492       (add-key hash-second 'set-open-in-new-frame-in-parent-frame-nw-hook *second-keys*)
 493       (add-key hash-second 'b-start-xterm *second-keys*)
 494       (add-key hash-second 'b-start-emacs *second-keys*)
 495       (show-key-binding hash hash-second :no-producing-doc))))
 496
 497
 498 (defun corner-help-colorize-line (list)
 499   (loop :for line :in list
 500      :collect (cond ((search "CLFSWM:" line) (list line *info-color-title*))
 501                     ((search "*:" line) (list line *info-color-underline*))
 502                     ((begin-with-2-spaces line)
 503                      (let ((pos (position #\: line)))
 504                        (if pos
 505                            (list (list (subseq line 0 (1+ pos)) *info-color-first*)
 506                                  (subseq line (1+ pos)))
 507                            line)))
 508                     (t line))))
 509
 510 (defun show-corner-help ()
 511   "Help on clfswm corner"
 512   (info-mode (corner-help-colorize-line
 513               (split-string (append-newline-space
 514                              (with-output-to-string (stream)
 515                                (produce-corner-doc stream)))
 516                             #\Newline))))
 517
 518
 519 (defun configuration-variable-colorize-line (list)
 520   (loop :for line :in list
 521      :collect (cond ((search "CLFSWM " line) (list line *info-color-title*))
 522                     ((search "* =" line)
 523                      (let ((pos (position #\= line)))
 524                        (list (list (subseq line 0 (1+ pos)) *info-color-first*)
 525                              (list (subseq line (1+ pos)) *info-color-second*))))
 526                     ((search "<=" line) (list line *info-color-underline*))
 527                     (t line))))
 528
 529
 530 (defun show-config-variable ()
 531   "Show all configurable variables"
 532   (let ((result nil))
 533     (labels ((rec ()
 534                (setf result nil)
 535                (info-mode-menu (loop :for group :in (config-all-groups)
 536                                   :for i :from 0
 537                                   :collect (list (number->char i)
 538                                                  (let ((group group))
 539                                                    (lambda ()
 540                                                      (setf result group)))
 541                                                  (config-group->string group))))
 542                (when result
 543                  (info-mode (configuration-variable-colorize-line
 544                              (split-string (append-newline-space
 545                                             (with-output-to-string (stream)
 546                                               (produce-conf-var-doc stream result t nil)))
 547                                            #\Newline)))
 548                  (rec))))
 549       (rec))))
 550
 551
 552
 553
 554 (defun show-date ()
 555   "Show the current time and date"
 556   (info-mode (list (list `("Current date:" ,*menu-color-comment*) (date-string)))))
 557
 558
 559
 560
 561
 562
 563 (defun info-on-shell (msg program)
 564   (let ((lines (do-shell program nil t)))
 565     (info-mode (append (list (list msg *menu-color-comment*))
 566                        (loop for line = (read-line lines nil nil)
 567                           while line
 568                           collect (ensure-printable line))))))
 569
 570
 571
 572 (defun show-cpu-proc ()
 573   "Show current processes sorted by CPU usage"
 574   (info-on-shell "Current processes sorted by CPU usage:"
 575                  "ps --cols=1000 --sort='-%cpu,uid,pgid,ppid,pid' -e -o user,pid,stime,pcpu,pmem,args"))
 576
 577 (defun show-mem-proc ()
 578   "Show current processes sorted by memory usage"
 579   (info-on-shell "Current processes sorted by MEMORY usage:"
 580                  "ps --cols=1000 --sort='-vsz,uid,pgid,ppid,pid' -e -o user,pid,stime,pcpu,pmem,args"))
 581
 582
 583 (defun show-cd-info ()
 584   "Show the current CD track"
 585   (info-on-shell "Current CD track:" "pcd i"))
 586
 587 (defun show-cd-playlist ()
 588   "Show the current CD playlist"
 589   (info-on-shell "Current CD playlist:" "pcd mi"))
 590
 591
 592 (defun show-version ()
 593   "Show the current CLFSWM version"
 594   (info-mode (list *version*)))
 595
 596
 597
 598
 599
 600