bug#19338: [PATCHv3 1/2] descr-text: add `describe-char-eldoc' describing character at point

[Michal Nazarewicz]

* lisp/descr-text.el (describe-char-eldoc): New function returning
basic Unicode codepoint information (e.g. name) about character
at point.  It is meant to be used as a default value of the
`eldoc-documentation-function' variable.
(describe-char-eldoc--format, describe-char-eldoc--truncate):
New helper functions for `describe-char-eldoc' function.

* tests/automated/descr-text-test.el: New file with tests for
`describe-char-eldoc--truncate', `describe-char-eldoc--format',
and `describe-char-eldoc'.
---
 etc/NEWS                          |  8 +++-
 lisp/descr-text.el                | 97 +++++++++++++++++++++++++++++++++++++++
 test/automated/descr-text-test.el | 94 +++++++++++++++++++++++++++++++++++++
 3 files changed, 197 insertions(+), 2 deletions(-)
 create mode 100644 test/automated/descr-text-test.el

>> +          (let ((ellipsis (and (cdr last) "…")))

On Sun, Dec 14 2014, Eli Zaretskii <eliz@gnu.org> wrote:
> Btw, will this display OK on a TTY?  Not all TTYs support UTF-8.

It will if TTY supports UTF-8. ;)  Perhaps it's not a problem on TTYs
that do not because people are unlikely to open documents using Unicode
on such TTYs?

I used “…” because it's a single character so it does not carve cut that
much from the WIDTH (alternative “...” would be three characters).

In any event, changed it to “...”.

diff --git a/etc/NEWS b/etc/NEWS
index e5656fa..53dc795 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -218,8 +218,12 @@ typing RET.
 result of the calculation into the current buffer.
 
 ** ElDoc
-*** New minor mode global-eldoc-mode
-*** eldoc-documentation-function now defaults to nil
+*** New minor mode `global-eldoc-mode'
+*** `eldoc-documentation-function' now defaults to `ignore'
+*** `describe-char-eldoc' displays information about character at point,
+and can be used as a default value of `eldoc-documentation-function'.  It is
+useful when, for example, one needs to distinguish various spaces (e.g. ] [,
+] [, ] [, etc.) while using mono-spaced font.
 
 ** eww
 
diff --git a/etc/NEWS b/etc/NEWS
index e5656fa..53dc795 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -218,8 +218,12 @@ typing RET.
 result of the calculation into the current buffer.
 
 ** ElDoc
-*** New minor mode global-eldoc-mode
-*** eldoc-documentation-function now defaults to nil
+*** New minor mode `global-eldoc-mode'
+*** `eldoc-documentation-function' now defaults to `ignore'
+*** `describe-char-eldoc' displays information about character at point,
+and can be used as a default value of `eldoc-documentation-function'.  It is
+useful when, for example, one needs to distinguish various spaces (e.g. ] [,
+] [, ] [, etc.) while using mono-spaced font.
 
 ** eww
 
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 1dc43e9..56f5866 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -825,6 +825,102 @@ relevant to POS."
 
 (define-obsolete-function-alias 'describe-char-after 'describe-char "22.1")
 
+;;; Describe-Char-ElDoc
+
+(defun describe-char-eldoc--truncate (name width)
+  "Truncate NAME at white spaces such that it is no longer than WIDTH.
+
+Split NAME on white space character and return string with as
+many leading words of NAME as possible without exceeding WIDTH
+characters.  If NAME consists of white space characters only,
+return an empty string.  Three dots (\"...\") are appended to
+returned string if some of the words from NAME have been omitted.
+
+NB: Function may return string longer than WIDTH if name consists
+of a single word, or it's first word is longer than WIDTH
+characters."
+  (let ((words (split-string name)))
+    (if words
+        (let ((last words))
+          (setq width (- width (length (car words))))
+          (while (and (cdr last)
+                      (<= (+ (length (cadr last)) (if (cddr last) 4 1)) width))
+            (setq last (cdr last))
+            (setq width (- width (length (car last)) 1)))
+          (let ((ellipsis (and (cdr last) "...")))
+            (setcdr last nil)
+            (concat (mapconcat 'identity words " ") ellipsis)))
+      "")))
+
+(defun describe-char-eldoc--format (ch &optional width)
+  "Format a description for character CH which is no more than WIDTH 
characters.
+
+Full description message has a \"U+HEX: NAME (GC: GENERAL-CATEGORY)\"
+format where:
+- HEX is a hexadecimal codepoint of the character (zero-padded to at
+  least four digits),
+- NAME is name of the character.
+- GC is a two-letter abbreviation of the general-category of the
+  character, and
+- GENERAL-CATEGORY is full name of the general-category of the
+  character.
+
+If WIDTH is non-nil some elements of the description may be
+omitted to accommodate the length restriction.  Under certain
+condition, the function may return string longer than WIDTH, see
+`describe-char-eldoc--truncate'."
+  (let ((name (get-char-code-property ch 'name)))
+    (when name
+      (let* ((code (propertize (format "U+%04X" ch)
+                               'face 'font-lock-constant-face))
+             (gc (get-char-code-property ch 'general-category))
+             (gc-desc (char-code-property-description 'general-category gc)))
+
+        (unless (or (not width) (<= (length name) width))
+          (setq name (describe-char-eldoc--truncate name width)))
+        (setq name (concat (substring name 0 1) (downcase (substring name 1))))
+        (setq name (propertize name 'face 'font-lock-variable-name-face))
+
+        (setq gc (propertize (symbol-name gc) 'face 'font-lock-comment-face))
+        (when gc-desc
+          (setq gc-desc (propertize gc-desc 'face 'font-lock-comment-face)))
+
+        (let ((lcode    (length code))
+              (lname    (length name))
+              (lgc      (length gc))
+              (lgc-desc (and gc-desc (length gc-desc))))
+          (cond
+           ((and gc-desc
+                 (or (not width) (<= (+ lcode lname lgc lgc-desc 7) width)))
+            (concat code ": " name " (" gc ": " gc-desc ")"))
+           ((and gc-desc (<= (+ lcode lname lgc-desc 5) width))
+            (concat code ": " name " (" gc-desc ")"))
+           ((or (not width) (<= (+ lcode lname lgc 5) width))
+            (concat code ": " name " (" gc ")"))
+           ((<= (+ lname lgc 3) width)
+            (concat name " (" gc ")"))
+           (t name)))))))
+
+;;;###autoload
+(defun describe-char-eldoc ()
+  "Return a description of character at point for use by ElDoc mode.
+
+Return nil if character at point is a printable ASCII
+character (i.e. codepoint between 32 and 127 inclusively).
+Otherwise return a description formatted by
+`describe-char-eldoc--format' function taking into account value
+of `eldoc-echo-area-use-multiline-p' variable and width of
+minibuffer window for width limit.
+
+This function is meant to be used as a value of
+`eldoc-documentation-function' variable."
+  (let ((ch (following-char)))
+    (when (and (not (zerop ch)) (or (< ch 32) (> ch 127)))
+      (describe-char-eldoc--format
+       ch
+       (unless (eq eldoc-echo-area-use-multiline-p t)
+         (1- (window-width (minibuffer-window))))))))
+
 (provide 'descr-text)
 
 ;;; descr-text.el ends here
diff --git a/test/automated/descr-text-test.el 
b/test/automated/descr-text-test.el
new file mode 100644
index 0000000..81ae727
--- /dev/null
+++ b/test/automated/descr-text-test.el
@@ -0,0 +1,94 @@
+;;; descr-text-test.el --- ERT tests for descr-text.el -*- lexical-binding: t 
-*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author:     Michal Nazarewicz <mina86@mina86.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package defines regression tests for the descr-text package.
+
+;;; Code:
+
+(require 'ert)
+(require 'descr-text)
+
+
+(ert-deftest descr-text-test-truncate ()
+  "Tests describe-char-eldoc--truncate function."
+  (should (equal ""
+                 (describe-char-eldoc--truncate " \t \n" 100)))
+  (should (equal "foo"
+                 (describe-char-eldoc--truncate "foo" 1)))
+  (should (equal "foo..."
+                 (describe-char-eldoc--truncate "foo wilma fred" 0)))
+  (should (equal "foo..."
+                 (describe-char-eldoc--truncate
+                  "foo wilma fred" (length "foo wilma"))))
+  (should (equal "foo wilma..."
+                 (describe-char-eldoc--truncate
+                  "foo wilma fred" (+ 3 (length "foo wilma")))))
+  (should (equal "foo wilma..."
+                 (describe-char-eldoc--truncate
+                  "foo wilma fred" (1- (length "foo wilma fred")))))
+  (should (equal "foo wilma fred"
+                 (describe-char-eldoc--truncate
+                  "foo wilma fred" (length "foo wilma fred"))))
+  (should (equal "foo wilma fred"
+                 (describe-char-eldoc--truncate
+                  "  foo\t wilma \nfred\t " (length "foo wilma fred")))))
+
+(ert-deftest descr-text-test-format-desc ()
+  "Tests describe-char-eldoc--format function."
+  (should (equal "U+2026: Horizontal ellipsis (Po: Punctuation, Other)"
+                 (describe-char-eldoc--format ?…)))
+  (should (equal "U+2026: Horizontal ellipsis (Punctuation, Other)"
+                 (describe-char-eldoc--format ?… 51)))
+  (should (equal "U+2026: Horizontal ellipsis (Po)"
+                 (describe-char-eldoc--format ?… 40)))
+  (should (equal "Horizontal ellipsis (Po)"
+                 (describe-char-eldoc--format ?… 30)))
+  (should (equal "Horizontal ellipsis"
+                 (describe-char-eldoc--format ?… 20)))
+  (should (equal "Horizontal..."
+                 (describe-char-eldoc--format ?… 10))))
+
+(ert-deftest descr-text-test-desc ()
+  "Tests describe-char-eldoc function."
+  (with-temp-buffer
+    (insert "a…")
+    (goto-char (point-min))
+    (should (eq ?a (following-char))) ; make sure we are where we think we are
+    ;; Function should return nil for an ASCII character.
+    (should (not (describe-char-eldoc)))
+
+    (goto-char (1+ (point)))
+    (should (eq ?… (following-char)))
+    (let ((eldoc-echo-area-use-multiline-p t))
+      ;; Function should return description of an Unicode character.
+      (should (equal "U+2026: Horizontal ellipsis (Po: Punctuation, Other)"
+                     (describe-char-eldoc))))
+
+    (goto-char (point-max))
+    ;; At the end of the buffer, function should return nil and not blow up.
+    (should (not (describe-char-eldoc)))))
+
+
+(provide 'descr-text-test)
+
+;;; descr-text-test.el ends here
-- 
2.2.0.rc0.207.ga3a616c