X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b90caf50d04d2c51742054bb6b0e836f6d425203..bd7a1e1564d04d7ea9c7f6587ffcf02ef8975512:/lisp/strokes.el diff --git a/lisp/strokes.el b/lisp/strokes.el index 75278f69d1..2363d333d3 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -1,10 +1,9 @@ ;;; strokes.el --- control Emacs through mouse strokes -;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009 Free Software Foundation, Inc. +;; Copyright (C) 1997, 2000-2015 Free Software Foundation, Inc. ;; Author: David Bakhash -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: lisp, mouse, extensions ;; This file is part of GNU Emacs. @@ -119,8 +118,7 @@ ;; > M-x strokes-prompt-user-save-strokes -;; and it will save your strokes in ~/.strokes, or you may wish to change -;; this by setting the variable `strokes-file'. +;; and it will save your strokes in your `strokes-file'. ;; Note that internally, all of the routines that are part of this ;; package are able to deal with complex strokes, as they are a superset @@ -181,7 +179,7 @@ ;;; Requirements and provisions... (autoload 'mail-position-on-field "sendmail") -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Constants... @@ -204,7 +202,7 @@ static char * stroke_xpm[] = { \"P c #FFFF0000FFFF\", \". c #45458B8B0000\", /* pixels */\n" - "The header to all xpm buffers created by strokes.") + "The header to all XPM buffers created by strokes.") ;;; user variables... @@ -213,14 +211,17 @@ static char * stroke_xpm[] = { :link '(emacs-commentary-link "strokes") :group 'mouse) -(defcustom strokes-modeline-string " Strokes" - "Modeline identification when Strokes mode is on \(default is \" Strokes\"\)." +(define-obsolete-variable-alias 'strokes-modeline-string 'strokes-lighter + "24.3") + +(defcustom strokes-lighter " Strokes" + "Mode line identifier for Strokes mode." :type 'string :group 'strokes) (defcustom strokes-character ?@ "Character used when drawing strokes in the strokes buffer. -\(The default is `@', which works well.\)" +\(The default is `@', which works well.)" :type 'character :group 'strokes) @@ -258,8 +259,9 @@ WARNING: Changing the value of this variable will gravely affect the :type 'integer :group 'strokes) -(defcustom strokes-file (convert-standard-filename "~/.strokes") - "File containing saved strokes for Strokes mode (default is ~/.strokes)." +(defcustom strokes-file (locate-user-emacs-file "strokes" ".strokes") + "File containing saved strokes for Strokes mode." + :version "24.4" ; added locate-user-emacs-file :type 'file :group 'strokes) @@ -282,16 +284,15 @@ This is set properly in the function `strokes-update-window-configuration'.") (defvar strokes-last-stroke nil "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.") +Its value gets set every time the function `strokes-fill-stroke' +gets called, 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.") +normalized stroke grid, with the top left at (0 . 0). COMMAND is +the corresponding interactive function.") (defvar strokes-load-hook nil "Functions to be called when Strokes is loaded.") @@ -347,7 +348,7 @@ corresponding interactive function.") (* x x)) (defsubst strokes-distance-squared (p1 p2) - "Gets the distance (squared) between to points P1 and P2. + "Compute the distance (squared) between to points P1 and P2. P1 and P2 are cons cells in the form (X . Y)." (let ((x1 (car p1)) (y1 (cdr p1)) @@ -432,9 +433,9 @@ or for window START-WINDOW if that is specified." ;;;###autoload (defun strokes-global-set-stroke (stroke command) "Interactively give STROKE the global binding as COMMAND. -Operated just like `global-set-key', except for strokes. -COMMAND is a symbol naming an interactively-callable function. STROKE -is a list of sampled positions on the stroke grid as described in the +Works just like `global-set-key', except for strokes. COMMAND is +a symbol naming an interactively-callable function. STROKE is a +list of sampled positions on the stroke grid as described in the documentation for the `strokes-define-stroke' function. See also `strokes-global-set-stroke-string'." @@ -448,7 +449,7 @@ See also `strokes-global-set-stroke-string'." (defun strokes-global-set-stroke-string (stroke string) "Interactively give STROKE the global binding as STRING. -Operated just like `global-set-key', except for strokes. STRING +Works just like `global-set-key', except for strokes. STRING is a string to be inserted by the stroke. STROKE is a list of sampled positions on the stroke grid as described in the documentation for the `strokes-define-stroke' function. @@ -474,7 +475,7 @@ Compare `strokes-global-set-stroke'." (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. -STROKE-EXTENT as a list \(\(XMIN . YMIN\) \(XMAX . YMAX\)\). +STROKE-EXTENT is 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'. The grid is a square whose dimension is [0,GRID-RESOLUTION)." @@ -541,10 +542,10 @@ The return value is a list ((XMIN . YMIN) (XMAX . YMAX))." (defun strokes-eliminate-consecutive-redundancies (entries) "Return a list with no consecutive redundant entries." ;; defun a grande vitesse grace a Dave G. - (loop for element on entries - if (not (equal (car element) (cadr element))) - collect (car element))) -;; (loop for element on entries + (cl-loop for element on entries + if (not (equal (car element) (cadr element))) + collect (car element))) +;; (cl-loop for element on entries ;; nconc (if (not (equal (car el) (cadr el))) ;; (list (car el))))) ;; yet another (orig) way of doing it... @@ -583,71 +584,73 @@ NOTE: This is where the global variable `strokes-last-stroke' is set." (if (and (strokes-click-p unfilled-stroke) (not force)) unfilled-stroke - (loop for grid-locs on unfilled-stroke - nconc (let* ((current (car grid-locs)) - (current-is-a-point-p (consp current)) - (next (cadr grid-locs)) - (next-is-a-point-p (consp next)) - (both-are-points-p (and current-is-a-point-p - next-is-a-point-p)) - (x1 (and current-is-a-point-p - (car current))) - (y1 (and current-is-a-point-p - (cdr current))) - (x2 (and next-is-a-point-p - (car next))) - (y2 (and next-is-a-point-p - (cdr next))) - (delta-x (and both-are-points-p - (- x2 x1))) - (delta-y (and both-are-points-p - (- y2 y1))) - (slope (and both-are-points-p - (if (zerop delta-x) - nil ; undefined vertical slope - (/ (float delta-y) - delta-x))))) - (cond ((not both-are-points-p) - (list current)) - ((null slope) ; undefined vertical slope - (if (>= delta-y 0) - (loop for y from y1 below y2 - collect (cons x1 y)) - (loop for y from y1 above y2 - collect (cons x1 y)))) - ((zerop slope) ; (= y1 y2) - (if (>= delta-x 0) - (loop for x from x1 below x2 - collect (cons x y1)) - (loop for x from x1 above x2 - collect (cons x y1)))) - ((>= (abs delta-x) (abs delta-y)) - (if (> delta-x 0) - (loop for x from x1 below x2 - collect (cons x - (+ y1 - (round (* slope - (- x x1)))))) - (loop for x from x1 above x2 - collect (cons x - (+ y1 - (round (* slope - (- x x1)))))))) - (t ; (< (abs delta-x) (abs delta-y)) - (if (> delta-y 0) - (loop for y from y1 below y2 - collect (cons (+ x1 - (round (/ (- y y1) - slope))) - y)) - (loop for y from y1 above y2 - collect (cons (+ x1 - (round (/ (- y y1) - slope))) - y)))))))))) + (cl-loop + for grid-locs on unfilled-stroke + nconc (let* ((current (car grid-locs)) + (current-is-a-point-p (consp current)) + (next (cadr grid-locs)) + (next-is-a-point-p (consp next)) + (both-are-points-p (and current-is-a-point-p + next-is-a-point-p)) + (x1 (and current-is-a-point-p + (car current))) + (y1 (and current-is-a-point-p + (cdr current))) + (x2 (and next-is-a-point-p + (car next))) + (y2 (and next-is-a-point-p + (cdr next))) + (delta-x (and both-are-points-p + (- x2 x1))) + (delta-y (and both-are-points-p + (- y2 y1))) + (slope (and both-are-points-p + (if (zerop delta-x) + nil ; undefined vertical slope + (/ (float delta-y) + delta-x))))) + (cond ((not both-are-points-p) + (list current)) + ((null slope) ; undefined vertical slope + (if (>= delta-y 0) + (cl-loop for y from y1 below y2 + collect (cons x1 y)) + (cl-loop for y from y1 above y2 + collect (cons x1 y)))) + ((zerop slope) ; (= y1 y2) + (if (>= delta-x 0) + (cl-loop for x from x1 below x2 + collect (cons x y1)) + (cl-loop for x from x1 above x2 + collect (cons x y1)))) + ((>= (abs delta-x) (abs delta-y)) + (if (> delta-x 0) + (cl-loop for x from x1 below x2 + collect (cons x + (+ y1 + (round (* slope + (- x x1)))))) + (cl-loop for x from x1 above x2 + collect (cons x + (+ y1 + (round (* slope + (- x x1)))))))) + (t ; (< (abs delta-x) (abs delta-y)) + (if (> delta-y 0) + ;; FIXME: Reduce redundancy between branches. + (cl-loop for y from y1 below y2 + collect (cons (+ x1 + (round (/ (- y y1) + slope))) + y)) + (cl-loop for y from y1 above y2 + collect (cons (+ x1 + (round (/ (- y y1) + slope))) + y)))))))))) (defun strokes-rate-stroke (stroke1 stroke2) - "Rates STROKE1 with STROKE2 and return a score based on a distance metric. + "Rate STROKE1 with STROKE2 and return a score based on a distance metric. Note: the rating is an error rating, and therefore, a return of 0 represents a perfect match. Also note that the order of stroke arguments is order-independent for the algorithm used here." @@ -719,6 +722,14 @@ Returns the corresponding match as (COMMAND . SCORE)." nil)) nil)) +(defsubst strokes-fill-current-buffer-with-whitespace () + "Erase the contents of the current buffer and fill it with whitespace." + (erase-buffer) + (cl-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. @@ -736,6 +747,11 @@ Optional EVENT is acceptable as the starting event of the stroke." ;; 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 "%s" prompt) (setq event (read-event)) @@ -840,6 +856,9 @@ Optional EVENT is acceptable as the starting event of the stroke." The command will be executed provided one exists for that stroke, based on the variable `strokes-minimum-match-score'. If no stroke matches, nothing is done and return value is nil." + ;; FIXME: Undocument return value. It is not documented for all cases, + ;; and doesn't allow to difference between no stroke matches and + ;; command-execute returning nil, anyway. (let* ((match (strokes-match-stroke stroke strokes-global-map)) (command (car match)) (score (cdr match))) @@ -917,14 +936,7 @@ and then safely save them for later use, send letters to friends extracting the strokes for editing use once again, so the editing cycle can continue. -Strokes are easy to program and fun to use. To start strokes going, -you'll want to put the following line in your .emacs file as mentioned -in the commentary to strokes.el. - -This will load strokes when and only when you start Emacs on a window -system, with a mouse or other pointer device defined. - -To toggle strokes-mode, you just do +To toggle strokes-mode, invoke the command > M-x strokes-mode @@ -959,8 +971,8 @@ and you can enter in any arbitrary stroke. Remember: The strokes package lets you program in simple and complex (multi-lift) strokes. The only difference is how you *invoke* the two. You will most likely use simple strokes, as complex strokes were developed for -Chinese/Japanese/Korean. So the shifted middle mouse button (S-mouse-2) will -invoke the command `strokes-do-stroke'. +Chinese/Japanese/Korean. So the shifted middle mouse button (S-mouse-2) +will invoke the command `strokes-do-stroke'. If ever you define a stroke which you don't like, then you can unset it with the command @@ -981,11 +993,10 @@ down, then use a prefix argument: > C-u M-x strokes-list-strokes -Your strokes are stored as you enter them. They get saved in a file -called ~/.strokes, along with other strokes configuration variables. -You can change this location by setting the variable `strokes-file'. -You will be prompted to save them when you exit Emacs, or you can save -them with +Your strokes are stored as you enter them. They get saved into the +file specified by the `strokes-file' variable, along with other strokes +configuration variables. You will be prompted to save them when you +exit Emacs, or you can save them with > M-x strokes-prompt-user-save-strokes @@ -1030,15 +1041,7 @@ o Strokes are a bit computer-dependent in that they depend somewhat on (help-mode) (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. @@ -1055,19 +1058,18 @@ This is based on the last time `strokes-window-configuration' was updated." ;; 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) @@ -1092,7 +1094,7 @@ This is based on the last time `strokes-window-configuration' was updated." (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")))) @@ -1107,7 +1109,7 @@ This is based on the last time `strokes-window-configuration' was updated." (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 @@ -1147,7 +1149,7 @@ Returns value of `strokes-use-strokes-buffer'." (not strokes-use-strokes-buffer)))) (defun strokes-xpm-for-stroke (&optional stroke bufname b/w-only) - "Create an XPM pixmap for the given STROKE in buffer ` *strokes-xpm*'. + "Create an XPM pixmap for the given STROKE in buffer \" *strokes-xpm*\". If STROKE is not supplied, then `strokes-last-stroke' will be used. Optional BUFNAME to name something else. The pixmap will contain time information via rainbow dot colors @@ -1168,41 +1170,41 @@ the stroke as a character in some language." (set-buffer buf) (erase-buffer) (insert strokes-xpm-header) - (loop repeat 33 do - (insert ?\") - (insert-char ?\s 33) - (insert "\",") - (newline) - finally - (forward-line -1) - (end-of-line) - (insert "}\n")) - (loop for point in stroke - for x = (car-safe point) - for y = (cdr-safe point) do - (cond ((consp point) - ;; draw a point, and possibly a starting-point - (if (and lift-flag (not b/w-only)) - ;; mark starting point with the appropriate color - (let ((char (or (car rainbow-chars) ?\.))) - (loop for i from 0 to 2 do - (loop for j from 0 to 2 do - (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-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) + (cl-loop repeat 33 do + (insert ?\") + (insert-char ?\s 33) + (insert "\",") + (newline) + finally + (forward-line -1) + (end-of-line) + (insert "}\n")) + (cl-loop for point in stroke + for x = (car-safe point) + for y = (cdr-safe point) do + (cond ((consp point) + ;; draw a point, and possibly a starting-point + (if (and lift-flag (not b/w-only)) + ;; mark starting point with the appropriate color + (let ((char (or (car rainbow-chars) ?\.))) + (cl-loop for i from 0 to 2 do + (cl-loop for j from 0 to 2 do + (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-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 (called-interactively-p 'interactive) (pop-to-buffer " *strokes-xpm*") ;; (xpm-mode 1) (goto-char (point-min)) @@ -1283,7 +1285,7 @@ the stroke as a character in some language." ;; (insert ;; "Command Stroke\n" ;; "------- ------") -;; (loop for def in strokes-map +;; (cl-loop for def in strokes-map ;; for i from 0 to (1- (length strokes-map)) do ;; (let ((stroke (car def)) ;; (command-name (symbol-name (cdr def)))) @@ -1318,8 +1320,8 @@ the stroke as a character in some language." ;;;###autoload (defun strokes-list-strokes (&optional chronological strokes-map) "Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP. -With CHRONOLOGICAL prefix arg \(\\[universal-argument]\) list strokes -chronologically by command name. +With CHRONOLOGICAL prefix arg (\\[universal-argument]) list strokes chronologically +by command name. If STROKES-MAP is not given, `strokes-global-map' will be used instead." (interactive "P") (setq strokes-map (or strokes-map @@ -1338,27 +1340,28 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead." (insert "Command Stroke\n" "------- ------") - (loop for def in strokes-map do - (let ((stroke (car def)) - (command-name (if (symbolp (cdr def)) - (symbol-name (cdr def)) - (prin1-to-string (cdr def))))) - (strokes-xpm-for-stroke stroke " *strokes-xpm*") - (newline 2) - (insert-char ?\s 45) - (beginning-of-line) - (insert command-name) - (beginning-of-line) - (forward-char 45) - (insert-image - (create-image (with-current-buffer " *strokes-xpm*" - (buffer-string)) - 'xpm t - :color-symbols - `(("foreground" - . ,(frame-parameter nil 'foreground-color)))))) - finally do (unless (eobp) - (kill-region (1+ (point)) (point-max)))) + (cl-loop + for def in strokes-map do + (let ((stroke (car def)) + (command-name (if (symbolp (cdr def)) + (symbol-name (cdr def)) + (prin1-to-string (cdr def))))) + (strokes-xpm-for-stroke stroke " *strokes-xpm*") + (newline 2) + (insert-char ?\s 45) + (beginning-of-line) + (insert command-name) + (beginning-of-line) + (forward-char 45) + (insert-image + (create-image (with-current-buffer " *strokes-xpm*" + (buffer-string)) + 'xpm t + :color-symbols + `(("foreground" + . ,(frame-parameter nil 'foreground-color)))))) + finally do (unless (eobp) + (kill-region (1+ (point)) (point-max)))) (view-buffer "*Strokes List*" nil) (set (make-local-variable 'view-mode-map) (let ((map (copy-keymap view-mode-map))) @@ -1383,8 +1386,12 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead." ;;;###autoload (define-minor-mode strokes-mode - "Toggle Strokes global minor mode.\\ -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 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 @@ -1396,7 +1403,7 @@ Encode/decode your strokes with \\[strokes-encode-buffer], \\[strokes-decode-buffer]. \\{strokes-mode-map}" - nil strokes-modeline-string strokes-mode-map + nil strokes-lighter strokes-mode-map :group 'strokes :global t (cond ((not (display-mouse-p)) (error "Can't use Strokes without a mouse")) @@ -1535,9 +1542,8 @@ Encode/decode your strokes with \\[strokes-encode-buffer], (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*"))) +XPM-BUFFER defaults to \" *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) @@ -1580,7 +1586,7 @@ XPM-BUFFER defaults to ` *strokes-xpm*'." ;; yet another of the same bit-type, so we continue ;; counting... (progn - (incf count) + (cl-incf count) (forward-char 1)) ;; otherwise, it's the opposite bit-type, so we do a ;; write and then restart count ### NOTE (for myself @@ -1620,8 +1626,7 @@ Optional BUFFER defaults to the current buffer. 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 @@ -1630,7 +1635,7 @@ Optional FORCE non-nil will ignore the buffer's read-only status." (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 @@ -1669,8 +1674,7 @@ Optional FORCE non-nil will ignore the buffer's read-only status." ;; 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 @@ -1705,10 +1709,9 @@ Optional FORCE non-nil will ignore the buffer's read-only status." (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)) +Store XPM in buffer BUFNAME if supplied (default is \" *strokes-xpm*\")" + (or bufname (setq bufname " *strokes-xpm*")) + (with-current-buffer (get-buffer-create bufname) (erase-buffer) (insert compressed-string) (goto-char (point-min)) @@ -1722,10 +1725,10 @@ Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)" (delete-char 1) (setq current-char-is-on-p (not current-char-is-on-p))) (goto-char (point-min)) - (loop repeat 33 do - (insert ?\") - (forward-char 33) - (insert "\",\n")) + (cl-loop repeat 33 do + (insert ?\") + (forward-char 33) + (insert "\",\n")) (goto-char (point-min)) (insert strokes-xpm-header)))) @@ -1754,5 +1757,4 @@ Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)" (run-hooks 'strokes-load-hook) (provide 'strokes) -;; arch-tag: 8377f60e-43fb-467a-bbcd-2774f91f833e ;;; strokes.el ends here