diff options
| -rw-r--r-- | lisp/textmodes/artist.el | 53 |
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. | ||
| 1791 | With 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 | ||