emacs/nxhtml/util/viper-tut.el

   1 ;;; viper-tut.el --- Viper tutorial
   2 ;;
   3 ;; Author: Lennart Borgman
   4 ;; Created: Fri Sep 08 2006
   5 (defconst viper-tut:version "0.2") ;;Version: 0.2
   6 ;; Last-Updated:
   7 ;; Keywords:
   8 ;; Compatibility: Emacs 22
   9 ;;
  10 ;; Features that might be required by this library:
  11 ;;
  12 ;;   `button', `cus-edit', `cus-face', `cus-load', `cus-start',
  13 ;;   `help-mode', `tutorial', `view', `wid-edit'.
  14 ;;
  15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16 ;;
  17 ;;; Commentary:
  18 ;;
  19 ;;
  20 ;;
  21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22 ;;
  23 ;;; Change log:
  24 ;;
  25 ;;
  26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27 ;;
  28 ;; This program is free software; you can redistribute it and/or modify
  29 ;; it under the terms of the GNU General Public License as published by
  30 ;; the Free Software Foundation; either version 2, or (at your option)
  31 ;; any later version.
  32 ;;
  33 ;; This program is distributed in the hope that it will be useful,
  34 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  35 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  36 ;; GNU General Public License for more details.
  37 ;;
  38 ;; You should have received a copy of the GNU General Public License
  39 ;; along with this program; see the file COPYING.  If not, write to the
  40 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  41 ;; Boston, MA 02111-1307, USA.
  42 ;;
  43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44 ;;
  45 ;;; Code:
  46
  47 (eval-when-compile (require 'mumamo))
  48 (eval-when-compile (require 'ourcomments-util))
  49 (require 'tutorial)
  50 (require 'cus-edit)
  51
  52 (defface viper-tut-header-top
  53   '((t (:foreground "black" :background "goldenrod3")))
  54   "Face for headers."
  55   :group 'web-vcs)
  56
  57 (defface viper-tut-header
  58   '((t (:foreground "black" :background "goldenrod2" :height 1.8)))
  59   "Face for headers."
  60   :group 'web-vcs)
  61
  62 (defvar tutorial--tab-map
  63   (let ((map (make-sparse-keymap)))
  64     (define-key map [tab] 'forward-button)
  65     (define-key map [(shift tab)] 'backward-button)
  66     (define-key map [(meta tab)] 'backward-button)
  67     map)
  68   "Keymap that allows tabbing between buttons.")
  69
  70 (defconst viper-tut--emacs-part 6)
  71
  72 (defconst viper-tut--default-keys
  73   `(
  74 ;;;;;;;;;;;;;; Part 1
  75     ;; ^D       Move DOWN one half-screen
  76     ;;(viper-scroll-up [(control ?d)])
  77     (viper-scroll-up [?\C-d])
  78
  79     ;; ^U       Move UP one half-screen
  80     ;;(viper-scroll-down [(control ?u)])
  81     (viper-scroll-down [?\C-u])
  82
  83     ;; h        Move left one character
  84     (viper-backward-char [?h])
  85
  86     ;; j        Move down one line
  87     (viper-next-line [?j])
  88
  89     ;; k        Move up one line
  90     (viper-previous-line [?k])
  91
  92     ;; l        Move right one character
  93     (viper-forward-char [?l])
  94
  95     ;; dd       DELETE one line
  96     (viper-command-argument [?d])
  97
  98     ;; x        X-OUT one character
  99     (viper-delete-char [?x])
 100
 101     ;; u        UNDO last change
 102     (viper-undo [?u])
 103
 104     ;; :q!<RETURN>      QUIT without saving changes
 105     (viper-ex [?:])
 106
 107     ;; ZZ       Exit and save any changes
 108     (viper-save-kill-buffer [?Z ?Z])
 109
 110     ;; o        OPEN a line for inserting text
 111     (viper-open-line [?o])
 112
 113     ;; i        INSERT starting at the cursor
 114     (viper-insert [?i])
 115
 116     ;; ESC      ESCAPE from insert mode
 117     ;;(viper-intercept-ESC-key [(escape)])
 118                                         ;(viper-intercept-ESC-key [27])
 119     (viper-intercept-ESC-key [escape])
 120     ;; chagned-keys=
 121     ;;       (([27]
 122     ;;         viper-intercept-ESC-key
 123     ;;         viper-intercept-ESC-key
 124     ;;         <escape>
 125     ;;         (more info current-binding (keymap (118 . cua-repeat-replace-region)) viper-intercept-ESC-key [27] <escape>)))
 126
 127
 128 ;;;;;;;;;;;;;; Part 2
 129     ;; w       Move to the beginning of the next WORD
 130     (viper-forward-word [?w])
 131     ;; e       Move to the END of the next word
 132     (viper-end-of-word [?e])
 133     ;; b       Move BACK to the beginning to the previous word
 134     (viper-backward-word [?b])
 135
 136     ;; $       Move to the end of the line
 137     (viper-goto-eol [?$])
 138
 139     ;; ^       Move to the first non-white character on the line
 140     (viper-bol-and-skip-white [?^])
 141
 142     ;; 0       Move to the first column on the line (column zero)
 143     (viper-beginning-of-line [?0])
 144     ;; #|      Move to an exact column on the line (column #) e.g.  5| 12|
 145     (viper-goto-col [?|])
 146
 147     ;; f char   FIND the next occurrence of char on the line
 148     (viper-find-char-forward [?f])
 149     ;; t char   Move 'TIL the next occurrence of char on the line
 150     (viper-goto-char-forward [?t])
 151
 152     ;; F char   FIND the previous occurrence of char on the line
 153     (viper-find-char-backward [?F])
 154     ;; T char   Move 'TIL the previous occurrence of char on the line
 155     (viper-goto-char-backward [?T])
 156
 157     ;; ;        Repeat the last  f, t, F, or T
 158     (viper-repeat-find [?\;])
 159     ;; ,        Reverse the last  f, t, F, or T
 160     (viper-repeat-find-opposite [?,])
 161
 162     ;; %       Show matching () or {} or []
 163     (viper-exec-mapped-kbd-macro [?%])
 164
 165     ;; H        Move to the HIGHEST position in the window
 166     (viper-window-top [?H])
 167     ;; M        Move to the MIDDLE position in the window
 168     (viper-window-middle [?M])
 169     ;; L        Move to the LOWEST position in the window
 170     (viper-window-bottom [?L])
 171
 172     ;; m char   MARK this location and name it char
 173     (viper-mark-point [?m])
 174     ;; ' char   (quote character) return to line named char
 175     ;; ''               (quote quote) return from last movement
 176     (viper-goto-mark-and-skip-white [?'])
 177
 178     ;; G      GO to the last line in the file
 179     ;; #G      GO to line #.  (e.g., 3G , 5G , 175G )
 180     (viper-goto-line [?G])
 181
 182     ;; {        (left brace) Move to the beginning of a paragraph
 183     ;; }        (right brace) Move to the end of a paragraph
 184     (viper-backward-paragraph [?{])
 185     (viper-forward-paragraph [?}])
 186
 187     ;; (        (left paren) Move to the beginning of a sentence
 188     ;; )        (right paren) Move to the beginning of the next sentence
 189     (viper-backward-sentence [?\(])
 190     (viper-forward-sentence [?\)])
 191
 192     ;; [[      Move to the beginning of a section
 193     ;; ]]      Move to the end of a section
 194     (viper-brac-function [?\[])
 195     (viper-ket-function [?\]])
 196
 197     ;; /string   Find string looking forward
 198     (viper-exec-mapped-kbd-macro [?/])
 199     ;; ?string   Find string looking backward
 200     (viper-search-backward [??])
 201
 202     ;; n         Repeat last / or ? command
 203     ;; N         Reverse last / or ? command
 204     (viper-search-next [?n])
 205     (viper-search-Next [?N])
 206
 207
 208 ;;;;;;;;;;;;;; Part 3
 209
 210     ;; #movement        repeat movement # times
 211     (viper-digit-argument [?1])
 212     (viper-digit-argument [?2])
 213     (viper-digit-argument [?3])
 214     (viper-digit-argument [?4])
 215     (viper-digit-argument [?5])
 216     (viper-digit-argument [?6])
 217     (viper-digit-argument [?7])
 218     (viper-digit-argument [?8])
 219     (viper-digit-argument [?9])
 220
 221     ;; dmovement        DELETE to where "movement" command specifies
 222     ;; d#movement       DELETE to where the  #movement  command specifies
 223     ;; d runs the command viper-command-argument
 224
 225     ;; ymovement        YANK to where "movement" command specifies
 226     ;; y#movement       YANK to where the  #movement  command specifies
 227     (viper-command-argument [?y])
 228
 229     ;; P        (upper p) PUT the contents of the buffer before the cursor
 230     ;; p        (lower p) PUT the contents of the buffer after the cursor
 231     (viper-put-back [?p])
 232     (viper-Put-back [?P])
 233
 234     ;; "#P      (upper p) PUT contents of buffer # before the cursor
 235     ;; "#p      (lower p) PUT contents of buffer # after the cursor
 236     ;;
 237     ;; "aDELETE DELETE text into buffer a
 238     ;; "aYANK   YANK text into buffer a
 239     ;; "aPUT    PUT text from named buffer a
 240     (viper-command-argument [?\"])
 241
 242     ;; :w<RETURN>       WRITE contents of the file (without quitting)
 243
 244     ;; :e filename<RETURN>    Begin EDITing the file called "filename"
 245
 246
 247
 248 ;;;;;;;;;;;;;; Part 4
 249
 250
 251     ;; o        OPEN a line below the cursor
 252     ;; O        OPEN a line above the cursor
 253     (viper-open-line [?o])
 254     (viper-Open-line [?O])
 255
 256     ;; i        INSERT starting before the cursor
 257     ;; I        INSERT at the beginning of the line
 258     (viper-insert [?i])
 259     (viper-Insert [?I])
 260
 261     ;; a        APPEND starting after the cursor
 262     ;; A        APPEND at the end of the line
 263     (viper-append [?a])
 264     (viper-Append [?A])
 265
 266     ;; ESC      ESCAPE from insert mode
 267     (viper-intercept-ESC-key [(escape)])
 268
 269     ;; J        JOIN two lines
 270     (viper-join-lines [?J])
 271
 272     ;; #s       SUBSTITUTE for # characters
 273     ;; #S       SUBSTITUTE for # whole lines
 274     (viper-substitute [?s])
 275     (viper-substitute-line [?S])
 276
 277     ;; r        REPLACE character (NO need to press ESC)
 278     ;; R        enter over-type mode
 279     (viper-replace-char [?r])
 280     (viper-overwrite [?R])
 281
 282     ;; cmovement        CHANGE to where the movement commands specifies
 283     (viper-command-argument [?c])
 284
 285
 286 ;;;;;;;;;;;;;; Part 5
 287
 288     ;; ~        (tilde) Convert case of current character
 289     (viper-toggle-case [?~])
 290     ;; U        (upper u) UNDO all changes made to the current line
 291     ;; not implemented
 292     ;;(viper-undo [?U])
 293
 294     ;; .        (dot) repeat last change
 295     (viper-repeat [?.])
 296
 297     ;; ^F       Move FORWARD one full-screen
 298     ;; ^B       Move BACKWARD one full-screen
 299     ;;(viper-scroll-screen [(control ?f)])
 300     (viper-scroll-screen [?\C-f])
 301     ;;(viper-scroll-screen-back [(control ?b)])
 302     (viper-scroll-screen-back [?\C-b])
 303
 304     ;; ^E       Move the window down one line without moving cursor
 305     ;; ^Y       Move the window up one line without moving cursor
 306     ;;(viper-scroll-up-one [(control ?e)])
 307     (viper-scroll-up-one [?\C-e])
 308     ;;(viper-scroll-down-one [(control ?y)])
 309     (viper-scroll-down-one [?\C-y])
 310
 311     ;; z<RETURN>        Position the current line to top of window
 312     ;; z.       Position the current line to middle of window
 313     ;; z-       Position the current line to bottom of window
 314     (viper-line-to-top "z\C-m")
 315     (viper-line-to-middle [?z ?.])
 316     (viper-line-to-bottom [?z ?-])
 317
 318     ;; ^G       Show status of current file
 319     ;;(viper-info-on-file [(control ?c)(control ?g)])
 320     (viper-info-on-file [?\C-c ?\C-g])
 321     ;; ^L       Refresh screen
 322     ;;(recenter [(control ?l)])
 323     (recenter-top-bottom [?\C-l])
 324
 325     ;; !}fmt    Format the paragraph, joining and filling lines to
 326     ;; !}sort   Sort lines of a paragraph alphabetically
 327     (viper-command-argument [?!])
 328
 329     ;; >movement        Shift right to where the movement command specifies
 330     ;; <movement        Shift left to where the movement command specifies
 331     (viper-command-argument [?>])
 332     (viper-command-argument [?<])
 333
 334     ))
 335
 336 (defun viper-tut--detailed-help (button)
 337   "Give detailed help about changed keys."
 338   (with-output-to-temp-buffer (help-buffer)
 339     (help-setup-xref (list #'viper-tut--detailed-help button)
 340                      (interactive-p))
 341     (with-current-buffer (help-buffer)
 342       (let* ((tutorial-buffer  (button-get button 'tutorial-buffer))
 343              ;;(tutorial-arg     (button-get button 'tutorial-arg))
 344              (explain-key-desc (button-get button 'explain-key-desc))
 345              (part             (button-get button 'part))
 346              (changed-keys (with-current-buffer tutorial-buffer
 347                              (let ((tutorial--lang "English"))
 348                                (tutorial--find-changed-keys
 349                                 (if (= part viper-tut--emacs-part)
 350                                     tutorial--default-keys
 351                                   viper-tut--default-keys))))))
 352         (when changed-keys
 353           (insert
 354            "The following key bindings used in the tutorial had been changed\n"
 355            (if (= part viper-tut--emacs-part)
 356                "from Emacs default in the "
 357              "from Viper default in the ")
 358            (buffer-name tutorial-buffer) " buffer:\n\n" )
 359           (let ((frm "   %-9s %-27s %-11s %s\n"))
 360             (insert (format frm "Key" "Standard Binding" "Is Now On" "Remark")))
 361           (dolist (tk changed-keys)
 362             (let* ((def-fun     (nth 1 tk))
 363                    (key         (nth 0 tk))
 364                    (def-fun-txt (nth 2 tk))
 365                    (where       (nth 3 tk))
 366                    (remark      (nth 4 tk))
 367                    (rem-fun (command-remapping def-fun))
 368                    (key-txt (key-description key))
 369                    (key-fun (with-current-buffer tutorial-buffer (key-binding key)))
 370                    tot-len)
 371               (unless (eq def-fun key-fun)
 372                 ;; Insert key binding description:
 373                 (when (string= key-txt explain-key-desc)
 374                   (put-text-property 0 (length key-txt) 'face '(:background "yellow") key-txt))
 375                 (insert "   " key-txt " ")
 376                 (setq tot-len (length key-txt))
 377                 (when (> 9 tot-len)
 378                   (insert (make-string (- 9 tot-len) ? ))
 379                   (setq tot-len 9))
 380                 ;; Insert a link describing the old binding:
 381                 (insert-button def-fun-txt
 382                                'help-echo (format "Describe function '%s" def-fun-txt)
 383                                'action `(lambda(button) (interactive)
 384                                          (describe-function ',def-fun))
 385                                'follow-link t)
 386                 (setq tot-len (+ tot-len (length def-fun-txt)))
 387                 (when (> 36 tot-len)
 388                   (insert (make-string (- 36 tot-len) ? )))
 389                 (when (listp where)
 390                   (setq where "list"))
 391                 ;; Tell where the old binding is now:
 392                 (insert (format " %-11s " where))
 393                 ;; Insert a link with more information, for example
 394                 ;; current binding and keymap or information about
 395                 ;; cua-mode replacements:
 396                 (insert-button (car remark)
 397                                'help-echo "Give more information about the changed key binding"
 398                                'action `(lambda(b) (interactive)
 399                                           (let ((value ,(cdr remark)))
 400                                             ;; Fix-me:
 401                                             (tutorial--describe-nonstandard-key value)))
 402                                'follow-link t)
 403                 (insert "\n")))))
 404
 405
 406
 407         (insert "
 408 It is legitimate to change key bindings, but changed bindings do not
 409 correspond to what the tutorial says.
 410 \(See also " )
 411         (insert-button "Key Binding Conventions"
 412                        'action
 413                        (lambda(button) (interactive)
 414                          (info
 415                           "(elisp) Key Binding Conventions")
 416                          (message "Type C-x 0 to close the new window"))
 417                        'follow-link t)
 418         (insert ".)\n\n")
 419         (with-no-warnings (print-help-return-message))))))
 420
 421
 422 (defvar viper-tut--part nil
 423   "Viper tutorial part.")
 424 (make-variable-buffer-local 'viper-tut--part)
 425
 426 (defun viper-tut--saved-file ()
 427   "File name in which to save tutorials."
 428   (let* ((file-name
 429           (file-name-nondirectory (viper-tut--file viper-tut--part)))
 430          (ext (file-name-extension file-name)))
 431     (when (or (not ext)
 432               (string= ext ""))
 433       (setq file-name (concat file-name ".tut")))
 434     (expand-file-name file-name (tutorial--saved-dir))))
 435
 436 (defun viper-tut--save-tutorial ()
 437   "Save the tutorial buffer.
 438 This saves the part of the tutorial before and after the area
 439 showing changed keys.  It also saves point position and the
 440 position where the display of changed bindings was inserted.
 441
 442 Do not save anything if not `viper-mode' is enabled in the
 443 tutorial buffer."
 444   ;; This runs in a hook so protect it:
 445   (condition-case err
 446       (when (boundp 'viper-mode-string)
 447         (tutorial--save-tutorial-to (viper-tut--saved-file)))
 448     (error (warn "Error saving tutorial state: %s" (error-message-string err)))))
 449
 450
 451 (defvar viper-tut--parts
 452   '(
 453     (0 "0intro" "Introduction")
 454     (1 "1basics" "Basic Editing")
 455     (2 "2moving" "Moving Efficiently")
 456     (3 "3cutpaste" "Cutting and Pasting")
 457     (4 "4inserting" "Inserting Techniques")
 458     (5 "5tricks" "Tricks and Timesavers")
 459     (6 "(no file)" "Emacs tutorial for Viper Users")
 460     ))
 461
 462 (defcustom viper-tut-directory
 463   (let* ((this-file (if load-file-name
 464                         load-file-name
 465                       (buffer-file-name)))
 466          (this-dir (file-name-directory this-file)))
 467     (file-name-as-directory
 468      (expand-file-name "../etc/viper-tut" this-dir)))
 469   "Directory where the Viper tutorial files lives."
 470   :type 'directory
 471   :group 'viper)
 472
 473 (defun viper-tut--file(part)
 474   "Get file name for part."
 475   (let ((tut-file))
 476     (mapc (lambda(rec)
 477             (when (= part (nth 0 rec))
 478               (setq tut-file
 479                     (if (= part viper-tut--emacs-part)
 480                         (let ((tf (expand-file-name (get-language-info "English" 'tutorial) tutorial-directory)))
 481                           (unless (file-exists-p tf)
 482                             (error "Can't find the English tutorial file for Emacs: %S" tf))
 483                           tf)
 484                       (expand-file-name (nth 1 rec) viper-tut-directory)))))
 485           viper-tut--parts)
 486     tut-file))
 487
 488 (defun viper-tut-viper-is-on ()
 489   ;;(message "viper-tut-viper-is-on, vms=%s, cb=%s" (boundp 'viper-mode-string) (current-buffer))
 490   ;;(boundp 'viper-mode-string)
 491   (boundp 'viper-current-state))
 492
 493 (defun viper-tut--display-changes (changed-keys part)
 494   "Display changes to some default Viper key bindings.
 495 If some of the default key bindings that the Viper tutorial
 496 depends on have been changed then display the changes in the
 497 tutorial buffer with some explanatory links.
 498
 499 CHANGED-KEYS should be a list in the format returned by
 500 `tutorial--find-changed-keys'."
 501   (when (or changed-keys
 502             (viper-tut-viper-is-on))
 503     ;; Need the custom button face for viper buttons:
 504     ;;(when (and (boundp 'viper-mode) viper-mode) (require 'cus-edit))
 505     (goto-char tutorial--point-before-chkeys)
 506     (let* ((start (point))
 507            end
 508            (head
 509             (if (viper-tut-viper-is-on)
 510                 (if (= part viper-tut--emacs-part)
 511                     "
 512  NOTICE: This part of the Viper tutorial runs the Emacs tutorial.
 513  Several keybindings are changed from Emacs default (either
 514  because of Viper or some other customization) and doesn't
 515  correspond to the tutorial.
 516
 517  We have inserted colored notices where the altered commands have
 518  been introduced.  If you change Viper state (vi state, insert
 519  state, etc) these notices will be changed to reflect the new
 520  state. ["
 521                   "
 522  NOTICE: The main purpose of the Viper tutorial is to teach you
 523  the most important vi commands (key bindings).  However, your
 524  Emacs has been customized by changing some of these basic Viper
 525  editing commands, so it doesn't correspond to the tutorial.  We
 526  have inserted colored notices where the altered commands have
 527  been introduced. [")
 528               "
 529   NOTICE: You have currently not turned on Viper. Nothing in this
 530   tutorial \(the Viper Tutorial\) will work unless you do that. ["
 531               ))
 532            (head2 (if (viper-tut-viper-is-on)
 533                       (get-lang-string tutorial--lang 'tut-chgdhead2)
 534                     "More information")))
 535       (when (and head head2)
 536         (insert head)
 537         (insert-button head2
 538                        'tutorial-buffer
 539                        (current-buffer)
 540                        ;;'tutorial-arg arg
 541                        'part part
 542                        'action
 543                        (if (viper-tut-viper-is-on)
 544                            'viper-tut--detailed-help
 545                          'go-home-blaha)
 546                        'follow-link t
 547                        'echo "Click for more information"
 548                        'face '(:inherit link :background "yellow"))
 549         (insert "]\n\n" )
 550         (when changed-keys
 551           (dolist (tk changed-keys)
 552             (let* ((def-fun     (nth 1 tk))
 553                    (key         (nth 0 tk))
 554                    (def-fun-txt (nth 2 tk))
 555                    (where       (nth 3 tk))
 556                    (remark      (nth 4 tk))
 557                    (rem-fun (command-remapping def-fun))
 558                    (key-txt (key-description key))
 559                    (key-fun (key-binding key))
 560                    tot-len)
 561               (unless (eq def-fun key-fun)
 562                 ;; Mark the key in the tutorial text
 563                 (unless (string= "Same key" where)
 564                   (let* ((here (point))
 565                          (key-desc (key-description key))
 566                          (vi-char (= 1 (length key-desc)))
 567                          vi-char-pos
 568                          hit)
 569                     (when (string= "RET" key-desc)
 570                       (setq key-desc "Return"))
 571                     (when (string= "DEL" key-desc)
 572                       (setq key-desc "Delback"))
 573                     (while (if (not vi-char)
 574                                (unless hit ;; Only tell once
 575                                  (setq hit t)
 576                                  (re-search-forward
 577                                   (concat "[^[:alpha:]]\\("
 578                                           (regexp-quote key-desc)
 579                                           "\\)[^[:alpha:]]") nil t))
 580                              (setq vi-char-pos
 581                                    (next-single-property-change
 582                                     (point) 'vi-char)))
 583                       (if (not vi-char)
 584                           (put-text-property (match-beginning 0)
 585                                              (match-end 0)
 586                                              'tutorial-remark nil) ;;'only-colored)
 587                         (put-text-property (match-beginning 0)
 588                                            (match-end 0)
 589                                            'face '(:background "yellow"))
 590                         (goto-char (1+ vi-char-pos))
 591                         (setq hit (string= key-desc (char-to-string (char-before))))
 592                         (when hit
 593                           (put-text-property vi-char-pos (1+ vi-char-pos)
 594                                              'face '(:background "yellow"))))
 595                       (when hit
 596                         (forward-line)
 597                         (let ((s  (get-lang-string tutorial--lang 'tut-chgdkey))
 598                               (s2 (get-lang-string tutorial--lang 'tut-chgdkey2))
 599                               (start (point))
 600                               end)
 601                           ;; key-desc " has been rebound, but you can use " where " instead ["))
 602                           (when (and s s2)
 603                             (when (or (not where) (= 0 (length where)))
 604                               (setq where (concat "`M-x " def-fun-txt "'")))
 605                             (setq s (format s key-desc where s2))
 606                             (insert s " [")
 607                             (insert-button s2
 608                                            'tutorial-buffer
 609                                            (current-buffer)
 610                                            ;;'tutorial-arg arg
 611                                            'part part
 612                                            'action
 613                                            'viper-tut--detailed-help
 614                                            'explain-key-desc key-desc
 615                                            'follow-link t
 616                                            'face '(:inherit link :background "yellow"))
 617                             (insert "] **")
 618                             (insert "\n")
 619                             (setq end (point))
 620                             (put-text-property start end 'local-map tutorial--tab-map)
 621                             (put-text-property start end 'tutorial-remark t)
 622                             (put-text-property start end
 623                                                'face '(:background "yellow" :foreground "#c00"))
 624                             (put-text-property start end 'read-only t)))))
 625                     (goto-char here)))))))
 626
 627
 628         (setq end (point))
 629         ;; Make the area with information about change key
 630         ;; bindings stand out:
 631         (put-text-property start end
 632                            'face
 633                            ;; The default warning face does not
 634                            ;;look good in this situation. Instead
 635                            ;;try something that could be
 636                            ;;recognized from warnings in normal
 637                            ;;life:
 638                            ;; 'font-lock-warning-face
 639                            (list :background "yellow" :foreground "#c00"))
 640         ;; Make it possible to use Tab/S-Tab between fields in
 641         ;; this area:
 642         (put-text-property start end 'local-map tutorial--tab-map)
 643         (put-text-property start end 'tutorial-remark t)
 644         (setq tutorial--point-after-chkeys (point-marker))
 645         ;; Make this area read-only:
 646         (put-text-property start end 'read-only t)))))
 647
 648 (defun viper-tut--at-change-state()
 649   (condition-case err
 650       (progn
 651         (let ((inhibit-read-only t)
 652               (here (point)))
 653           ;; Delete the remarks:
 654           ;;(tutorial--remove-remarks)
 655           ;; Add them again
 656           ;;(viper-tut--add-remarks)
 657           (goto-char here)
 658           )
 659         )
 660     (error (message "error in viper-tut--at-change-state: %s" (error-message-string err)))))
 661
 662
 663 ;;;###autoload
 664 (defun viper-tutorial(part &optional dont-ask-for-revert)
 665   "Run a tutorial for Viper.
 666
 667 A simple classic tutorial in 5 parts that have been used by many
 668 people starting to learn vi keys.  You may learn enough to start
 669 using `viper-mode' in Emacs.
 670
 671 Some people find that vi keys helps against repetetive strain
 672 injury, see URL
 673
 674   `http://www.emacswiki.org/emacs/RepeatedStrainInjury'.
 675
 676 Note: There might be a few clashes between vi key binding and
 677 Emacs standard key bindings.  You will be notified about those in
 678 the tutorial.  Even more, if your own key bindings comes in
 679 between you will be notified about that too."
 680   (interactive (list
 681                 ;;                 (condition-case nil
 682                 ;;                     (widget-choose "The following viper tutorials are available"
 683                 ;;                                    (mapcar (lambda(rec)
 684                 ;;                                              (cons (nth 2 rec) (nth 0 rec)))
 685                 ;;                                            viper-tut--parts))
 686                 ;;                   (error nil))
 687                 0
 688                 ))
 689   (if (not (boundp 'viper-current-state))
 690       (let ((prompt
 691              "
 692   You can not run the Viper tutorial in this Emacs because you
 693   have not enabled Viper.
 694
 695   Do you want to run the Viper tutorial in a new Emacs? "))
 696         (if (y-or-n-p prompt)
 697             (let ((ret (funcall 'emacs--no-desktop
 698                                 "-eval"
 699                                 (concat
 700                                  "(progn"
 701                                  " (setq viper-mode t)"
 702                                  " (require 'viper)"
 703                                  " (require 'viper-tut)"
 704                                  " (call-interactively 'viper-tutorial))"))))
 705               (message "Starting Viper tutorial in a new Emacs"))
 706           (message "Viper tutorial aborted by user")))
 707
 708     (let* ((filename (viper-tut--file part))
 709            ;; Choose a buffer name including the language so that
 710            ;; several languages can be tested simultaneously:
 711            (tut-buf-name "Viper TUTORIAL")
 712            (old-tut-buf (get-buffer tut-buf-name))
 713            (old-tut-part (when old-tut-buf
 714                            (with-current-buffer old-tut-buf
 715                              viper-tut--part)))
 716            (old-tut-win (when old-tut-buf (get-buffer-window old-tut-buf t)))
 717            (old-tut-is-ok (when old-tut-buf
 718                             (and
 719                              (= part old-tut-part)
 720                              (not (buffer-modified-p old-tut-buf)))))
 721            old-tut-file
 722            (old-tut-point 1))
 723       (unless (file-exists-p filename) (error "Can't fine %s" filename))
 724       (setq tutorial--point-after-chkeys (point-min))
 725       ;; Try to display the tutorial buffer before asking to revert it.
 726       ;; If the tutorial buffer is shown in some window make sure it is
 727       ;; selected and displayed:
 728       (if old-tut-win
 729           (raise-frame
 730            (window-frame
 731             (select-window (get-buffer-window old-tut-buf t))))
 732         ;; Else, is there an old tutorial buffer? Then display it:
 733         (when old-tut-buf
 734           (switch-to-buffer old-tut-buf)))
 735       ;; Use whole frame for tutorial
 736       ;;(delete-other-windows)
 737       ;; If the tutorial buffer has been changed then ask if it should
 738       ;; be reverted:
 739       (when (and old-tut-buf
 740                  (not old-tut-is-ok)
 741                  (= part old-tut-part))
 742         (setq old-tut-is-ok
 743               (if dont-ask-for-revert
 744                   nil
 745                 (not (y-or-n-p
 746                       "You have changed the Tutorial buffer.  Revert it? ")))))
 747       ;; (Re)build the tutorial buffer if it is not ok
 748       (unless old-tut-is-ok
 749         (switch-to-buffer (get-buffer-create tut-buf-name))
 750         (unless old-tut-buf (text-mode))
 751         (setq viper-tut--part part)
 752         (setq old-tut-file (file-exists-p (viper-tut--saved-file)))
 753         (when (= part 0) (setq old-tut-file nil)) ;; You do not edit in the intro
 754         (setq buffer-read-only nil)
 755         (let ((inhibit-read-only t)) ;; For the text property
 756           (erase-buffer))
 757         (message "Preparing Viper tutorial ...") (sit-for 0)
 758
 759         ;; Do not associate the tutorial buffer with a file. Instead use
 760         ;; a hook to save it when the buffer is killed.
 761         (setq buffer-auto-save-file-name nil)
 762         (add-hook 'kill-buffer-hook 'viper-tut--save-tutorial nil t)
 763
 764         ;; Insert the tutorial. First offer to resume last tutorial
 765         ;; editing session.
 766         (when dont-ask-for-revert
 767           (setq old-tut-file nil))
 768         (when old-tut-file
 769           (setq old-tut-file
 770                 (y-or-n-p
 771                  (format
 772                   "Resume your last saved Viper tutorial part %s? "
 773                   part))))
 774         (if old-tut-file
 775             (progn
 776               (insert-file-contents (viper-tut--saved-file))
 777               (goto-char (point-min))
 778               (setq old-tut-point
 779                     (string-to-number
 780                      (buffer-substring-no-properties
 781                       (line-beginning-position) (line-end-position))))
 782               (forward-line)
 783               (setq tutorial--point-before-chkeys
 784                     (string-to-number
 785                      (buffer-substring-no-properties
 786                       (line-beginning-position) (line-end-position))))
 787               (forward-line)
 788               (delete-region (point-min) (point))
 789               (goto-char tutorial--point-before-chkeys)
 790               (setq tutorial--point-before-chkeys (point-marker)))
 791           ;;(insert-file-contents (expand-file-name filename data-directory))
 792           (insert-file-contents filename)
 793           (viper-tut--replace-links)
 794           (save-excursion
 795             (goto-char (point-min))
 796             (while (re-search-forward "'\\([][+a-zA-Z~<>!;,:.'\"%/?(){}$^0|-]\\)'" nil t)
 797               (let ((matched-char (match-string 1))
 798                     (inhibit-read-only t))
 799                 (put-text-property 0 1 'vi-char t matched-char)
 800                 (put-text-property 0 1 'face '(:foreground "blue") matched-char)
 801                 (replace-match matched-char))))
 802           (forward-line)
 803           (setq tutorial--point-before-chkeys (point-marker)))
 804
 805         (viper-tut--add-remarks)
 806
 807         (goto-char (point-min))
 808         (when old-tut-file
 809           ;; Just move to old point in saved tutorial.
 810           (let ((old-point
 811                  (if (> 0 old-tut-point)
 812                      (- old-tut-point)
 813                    (+ old-tut-point tutorial--point-after-chkeys))))
 814             (when (< old-point 1)
 815               (setq old-point 1))
 816             (goto-char old-point)))
 817
 818         (viper-tut-fix-header-and-footer)
 819
 820         ;; Clear message:
 821         (message "") (sit-for 0)
 822
 823         (setq buffer-undo-list nil)
 824         (set-buffer-modified-p nil))
 825       (setq buffer-read-only (= 0 part)))))
 826
 827 ;;(tutorial--find-changed-keys '((scroll-up [?\C-v])))
 828 (defun viper-tut--add-remarks()
 829   ;; Check if there are key bindings that may disturb the
 830   ;; tutorial.  If so tell the user.
 831   (let* ((tutorial--lang "English")
 832          (changed-keys
 833           (if (= viper-tut--part viper-tut--emacs-part)
 834               (tutorial--find-changed-keys tutorial--default-keys)
 835             (tutorial--find-changed-keys viper-tut--default-keys))))
 836     (viper-tut--display-changes changed-keys viper-tut--part))
 837
 838   (if (= viper-tut--part viper-tut--emacs-part)
 839       (progn
 840         (add-hook 'viper-vi-state-hook 'viper-tut--at-change-state nil t)
 841         (add-hook 'viper-insert-state-hook 'viper-tut--at-change-state nil t)
 842         (add-hook 'viper-replace-state-hook 'viper-tut--at-change-state nil t)
 843         (add-hook 'viper-emacs-state-hook 'viper-tut--at-change-state nil t)
 844         )
 845     (remove-hook 'viper-vi-state-hook 'viper-tut--at-change-state t)
 846     (remove-hook 'viper-insert-statehook 'viper-tut--at-change-state t)
 847     (remove-hook 'viper-replace-state-hook 'viper-tut--at-change-state t)
 848     (remove-hook 'viper-emacs-state-hook 'viper-tut--at-change-state t)
 849     ))
 850
 851 (defun viper-tut-fix-header-and-footer ()
 852   (save-excursion
 853     (goto-char (point-min))
 854     (add-text-properties (point) (1+ (line-end-position))
 855                          '( read-only t face viper-tut-header))
 856     (goto-char (point-min))
 857     (viper-tut--insert-goto-row nil)
 858     (goto-char (point-max))
 859     (viper-tut--insert-goto-row t)))
 860
 861 (defun viper-tut--insert-goto-row(last)
 862   (let ((start (point))
 863         end)
 864     (insert " Go to part: ")
 865     (dolist (rec viper-tut--parts)
 866       (let ((n (nth 0 rec))
 867             (file (nth 1 rec))
 868             (title (nth 2 rec)))
 869         (if (= n viper-tut--part)
 870             (insert (format "%s" n))
 871           (insert-button (format "%s" n)
 872                          'help-echo (concat "Go to part: " title)
 873                          'follow-link t
 874                          'action
 875                          `(lambda (button)
 876                             (viper-tutorial ,n t))))
 877         (insert "  ")))
 878     (insert "   ")
 879     (insert-button "Exit Tutorial"
 880                    'help-echo "Exit tutorial and close tutorial buffer"
 881                    'follow-link t
 882                    'action
 883                    (lambda (button)
 884                      (kill-buffer (current-buffer))))
 885     (unless last (insert "\n"))
 886     (setq end (point))
 887     (put-text-property start end 'local-map tutorial--tab-map)
 888     (put-text-property start end 'tutorial-remark t)
 889     (put-text-property start end
 890                        'face 'viper-tut-header-top)
 891     (put-text-property start end 'read-only t)))
 892
 893 (defun viper-tut--replace-links()
 894   "Replace markers for links with actual links."
 895   (let ((re-links (regexp-opt '("VIPER-MANUAL"
 896                                 "README-FILE"
 897                                 "DIGIT-ARGUMENT"
 898                                 "KILL-BUFFER"
 899                                 "ISEARCH-FORWARD"
 900                                 "UNIVERSAL-ARGUMENT"
 901                                 "SEARCH-COMMANDS"
 902                                 "R-AND-R"
 903                                 "CUA-MODE"
 904                                 "KEYBOARD-MACROS"
 905                                 "VIPER-TOGGLE-KEY"
 906                                 "* EMACS-NOTICE:")))
 907         (case-fold-search nil)
 908         (inhibit-read-only t))
 909     (save-excursion
 910       (goto-char (point-min))
 911       (while (re-search-forward re-links nil t)
 912         (let ((matched (match-string 0))
 913               start
 914               end)
 915           (replace-match "")
 916           (setq start (point))
 917           (cond
 918            ((string= matched "VIPER-TOGGLE-KEY")
 919             (insert-button "viper-toggle-key"
 920                            'action
 921                            (lambda(button) (interactive)
 922                              (describe-variable 'viper-toggle-key))
 923                            'follow-link t))
 924            ((string= matched "CUA-MODE")
 925             (insert-button "cua-mode"
 926                            'action
 927                            (lambda(button) (interactive)
 928                              (describe-function 'cua-mode))
 929                            'follow-link t))
 930            ((string= matched "ISEARCH-FORWARD")
 931             (insert-button "isearch-forward"
 932                            'action
 933                            (lambda(button) (interactive)
 934                              (describe-function 'isearch-forward))
 935                            'follow-link t))
 936            ((string= matched "KILL-BUFFER")
 937             (insert-button "kill-buffer"
 938                            'action
 939                            (lambda(button) (interactive)
 940                              (describe-function 'kill-buffer))
 941                            'follow-link t))
 942            ((string= matched "UNIVERSAL-ARGUMENT")
 943             (insert-button "universal-argument"
 944                            'action
 945                            (lambda(button) (interactive)
 946                              (describe-function 'universal-argument))
 947                            'follow-link t))
 948            ((string= matched "DIGIT-ARGUMENT")
 949             (insert-button "digit-argument"
 950                            'action
 951                            (lambda(button) (interactive)
 952                              (describe-function 'digit-argument))
 953                            'follow-link t))
 954            ((string= matched "* EMACS-NOTICE:")
 955             (insert "* Emacs NOTICE:")
 956             (while (progn
 957                      (forward-line 1)
 958                      (not (looking-at "^$"))))
 959             (put-text-property start (point)
 960                                'face '(:background
 961                                        "#ffe4b5"
 962                                        :foreground "#999999"))
 963             (put-text-property start (point) 'read-only t)
 964             )
 965            ((string= matched "SEARCH-COMMANDS")
 966             (insert-button "search commands"
 967                            'action
 968                            (lambda(button) (interactive)
 969                              (info-other-window "(emacs) Search")
 970                              (message "Type C-x 0 to close the new window"))
 971                            'follow-link t))
 972            ((string= matched "KEYBOARD-MACROS")
 973             (insert-button "keyboard macros"
 974                            'action
 975                            (lambda(button) (interactive)
 976                              (info-other-window "(emacs) Keyboard Macros")
 977                              (message "Type C-x 0 to close the new window"))
 978                            'follow-link t))
 979            ((string= matched "VIPER-MANUAL")
 980             (insert-button "Viper manual"
 981                            'action
 982                            (lambda(button) (interactive)
 983                              (info-other-window "(viper)")
 984                              (message "Type C-x 0 to close the new window"))
 985                            'follow-link t))
 986            ((string= matched "R-AND-R")
 987             (insert-button "r and R"
 988                            'action
 989                            (lambda(button) (interactive)
 990                              (info-other-window "(viper) Basics")
 991                              (message "Type C-x 0 to close the new window"))
 992                            'follow-link t))
 993            ((string= matched "README-FILE")
 994             (insert-button "README file"
 995                            'action
 996                            (lambda(button) (interactive)
 997                              (find-file-other-window (expand-file-name "README" viper-tut-directory))
 998                              (message "Type C-x 0 to close the new window"))
 999                            'follow-link t))
1000            (t
1001             (error "Unmatched text: %s" matched)))
1002           (put-text-property start (point) 'tutorial-remark t)
1003           (put-text-property start (point) 'tutorial-orig matched)
1004           (put-text-property start (point) 'local-map tutorial--tab-map)
1005           (put-text-property start (point) 'read-only t))))))
1006
1007 (provide 'viper-tut)
1008 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1009 ;;; viper-tut.el ends here