;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
-;; Version: 1.5
+;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
+;; 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
;; 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
;; │ │
;; └──────────┘
;;
-;; 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 <http://www.gnuvola.org/software/j/aa2u/>)
-;; - 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: <http://git.sv.gnu.org/cgit/emacs/elpa.git/tree/packages/ascii-art-to-unicode/HACKING>
+;; - Tip Jar: <http://www.gnuvola.org/software/aa2u/>
;;; 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
Lastly, all words are separated by space (U+20)."
(format "BOX DRAWINGS %s %s"
- weight
+ aa2u-uniform-weight
(mapconcat 'symbol-name components
" AND ")))
'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.
;; | +---|
(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))
(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))
;; ‘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))
'aa2u-components nil)))
;;;---------------------------------------------------------------------------
-;;; command
+;;; commands
;;;###autoload
(defun aa2u (beg end &optional interactive)
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")
(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