cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-help.el

   1 ;;; xwem-help.el --- Getting help in XWEM.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: 1 Sep 2003
   7 ;; Keywords: xlib, xwem
   8 ;; X-CVS: $Id: xwem-help.el,v 1.8 2005-04-04 19:54:12 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30
  31 ;; Help subsystem.  Entry point is `H-h'.
  32
  33 ;;; Code:
  34 \f
  35 (require 'xwem-load)
  36 (require 'xwem-misc)
  37
  38 (defmacro xwem-help-display (title &rest forms)
  39   "Evaluate FORMS in special emacs frame and xwem help buffer."
  40   `(let ((temp-buffer-show-function 'xwem-special-popup-frame))
  41      (with-displaying-help-buffer
  42       (lambda ()
  43         (set-buffer standard-output)
  44         ,@forms)
  45       (format "xwem %s" (or ,title "")))))
  46 (put 'xwem-help-display 'lisp-indent-function 'defun)
  47
  48 ;;; Some help stuff
  49 ;;;###xwem-autoload
  50 (defun xwem-logo-string ()
  51   "Return textified XWEM's logo string."
  52   (concat (xwem-str-with-faces "X" (list 'bold-italic))
  53           (xwem-str-with-faces "W" (list 'bold-italic 'red))
  54           (xwem-str-with-faces "E" (list 'bold-italic 'green))
  55           (xwem-str-with-faces "M" (list 'bold-italic 'blue))))
  56
  57 ;;;###autoload(autoload 'xwem-help "xwem-help" "" t)
  58 (define-xwem-command xwem-help ()
  59   "Display some help info."
  60   (xwem-interactive)
  61
  62   (xwem-help-display nil
  63     (insert "Hello, this is help for ")
  64     (insert (xwem-logo-string))
  65     (insert "\n\n")
  66
  67     (insert "TODO: here is some description for ")
  68     (insert (xwem-logo-string))
  69     (insert " stuff.\n")
  70     (insert "\n")
  71
  72     ;; Frames config
  73     (insert "---=== Frames Info ===---\n\n")
  74     (insert (format "You have %d frames now and [%d] frame is selected.\n"
  75                     (length xwem-frames-list)
  76                     (xwem-frame-num (xwem-frame-selected))))
  77     (insert "\n")
  78
  79     ;; Clients
  80     ;; Maybe use tree-widget package to display this info?
  81     (let ((curr-classn "")
  82           (curr-classi ""))
  83       (insert "---=== Clients Info ===---\n")
  84       (mapc
  85        #'(lambda (el)
  86            (let ((clclass (xwem-hints-wm-class (xwem-cl-hints el)))
  87                  (clgeom (xwem-cl-xgeom el)))
  88              (when (not (string= curr-classn (cdr clclass)))
  89                (setq curr-classn (cadr clclass))
  90                (insert (format "\n= Begin for class name: <%s> =\n"
  91                                curr-classn)))
  92              (when (not (string= curr-classi (car clclass)))
  93                (setq curr-classi (car clclass))
  94                (insert (format "\n- Class instance: <%s> -\n" curr-classi)))
  95              (insert (format "WM-NAME: <%s>, Geom: %dx%d+%d+%d\n"
  96                              (xwem-hints-wm-name (xwem-cl-hints el))
  97                              (X-Geom-width clgeom)
  98                              (X-Geom-height clgeom)
  99                              (X-Geom-x clgeom)
 100                              (X-Geom-y clgeom)))))
 101        (sort (copy-list xwem-clients)
 102              #'(lambda (el1 el2)
 103                  (let ((cl1-clas (xwem-hints-wm-class (xwem-cl-hints el1)))
 104                        (cl1-name (xwem-hints-wm-name (xwem-cl-hints el1)))
 105                        (cl2-clas (xwem-hints-wm-class (xwem-cl-hints el2)))
 106                        (cl2-name (xwem-hints-wm-name (xwem-cl-hints el2))))
 107                    ;; Sort by class name, than by class
 108                    ;; instance, than by wm-name.
 109                    (or (string-lessp (cdr cl1-clas) (cdr cl2-clas))
 110                        (and (string= (cdr cl1-clas) (cdr cl2-clas))
 111                             (string-lessp (car cl1-clas) (car cl2-clas)))
 112                        (and (string= (car cl1-clas) (car cl2-clas))
 113                             (string-lessp cl1-name cl2-name)))))))
 114       (insert "\n"))
 115
 116     ;; Bindings
 117     (insert "---=== Bindings for `")
 118     (insert (xwem-str-with-faces "xwem-global-map" 'font-lock-keyword-face))
 119     (insert "' ===---\n")
 120     (describe-bindings-internal xwem-global-map)))
 121
 122 ;;;###autoload(autoload 'xwem-help-for-help "xwem-help" "" t)
 123 (define-xwem-command xwem-help-for-help ()
 124   "Help for XWEM's help system."
 125   (xwem-interactive)
 126
 127   (xwem-help-display "help-for-help"
 128    (let ((heading "key             binding\n---             -------\n"))
 129      (insert "Here should be Help-for-Help!\n\n")
 130
 131      (insert (format "Help prefix is %s, keys are:\n"
 132                      (substitute-command-keys
 133                       "\\<xwem-global-map>\\[xwem-help-prefix]"))
 134              heading)
 135      (describe-bindings-internal 'xwem-help-prefix))
 136    ))
 137
 138 (defun xwem-describe-prefix-bindings-1 (map keys title)
 139   "For keymap MAP describe prefix KEYS.
 140 If KEYS is nil describe all keymap."
 141   (setq map (xwem-kbd-fixup-keymap map))
 142   (when (and (keymapp map)
 143              (or (null keys)
 144                  (lookup-key map keys t)))
 145     (let ((heading "key             binding\n---             -------\n"))
 146       (insert title "\n" heading)
 147       (describe-bindings-internal map nil nil keys))))
 148 (put 'xwem-describe-prefix-bindings-1 'lisp-indent-function 2)
 149
 150 ;;;###autoload(autoload 'xwem-describe-prefix-bindings "xwem-help" "" t)
 151 (define-xwem-command xwem-describe-prefix-bindings (prefix)
 152   "Describe the bindings of the PREFIX used to reach this command."
 153   (xwem-interactive (list xwem-this-command-keys))
 154
 155   ;; Adjust prefix, cut last key
 156   (when prefix
 157     (setq prefix (vconcat (butlast (append prefix nil)))))
 158
 159   (xwem-help-display (format "%s prefix" (key-description prefix))
 160     (when prefix
 161       (insert (format "Key bindings starting with `%s':\n"
 162                       (key-description prefix))))
 163
 164     ;; Minor modes bindings
 165     (mapc #'(lambda (mimap)
 166               (when (eval (car mimap))
 167                 (xwem-describe-prefix-bindings-1 (eval (cdr mimap)) prefix
 168                   (format "\nMinor mode bindings for `%S':" (car mimap)))))
 169           xwem-minor-mode-map-alist)
 170
 171     ;; Local bindings
 172     (xwem-describe-prefix-bindings-1 (xwem-local-map xwem-event-client) prefix
 173       (format "\n%s major mode bindings:"
 174               (upcase (symbol-name (xwem-cl-manage-type xwem-event-client)))))
 175
 176     ;; Finally global bindings
 177     (xwem-describe-prefix-bindings-1 xwem-global-map prefix
 178       (format "\nGlobal bindings:"))
 179
 180     ;; Frame bindings
 181     (xwem-describe-prefix-bindings-1 'xwem-frame-prefix prefix
 182       (format "\nFrame bindings:"))
 183
 184     ;; Root bindings.  Really need?
 185     (xwem-describe-prefix-bindings-1 'xwem-root-prefix prefix
 186       (format "\nRoot bindings:"))
 187     ))
 188
 189 ;;;###autoload(autoload 'xwem-help-describe-bindings "xwem-help" "" t)
 190 (define-xwem-command xwem-help-describe-bindings ()
 191   "Describe all current bindings."
 192   (xwem-interactive)
 193   (xwem-describe-prefix-bindings nil))
 194
 195 ;;;###autoload(autoload 'xwem-help-describe-key1 "xwem-help" "" t)
 196 (define-xwem-command xwem-help-describe-key1 (key)
 197   "Describe KEY"
 198   (xwem-interactive (list xwem-this-command-keys))
 199
 200   (let ((dfn (xwem-kbd-get-binding key))
 201         (keystr (key-description key)))
 202
 203     (if (or (null dfn) (integerp dfn))
 204         (xwem-message 'info "%s is undefined." keystr)
 205       (xwem-help-display (format "key `%s'" keystr)
 206        (insert keystr)
 207        (insert " runs ")
 208        (if (symbolp dfn)
 209            (insert (format "`%S'" dfn))
 210          (insert (format "%S" dfn)))
 211        (insert "\n\n")
 212        (cond ((or (stringp dfn) (vectorp dfn))
 213               (let ((cmd (xwem-kbd-get-binding dfn)))
 214                 (if (not cmd)
 215                     (insert "a keyboard macro")
 216                   (insert "a keyboard macro which runs the command\n")
 217                   (insert (format "`%S'" cmd))
 218                   (insert ":\n\n")
 219                   (when (documentation cmd)
 220                     (insert (documentation cmd))))))
 221              ((and (consp dfn) (not (eq 'lambda (car-safe dfn))))
 222               (let ((describe-function-show-arglist nil))
 223                 (describe-function-1 (car dfn))))
 224              ((symbolp dfn)
 225               (describe-function-1 dfn))
 226              ((documentation dfn)
 227               (insert (documentation dfn)))
 228              (t (insert "not documented"))))
 229       )))
 230
 231 ;;;###autoload(autoload 'xwem-help-mode "xwem-help" "" t)
 232 (define-xwem-command xwem-help-mode (client)
 233   "Describe client mode."
 234   (xwem-interactive (list (xwem-cl-selected)))
 235
 236   (xwem-help-display (format "%S" (xwem-cl-manage-type client))
 237     (insert (format "%s mode:\n" (upcase (symbol-name (xwem-cl-manage-type client)))))
 238     (insert (function-documentation
 239              (get 'manage (xwem-cl-manage-type client))))
 240     (insert "\nCommands:\n")
 241     ;; Minor modes bindings
 242     (mapc #'(lambda (mimap)
 243               (when (eval (car mimap))
 244                 (xwem-describe-prefix-bindings-1 (eval (cdr mimap)) nil
 245                   (format "\nMinor mode bindings for `%S':" (car mimap)))))
 246           xwem-minor-mode-map-alist)
 247     ))
 248
 249 ;;;###autoload(autoload 'xwem-help-describe-key "xwem-help" "" t)
 250 (define-xwem-command xwem-help-describe-key (keys)
 251   "Describe keysequence."
 252   (xwem-interactive "KDescribe key: ")
 253
 254   (xwem-help-describe-key1 keys))
 255
 256 ;;;###autoload(autoload 'xwem-help-frames "xwem-help" "" t)
 257 (define-xwem-command xwem-help-frames ()
 258   "Help for XWEM's frames."
 259   (xwem-interactive)
 260   ;; TODO: write me
 261   (xwem-message 'todo "`xwem-help-frames' is not written yet.")
 262   )
 263
 264 ;;;###autoload(autoload 'xwem-help-wins "xwem-help" "" t)
 265 (define-xwem-command xwem-help-wins ()
 266   "Help for XWEM's windows."
 267   (xwem-interactive)
 268   ;; TODO: write me
 269   (xwem-message 'todo "`xwem-help-wins' is not written yet.")
 270   )
 271
 272 ;; TODO: we should write something similar to ibuffer or
 273 ;; electric-buffer-list to operate on cliets, switching, getting stat,
 274 ;; etc.
 275 ;;;###autoload(autoload 'xwem-help-clients "xwem-help" "" t)
 276 (define-xwem-command xwem-help-clients ()
 277   "Help for XWEM's clients."
 278   (xwem-interactive)
 279   ;; TODO: write me
 280   (xwem-message 'todo "`xwem-help-clients' is not written yet.")
 281   )
 282
 283 ;;;###autoload(autoload 'xwem-help-where-is "xwem-help" "" t)
 284 (define-xwem-command xwem-help-where-is (dfn &optional paste)
 285   "Where-is for XWEM."
 286   (xwem-interactive "CXWEM where is command: \nP")
 287
 288   (let* ((keys (where-is-internal dfn (list xwem-global-map)))
 289          (msg (if keys (format "%s is on %s"
 290                                dfn (sorted-key-descriptions keys))
 291                 (format "%s is not on any keys" dfn))))
 292     (if paste
 293         (xwem-kbd-add-pending-keys msg)
 294       (xwem-message 'info msg))))
 295
 296 \f
 297 (provide 'xwem-help)
 298
 299 ;;; xwem-help.el ends here