;;; strokes.el --- control Emacs through mouse strokes
-;; Copyright (C) 1997, 2000, 2002, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2011 Free Software Foundation, Inc.
;; Author: David Bakhash <cadet@alum.mit.edu>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; the user to enter strokes which "remove the pencil from the paper"
;; so to speak, so one character can have multiple strokes.
+;; NOTE (Oct 7, 2006): The URLs below seem to be invalid!!!
+
;; You can read more about strokes at:
;; http://www.mit.edu/people/cadet/strokes-help.html
(defgroup strokes nil
"Control Emacs through mouse strokes."
:link '(emacs-commentary-link "strokes")
- :link '(url-link "http://www.mit.edu/people/cadet/strokes-help.html")
:group 'mouse)
(defcustom strokes-modeline-string " Strokes"
- "*Modeline identification when Strokes mode is on \(default is \" Strokes\"\)."
+ "Modeline identification when Strokes mode is on \(default is \" Strokes\"\)."
:type 'string
:group 'strokes)
(defcustom strokes-character ?@
- "*Character used when drawing strokes in the strokes buffer.
+ "Character used when drawing strokes in the strokes buffer.
\(The default is `@', which works well.\)"
:type 'character
:group 'strokes)
(defcustom strokes-minimum-match-score 1000
- "*Minimum score for a stroke to be considered a possible match.
+ "Minimum score for a stroke to be considered a possible match.
Setting this variable to 0 would require a perfectly precise match.
The default value is 1000, but it's mostly dependent on how precisely
you manage to replicate your user-defined strokes. It also depends on
:group 'strokes)
(defcustom strokes-grid-resolution 9
- "*Integer defining dimensions of the stroke grid.
-The grid is a square grid, where STROKES-GRID-RESOLUTION defaults to
+ "Integer defining dimensions of the stroke grid.
+The grid is a square grid, where `strokes-grid-resolution' defaults to
`9', making a 9x9 grid whose coordinates go from (0 . 0) on the top
-left to ((STROKES-GRID-RESOLUTION - 1) . (STROKES-GRID-RESOLUTION - 1))
+left to ((strokes-grid-resolution - 1) . (strokes-grid-resolution - 1))
on the bottom right. The greater the resolution, the more intricate
your strokes can be.
NOTE: This variable should be odd and MUST NOT be less than 3 and need
:group 'strokes)
(defcustom strokes-file (convert-standard-filename "~/.strokes")
- "*File containing saved strokes for stroke-mode (default is ~/.strokes)."
+ "File containing saved strokes for Strokes mode (default is ~/.strokes)."
:type 'file
:group 'strokes)
"The name of the buffer that the strokes take place in.")
(defcustom strokes-use-strokes-buffer t
- "*If non-nil, the strokes buffer is used and strokes are displayed.
+ "If non-nil, the strokes buffer is used and strokes are displayed.
If nil, strokes will be read the same, however the user will not be
able to see the strokes. This be helpful for people who don't like
the delay in switching to the strokes buffer."
"Last stroke entered by the user.
Its value gets set every time the function
`strokes-fill-stroke' gets called,
-since that is the best time to set the variable")
+since that is the best time to set the variable.")
(defvar strokes-global-map '()
"Association list of strokes and their definitions.
Each entry is (STROKE . COMMAND) where STROKE is itself a list of
coordinates (X . Y) where X and Y are lists of positions on the
normalized stroke grid, with the top left at (0 . 0). COMMAND is the
-corresponding interactive function")
+corresponding interactive function.")
(defvar strokes-load-hook nil
- "Function or functions to be called when `strokes' is loaded.")
+ "Functions to be called when Strokes is loaded.")
;;; ### NOT IMPLEMENTED YET ###
;;(defvar edit-strokes-menu
(defun strokes-get-grid-position (stroke-extent position &optional grid-resolution)
"Map POSITION to a new grid position.
-Do so based on its STROKE-EXTENT and GRID-RESOLUTION.
+Do so based on its STROKE-EXTENT and GRID-RESOLUTION.
STROKE-EXTENT as a list \(\(XMIN . YMIN\) \(XMAX . YMAX\)\).
If POSITION is a `strokes-lift', then it is itself returned.
-Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.
+Optional GRID-RESOLUTION may be used in place of `strokes-grid-resolution'.
The grid is a square whose dimension is [0,GRID-RESOLUTION)."
(cond ((consp position) ; actual pixel location
(let ((grid-resolution (or grid-resolution strokes-grid-resolution))
(defun strokes-renormalize-to-grid (positions &optional grid-resolution)
"Map POSITIONS to a new grid whose dimensions are based on GRID-RESOLUTION.
POSITIONS is a list of positions and stroke-lifts.
-Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION.
+Optional GRID-RESOLUTION may be used in place of `strokes-grid-resolution'.
The grid is a square whose dimension is [0,GRID-RESOLUTION)."
(or grid-resolution (setq grid-resolution strokes-grid-resolution))
(let ((stroke-extent (strokes-get-stroke-extent positions)))
nil))
nil))
+(defsubst strokes-fill-current-buffer-with-whitespace ()
+ "Erase the contents of the current buffer and fill it with whitespace."
+ (erase-buffer)
+ (loop repeat (frame-height) do
+ (insert-char ?\s (1- (frame-width)))
+ (newline))
+ (goto-char (point-min)))
+
;;;###autoload
(defun strokes-read-stroke (&optional prompt event)
"Read a simple stroke (interactively) and return the stroke.
This function will display the stroke interactively as it is being
entered in the strokes buffer if the variable
`strokes-use-strokes-buffer' is non-nil.
-Optional EVENT is acceptable as the starting event of the stroke"
+Optional EVENT is acceptable as the starting event of the stroke."
(save-excursion
(let ((pix-locs nil)
(grid-locs nil)
;; display the stroke as it's being read
(save-window-excursion
(set-window-configuration strokes-window-configuration)
+ ;; The frame has been resized, so we need to refill the
+ ;; strokes buffer so that the strokes canvas is the whole
+ ;; visible buffer.
+ (unless (> 1 (abs (- (line-end-position) (window-width))))
+ (strokes-fill-current-buffer-with-whitespace))
(when prompt
- (message prompt)
+ (message "%s" prompt)
(setq event (read-event))
(or (strokes-button-press-event-p event)
(error "You must draw with the mouse")))
(bury-buffer))))
;; Otherwise, don't use strokes buffer and read stroke silently
(when prompt
- (message prompt)
+ (message "%s" prompt)
(setq event (read-event))
(or (strokes-button-press-event-p event)
(error "You must draw with the mouse")))
Note that a complex stroke allows the user to pen-up and pen-down. This
is implemented by allowing the user to paint with button 1 or button 2 and
then complete the stroke with button 3.
-Optional EVENT is acceptable as the starting event of the stroke"
+Optional EVENT is acceptable as the starting event of the stroke."
(save-excursion
(save-window-excursion
(set-window-configuration strokes-window-configuration)
(grid-locs nil))
(if prompt
(while (not (strokes-button-press-event-p event))
- (message prompt)
+ (message "%s" prompt)
(setq event (read-event))))
(unwind-protect
(track-mouse
;;;###autoload
(defun strokes-help ()
- "Get instruction on using the `strokes' package."
+ "Get instruction on using the Strokes package."
(interactive)
(with-output-to-temp-buffer "*Help with Strokes*"
(princ
- "This is help for the strokes package.
+ (substitute-command-keys
+ "This is help for the strokes package.
------------------------------------------------------------
You will be prompted to save them when you exit Emacs, or you can save
them with
-> M-x strokes-save-strokes
+> M-x strokes-prompt-user-save-strokes
Your strokes get loaded automatically when you enable `strokes-mode'.
You can also load in your user-defined strokes with
be running a version of Emacs with XPM support. You use the binding
to `strokes-compose-complex-stroke' to start drawing your strokes.
These are just complex strokes, and thus continue drawing with mouse-1
-or mouse-2 and end with mouse-3. Then the stroke image gets inserted
+or mouse-2 and end with mouse-3. Then the stroke image gets inserted
into the buffer. You treat it somewhat like any other character,
which you can copy, paste, delete, move, etc. When all is done, you
may want to send the file, or save it. This is done with
variable which many people wanted to see was
`strokes-use-strokes-buffer' which allows the user to use strokes
silently--without displaying the strokes. All variables can be set
- by customizing the group `strokes' via \[customize-group].")
+ by customizing the group `strokes' via \\[customize-group]."))
(set-buffer standard-output)
(help-mode)
- (print-help-return-message)))
+ (help-print-return-message)))
-(defalias 'strokes-report-bug 'report-emacs-bug)
-
-(defsubst strokes-fill-current-buffer-with-whitespace ()
- "Erase the contents of the current buffer and fill it with whitespace."
- (erase-buffer)
- (loop repeat (frame-height) do
- (insert-char ?\s (1- (frame-width)))
- (newline))
- (goto-char (point-min)))
+(define-obsolete-function-alias 'strokes-report-bug 'report-emacs-bug "24.1")
(defun strokes-window-configuration-changed-p ()
"Non-nil if the `strokes-window-configuration' frame properties changed.
;; don't try to update strokes window configuration
;; if window is dedicated or a minibuffer
nil)
- ((or (interactive-p)
+ ((or (called-interactively-p 'interactive)
(not (buffer-live-p (get-buffer strokes-buffer-name)))
(null strokes-window-configuration))
;; create `strokes-window-configuration' from scratch...
(save-excursion
(save-window-excursion
- (get-buffer-create strokes-buffer-name)
+ (set-buffer (get-buffer-create strokes-buffer-name))
(set-window-buffer current-window strokes-buffer-name)
(delete-other-windows)
(fundamental-mode)
(auto-save-mode 0)
- (if (featurep 'font-lock)
- (font-lock-mode 0))
+ (font-lock-mode 0)
(abbrev-mode 0)
(buffer-disable-undo (current-buffer))
(setq truncate-lines nil)
(cond ((and (file-exists-p strokes-file)
(file-readable-p strokes-file))
(load-file strokes-file))
- ((interactive-p)
+ ((called-interactively-p 'interactive)
(error "Trouble loading user-defined strokes; nothing done"))
(t
(message "No user-defined strokes, sorry"))))
(setq strokes-global-map nil)
(strokes-load-user-strokes)
(if (and (not (equal current strokes-global-map))
- (or (interactive-p)
+ (or (called-interactively-p 'interactive)
(yes-or-no-p "Save your strokes? ")))
(progn
(require 'pp) ; pretty-print variables
(let ((char (or (car rainbow-chars) ?\.)))
(loop for i from 0 to 2 do
(loop for j from 0 to 2 do
- (goto-line (+ 16 i y))
+ (goto-char (point-min))
+ (forward-line (+ 15 i y))
(forward-char (+ 1 j x))
(delete-char 1)
(insert char)))
(setq rainbow-chars (cdr rainbow-chars)
lift-flag nil))
;; Otherwise, just plot the point...
- (goto-line (+ 17 y))
+ (goto-char (point-min))
+ (forward-line (+ 16 y))
(forward-char (+ 2 x))
(subst-char-in-region (point) (1+ (point)) ?\s ?\*)))
((strokes-lift-p point)
;; a lift--tell the loop to X out the next point...
(setq lift-flag t))))
- (when (interactive-p)
+ (when (called-interactively-p 'interactive)
(pop-to-buffer " *strokes-xpm*")
;; (xpm-mode 1)
(goto-char (point-min))
;;;;;###autoload
;;(defalias 'edit-strokes 'strokes-edit-strokes)
-(eval-when-compile (defvar view-mode-map))
+(defvar view-mode-map)
;;;###autoload
(defun strokes-list-strokes (&optional chronological strokes-map)
(goto-char (point-min))))
(defun strokes-alphabetic-lessp (stroke1 stroke2)
- "T iff command name for STROKE1 is less than STROKE2's in lexicographic order."
+ "Return t if STROKE1's command name precedes STROKE2's in lexicographic order."
(let ((command-name-1 (symbol-name (cdr stroke1)))
(command-name-2 (symbol-name (cdr stroke2))))
(string-lessp command-name-1 command-name-2)))
;;;###autoload
(define-minor-mode strokes-mode
- "Toggle Strokes global minor mode.\\<strokes-mode-map>
-With ARG, turn strokes on if and only if ARG is positive.
+ "Toggle Strokes mode, a global minor mode.
+With a prefix argument ARG, enable Strokes mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+\\<strokes-mode-map>
Strokes are pictographic mouse gestures which invoke commands.
Strokes are invoked with \\[strokes-do-stroke]. You can define
new strokes with \\[strokes-global-set-stroke]. See also
"Face for strokes characters."
:version "21.1"
:group 'strokes)
-;; backward-compatibility alias
-(put 'strokes-char-face 'face-alias 'strokes-char)
(put 'strokes 'char-table-extra-slots 0)
(defconst strokes-char-table (make-char-table 'strokes) ;
(eq char ?*)))
;;(defsubst strokes-xor (a b) ### Should I make this an inline function? ###
-;; "T iff one and only one of A and B is non-nil; otherwise, returns nil.
+;; "T if one and only one of A and B is non-nil; otherwise, returns nil.
;;NOTE: Don't use this as a numeric xor since it treats all non-nil
;; values as t including `0' (zero)."
;; (eq (null a) (not (null b))))
(defun strokes-xpm-to-compressed-string (&optional xpm-buffer)
"Convert XPM in XPM-BUFFER to compressed string representing the stroke.
XPM-BUFFER defaults to ` *strokes-xpm*'."
- (save-excursion
- (set-buffer (setq xpm-buffer (or xpm-buffer " *strokes-xpm*")))
+ (with-current-buffer (setq xpm-buffer (or xpm-buffer " *strokes-xpm*"))
(goto-char (point-min))
(search-forward "/* pixels */") ; skip past header junk
(forward-char 2)
Optional FORCE non-nil will ignore the buffer's read-only status."
(interactive)
;; (interactive "*bStrokify buffer: ")
- (save-excursion
- (set-buffer (setq buffer (get-buffer (or buffer (current-buffer)))))
+ (with-current-buffer (setq buffer (get-buffer (or buffer (current-buffer))))
(when (or (not buffer-read-only)
force
inhibit-read-only
(let ((inhibit-read-only t))
(message "Strokifying %s..." buffer)
(goto-char (point-min))
- (let (ext string image)
+ (let (string image)
;; The comment below is what I'd have to do if I wanted to
;; deal with random newlines in the midst of the compressed
;; strings. If I do this, I'll also have to change
;; buffer is killed?
;; (interactive "*bUnstrokify buffer: ")
(interactive)
- (save-excursion
- (set-buffer (setq buffer (or buffer (current-buffer))))
+ (with-current-buffer (setq buffer (or buffer (current-buffer)))
(when (or (not buffer-read-only)
force
inhibit-read-only
(defun strokes-xpm-for-compressed-string (compressed-string &optional bufname)
"Convert the stroke represented by COMPRESSED-STRING into an XPM.
Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)"
- (save-excursion
- (or bufname (setq bufname " *strokes-xpm*"))
- (set-buffer (get-buffer-create bufname))
+ (or bufname (setq bufname " *strokes-xpm*"))
+ (with-current-buffer (get-buffer-create bufname)
(erase-buffer)
(insert compressed-string)
(goto-char (point-min))
;; strokes-decode-buffer does a save-excursion.
(forward-char)))
-(defun strokes-unload-hook ()
+(defun strokes-unload-function ()
+ "Unload the Strokes library."
(strokes-mode -1)
- (remove-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes))
-
-(add-hook 'strokes-unload-hook 'strokes-unload-hook)
+ ;; continue standard unloading
+ nil)
(run-hooks 'strokes-load-hook)
(provide 'strokes)
-;;; arch-tag: 8377f60e-43fb-467a-bbcd-2774f91f833e
;;; strokes.el ends here
HCoop / bpt / emacs.git / blobdiff