aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/textmodes/artist.el53
1 files changed, 10 insertions, 43 deletions
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 0d67542e16d..2d40d6da026 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -1532,7 +1532,7 @@ The returned value is suitable for the `x-popup-menu' function."
1532 "Compute completion table from MENU-TABLE, suitable for `completing-read'." 1532 "Compute completion table from MENU-TABLE, suitable for `completing-read'."
1533 (apply 1533 (apply
1534 'nconc 1534 'nconc
1535 (artist-remove-nulls 1535 (remq nil
1536 (mapcar 1536 (mapcar
1537 (lambda (element) 1537 (lambda (element)
1538 (let ((element-tag (artist-mt-get-tag element))) 1538 (let ((element-tag (artist-mt-get-tag element)))
@@ -1772,29 +1772,6 @@ info-variant-part."
1772 "Call function FN with ARGS iff FN is not nil." 1772 "Call function FN with ARGS iff FN is not nil."
1773 (list 'if fn (cons 'funcall (cons fn args)))) 1773 (list 'if fn (cons 'funcall (cons fn args))))
1774 1774
1775(defvar artist-butlast-fn 'artist-butlast
1776 "The butlast function.")
1777
1778(if (fboundp 'butlast)
1779 (setq artist-butlast-fn 'butlast)
1780 (setq artist-butlast-fn 'artist-butlast))
1781
1782(defun artist-butlast (l)
1783 "Return the list L with all elements but the last."
1784 (cond ((null l) nil)
1785 ((null (cdr l)) nil)
1786 (t (cons (car l) (artist-butlast (cdr l))))))
1787
1788
1789(defun artist-last (l &optional n)
1790 "Return the last link in the list L.
1791With optional argument N, returns Nth-to-last link (default 1)."
1792 (nth (- (length l) (or n 1)) l))
1793
1794(defun artist-remove-nulls (l)
1795 "Remove nils in list L."
1796 (remq nil l))
1797
1798(defun artist-uniq (l) 1775(defun artist-uniq (l)
1799 "Remove consecutive duplicates in list L. Comparison is done with `equal'." 1776 "Remove consecutive duplicates in list L. Comparison is done with `equal'."
1800 (cond ((null l) nil) 1777 (cond ((null l) nil)
@@ -1802,16 +1779,6 @@ With optional argument N, returns Nth-to-last link (default 1)."
1802 ((equal (car l) (car (cdr l))) (artist-uniq (cdr l))) ; first 2 equal 1779 ((equal (car l) (car (cdr l))) (artist-uniq (cdr l))) ; first 2 equal
1803 (t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different 1780 (t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different
1804 1781
1805(defmacro artist-push (x stack)
1806 "Push element X to a STACK."
1807 (list 'setq stack (list 'cons x stack)))
1808
1809(defmacro artist-pop (stack)
1810 "Pop an element from a STACK."
1811 (list 'prog1
1812 (list 'car stack)
1813 (list 'setq stack (list 'cdr stack))))
1814
1815(defun artist-string-split (str r) 1782(defun artist-string-split (str r)
1816 "Split string STR at occurrences of regexp R, returning a list of strings." 1783 "Split string STR at occurrences of regexp R, returning a list of strings."
1817 (let ((res nil) 1784 (let ((res nil)
@@ -3246,14 +3213,14 @@ through X1, Y1. An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3246 "Vaporize lines reachable from point X1, Y1." 3213 "Vaporize lines reachable from point X1, Y1."
3247 (let ((ep-stack nil)) 3214 (let ((ep-stack nil))
3248 (mapcar 3215 (mapcar
3249 (lambda (ep) (artist-push ep ep-stack)) 3216 (lambda (ep) (push ep ep-stack))
3250 (artist-vap-find-endpoints x1 y1)) 3217 (artist-vap-find-endpoints x1 y1))
3251 (while (not (null ep-stack)) 3218 (while (not (null ep-stack))
3252 (let* ((vaporize-point (artist-pop ep-stack)) 3219 (let* ((vaporize-point (pop ep-stack))
3253 (new-endpoints (artist-vaporize-line (car vaporize-point) 3220 (new-endpoints (artist-vaporize-line (car vaporize-point)
3254 (cdr vaporize-point)))) 3221 (cdr vaporize-point))))
3255 (mapcar 3222 (mapcar
3256 (lambda (endpoint) (artist-push endpoint ep-stack)) 3223 (lambda (endpoint) (push endpoint ep-stack))
3257 new-endpoints))))) 3224 new-endpoints)))))
3258 3225
3259 3226
@@ -3414,7 +3381,7 @@ The POINT-LIST is expected to cover the first quadrant."
3414 ;; that look like: \ / instead we get: ( ) 3381 ;; that look like: \ / instead we get: ( )
3415 ;; \ / \ / 3382 ;; \ / \ /
3416 ;; --------- --------- 3383 ;; --------- ---------
3417 (let ((last-coord (artist-last point-list))) 3384 (let ((last-coord (last point-list)))
3418 (if (= (artist-coord-get-new-char last-coord) ?/) 3385 (if (= (artist-coord-get-new-char last-coord) ?/)
3419 (artist-coord-set-new-char last-coord artist-ellipse-right-char))) 3386 (artist-coord-set-new-char last-coord artist-ellipse-right-char)))
3420 3387
@@ -3447,7 +3414,7 @@ The POINT-LIST is expected to cover the first quadrant."
3447 (t c))))) 3414 (t c)))))
3448 ;; The cdr and butlast below is so we don't draw the middle top 3415 ;; The cdr and butlast below is so we don't draw the middle top
3449 ;; and middle bottom char twice. 3416 ;; and middle bottom char twice.
3450 (funcall artist-butlast-fn (cdr (reverse right-half))))) 3417 (butlast (cdr (reverse right-half)))))
3451 (append right-half left-half))) 3418 (append right-half left-half)))
3452 3419
3453 3420
@@ -3763,10 +3730,10 @@ original contents of that area in the buffer."
3763 ;; area we are about to fill, or, in other words, don't fill if we 3730 ;; area we are about to fill, or, in other words, don't fill if we
3764 ;; needn't. 3731 ;; needn't.
3765 (if (not (= c artist-fill-char)) 3732 (if (not (= c artist-fill-char))
3766 (artist-push (artist-new-coord x1 y1) stack)) 3733 (push (artist-new-coord x1 y1) stack))
3767 3734
3768 (while (not (null stack)) 3735 (while (not (null stack))
3769 (let* ((coord (artist-pop stack)) 3736 (let* ((coord (pop stack))
3770 (x (artist-coord-get-x coord)) 3737 (x (artist-coord-get-x coord))
3771 (y (artist-coord-get-y coord)) 3738 (y (artist-coord-get-y coord))
3772 3739
@@ -3798,7 +3765,7 @@ original contents of that area in the buffer."
3798 (if lines-above 3765 (if lines-above
3799 (let ((c-above (artist-get-char-at-xy-conv x (- y 1)))) 3766 (let ((c-above (artist-get-char-at-xy-conv x (- y 1))))
3800 (if (and (= c-above c) (/= c-above last-c-above)) 3767 (if (and (= c-above c) (/= c-above last-c-above))
3801 (artist-push (artist-new-coord x (- y 1)) stack)) 3768 (push (artist-new-coord x (- y 1)) stack))
3802 (setq last-c-above c-above))) 3769 (setq last-c-above c-above)))
3803 (setq last-x x) 3770 (setq last-x x)
3804 (setq x (- x 1))) 3771 (setq x (- x 1)))
@@ -3812,7 +3779,7 @@ original contents of that area in the buffer."
3812 (if lines-below 3779 (if lines-below
3813 (let ((c-below (artist-get-char-at-xy-conv x (1+ y)))) 3780 (let ((c-below (artist-get-char-at-xy-conv x (1+ y))))
3814 (if (and (= c-below c) (/= c-below last-c-below)) 3781 (if (and (= c-below c) (/= c-below last-c-below))
3815 (artist-push (artist-new-coord x (1+ y)) stack)) 3782 (push (artist-new-coord x (1+ y)) stack))
3816 (setq last-c-below c-below))) 3783 (setq last-c-below c-below)))
3817 (setq x (- x 1))) 3784 (setq x (- x 1)))
3818 3785