X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/2b0d5df6f626fa1bc1413f4e51f1e9bcbd290816..386a3b0923a19714e2238288c0c9ed44a3ba3329:/packages/ascii-art-to-unicode/ascii-art-to-unicode.el diff --git a/packages/ascii-art-to-unicode/ascii-art-to-unicode.el b/packages/ascii-art-to-unicode/ascii-art-to-unicode.el index 6c691a71f..4ea78558e 100644 --- a/packages/ascii-art-to-unicode/ascii-art-to-unicode.el +++ b/packages/ascii-art-to-unicode/ascii-art-to-unicode.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2014 Free Software Foundation, Inc. ;; Author: Thien-Thi Nguyen -;; Version: 1.4 +;; Version: 1.7 ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -22,6 +22,7 @@ ;; The command `aa2u' converts simple ASCII art line drawings in ;; the {active,accessible} region of the current buffer to Unicode. +;; Command `aa2u-rectangle' is like `aa2u', but works on rectangles. ;; ;; Example use case: ;; - M-x artist-mode RET @@ -56,56 +57,45 @@ ;; │ │ ;; └──────────┘ ;; -;; TODO: -;; - Add phase 0, to grok and lock label (as opposed to line) text. -;; - Add interactive mode, to choose per-line light vs heavy. -;; - Improve neighbor-determining heuristic. -;; - Choose plus-replacement by composing "VERTICAL", "LEFT", etc. - -;;; News: - -;; - 1.4 | 2014-01-14 -;; - move to ELPA (from ) -;; - change copyright to FSF -;; - require 'cl-lib instead of 'cl -;; - use ‘cl-flet’ and ‘cl-labels’ -;; - comment munging -;; - add ‘lexical-binding: t’ -;; - remove huge list at EOF -;; - add Author and News headers +;; Much easier on the eyes now! ;; -;; - 1.3 | 2013-09-21 -;; - bug fixed: ‘?+’ neighbor valuation polarity flipped -;; - new support for BOX DRAWINGS LIGHT {UP,DOWN,LEFT,RIGHT} (singleton) +;; Normally, lines are drawn with the `LIGHT' weight. If you set var +;; `aa2u-uniform-weight' to symbol `HEAVY', you will see, instead: ;; -;; - 1.2 | 2012-11-05 -;; - refer to Unicode characters by name, not number +;; ┏━━━━━━━━━━━━━━━┓ +;; ┃ ┃ +;; ┃ ┏━━━━━━━╋━━┓ +;; ┃ ┃ ┃ ┃ +;; ┃ ┃ ┃ ┃ +;; ┃ ┃ ┃ ┃ +;; ┗━━━━━━━╋━━━━━━━┛ ┃ +;; ┃ ┃ +;; ┃ ┃ +;; ┃ ┃ +;; ┗━━━━━━━━━━┛ ;; -;; - 1.1 | 2012-04-17 -;; - TAB agnostic -;; - ‘aa2u’ operates on active region if ‘use-region-p’ -;; - example use case also demonstrates transformation ;; -;; - 1.0 | 2012-04-07 -;; - initial release +;; See Also +;; - HACKING: +;; - Tip Jar: ;;; Code: (require 'cl-lib) (require 'pcase) +(defvar aa2u-uniform-weight 'LIGHT + "A symbol, either `LIGHT' or `HEAVY'. +This specifies the weight of all the lines.") + ;;;--------------------------------------------------------------------------- ;;; support -(defun aa2u-ucs-bd-uniform-name (weight &rest components) +(defun aa2u-ucs-bd-uniform-name (&rest components) "Return a string naming UCS char w/ WEIGHT and COMPONENTS. -The string begins with \"BOX DRAWINGS\"; followed by WEIGHT, -a symbol from the set: - - HEAVY - LIGHT - -followed by COMPONENTS, a list of one or two symbols from the set: +The string begins with \"BOX DRAWINGS\"; followed by the weight +as per variable `aa2u-uniform-weight', followed by COMPONENTS, +a list of one or two symbols from the set: VERTICAL HORIZONTAL @@ -120,7 +110,7 @@ string includes \"AND\" between the elements of COMPONENTS. Lastly, all words are separated by space (U+20)." (format "BOX DRAWINGS %s %s" - weight + aa2u-uniform-weight (mapconcat 'symbol-name components " AND "))) @@ -140,17 +130,17 @@ Their values are STRINGIFIER and COMPONENTS, respectively." (defun aa2u-phase-1 () (goto-char (point-min)) - (let ((vert (aa2u-1c 'aa2u-ucs-bd-uniform-name 'LIGHT 'VERTICAL))) + (let ((vert (aa2u-1c 'aa2u-ucs-bd-uniform-name 'VERTICAL))) (while (search-forward "|" nil t) (replace-match vert t t))) (goto-char (point-min)) - (let ((horz (aa2u-1c 'aa2u-ucs-bd-uniform-name 'LIGHT 'HORIZONTAL))) + (let ((horz (aa2u-1c 'aa2u-ucs-bd-uniform-name 'HORIZONTAL))) (while (search-forward "-" nil t) (replace-match horz t t)))) (defun aa2u-replacement (pos) (let ((cc (- pos (line-beginning-position)))) - (cl-labels + (cl-flet* ((ok (name pos) (when (or ;; Infer LIGHTness between "snug" ‘?+’es. @@ -162,9 +152,9 @@ Their values are STRINGIFIER and COMPONENTS, respectively." ;; | +---| (eq ?+ (char-after pos)) ;; Require properly directional neighborliness. - (memq (case name - ((n s) 'VERTICAL) - ((w e) 'HORIZONTAL)) + (memq (cl-case name + ((UP DOWN) 'VERTICAL) + ((LEFT RIGHT) 'HORIZONTAL)) (get-text-property pos 'aa2u-components))) name)) (v (name dir) (let ((bol (line-beginning-position dir)) @@ -177,28 +167,20 @@ Their values are STRINGIFIER and COMPONENTS, respectively." (unless (or (> bol pos) (<= eol pos)) (ok name pos)))) - (light (&rest components) (apply 'aa2u-1c - 'aa2u-ucs-bd-uniform-name - 'LIGHT components))) - (let* ((n (v 'n 0)) - (s (v 's 2)) - (w (h 'w -1)) - (e (h 'e 1))) - (pcase (delq nil (list n s w e)) - (`(n s w e) (light 'VERTICAL 'HORIZONTAL)) - (`(s e) (light 'DOWN 'RIGHT)) - (`(s w) (light 'DOWN 'LEFT)) - (`(n e) (light 'UP 'RIGHT)) - (`(n w) (light 'UP 'LEFT)) - (`(n s e) (light 'VERTICAL 'RIGHT)) - (`(n s w) (light 'VERTICAL 'LEFT)) - (`(n w e) (light 'UP 'HORIZONTAL)) - (`(s w e) (light 'DOWN 'HORIZONTAL)) - (`(n) (light 'UP)) - (`(s) (light 'DOWN)) - (`(w) (light 'LEFT)) - (`(e) (light 'RIGHT)) - (_ nil)))))) + (two-p (ls) (= 2 (length ls))) + (just (&rest args) (delq nil args))) + (apply 'aa2u-1c + 'aa2u-ucs-bd-uniform-name + (just (pcase (just (v 'UP 0) + (v 'DOWN 2)) + ((pred two-p) 'VERTICAL) + (`(,vc) vc) + (_ nil)) + (pcase (just (h 'LEFT -1) + (h 'RIGHT 1)) + ((pred two-p) 'HORIZONTAL) + (`(,hc) hc) + (_ nil))))))) (defun aa2u-phase-2 () (goto-char (point-min)) @@ -225,10 +207,10 @@ Their values are STRINGIFIER and COMPONENTS, respectively." 'aa2u-components nil))) ;;;--------------------------------------------------------------------------- -;;; command +;;; commands ;;;###autoload -(defun aa2u () +(defun aa2u (beg end &optional interactive) "Convert simple ASCII art line drawings to Unicode. Specifically, perform the following replacements: @@ -254,20 +236,41 @@ More precisely, hyphen and vertical bar are substituted unconditionally, first, and plus is substituted with a character depending on its north, south, east and west neighbors. -This command operates on either the active region, as per -`use-region-p', or the accessible portion otherwise." - (interactive) +NB: Actually, `aa2u' can also use \"HEAVY\" instead of \"LIGHT\", +depending on the value of variable `aa2u-uniform-weight'. + +This command operates on either the active region, +or the accessible portion otherwise." + (interactive "r\np") + ;; This weirdness, along w/ the undocumented "p" in the ‘interactive’ + ;; form, is to allow ‘M-x aa2u’ (interactive invocation) w/ no region + ;; selected to default to the accessible portion (as documented), which + ;; was the norm in ascii-art-to-unicode.el prior to 1.5. A bugfix, + ;; essentially. This is ugly, unfortunately -- is there a better way?! + (when (and interactive (not (region-active-p))) + (setq beg (point-min) + end (point-max))) (save-excursion - (cl-flet - ((do-it! () (aa2u-phase-1) (aa2u-phase-2) (aa2u-phase-3))) - (if (use-region-p) - (let ((beg (region-beginning)) - (end (region-end))) - (save-restriction - (widen) - (narrow-to-region beg end) - (do-it!))) - (do-it!))))) + (save-restriction + (widen) + (narrow-to-region beg end) + (aa2u-phase-1) + (aa2u-phase-2) + (aa2u-phase-3)))) + +;;;###autoload +(defun aa2u-rectangle (start end) + "Like `aa2u' on the region-rectangle. +When called from a program the rectangle's corners +are START (top left) and END (bottom right)." + (interactive "r") + (let* ((was (delete-extract-rectangle start end)) + (now (with-temp-buffer + (insert-rectangle was) + (aa2u (point) (mark)) + (extract-rectangle (point-min) (point-max))))) + (goto-char (min start end)) + (insert-rectangle now))) ;;;--------------------------------------------------------------------------- ;;; that's it