1532 |
"Compute completion table from MENU-TABLE, suitable for `completing-read'." |
"Compute completion table from MENU-TABLE, suitable for `completing-read'." |
1533 |
(apply |
(apply |
1534 |
'nconc |
'nconc |
1535 |
(artist-remove-nulls |
(remq nil |
1536 |
(mapcar |
(mapcar |
1537 |
(lambda (element) |
(lambda (element) |
1538 |
(let ((element-tag (artist-mt-get-tag element))) |
(let ((element-tag (artist-mt-get-tag element))) |
1772 |
"Call function FN with ARGS iff FN is not nil." |
"Call function FN with ARGS iff FN is not nil." |
1773 |
(list 'if fn (cons 'funcall (cons fn args)))) |
(list 'if fn (cons 'funcall (cons fn args)))) |
1774 |
|
|
|
(defvar artist-butlast-fn 'artist-butlast |
|
|
"The butlast function.") |
|
|
|
|
|
(if (fboundp 'butlast) |
|
|
(setq artist-butlast-fn 'butlast) |
|
|
(setq artist-butlast-fn 'artist-butlast)) |
|
|
|
|
|
(defun artist-butlast (l) |
|
|
"Return the list L with all elements but the last." |
|
|
(cond ((null l) nil) |
|
|
((null (cdr l)) nil) |
|
|
(t (cons (car l) (artist-butlast (cdr l)))))) |
|
|
|
|
|
|
|
|
(defun artist-last (l &optional n) |
|
|
"Return the last link in the list L. |
|
|
With optional argument N, returns Nth-to-last link (default 1)." |
|
|
(nth (- (length l) (or n 1)) l)) |
|
|
|
|
|
(defun artist-remove-nulls (l) |
|
|
"Remove nils in list L." |
|
|
(remq nil l)) |
|
|
|
|
1775 |
(defun artist-uniq (l) |
(defun artist-uniq (l) |
1776 |
"Remove consecutive duplicates in list L. Comparison is done with `equal'." |
"Remove consecutive duplicates in list L. Comparison is done with `equal'." |
1777 |
(cond ((null l) nil) |
(cond ((null l) nil) |
1779 |
((equal (car l) (car (cdr l))) (artist-uniq (cdr l))) ; first 2 equal |
((equal (car l) (car (cdr l))) (artist-uniq (cdr l))) ; first 2 equal |
1780 |
(t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different |
(t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different |
1781 |
|
|
|
(defmacro artist-push (x stack) |
|
|
"Push element X to a STACK." |
|
|
(list 'setq stack (list 'cons x stack))) |
|
|
|
|
|
(defmacro artist-pop (stack) |
|
|
"Pop an element from a STACK." |
|
|
(list 'prog1 |
|
|
(list 'car stack) |
|
|
(list 'setq stack (list 'cdr stack)))) |
|
|
|
|
1782 |
(defun artist-string-split (str r) |
(defun artist-string-split (str r) |
1783 |
"Split string STR at occurrences of regexp R, returning a list of strings." |
"Split string STR at occurrences of regexp R, returning a list of strings." |
1784 |
(let ((res nil) |
(let ((res nil) |
3213 |
"Vaporize lines reachable from point X1, Y1." |
"Vaporize lines reachable from point X1, Y1." |
3214 |
(let ((ep-stack nil)) |
(let ((ep-stack nil)) |
3215 |
(mapcar |
(mapcar |
3216 |
(lambda (ep) (artist-push ep ep-stack)) |
(lambda (ep) (push ep ep-stack)) |
3217 |
(artist-vap-find-endpoints x1 y1)) |
(artist-vap-find-endpoints x1 y1)) |
3218 |
(while (not (null ep-stack)) |
(while (not (null ep-stack)) |
3219 |
(let* ((vaporize-point (artist-pop ep-stack)) |
(let* ((vaporize-point (pop ep-stack)) |
3220 |
(new-endpoints (artist-vaporize-line (car vaporize-point) |
(new-endpoints (artist-vaporize-line (car vaporize-point) |
3221 |
(cdr vaporize-point)))) |
(cdr vaporize-point)))) |
3222 |
(mapcar |
(mapcar |
3223 |
(lambda (endpoint) (artist-push endpoint ep-stack)) |
(lambda (endpoint) (push endpoint ep-stack)) |
3224 |
new-endpoints))))) |
new-endpoints))))) |
3225 |
|
|
3226 |
|
|
3381 |
;; that look like: \ / instead we get: ( ) |
;; that look like: \ / instead we get: ( ) |
3382 |
;; \ / \ / |
;; \ / \ / |
3383 |
;; --------- --------- |
;; --------- --------- |
3384 |
(let ((last-coord (artist-last point-list))) |
(let ((last-coord (last point-list))) |
3385 |
(if (= (artist-coord-get-new-char last-coord) ?/) |
(if (= (artist-coord-get-new-char last-coord) ?/) |
3386 |
(artist-coord-set-new-char last-coord artist-ellipse-right-char))) |
(artist-coord-set-new-char last-coord artist-ellipse-right-char))) |
3387 |
|
|
3414 |
(t c))))) |
(t c))))) |
3415 |
;; The cdr and butlast below is so we don't draw the middle top |
;; The cdr and butlast below is so we don't draw the middle top |
3416 |
;; and middle bottom char twice. |
;; and middle bottom char twice. |
3417 |
(funcall artist-butlast-fn (cdr (reverse right-half))))) |
(butlast (cdr (reverse right-half))))) |
3418 |
(append right-half left-half))) |
(append right-half left-half))) |
3419 |
|
|
3420 |
|
|
3730 |
;; area we are about to fill, or, in other words, don't fill if we |
;; area we are about to fill, or, in other words, don't fill if we |
3731 |
;; needn't. |
;; needn't. |
3732 |
(if (not (= c artist-fill-char)) |
(if (not (= c artist-fill-char)) |
3733 |
(artist-push (artist-new-coord x1 y1) stack)) |
(push (artist-new-coord x1 y1) stack)) |
3734 |
|
|
3735 |
(while (not (null stack)) |
(while (not (null stack)) |
3736 |
(let* ((coord (artist-pop stack)) |
(let* ((coord (pop stack)) |
3737 |
(x (artist-coord-get-x coord)) |
(x (artist-coord-get-x coord)) |
3738 |
(y (artist-coord-get-y coord)) |
(y (artist-coord-get-y coord)) |
3739 |
|
|
3765 |
(if lines-above |
(if lines-above |
3766 |
(let ((c-above (artist-get-char-at-xy-conv x (- y 1)))) |
(let ((c-above (artist-get-char-at-xy-conv x (- y 1)))) |
3767 |
(if (and (= c-above c) (/= c-above last-c-above)) |
(if (and (= c-above c) (/= c-above last-c-above)) |
3768 |
(artist-push (artist-new-coord x (- y 1)) stack)) |
(push (artist-new-coord x (- y 1)) stack)) |
3769 |
(setq last-c-above c-above))) |
(setq last-c-above c-above))) |
3770 |
(setq last-x x) |
(setq last-x x) |
3771 |
(setq x (- x 1))) |
(setq x (- x 1))) |
3779 |
(if lines-below |
(if lines-below |
3780 |
(let ((c-below (artist-get-char-at-xy-conv x (1+ y)))) |
(let ((c-below (artist-get-char-at-xy-conv x (1+ y)))) |
3781 |
(if (and (= c-below c) (/= c-below last-c-below)) |
(if (and (= c-below c) (/= c-below last-c-below)) |
3782 |
(artist-push (artist-new-coord x (1+ y)) stack)) |
(push (artist-new-coord x (1+ y)) stack)) |
3783 |
(setq last-c-below c-below))) |
(setq last-c-below c-below))) |
3784 |
(setq x (- x 1))) |
(setq x (- x 1))) |
3785 |
|
|