Commit 81681ed9 authored by Michal Nazarewicz's avatar Michal Nazarewicz

descr-text: add `describe-char-eldoc' describing character at point

* 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'.
parent 11e161f5
......@@ -238,8 +238,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
......
2015-01-20 Michal Nazarewicz <mina86@mina86.com>
* 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.
2015-01-20 Michal Nazarewicz <mina86@mina86.com>
* textmodes/paragraphs.el (sentence-end-base): Include an
......
......@@ -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
2015-01-20 Michal Nazarewicz <mina86@mina86.com>
* automated/descr-text-test.el: New file with tests for
`describe-char-eldoc--truncate', `describe-char-eldoc--format',
and `describe-char-eldoc'.
2015-01-20 Michal Nazarewicz <mina86@mina86.com>
* automated/tildify-tests.el (tildify-space-undo-test--test):
......
;;; 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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment