X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/4a86dbddcfb98011389f20145551c0b52ca32219..b8f95e4e0a821bb0c6a09fdda382620ab081d6a0:/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 c79245cbd..05cf38c6f 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,10 @@ ;; Copyright (C) 2014 Free Software Foundation, Inc. ;; Author: Thien-Thi Nguyen -;; Version: 1.6 +;; Maintainer: Thien-Thi Nguyen +;; Version: 1.9 +;; Keywords: ascii, unicode, box-drawing +;; URL: http://www.gnuvola.org/software/aa2u/ ;; 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 +25,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 @@ -73,16 +77,33 @@ ;; ┃ ┃ ;; ┗━━━━━━━━━━┛ ;; +;; 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: ;; -;; See Also -;; - HACKING: -;; - Tip Jar: +;; ┌───────────────────┐ +;; │ │ +;; │ |\/| │ +;; │ `Oo' --Oop Ack! │ +;; │ ^&-MM. │ +;; │ │ +;; └─────────┬─────────┘ +;; │ +;; """"""""" +;; +;; Command `aa2u-mark-rectangle-as-text' is similar, for rectangles. +;; +;; Tip: For best results, you should make sure all the tab characaters +;; are converted to spaces. See: `untabify', `indent-tabs-mode'. ;;; Code: (require 'cl-lib) (require 'pcase) +(autoload 'apply-on-rectangle "rect") + (defvar aa2u-uniform-weight 'LIGHT "A symbol, either `LIGHT' or `HEAVY'. This specifies the weight of all the lines.") @@ -90,6 +111,9 @@ This specifies the weight of all the lines.") ;;;--------------------------------------------------------------------------- ;;; support +(defsubst aa2u--text-p (pos) + (get-text-property pos 'aa2u-text)) + (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 @@ -128,14 +152,15 @@ 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 'VERTICAL))) - (while (search-forward "|" nil t) - (replace-match vert t t))) - (goto-char (point-min)) - (let ((horz (aa2u-1c 'aa2u-ucs-bd-uniform-name '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)))) @@ -151,7 +176,7 @@ Their values are STRINGIFIER and COMPONENTS, respectively." ;; | +---| (eq ?+ (char-after pos)) ;; Require properly directional neighborliness. - (memq (case name + (memq (cl-case name ((UP DOWN) 'VERTICAL) ((LEFT RIGHT) 'HORIZONTAL)) (get-text-property pos 'aa2u-components))) @@ -191,9 +216,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)) @@ -206,7 +232,7 @@ Their values are STRINGIFIER and COMPONENTS, respectively." 'aa2u-components nil))) ;;;--------------------------------------------------------------------------- -;;; command +;;; commands ;;;###autoload (defun aa2u (beg end &optional interactive) @@ -257,6 +283,46 @@ 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))) + +;;;###autoload +(defun aa2u-mark-rectangle-as-text (start end &optional unmark) + "Like `aa2u-mark-as-text' on the region-rectangle. +When called from a program the rectangle's corners +are START (top left) and END (bottom right)." + (interactive "r\nP") + (apply-on-rectangle + (lambda (scol ecol unmark) + (let ((p (point))) + (aa2u-mark-as-text (+ p scol) (+ p ecol) unmark))) + start end + unmark)) + ;;;--------------------------------------------------------------------------- ;;; that's it