;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
-;; Copyright (C) 1985, 1994, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2011 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; 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 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:
(defgroup picture nil
"Picture mode --- editing using quarter-plane screen model."
:prefix "picture-"
- :group 'editing)
+ :group 'wp)
(defcustom picture-rectangle-ctl ?+
- "*Character `picture-draw-rectangle' uses for top left corners."
+ "Character `picture-draw-rectangle' uses for top left corners."
:type 'character
:group 'picture)
(defcustom picture-rectangle-ctr ?+
- "*Character `picture-draw-rectangle' uses for top right corners."
+ "Character `picture-draw-rectangle' uses for top right corners."
:type 'character
:group 'picture)
(defcustom picture-rectangle-cbr ?+
- "*Character `picture-draw-rectangle' uses for bottom right corners."
+ "Character `picture-draw-rectangle' uses for bottom right corners."
:type 'character
:group 'picture)
(defcustom picture-rectangle-cbl ?+
- "*Character `picture-draw-rectangle' uses for bottom left corners."
+ "Character `picture-draw-rectangle' uses for bottom left corners."
:type 'character
:group 'picture)
(defcustom picture-rectangle-v ?|
- "*Character `picture-draw-rectangle' uses for vertical lines."
+ "Character `picture-draw-rectangle' uses for vertical lines."
:type 'character
:group 'picture)
(defcustom picture-rectangle-h ?-
- "*Character `picture-draw-rectangle' uses for horizontal lines."
+ "Character `picture-draw-rectangle' uses for horizontal lines."
:type 'character
:group 'picture)
(picture-motion (- arg)))
(defun picture-mouse-set-point (event)
- "Move point to the position clicked on, making whitespace if necessary."
+ "Move point to the position of EVENT, making whitespace if necessary."
(interactive "e")
- (let* ((pos (posn-col-row (event-start event)))
- (x (car pos))
- (y (cdr pos))
- (current-row (count-lines (window-start) (line-beginning-position))))
- (unless (equal x (current-column))
- (picture-forward-column (- x (current-column))))
- (unless (equal y current-row)
- (picture-move-down (- y current-row)))))
+ (let ((position (event-start event)))
+ (unless (posn-area position) ; Ignore EVENT unless in text area
+ (let* ((window (posn-window position))
+ (frame (if (framep window) window (window-frame window)))
+ (pair (posn-x-y position))
+ (start-pos (window-start window))
+ (start-pair (posn-x-y (posn-at-point start-pos)))
+ (dx (- (car pair) (car start-pair)))
+ (dy (- (cdr pair) (cdr start-pair)))
+ (char-ht (frame-char-height frame))
+ (spacing (when (display-graphic-p frame)
+ (or (with-current-buffer (window-buffer window)
+ line-spacing)
+ (frame-parameter frame 'line-spacing))))
+ rows cols)
+ (cond ((floatp spacing)
+ (setq spacing (truncate (* spacing char-ht))))
+ ((null spacing)
+ (setq spacing 0)))
+ (goto-char start-pos)
+ (picture-move-down (/ dy (+ char-ht spacing)))
+ (picture-forward-column (/ dx (frame-char-width frame)))))))
\f
;; Picture insertion and deletion.
;; Picture Tabs
(defcustom picture-tab-chars "!-~"
- "*A character set which controls behavior of commands.
+ "A character set which controls behavior of commands.
\\[picture-set-tab-stops] and \\[picture-tab-search]. It is NOT a
regular expression, any regexp special characters will be quoted.
It defines a set of \"interesting characters\" to look for when setting
(move-to-column target))
(if (re-search-forward
(concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")
- (save-excursion (end-of-line) (point))
+ (line-end-position)
'move)
(setq target (1- (current-column)))
(setq target nil)))
(left (min c1 c2))
(top (min r1 r2))
(bottom (max r1 r2)))
- (goto-line top)
+ (goto-char (point-min))
+ (forward-line (1- top))
(move-to-column left t)
(picture-update-desired-column t)
(picture-insert picture-rectangle-v (- (picture-current-line) top))
(picture-set-motion pvs phs)
- (goto-line sl)
+ (goto-char (point-min))
+ (forward-line (1- sl))
(move-to-column sc t)))
\f
Insert rectangle from named register: \\[picture-yank-rectangle-from-register]
Draw a rectangular box around mark and point: \\[picture-draw-rectangle]
Copies a rectangle to a register: \\[copy-rectangle-to-register]
- Undo effects of rectangle overlay commands: \\[advertised-undo]
+ Undo effects of rectangle overlay commands: \\[undo]
You can return to the previous mode with \\[picture-mode-exit], which
also strips trailing whitespace from every line. Stripping is suppressed
(provide 'picture)
-;;; arch-tag: e452d08d-a470-4fbf-896e-ea276698d1ca
;;; picture.el ends here