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

   1 ;;; xwem-strokes.el --- Strokes support by XWEM.
   2
   3 ;; Copyright (C) 2003-2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;;         Steve Youngs  <steve@youngs.au.com>
   7 ;; Created: Thu Dec  4 17:42:12 MSK 2003
   8 ;; Keywords: xwem, xlib
   9 ;; X-CVS: $Id: xwem-strokes.el,v 1.10 2005-04-04 19:54:16 lg Exp $
  10
  11 ;; This file is part of XWEM.
  12
  13 ;; XWEM is free software; you can redistribute it and/or modify it
  14 ;; under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  20 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  21 ;; License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  25 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  26 ;; 02111-1307, USA.
  27
  28 ;;; Synched up with: Not in FSF
  29
  30 ;;; Commentary:
  31
  32 ;;
  33
  34 ;;; Code:
  35 \f
  36 (require 'strokes)
  37 (require 'xwem-load)
  38 (require 'xwem-misc)
  39
  40 ;;; Customisation
  41 (defgroup xwem-strokes nil
  42   "Group to customize XWEM strokes."
  43   :prefix "xwem-strokes-"
  44   :group 'xwem)
  45
  46 (defcustom xwem-strokes-grid 25
  47   "*XWEM strokes Grid resolution.
  48 Look at `strokes-grid-resolution' for details."
  49   :type 'integer
  50   :group 'xwem-strokes)
  51
  52 (defcustom xwem-strokes-minimum-match-score 2000
  53   "*Take a look at `strokes-minimum-match-score'."
  54   :type 'integer
  55   :group 'xwem-strokes)
  56
  57 (defcustom xwem-strokes-file "xwem-strokes.el"
  58   "*File contained strokes for xwem stroke mode."
  59   :type 'file
  60   :group 'xwem-strokes)
  61
  62 (defcustom xwem-strokes-click-command 'xwem-strokes-default-click-command
  63   "*Command to execute when stroke is actually a `click'."
  64   :type 'function
  65   :group 'xwem-strokes)
  66
  67 (defcustom xwem-strokes-cursor-type '(X-XC-dot)
  68   "*Type of cursor to use when XWEM enters strokes mode."
  69   :type (xwem-cursor-shape-choice)
  70   :set (xwem-cus-set-cursor-shape xwem-strokes-cursor)
  71   :initialize 'custom-initialize-default
  72   :group 'xwem-strokes)
  73
  74 (defcustom xwem-strokes-cursor-foreground-color "#00ea00"
  75   "*Cursor's foreground color when XWEM in strokes mode."
  76   :type 'color
  77   :set (xwem-cus-set-cursor-foreground xwem-strokes-cursor)
  78   :initialize 'custom-initialize-default
  79   :group 'xwem-strokes)
  80
  81 (defcustom xwem-strokes-cursor-background-color "#002800"
  82   "*Cursor's background color when XWEM in strokes mode."
  83   :type 'color
  84   :set (xwem-cus-set-cursor-background xwem-strokes-cursor)
  85   :initialize 'custom-initialize-default
  86   :group 'xwem-strokes)
  87
  88 (defcustom xwem-strokes-gc-function 'X-GXCopy
  89   "Function applied to draw strokes."
  90   :type (xwem-gc-function-choice)
  91   :group 'xwem-strokes)
  92
  93 (define-xwem-face xwem-strokes-face
  94   `(((background light)
  95      (:foreground "red4" :background "black"))
  96     ((background dark)
  97      (:foreground "red" :background "black"))
  98     ((background begin light)
  99      (:foreground "magenta4" :background "black"
 100       :line-width 12 :cap-style X-CapRound))
 101     ((background begin dark)
 102      (:foreground "magenta" :background "black"
 103       :line-width 12 :cap-style X-CapRound))
 104     (t (:foreground "red4" :background "black"
 105         :line-width 8 :cap-style X-CapRound
 106         :subwindow-mode X-IncludeInferiors
 107         :function (eval xwem-strokes-gc-function))))
 108   "Face used to draw strokes."
 109   :group 'xwem-strokes
 110   :group 'xwem-faces)
 111
 112 ;;; Internal variables
 113
 114 ;; Stroke variables
 115 (defvar xwem-strokes-keymap
 116   (let ((map (make-sparse-keymap)))
 117     (set-keymap-default-binding map 'xwem-strokes-nocmd)
 118
 119     (define-key map [button2] 'xwem-strokes-idescribe)
 120     (define-key map [button1] 'xwem-strokes-ibutton1)
 121     (define-key map [button1up] 'xwem-strokes-ibutton1up)
 122     (define-key map [(meta button1up)] 'xwem-strokes-ibutton1up)
 123     (define-key map [(control button1up)] 'xwem-strokes-ibutton1up)
 124     (define-key map [(meta control button1up)] 'xwem-strokes-ibutton1up)
 125     (define-key map [button3] 'xwem-strokes-ibutton3)
 126     map)
 127   "Keymap being used while in strokes event loop.")
 128
 129 (defvar xwem-strokes-map nil "Stroke map for XWEM.")
 130
 131 (defvar xwem-strokes-curr nil
 132   "Current events list, it passed to `stroke-' routines.")
 133 (defvar xwem-strokes-defining nil
 134   "Non-nil mean that we defining stroke now.")
 135
 136 (defvar xwem-strokes-background-mode nil
 137   "Saved background mode.")
 138
 139 (defvar xwem-strokes-cursor nil
 140   "Cursor used while reading stroke.")
 141
 142 ;; Functions
 143 (define-xwem-command xwem-strokes-default-click-command ()
 144   "Default command to execute when strokes detected click.
 145 Click is detected when no mouse moving occured while doing stroke."
 146   (xwem-interactive)
 147   (xwem-message 'info "Such an ugly `xwem-strokes-click-command', which you normally should customize."))
 148
 149 (defun xwem-strokes-save-strokes ()
 150   "Save user defined strokes to file named by `xwem-strokes-file'.
 151 Modification to `strokes-prompt-user-save-strokes' to work with xwem's stuff."
 152   (let ((strokes-global-map xwem-strokes-map)
 153         (strokes-file (expand-file-name xwem-strokes-file xwem-dir)))
 154
 155     (flet ((yes-or-no-p-maybe-dialog-box (prompt)
 156             #'(lambda () (xwem-under-minibuffer (yes-or-no-p prompt)))))
 157       (funcall 'strokes-prompt-user-save-strokes))
 158
 159     ;; Fix stroke-file ..
 160     (when (file-exists-p strokes-file)
 161       (let ((b (find-file-noselect strokes-file)))
 162         (with-current-buffer b
 163           (when (search-forward "strokes-global-map")
 164             (replace-match "xwem-strokes-map"))
 165           (save-buffer))
 166         (kill-buffer b)))
 167     ))
 168
 169 (defun xwem-strokes-load-strokes ()
 170   "Load user defined strokes from file named by `xwem-strokes-file'."
 171   (if (file-exists-p (expand-file-name xwem-strokes-file xwem-dir))
 172 ;      (xwem-under-minibuffer
 173 ;       (and (y-or-n-p
 174 ;            (format "XWEM: No strokes loaded.  Load `%s'? "
 175 ;                    (expand-file-name xwem-strokes-file xwem-dir)))
 176       (let ((strokes-file (expand-file-name xwem-strokes-file xwem-dir)))
 177         (strokes-load-user-strokes))))
 178
 179 (defun xwem-strokes-cmd-valid-p (cmd)
 180   "Return non-nil if CMD is valid to be run after stroke."
 181   ;; NOTE: string/keyboard macro/interactive function/interactive
 182   ;; lambda are valid commands.
 183   (commandp cmd))
 184
 185 (defun xwem-strokes-cmd-type (cmd)
 186   "Return type of strokes command CMD.
 187 Type is one of \"string\", \"kbd macro\", \"symbol\" or \"function\"."
 188   (cond ((stringp cmd) "string")
 189         ((vectorp cmd) "kbd macro")
 190         ((symbolp cmd) "symbol")
 191         ((functionp cmd) "function")
 192         (t "unknown")))
 193
 194 (defun xwem-strokes-cmd-description (cmd)
 195   "Return description of strokes command CMD."
 196   (let ((ctype (xwem-strokes-cmd-type cmd)))
 197     (cond ((string= ctype "string") (concat "\"" cmd "\""))
 198           ((string= ctype "kbd macro") (key-description cmd))
 199           ((string= ctype "symbol") (format "%S" cmd))
 200           ((string= ctype "function") (format "%S" cmd)))))
 201
 202 (defun xwem-strokes-read-command (&optional prompt)
 203   "Read command, prompting PROMPT.  Command may be interactive command or string."
 204   ;; TODO: - write me
 205   ;;   * Emacs command
 206   ;;   * Emacs string
 207   ;;   * XWEM binded keyboard macro
 208   (condition-case nil
 209       (let* ((type (xwem-completing-read
 210                     "XWEM Stroke type: " '(("key") ("command") ("string"))
 211                     nil t "command"))
 212              (cmd (cond ((string= type "command")
 213                          (xwem-read-command "XWEM Stroke command: "))
 214                         ((string= type "string")
 215                          (xwem-read-from-minibuffer "XWEM Stroke string: "))
 216                         ((string= type "key")
 217                          (let ((xwem-interactively t))
 218                            (prog1
 219                                (xwem-kbd-get-binding
 220                                 (xwem-read-key-sequence "XWEM Stroke key: "))
 221                              (xwem-kbd-stop-grabbing))))
 222                         (t nil))))
 223         cmd)
 224     (t nil)))
 225
 226 (defun xwem-strokes-execute-command (cmd)
 227   "Execute CMD.  CMD is one of interactive command or keysequence."
 228   (if (xwem-strokes-cmd-valid-p cmd)
 229     (cond ((stringp cmd)
 230            (xwem-deffered-funcall 'xwem-kbd-force-mods-release)
 231            (xwem-deffered-funcall
 232             'xwem-kbd-add-pending-keys cmd (xwem-cl-selected)))
 233
 234           ((vectorp cmd)
 235            (xwem-kbd-force-mods-release)
 236            (setq xwem-this-command-keys []) ; XXX
 237            (xwem-keymacro-execute-keys cmd))
 238
 239           (t (command-execute cmd)))
 240
 241     (xwem-message 'error "Invalid strokes command `%S'" cmd)))
 242
 243 (defun xwem-strokes-execute-stroke (stroke)
 244   "Given STROKE, execute the command corresponds to it."
 245   (let* ((match (strokes-match-stroke stroke xwem-strokes-map))
 246          (command (car match))
 247          (score (cdr match)))
 248     (cond ((strokes-click-p stroke)
 249            (command-execute xwem-strokes-click-command))
 250
 251           ((and match (<= score xwem-strokes-minimum-match-score))
 252            (xwem-message 'info "Executing stroke: '%s'"
 253                          (xwem-strokes-cmd-description command))
 254            (xwem-strokes-execute-command command))
 255
 256           ((null xwem-strokes-map)
 257            ;; First try loading strokes file
 258            (xwem-strokes-load-strokes)
 259
 260            (if (null xwem-strokes-map)
 261                (xwem-message 'error "No strokes defined; use `xwem-strokes-global-set-stroke'")
 262
 263              ;; Re-execute stroke in hope it will be founded in loaded
 264              ;; xwem-strokes-map.
 265              (xwem-strokes-execute-stroke stroke)))
 266
 267           (t (xwem-message 'error "No stroke matches; see variable `xwem-strokes-minimum-match-score'")))
 268     ))
 269
 270 (defun xwem-strokes-define-or-execute (st)
 271   "Bind stroke ST to command or execute."
 272   (if (not xwem-strokes-defining)
 273       ;; Execute stroke
 274       (xwem-strokes-execute-stroke st)
 275
 276     ;; Attach command to stroke
 277     (setq xwem-strokes-defining nil)
 278     (let ((cmdorstr (xwem-strokes-read-command)))
 279       (when (xwem-strokes-cmd-valid-p cmdorstr)
 280         (strokes-define-stroke xwem-strokes-map st cmdorstr)
 281         (xwem-message 'info "New stroke defined.")))))
 282
 283 (defun xwem-strokes-start-new (x y)
 284   "Start new stroke or new stick at X Y point."
 285   (push (cons x y) xwem-strokes-curr)
 286   (setq xwem-strokes-background-mode
 287         (xwem-misc-xwin-background-mode (xwem-rootwin) x y))
 288   (XDrawArc (xwem-dpy) (xwem-rootwin)
 289             (xwem-face-get-gc 'xwem-strokes-face
 290               (list 'background 'begin xwem-strokes-background-mode))
 291             x y 1 1 0 (* 360 64)))
 292
 293 (defun xwem-strokes-continue (x y)
 294   "Continue stroke at X Y."
 295   (let* ((xsc xwem-strokes-curr)
 296          (old-x (if (car xsc) (X-Point-x (car xsc)) x))
 297          (old-y (if (car xsc) (X-Point-y (car xsc)) y)))
 298
 299     (push (cons x y) xwem-strokes-curr)
 300     (XDrawLine (xwem-dpy) (xwem-rootwin)
 301                (xwem-face-get-gc 'xwem-strokes-face
 302                  (list 'background xwem-strokes-background-mode))
 303                old-x old-y x y)))
 304
 305 ;;;###autoload(autoload 'xwem-strokes-define "xwem-strokes" "" t)
 306 (define-xwem-command xwem-strokes-define (arg)
 307   "Define new stroke.
 308 If used with prefix ARG, then define new complex stroke.
 309 See also documentation for the `strokes-define-stroke' function."
 310   (xwem-interactive "P")
 311
 312   (if arg
 313       (xwem-strokes-cmplx-begin '(4))
 314     (xwem-strokes-begin '(4))))
 315
 316 (defun xwem-strokes-motion (xev)
 317   "Handles motion notify events."
 318   (if (strokes-lift-p (car xwem-strokes-curr))
 319       ;; Before new stick in complex stroke, should not happen because
 320       ;; we select for ButtonMotion, i.e. report motion events only
 321       ;; when some button pressed.
 322       nil
 323     (xwem-strokes-continue
 324      (X-Event-xmotion-root-x xev) (X-Event-xmotion-root-y xev))))
 325
 326 ;;; Interactive commands
 327
 328 ;;;###autoload(autoload 'xwem-strokes-ibutton1 "xwem-strokes" "" t)
 329 (define-xwem-command xwem-strokes-ibutton1 ()
 330   "On button1 command."
 331   (xwem-interactive)
 332
 333   (declare (special xwem-stroke-complexp))
 334   (declare (special xwem-stroke-done))
 335
 336   (xwem-strokes-start-new (X-Event-xbutton-root-x xwem-last-xevent)
 337                           (X-Event-xbutton-root-y xwem-last-xevent)))
 338
 339 ;;;###autoload(autoload 'xwem-strokes-idescribe "xwem-strokes" "" t)
 340 (define-xwem-command xwem-strokes-idescribe ()
 341   "Describe current stroke."
 342   (xwem-interactive)
 343
 344   (declare (special xwem-stroke-complexp))
 345   (declare (special xwem-stroke-done))
 346
 347   (xwem-strokes-describe-current))
 348
 349 ;;;###autoload(autoload 'xwem-strokes-ibutton1up "xwem-strokes" "" t)
 350 (define-xwem-command xwem-strokes-ibutton1up ()
 351   "On button1 up command."
 352   (xwem-interactive)
 353
 354   (declare (special xwem-stroke-complexp))
 355   (declare (special xwem-stroke-done))
 356
 357   (if (not xwem-stroke-complexp)
 358       (progn (setq xwem-strokes-curr (nreverse xwem-strokes-curr))
 359              (setq xwem-stroke-done t))
 360
 361     (push strokes-lift xwem-strokes-curr)))
 362
 363 ;;;###autoload(autoload 'xwem-strokes-ibutton3 "xwem-strokes" "" t)
 364 (define-xwem-command xwem-strokes-ibutton3 ()
 365   "On button3 up command."
 366   (xwem-interactive)
 367
 368   (declare (special xwem-stroke-complexp))
 369   (declare (special xwem-stroke-done))
 370
 371   (setq xwem-strokes-curr (nreverse (cdr xwem-strokes-curr)))
 372   (when (strokes-lift-p (car xwem-strokes-curr))
 373     (setq xwem-strokes-curr (cdr xwem-strokes-curr)))
 374   (setq xwem-stroke-done t))
 375
 376 ;;;###autoload(autoload 'xwem-strokes-nocmd "xwem-strokes" "" t)
 377 (define-xwem-command xwem-strokes-nocmd ()
 378   "`nil' command."
 379   (xwem-interactive))
 380
 381 (defun xwem-strokes-go (complexp)
 382   "Install stuff needed to handle stroke input.
 383 If COMPLEXP is non-nil than setup all for complex stroke input."
 384   ;; TODO:
 385   ;;   - Check whether there already button release event, so we wount
 386   ;;     start stroke in that case
 387
 388   ;; Grab pointer
 389   (xwem-mouse-grab xwem-strokes-cursor (xwem-rootwin)
 390                    (Xmask-or XM-ButtonPress XM-ButtonRelease XM-ButtonMotion))
 391
 392   (setq xwem-strokes-curr nil)
 393   (xwem-strokes-start-new (X-Event-xbutton-root-x xwem-last-xevent)
 394                           (X-Event-xbutton-root-y xwem-last-xevent))
 395   ;; Event loop
 396   (xwem-unwind-protect
 397       (let ((gc-cons-threshold most-positive-fixnum) ; inhibit GC'ing
 398             (xwem-override-local-map xwem-strokes-keymap) ; override local keymap
 399             (xwem-keyboard-echo-keystrokes nil) ; Do not show
 400             (xwem-stroke-complexp complexp)
 401             (xwem-stroke-done nil)
 402             xev)
 403         (declare (special xwem-stroke-done))
 404         (declare (special xwem-stroke-complexp))
 405
 406         (while (not xwem-stroke-done)
 407           (X-Event-CASE (setq xev (xwem-next-event))
 408             (:X-MotionNotify (xwem-strokes-motion xev))
 409             ((:X-KeyPress :X-ButtonPress :X-ButtonRelease)
 410              (xwem-dispatch-command-xevent xev)))))
 411     (xwem-strokes-done))
 412
 413   ;; Execute or define stroke
 414   (let* ((grid-locs (strokes-renormalize-to-grid
 415                      xwem-strokes-curr xwem-strokes-grid))
 416          (st (strokes-fill-stroke
 417               (strokes-eliminate-consecutive-redundancies grid-locs))))
 418     (xwem-strokes-define-or-execute st)))
 419
 420 (defun xwem-strokes-done (&optional xev)
 421   "Uninstalls stuff installed by `xwem-strokes-go'.
 422 XEV is last processed X-Event."
 423   (XUngrabPointer (xwem-dpy))
 424
 425   (let ((xsc (or xwem-strokes-curr
 426                  (list (or (and xev (cons (X-Event-xbutton-root-x xev)
 427                                           (X-Event-xbutton-root-y xev)))
 428                            (cons 0 0)))))
 429         (x 10000000) (y 1000000) (xma 0) (yma 0)
 430         (thi (* 2 (max (xwem-face-line-width 'xwem-strokes-face
 431                                              '(background begin light))
 432                        (xwem-face-line-width 'xwem-strokes-face
 433                                              '(background begin dark))
 434                        (xwem-face-line-width 'xwem-strokes-face)))))
 435
 436     (while xsc
 437       (while (not (consp (car xsc)))
 438         ;; cut off lifts
 439         (setq xsc (cdr xsc)))
 440
 441       (when (< (caar xsc) x)
 442         (setq x (caar xsc)))
 443       (when (> (caar xsc) xma)
 444         (setq xma (caar xsc)))
 445
 446       (when (< (cdar xsc) y)
 447         (setq y (cdar xsc)))
 448       (when (> (cdar xsc) yma)
 449         (setq yma (cdar xsc)))
 450
 451       (setq xsc (cdr xsc)))
 452
 453     (xwem-root-refresh
 454      (- x thi) (- y thi) (+ (- xma x) (* 2 thi)) (+ (- yma y) (* thi 2)))))
 455
 456 (defun xwem-strokes-describe-current ()
 457   "Describe current complex stroke."
 458   (let ((pix-lock (copy-list xwem-strokes-curr))        ; because of nreverse
 459         (match nil))
 460
 461     (setq pix-lock (nreverse (cdr pix-lock)))
 462     (when (strokes-lift-p (car pix-lock))
 463       (setq pix-lock (cdr pix-lock)))
 464
 465     (setq match (strokes-match-stroke
 466                  (strokes-fill-stroke
 467                   (strokes-eliminate-consecutive-redundancies
 468                    (strokes-renormalize-to-grid pix-lock xwem-strokes-grid)))
 469                  xwem-strokes-map))
 470
 471     (xwem-message 'info "Current stroke executes: %S" (car match))))
 472
 473 ;;;###autoload(autoload 'xwem-strokes-begin "xwem-strokes" "" t)
 474 (define-xwem-command xwem-strokes-begin (arg)
 475   "Begin to input simple stroke.
 476 If prefix ARG is given start to define simple stroke."
 477   (xwem-interactive "P")
 478
 479   (when arg
 480     (setq xwem-strokes-defining t))
 481
 482   (xwem-strokes-go nil))
 483
 484 ;;;###autoload(autoload 'xwem-strokes-cmplx-begin "xwem-strokes" "" t)
 485 (define-xwem-command xwem-strokes-cmplx-begin (arg)
 486   "Begin to input complex stroke(i.e. which has more than one strokes).
 487 If prefix ARG is given start to define new complex stroke."
 488   (xwem-interactive "P")
 489
 490   (when arg
 491     (setq xwem-strokes-defining t))
 492
 493   (xwem-strokes-go t))
 494
 495 ;;;###autoload(autoload 'xwem-strokes-unset-last-stroke "xwem-strokes" "" t)
 496 (define-xwem-command xwem-strokes-unset-last-stroke (arg)
 497   "Removes last stroke from `xwem-strokes-map'.
 498 With prefix ARG do not require a confirmation"
 499   (xwem-interactive
 500    (list (or xwem-prefix-arg
 501              (y-or-n-p (format "XWEM: Really delete last stroke (%s)"
 502                                (xwem-strokes-cmd-description
 503                                 (cdr (car xwem-strokes-map))))))))
 504
 505   (if arg
 506       (progn
 507         (setq xwem-strokes-map (cdr xwem-strokes-map))
 508         (xwem-message 'info "Last stroke has been deleted."))
 509     (xwem-message 'info "Nothing done.")))
 510
 511 (defun xwem-strokes-sort (smap &optional how)
 512   "Sort strokes map SMAP."
 513   (sort (copy-list smap)
 514         #'(lambda (s1 s2)
 515             (let ((c1 (cdr s1))
 516                   (c2 (cdr s2)))
 517               (cond ((and (stringp c1) (stringp c2))
 518                      (string-lessp c1 c2))
 519                     ((and (symbolp c1) (symbolp 2))
 520                      (string-lessp (symbol-name c1) (symbol-name c2)))
 521                     ((stringp c1) t)
 522                     ((and (vectorp c1) (not (stringp c2))) t)
 523                     ((and (symbolp c1) (not (stringp c2)) (not (vectorp c2))) t)
 524                     ((and (functionp c1) (not (stringp c2))
 525                           (not (vectorp c2)) (not (symbolp c2))) t))))
 526         ))
 527
 528 ;;;###autoload(autoload 'xwem-strokes-list "xwem-strokes" "" t)
 529 (define-xwem-command xwem-strokes-list (arg)
 530   "List strokes defined for XWEM use.
 531 With prefix ARG sort strokes by command (NOT IMPLEMENTED YET)."
 532   (xwem-interactive "P")
 533
 534   (unless xwem-strokes-map
 535     (xwem-strokes-load-strokes))
 536
 537   (let ((stb (get-buffer-create "*XWEM Strokes*")))
 538     (xwem-special-popup-frame stb)
 539     (with-current-buffer  stb
 540       (setq buffer-read-only nil)
 541       (erase-buffer)
 542       (insert
 543        "Command type     Command                                     Stroke\n"
 544        "------------     -------                                     ------")
 545       (mapc #'(lambda (stdef)
 546                 (let ((stroke (car stdef))
 547                       (stroke-cmd (cdr stdef)))
 548                   (when (xwem-strokes-cmd-valid-p stroke-cmd)
 549                     (strokes-xpm-for-stroke stroke " *strokes-xpm*")
 550                     (newline 1)
 551                     (insert-char ?\x20 62)
 552                     (beginning-of-line)
 553                     (insert (xwem-strokes-cmd-type stroke-cmd))
 554                     (beginning-of-line)
 555                     (forward-char 17)
 556                     (insert (xwem-strokes-cmd-description stroke-cmd))
 557                     (beginning-of-line)
 558                     (forward-char 62)
 559                     (make-annotation
 560                      (make-glyph
 561                       (list
 562                        (vector 'xpm
 563                                :data (buffer-substring
 564                                       (point-min " *strokes-xpm*")
 565                                       (point-max " *strokes-xpm*")
 566                                       " *strokes-xpm*"))
 567                        [string :data "[Image]"]))
 568                      (1- (point)) 'text)
 569                     (add-text-properties
 570                      (point-at-bol) (point-at-eol) (list 'face 'underline))
 571                     )))
 572             (if arg
 573                 (xwem-strokes-sort xwem-strokes-map)
 574               xwem-strokes-map))
 575
 576       (kill-region (min (1+ (point)) (point-max)) (point-max))
 577       (goto-char (point-min))
 578
 579       ;; Start viewing mode
 580       (view-mode)
 581
 582       (define-key view-minor-mode-map (kbd "q")
 583         #'(lambda ()
 584             (interactive)
 585             (kill-buffer (current-buffer))
 586             (define-key view-minor-mode-map (kbd "q") 'view-quit)))
 587       )))
 588
 589 (defun xwem-strokes-init ()
 590   "Initialize strokes support."
 591   (xwem-message 'init "Initializing strokes ...")
 592
 593   (setq xwem-strokes-curr nil)
 594   (setq  xwem-strokes-cursor
 595          (xwem-make-cursor xwem-strokes-cursor-type
 596                            xwem-strokes-cursor-foreground-color
 597                            xwem-strokes-cursor-background-color))
 598
 599   (xwem-message 'init "Initializing strokes ... done"))
 600
 601 \f
 602 (if xwem-started
 603     (xwem-strokes-init)
 604   (add-hook 'xwem-after-init-hook 'xwem-strokes-init))
 605
 606 \f
 607 (provide 'xwem-strokes)
 608
 609 ;;; xwem-strokes.el ends here