X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/1d086771492d8fde0241d652e83ca485506b9d27..aa4afe3bab1ba1f7bb4d1b606ffa9311160c017f:/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 cd3126deb..45e5d0f6f 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,9 @@ ;; Copyright (C) 2014 Free Software Foundation, Inc. ;; Author: Thien-Thi Nguyen -;; Version: 1.5 +;; Maintainer: Thien-Thi Nguyen +;; Version: 1.7 +;; Keywords: ascii, unicode, box-drawing ;; 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 +24,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,59 +59,64 @@ ;; │ │ ;; └──────────┘ ;; -;; 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.5 | 2014-04-03 -;; - ‘aa2u’ takes args BEG and END +;; Much easier on the eyes now! +;; +;; Normally, lines are drawn with the `LIGHT' weight. If you set var +;; `aa2u-uniform-weight' to symbol `HEAVY', you will see, instead: +;; +;; ┏━━━━━━━━━━━━━━━┓ +;; ┃ ┃ +;; ┃ ┏━━━━━━━╋━━┓ +;; ┃ ┃ ┃ ┃ +;; ┃ ┃ ┃ ┃ +;; ┃ ┃ ┃ ┃ +;; ┗━━━━━━━╋━━━━━━━┛ ┃ +;; ┃ ┃ +;; ┃ ┃ +;; ┃ ┃ +;; ┗━━━━━━━━━━┛ ;; -;; - 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 +;; To protect particular ‘|’, ‘-’ or ‘+’ characters from conversion, +;; you can set the property `aa2u-text' on that text with command +;; `aa2u-mark-as-text'. A prefix arg clears the property, instead. +;; (You can use `describe-text-properties' to check.) For example: ;; -;; - 1.3 | 2013-09-21 -;; - bug fixed: ‘?+’ neighbor valuation polarity flipped -;; - new support for BOX DRAWINGS LIGHT {UP,DOWN,LEFT,RIGHT} (singleton) ;; -;; - 1.2 | 2012-11-05 -;; - refer to Unicode characters by name, not number +;; ┌───────────────────┐ +;; │ │ +;; │ |\/| │ +;; │ `Oo' --Oop Ack! │ +;; │ ^&-MM. │ +;; │ │ +;; └─────────┬─────────┘ +;; │ +;; """"""""" ;; -;; - 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) - "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 +(defsubst aa2u--text-p (pos) + (get-text-property pos 'aa2u-text)) -followed by COMPONENTS, a list of one or two symbols from the set: +(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 the weight +as per variable `aa2u-uniform-weight', followed by COMPONENTS, +a list of one or two symbols from the set: VERTICAL HORIZONTAL @@ -123,7 +131,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 "))) @@ -142,18 +150,19 @@ Their values are STRINGIFIER and COMPONENTS, respectively." 'aa2u-components components))) (defun aa2u-phase-1 () - (goto-char (point-min)) - (let ((vert (aa2u-1c 'aa2u-ucs-bd-uniform-name 'LIGHT '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))) - (while (search-forward "-" nil t) - (replace-match horz t t)))) + (cl-flet + ((gsr (was name) + (goto-char (point-min)) + (let ((now (aa2u-1c 'aa2u-ucs-bd-uniform-name name))) + (while (search-forward was nil t) + (unless (aa2u--text-p (match-beginning 0)) + (replace-match now t t)))))) + (gsr "|" 'VERTICAL) + (gsr "-" 'HORIZONTAL))) (defun aa2u-replacement (pos) (let ((cc (- pos (line-beginning-position)))) - (cl-labels + (cl-flet* ((ok (name pos) (when (or ;; Infer LIGHTness between "snug" ‘?+’es. @@ -165,9 +174,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)) @@ -180,28 +189,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)) @@ -213,9 +214,10 @@ Their values are STRINGIFIER and COMPONENTS, respectively." ;; ‘memq’ to an ‘intersction’. (while (search-forward "+" nil t) (let ((p (point))) - (push (cons p (or (aa2u-replacement (1- p)) - "?")) - changes))) + (unless (aa2u--text-p (1- p)) + (push (cons p (or (aa2u-replacement (1- p)) + "?")) + changes)))) ;; (phase 2.2 -- apply changes) (dolist (ch changes) (goto-char (car ch)) @@ -228,7 +230,7 @@ Their values are STRINGIFIER and COMPONENTS, respectively." 'aa2u-components nil))) ;;;--------------------------------------------------------------------------- -;;; command +;;; commands ;;;###autoload (defun aa2u (beg end &optional interactive) @@ -257,6 +259,9 @@ 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. +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") @@ -276,6 +281,33 @@ or the accessible portion otherwise." (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))) + +;;;###autoload +(defun aa2u-mark-as-text (start end &optional unmark) + "Set property `aa2u-text' of the text from START to END. +This prevents `aa2u' from misinterpreting \"|\", \"-\" and \"+\" +in that region as lines and intersections to be replaced. +Prefix arg means to remove property `aa2u-text', instead." + (interactive "r\nP") + (funcall (if unmark + 'remove-text-properties + 'add-text-properties) + start end + '(aa2u-text t))) + ;;;--------------------------------------------------------------------------- ;;; that's it