;;; artist.el --- draw ascii graphics with your mouse
;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Tomas Abrahamsson <tab@lysator.liu.se>
;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se>
;; Release-date: 6-Aug-2004
;; Location: http://www.lysator.liu.se/~tab/artist/
+;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
+;; file on 19/3/2008, and the maintainer agreed that when a bug is filed in
+;; the Emacs bug reporting system against this file, a copy of the bug
+;; report be sent to the maintainer's email address.
+
;; 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 3, 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:
;; If you add a new drawing mode, send it to me, and I would gladly
;; include in the next release!
-
;;; Installation:
;; To use artist, put this in your .emacs:
(defvar x-pointer-crosshair)
-(eval-and-compile
- (condition-case ()
- (require 'custom)
- (error nil))
- (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args)
- nil)
- (defmacro defface (var values doc &rest args)
- `(make-face ,var))
- (defmacro defcustom (var value doc &rest args)
- `(defvar ,var ,value ,doc))))
-
;; User options
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
(defcustom artist-aspect-ratio 1
"Defines the character height-to-width aspect ratio.
-This is used when drawing squares and circles. If the height of the"
+This is used when drawing squares and circles."
:group 'artist
:type 'number)
\\/ /
A----*----/\\/----------B
/ /\\
- (in fact, only the left part (between the A and the leftmost ``/''
- crossing the line) will be vaporized)"
+ (in fact, only the left part [between the A and the leftmost ``/''
+ crossing the line] will be vaporized)."
:group 'artist
:type 'integer)
;; package shows lists of characters as a lists of integers,
;; which is confusing
"*Characters (``color'') to use when spraying.
-They should be ordered
-from the ``lightest'' to the ``heaviest'' since spraying replaces a
-light character with the next heavier one.")
+They should be ordered from the ``lightest'' to the ``heaviest''
+since spraying replaces a light character with the next heavier one.")
(defvar artist-spray-new-char ?.
"*Initial character to use when spraying.
-This character is used if spraying upon a character that is
-not in `artist-spray-chars'. The character defined by this variable
-should be in `artist-spray-chars', or spraying will behave
-strangely.")
+This character is used if spraying upon a character that is not in
+`artist-spray-chars'. The character defined by this variable should
+be in `artist-spray-chars', or spraying will behave strangely.")
;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
(make-variable-buffer-local 'artist-mode)
(defvar artist-mode-name " Artist"
- "Name of artist mode beginning with a space (appears in the mode-line).")
+ "Name of Artist mode beginning with a space (appears in the mode-line).")
(defvar artist-curr-go 'pen-char
"Current selected graphics operation.")
* OP is an atom: the KEY-SYMBOL in the `artist-mt' structure
* PREV-OP and NEXT-OP are strings: the KEYWORD in the `artist-mt' structure
-This variable is initialized by the artist-make-prev-next-op-alist function.")
+This variable is initialized by the `artist-make-prev-next-op-alist' function.")
(eval-when-compile
;; Make rect available at compile-time
2
artist-draw-rect
(artist-undraw-rect
- artist-t artist-cut-rect)
+ artist-t artist-cut-rect))
("cut square" cut-s "cut-s"
artist-no-arrows nil
nil nil nil
2
artist-draw-square
(artist-undraw-square
- artist-t artist-cut-square))))))
+ artist-t artist-cut-square)))))
(graphics-operation
("Copy" (("copy rectangle" copy-r "copy-r"
2
artist-draw-rect
(artist-undraw-rect
- artist-t artist-copy-rect)
+ artist-t artist-copy-rect))
("copy square" copy-s "copy-s"
artist-no-arrows nil
nil nil nil
2
artist-draw-square
(artist-undraw-square
- artist-t artist-copy-square))))))
+ artist-t artist-copy-square)))))
(graphics-operation
("Paste" (("paste" paste "paste"
"Master Table for `artist-mode'.
This table is primarily a table over the different graphics operations
-available in artist mode, but it also holds layout information for the
+available in Artist mode, but it also holds layout information for the
popup menu.
The master table is a list of table elements. The elements of this table
can have arrows. The function is called with no arguments and
must return nil or t.
ARROW-SET-FN is a function that is called to set arrow end-points.
- Arguments and return values for this funcion are described below.
+ Arguments and return values for this function are described below.
INIT-FN is, if non-nil, a function that is called when the first
point of the shape is set. Arguments and return values for
- this funcion are described below.
+ this function are described below.
PREP-FILL-FN is, if non-nil, a function that is called after
the last point is set, but before the filling is done.
- Arguments and return values for this funcion are described below.
+ Arguments and return values for this function are described below.
EXIT-FN is, if non-nil, a function that is called after filling
- is done. Arguments and return values for this funcion are
+ is done. Arguments and return values for this function are
described below.
DRAW-HOW defines the kind of shape. The kinds of shapes are:
- `artist-do-continously' -- Do drawing operation continously,
+ `artist-do-continously' -- Do drawing operation continuously,
as long as the mouse button is held down.
`artist-do-poly' -- Do drawing operation many times.
1 -- Do drawing operation only once.
2 -- The drawing operation requires two points.
DRAW-FN is the function to call for drawing. Arguments and
- return values for this funcion are described below.
+ return values for this function are described below.
EXTRA-DRAW-INFO the layout of this depends on the value of DRAW-HOW:
If DRAW-HOW is `artist-do-continously':
(UNDRAW-FN FILL-PRED FILL-FN)
UNDRAW-FN is a function to call for undrawing the shape.
- Arguments and return values for this funcion are
+ Arguments and return values for this function are
described below.
FILL-PRED is a function that is called to find out if the shape
can have arrows. The function must take no arguments and
return nil or t.
FILL-FN is a function to call for filling the shape.
- Arguments and return values for this funcion are
+ Arguments and return values for this function are
described below.
If DRAW-HOW is 1:
()
-Note! All symbols and keywords (both in the `funcion-call' INFO-PART
+Note! All symbols and keywords (both in the `function-call' INFO-PART
as well as in the `graphics-operation' INFO-PART) must be unique.
The following table describe function arguments and return value
ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
`artist-make-endpoint'
- SHAPE is an opaque structure, created by the DRAW-FN and intented
+ SHAPE is an opaque structure, created by the DRAW-FN and intended
to be used only by the UNDRAW-FN.
If DRAW-HOW is `artist-do-poly':
ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
`artist-make-endpoint'.
- SHAPE is an opaque structure, created by the DRAW-FN and intented
+ SHAPE is an opaque structure, created by the DRAW-FN and intended
to be used only by the UNDRAW-FN.
POINT-LIST is a list of vectors [X Y].")
;;;###autoload
(defun artist-mode (&optional state)
- "Toggle artist mode. With arg, turn artist mode on if arg is positive.
-Artist lets you draw lines, squares, rectangles and poly-lines, ellipses
-and circles with your mouse and/or keyboard.
+ "Toggle Artist mode.
+With argument STATE, turn Artist mode on if STATE is positive.
+Artist lets you draw lines, squares, rectangles and poly-lines,
+ellipses and circles with your mouse and/or keyboard.
-How to quit artist mode
+How to quit Artist mode
Type \\[artist-mode-off] to quit artist-mode.
* Straight lines can only go horizontally, vertically
or diagonally.
- * Poly-lines are drawn while holding mouse-1 down. When you
- release the button, the point is set. If you want a segment
+ * Poly-lines are drawn while holding mouse-1 down. When you
+ release the button, the point is set. If you want a segment
to be straight, hold down shift before pressing the
- mouse-1 button. Click mouse-2 or mouse-3 to stop drawing
+ mouse-1 button. Click mouse-2 or mouse-3 to stop drawing
poly-lines.
* See thru for text means that text already in the buffer
overwrite means the opposite.
* Vaporizing connected lines only vaporizes lines whose
- _endpoints_ are connected. See also the variable
+ _endpoints_ are connected. See also the variable
`artist-vaporize-fuzziness'.
* Cut copies, then clears the rectangle/square.
Trimming Toggles trimming of line-endings (that is: when the shape
is drawn, extraneous white-space at end of lines is removed)
- Borders Toggles the drawing of line borders around filled shapes.
+ Borders Toggles the drawing of line borders around filled shapes
Drawing with keys
Move around with \\[artist-next-line], \\[artist-previous-line], \\[artist-forward-char] and \\[artist-backward-char].
- \\[artist-select-fill-char] Sets the charater to use when filling
- \\[artist-select-line-char] Sets the charater to use when drawing
- \\[artist-select-erase-char] Sets the charater to use when erasing
+ \\[artist-select-fill-char] Sets the character to use when filling
+ \\[artist-select-line-char] Sets the character to use when drawing
+ \\[artist-select-erase-char] Sets the character to use when erasing
\\[artist-toggle-rubber-banding] Toggles rubber-banding
\\[artist-toggle-trim-line-endings] Toggles trimming of line-endings
\\[artist-toggle-borderless-shapes] Toggles borders on drawn shapes
;; Init and exit
(defun artist-mode-init ()
"Init Artist mode. This will call the hook `artist-mode-init-hook'."
+ ;; Set up a conversion table for mapping tabs and new-lines to spaces.
+ ;; the last case, 0, is for the last position in buffer/region, where
+ ;; the `following-char' function returns 0.
(let ((i 0))
(while (< i 256)
(aset artist-replacement-table i i)
(aset artist-replacement-table ?\n ?\s)
(aset artist-replacement-table ?\t ?\s)
(aset artist-replacement-table 0 ?\s)
+ ;; More setup
(make-local-variable 'artist-key-is-drawing)
(make-local-variable 'artist-key-endpoint1)
(make-local-variable 'artist-key-poly-point-list)
(sit-for 0))
(defun artist-mode-line-show-curr-operation (is-drawing)
- "Show current operation in mode-line. If IS-DRAWING, show that."
+ "Show current operation in mode-line. If IS-DRAWING, show that."
(let ((mtext (concat artist-mode-name "/"
(artist-go-get-mode-line-from-symbol artist-curr-go)
(if is-drawing "/*" ""))))
;
(defun artist-compute-popup-menu-table (menu-table)
- "Create a menu from from MENU-TABLE data.
+ "Create a menu from MENU-TABLE data.
The returned value is suitable for the `x-popup-menu' function."
(cons "Artist menu"
(artist-compute-popup-menu-table-sub menu-table)))
(defun artist-go-get-symbol-shift (symbol is-shifted)
"Search for (shifted or unshifted) graphics operation SYMBOL.
If IS-SHIFTED is non-nil, return the shifted symbol,
-otherwise the shifted symbol."
+otherwise the unshifted symbol."
(artist-go-get-symbol-shift-sub artist-mt symbol is-shifted))
(defun artist-go-get-symbol-shift-sub (table symbol is-shifted)
"Search TABLE for (shifted or unshifted) graphics SYMBOL.
If IS-SHIFTED is non-nil, return the shifted symbol,
-otherwise the shifted symbol."
+otherwise the unshifted symbol."
(catch 'found
(mapc
(lambda (element)
(defun artist-clear-buffer (buf)
"Clear contents of buffer BUF."
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(goto-char (point-min))
(delete-char (- (point-max) (point-min)) nil)))
Return a list (RETURN-CODE STDOUT STDERR)."
(save-excursion
(let* ((tmp-stdin-file-name (if stdin
- (make-temp-file
- (concat (file-name-as-directory
- (or (getenv "TMPDIR") "/tmp"))
- "artist-stdin."))
+ (make-temp-file "artist-stdin.")
nil))
(tmp-stdout-buffer (get-buffer-create
(concat "*artist-" program "*")))
- (tmp-stderr-file-name (make-temp-file
- (concat (file-name-as-directory
- (or (getenv "TMPDIR") "/tmp"))
- "artist-stdout.")))
+ (tmp-stderr-file-name (make-temp-file "artist-stdout."))
(binary-process-input nil) ; for msdos
(binary-process-output nil))
;; the return value
(list res
- (save-excursion
- (set-buffer tmp-stdout-buffer)
- (copy-sequence (buffer-substring (point-min)
- (point-max))))
+ (with-current-buffer tmp-stdout-buffer
+ (buffer-substring (point-min) (point-max)))
(artist-file-to-string tmp-stderr-file-name)))
;; Unwind: remove temporary files and buffers
(following-char))
+(defsubst artist-get-replacement-char (c)
+ "Retrieve a replacement for character C from `artist-replacement-table'.
+The replacement is used to convert tabs and new-lines to spaces."
+ ;; Characters may be outside the range of the `artist-replacement-table',
+ ;; for example if they are unicode code points >= 256.
+ ;; Check so we don't attempt to access the array out of its bounds,
+ ;; assuming no such character needs to be replaced.
+ (if (< c (length artist-replacement-table))
+ (aref artist-replacement-table c)
+ c))
+
(defun artist-get-char-at-xy-conv (x y)
"Retrieve the character at X, Y, converting tabs and new-lines to spaces."
(save-excursion
- (aref artist-replacement-table (artist-get-char-at-xy x y))))
+ (artist-get-replacement-char (artist-get-char-at-xy x y))))
(defun artist-replace-char (new-char)
(artist-move-to-xy (1+ (artist-current-column))
(artist-current-line))
(delete-char -1)
- (insert (aref artist-replacement-table new-char)))
+ (insert (artist-get-replacement-char new-char)))
;; In emacs-19, the self-insert-command works better and faster
(let ((overwrite-mode 'overwrite-mode-textual)
(fill-column 32765) ; Large :-)
(blink-matching-paren nil))
- (setq last-command-event (aref artist-replacement-table new-char))
+ (setq last-command-event (artist-get-replacement-char new-char))
(self-insert-command 1))))
(defun artist-replace-chars (new-char count)
;; The self-insert-command doesn't care about the overwrite-mode,
;; so the insertion is done in the same way as in picture mode.
;; This seems to be a little bit slower.
- (let* ((replaced-c (aref artist-replacement-table new-char))
+ (let* ((replaced-c (artist-get-replacement-char new-char))
(replaced-s (make-string count replaced-c)))
(artist-move-to-xy (+ (artist-current-column) count)
(artist-current-line))
(let ((overwrite-mode 'overwrite-mode-textual)
(fill-column 32765) ; Large :-)
(blink-matching-paren nil))
- (setq last-command-event (aref artist-replacement-table new-char))
+ (setq last-command-event (artist-get-replacement-char new-char))
(self-insert-command count))))
(defsubst artist-replace-string (string &optional see-thru)
"Replace contents at point with STRING.
-With optional argument SEE-THRU, set to non-nil, text in the buffer
+With optional argument SEE-THRU set to non-nil, text in the buffer
``shines thru'' blanks in the STRING."
(let ((char-list (append string nil)) ; convert the string to a list
(overwrite-mode 'overwrite-mode-textual)
(blink-matching-paren nil))
(while char-list
(let ((c (car char-list)))
- (if (and see-thru (= (aref artist-replacement-table c) ?\s))
+ (if (and see-thru (= (artist-get-replacement-char c) ?\s))
(artist-move-to-xy (1+ (artist-current-column))
(artist-current-line))
(artist-replace-char c)))
;; Some inline funtions for creating, setting and reading
;; members of a coordinate
;;
+
(defsubst artist-new-coord (x y &optional new-char)
"Create a new coordinate at X,Y for use in a line.
Optional argument NEW-CHAR can be used for setting the new-char component
;;
(defun artist-draw-line (x1 y1 x2 y2)
- "Draws a line from X1, Y1 to X2, Y2.
+ "Draw a line from X1, Y1 to X2, Y2.
Output is a line, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
(artist-eight-point x1 y1 x2 y2))))))))
(defun artist-undraw-line (line)
- "Undraws LINE."
+ "Undraw LINE."
(mapcar
(lambda (coord)
(artist-move-to-xy (artist-coord-get-x coord)
;;
(defun artist-draw-sline (x1 y1 x2 y2)
- "Draw a strait line from X1, Y1 to X2, Y2.
+ "Draw a straight line from X1, Y1 to X2, Y2.
Straight lines are vertical, horizontal or diagonal lines.
They are faster to draw and most often they are what you need
when drawing a simple image.
;;
(defun artist-draw-rect (x1 y1 x2 y2)
- "Draws a rectangle with corners at X1, Y1 and X2, Y2.
+ "Draw a rectangle with corners at X1, Y1 and X2, Y2.
Output is a rectangle, which is a list on the form
\(END-POINT-1 END-POINT-2 SHAPE-INFO).
(list line1 line2 line3 line4))))
(defun artist-undraw-rect (rectangle)
- "Undraws RECTANGLE."
+ "Undraw RECTANGLE."
(if rectangle
(let ((shape-info (artist-2point-get-shapeinfo rectangle)))
(artist-undraw-sline (elt shape-info 3))
(defun artist-rect-corners-squarify (x1 y1 x2 y2)
"Compute square corners from rectangle corners at X1, Y1 and X2, Y2.
-The square's first corner will be X1, Y1. The position of the second corner
-depends on which of X2 and Y2 is most far away from X1, Y1."
+The square's first corner will be X1, Y1. The position of the second
+corner depends on which of X2 and Y2 is most far away from X1, Y1."
(let* ((delta-x (- x2 x1))
(delta-y (- y2 y1))
(delta-x-sign (if (< delta-x 0) -1 1))
(list line1 line2 line3 line4))))
(defun artist-undraw-square (square)
- "Undraws SQUARE."
+ "Undraw SQUARE."
(if square
(let ((shape-info (artist-2point-get-shapeinfo square)))
(artist-undraw-sline (elt shape-info 3))
(setq y (1+ y))))))
(defun artist-fill-square (square x1 y1 x2 y2)
- "Fills a SQUARE from X1,Y1 to X2,Y2."
+ "Fill a SQUARE from X1,Y1 to X2,Y2."
(let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
(new-x1 (elt square-corners 0))
(new-y1 (elt square-corners 1))
;;
(defun artist-pen (x1 y1)
- "Draws a character at X1, Y1.
+ "Draw a character at X1, Y1.
The character is replaced with the character in `artist-fill-char'."
(artist-move-to-xy x1 y1)
(artist-replace-char (if artist-line-char-set
(defun artist-pen-line (x1 y1)
- "Draws a line from last pen position to X1, Y1.
+ "Draw a line from last pen position to X1, Y1.
The character is replaced with the character in `artist-fill-char'.
This will store all points in `artist-key-poly-point-list' in reversed
order (I assume it is faster to cons to the beginning of the list than
(defun artist-text-insert-common (x y text see-thru)
"At position X, Y, insert text TEXT.
-If SEE-THRU is non-nil, then blanks in TEXT does not replace text
+If SEE-THRU is non-nil, then blanks in TEXT do not replace text
in the buffer."
(let* ((string-list (artist-string-split text "\n"))
(i 0)
`artist-text-renderer-function', which must return a list of strings,
to be inserted in the buffer.
-Blanks in the rendered text overwrites any text in the buffer."
+Blanks in the rendered text overwrite any text in the buffer."
(let* ((input-text (read-string "Type text to render: "))
(rendered-text (artist-funcall artist-text-renderer-function input-text)))
(artist-text-insert-overwrite x y rendered-text)))
;;
(defun artist-spray-get-interval ()
- "Retrieves the interval for repeated spray."
+ "Retrieve the interval for repeated spray."
artist-spray-interval)
(defun artist-spray-random-points (n radius)
(setq spray-points (cdr spray-points)))))
(defun artist-spray-clear-circle (circle x1 y1 x2 y2)
- "Clears circle CIRCLE at X1, Y1 through X2, Y2."
+ "Clear circle CIRCLE at X1, Y1 through X2, Y2."
(artist-undraw-circle circle))
(defun artist-spray-set-radius (circle x1 y1 x2 y2)
;;
(defun artist-erase-char (x1 y1)
- "Erases a character at X1, Y1.
+ "Erase a character at X1, Y1.
The character is replaced with the character in `artist-erase-char'."
(artist-move-to-xy x1 y1)
(artist-replace-char artist-erase-char))
(defun artist-vaporize-line (x1 y1)
"Vaporize (erase) the straight line through X1, Y1.
Do this by replacing the characters that forms the line with
-`artist-erase-char'. Output is a list of endpoints for lines
-through X1, Y1. An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
+`artist-erase-char'. Output is a list of endpoints for lines through
+X1, Y1. An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
(let ((endpoints (artist-vap-find-endpoints x1 y1)))
(mapc
(lambda (endpoints)
(defun artist-ellipse-generate-quadrant (x-radius y-radius)
"Create a point-list for first quadrant.
Points go from (X-RADIUS, 0) to (0, Y-RADIUS).
-Quadrant is generated around origo."
+Quadrant is generated around origin."
(let* ((rx2 (* x-radius x-radius))
(ry2 (* y-radius y-radius))
(2rx2 (* 2 rx2))
(artist-copy-generic x1 y1 x2 y2))
(defun artist-copy-square (square x1 y1 x2 y2)
- "Copies a SQUARE drawn from X1, Y1 to X2, Y2 (but made square)."
+ "Copy a SQUARE drawn from X1, Y1 to X2, Y2 (but made square)."
(artist-undraw-square square)
(let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
(new-x1 (elt square-corners 0))
(artist-copy-generic new-x1 new-y1 new-x2 new-y2)))
(defun artist-paste (x y)
- "Pastes the contents of the copy-buffer at X,Y."
+ "Paste the contents of the copy-buffer at X,Y."
(let ((copy-buf (if artist-interface-with-rect
killed-rectangle
artist-copy-buffer)))
(>= y last-line)))))
(defun artist-flood-fill (x1 y1)
- "Flood-fill starting at X1, Y1. Fill with the char in `artist-fill-char'."
+ "Flood-fill starting at X1, Y1. Fill with the char in `artist-fill-char'."
(let ((stack nil)
(input-queue nil)
;; We are flood-filling the area that has this character.
;;
(defun artist-key-undraw-continously (x y)
- "Undraw current continous shape with point at X, Y."
- ;; No undraw-info for continous shapes
+ "Undraw current continuous shape with point at X, Y."
+ ;; No undraw-info for continuous shapes
nil)
(defun artist-key-undraw-poly (x y)
;; user has released the button, so the timer will always be cancelled
;; at that point.
(defun artist-key-draw-continously (x y)
- "Draws current continous shape at X,Y."
+ "Draw current continuous shape at X,Y."
(let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
(setq artist-key-shape (artist-funcall draw-fn x y))))
(defun artist-key-draw-poly (x y)
- "Draws current poly-point shape with nth point at X,Y."
+ "Draw current poly-point shape with nth point at X,Y."
(let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
(x1 (artist-endpoint-get-x artist-key-endpoint1))
(y1 (artist-endpoint-get-y artist-key-endpoint1)))
(setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
(defun artist-key-draw-1point (x y)
- "Draws current 1-point shape at X,Y."
+ "Draw current 1-point shape at X,Y."
(let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
(setq artist-key-shape (artist-funcall draw-fn x y))))
(defun artist-key-draw-2points (x y)
- "Draws current 2-point shape at X,Y."
+ "Draw current 2-point shape at X,Y."
(let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
(x1 (artist-endpoint-get-x artist-key-endpoint1))
(y1 (artist-endpoint-get-y artist-key-endpoint1)))
;;
(defun artist-key-do-continously-continously (x y)
- "Update current continous shape at X,Y."
+ "Update current continuous shape at X,Y."
(let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
(artist-funcall draw-fn x y)))
(defun artist-key-do-continously-1point (x y)
"Update current 1-point shape at X,Y."
- ;; Nothing to do continously for operations
+ ;; Nothing to do continuously for operations
;; where we have only one input point
nil)
(defun artist-key-set-point-continously (x y)
- "Set point for current continous shape at X,Y."
- ;; Maybe set arrow-points for continous shapes
+ "Set point for current continuous shape at X,Y."
+ ;; Maybe set arrow-points for continuous shapes
(let ((arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
(arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go))
(init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
;;
(defun artist-previous-line (&optional n)
- "Move cursor up optional N lines (default is 1), updating current shape.
+ "Move cursor up N lines (default is 1), updating current shape.
If N is negative, move cursor down."
(interactive "p")
(let ((col (artist-current-column)))
(defun artist-next-line (&optional n)
- "Move cursor down optional N lines (default is 1), updating current shape.
+ "Move cursor down N lines (default is 1), updating current shape.
If N is negative, move cursor up."
(interactive "p")
(let ((col (artist-current-column)))
(artist-key-do-continously-common)))
(defun artist-backward-char (&optional n)
- "Move cursor backward optional N chars (default is 1), updating curr shape.
+ "Move cursor backward N chars (default is 1), updating current shape.
If N is negative, move forward."
(interactive "p")
(if (> n 0)
(artist-forward-char n)))
(defun artist-forward-char (&optional n)
- "Move cursor forward optional N chars (default is 1), updating curr shape.
+ "Move cursor forward N chars (default is 1), updating current shape.
If N is negative, move backward."
(interactive "p")
(let* ((step-x (if (>= n 0) 1 -1))
(defun artist-charlist-to-string (char-list)
"Convert a list of characters, CHAR-LIST, to a string."
- (let ((result ""))
- (while (not (null char-list))
- (setq result (concat result (char-to-string (car char-list))))
- (setq char-list (cdr char-list)))
- result))
+ (concat char-list))
(defun artist-string-to-charlist (str)
"Convert a string, STR, to list of characters."
"Perform the update of the X Windows pointer shape."
(set-mouse-color nil))
+(defvar x-pointer-shape)
+
(defun artist-set-pointer-shape (new-pointer-shape)
"Set the shape of the X Windows pointer to NEW-POINTER-SHAPE."
(setq x-pointer-shape new-pointer-shape)
"Function that does nothing."
(interactive))
+(defun artist-compute-up-event-key (ev)
+ "Compute the corresponding up key sequence for event EV."
+ (let* ((basic (event-basic-type ev))
+ (unshifted basic)
+ (shifted (make-symbol (concat "S-" (symbol-name basic)))))
+ (if (artist-event-is-shifted ev)
+ (make-vector 1 shifted)
+ (make-vector 1 unshifted))))
+
(defun artist-down-mouse-1 (ev)
"Perform drawing action for event EV."
(interactive "@e")
(orig-draw-region-min-y artist-draw-region-min-y)
(orig-draw-region-max-y artist-draw-region-max-y)
(orig-pointer-shape (if (eq window-system 'x) x-pointer-shape nil))
- (echo-keystrokes 10000) ; a lot of seconds
+ (echoq-keystrokes 10000) ; a lot of seconds
;; Remember original binding for the button-up event to this
;; button-down event.
- (key (let* ((basic (event-basic-type ev))
- (unshifted basic)
- (shifted (make-symbol (concat "S-" (symbol-name basic)))))
- (if (artist-event-is-shifted ev)
- (make-vector 1 shifted)
- (make-vector 1 unshifted))))
+ (key (artist-compute-up-event-key ev))
(orig-button-up-binding (lookup-key (current-global-map) key)))
(unwind-protect
(progn
(select-window (posn-window (event-start last-input-event)))
(list last-input-event
- (x-popup-menu last-nonmenu-event artist-popup-menu-table))))
+ (if (display-popup-menus-p)
+ (x-popup-menu last-nonmenu-event artist-popup-menu-table)
+ 'no-popup-menus))))
+
+ (if (eq op 'no-popup-menus)
+ ;; No popup menus. Call `tmm-prompt' instead, but with the
+ ;; up-mouse-button, if any, temporarily disabled, otherwise
+ ;; it'll interfere.
+ (let* ((key (artist-compute-up-event-key ev))
+ (orig-button-up-binding (lookup-key (current-global-map) key)))
+ (unwind-protect
+ (define-key (current-global-map) key 'artist-do-nothing)
+ (setq op (tmm-prompt artist-popup-menu-table))
+ (if orig-button-up-binding
+ (define-key (current-global-map) key orig-button-up-binding)))))
(let ((draw-fn (artist-go-get-draw-fn-from-symbol (car op)))
(set-fn (artist-fc-get-fn-from-symbol (car op))))
(defun artist-mouse-draw-continously (ev)
- "Generic function for shapes that requires 1 point as input.
-Operation is done continously while the mouse button is hold down.
+ "Generic function for shapes that require 1 point as input.
+Operation is done continuously while the mouse button is hold down.
The event, EV, is the mouse event."
(let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
(shifted (artist-go-get-symbol-shift artist-curr-go t))
;; 1. If your new drawing mode falls into one of the following
;; categories, goto point 2, otherwise goto point 3.
;;
-;; - Modes where the shapes are drawn continously, as long as
-;; the mouse button is held down (continous modes).
+;; - Modes where the shapes are drawn continuously, as long as
+;; the mouse button is held down (continuous modes).
;; Example: the erase-char mode, the pen and pen-line modes.
;;
;; - Modes where the shape is made up of from 2 points to an
;; Example: lines, rectangles
;;
;; - Modes where the shape is made up of 1 point (1-point
-;; modes). This mode differs from the continous modes in
+;; modes). This mode differs from the continuous modes in
;; that the shape is drawn only once when the mouse button
;; is pressed.
;; Examples: paste, a flood-fill, vaporize modes
;; For each of the cases below, the arguments given to the init-fn,
;; prep-fill-fn, arrow-set-fn and exit-fn are stated.
;;
-;; If your mode matches the continous mode or the 1-point mode:
+;; If your mode matches the continuous mode or the 1-point mode:
;;
;; a. Create a draw-function that draws your shape. Your function
;; must take x and y as arguments. The return value is not
;; See `artist-draw-rect' for an example.
;;
;; You must call the init-fn, the prep-fill-fn, arrow-set-fn
-;; and the exit-fn at the apropriate points.
+;; and the exit-fn at the appropriate points.
;;
;; When artist-mouse-draw-xxx ends, the shape for your mode
;; must be completely drawn.
;; - artist-key-set-point-xxx for setting a point in the
;; mode, to be called from `artist-key-set-point-common'.
;;
-;; - artist-key-do-continously-xxx to be called from
-;; `artist-key-do-continously-common' whenever the user
+;; - artist-key-do-continuously-xxx to be called from
+;; `artist-key-do-continuously-common' whenever the user
;; moves around.
;;
;; As for the artist-mouse-draw-xxx, these two functions must
;; work.
;;
;; You must call the init-fn, the prep-fill-fn, arrow-set-fn
-;; and the exit-fn at the apropriate points.
+;; and the exit-fn at the appropriate points.
;;
;; e. Add your new mode to the master table, `artist-mt'.
;;
;; Don't hesitate to ask me any questions.
-;;; arch-tag: 3e63b881-aaaa-4b83-a072-220d4661a8a3
+;; arch-tag: 3e63b881-aaaa-4b83-a072-220d4661a8a3
;;; artist.el ends here
HCoop / bpt / emacs.git / blobdiff