;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
-;; Version: 1.4
+;; Version: 1.6
;; 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
;; │ │
;; └──────────┘
;;
-;; 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 <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
+;; 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: <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)
+(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
Lastly, all words are separated by space (U+20)."
(format "BOX DRAWINGS %s %s"
- weight
+ aa2u-uniform-weight
(mapconcat 'symbol-name components
" AND ")))
(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.
;; | +---|
(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))
;;; command
;;;###autoload
-(defun aa2u ()
+(defun aa2u (beg end &optional interactive)
"Convert simple ASCII art line drawings to Unicode.
Specifically, perform the following replacements:
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))))
;;;---------------------------------------------------------------------------
;;; that's it