From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Michal Nazarewicz Newsgroups: gmane.emacs.bugs Subject: bug#19338: [PATCH 2/3] descr-text: add `describe-char-eldoc' describing character at point Date: Wed, 10 Dec 2014 18:49:44 +0100 Message-ID: <1418233785-18020-2-git-send-email-mpn@google.com> References: <1418233785-18020-1-git-send-email-mpn@google.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Trace: ger.gmane.org 1418234061 5882 80.91.229.3 (10 Dec 2014 17:54:21 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 10 Dec 2014 17:54:21 +0000 (UTC) To: 19338@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Dec 10 18:54:16 2014 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XylSo-0000wZ-Um for geb-bug-gnu-emacs@m.gmane.org; Wed, 10 Dec 2014 18:54:15 +0100 Original-Received: from localhost ([::1]:47117 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XylSo-0003IQ-E7 for geb-bug-gnu-emacs@m.gmane.org; Wed, 10 Dec 2014 12:54:14 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:56858) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XylSh-0003HS-Hn for bug-gnu-emacs@gnu.org; Wed, 10 Dec 2014 12:54:12 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XylSd-0005SQ-1u for bug-gnu-emacs@gnu.org; Wed, 10 Dec 2014 12:54:07 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:60804) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XylSc-0005SK-UX for bug-gnu-emacs@gnu.org; Wed, 10 Dec 2014 12:54:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1XylSc-0003Bg-Nw for bug-gnu-emacs@gnu.org; Wed, 10 Dec 2014 12:54:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Michal Nazarewicz Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 10 Dec 2014 17:54:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 19338 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 19338-submit@debbugs.gnu.org id=B19338.141823401812202 (code B ref 19338); Wed, 10 Dec 2014 17:54:02 +0000 Original-Received: (at 19338) by debbugs.gnu.org; 10 Dec 2014 17:53:38 +0000 Original-Received: from localhost ([127.0.0.1]:41934 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XylSD-0003Ab-Ez for submit@debbugs.gnu.org; Wed, 10 Dec 2014 12:53:38 -0500 Original-Received: from mail-wg0-f52.google.com ([74.125.82.52]:39407) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XylOd-00033g-Sb for 19338@debbugs.gnu.org; Wed, 10 Dec 2014 12:49:56 -0500 Original-Received: by mail-wg0-f52.google.com with SMTP id x12so4284316wgg.25 for <19338@debbugs.gnu.org>; Wed, 10 Dec 2014 09:49:50 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=20120113; h=from:to:subject:date:message-id:in-reply-to:references:mime-version :content-type:content-transfer-encoding; bh=5gzbx+eswN4DRlE/AD9bW8/CVlhIyb39naRer7BbSj0=; b=L67xKC/nVJ+e5hCU9I75w9/U4MHX1lb+su+Asq9tnZo1mdDihskondJFBFvEPOqyLc Zt5SMHrgORD7dXQH82U6Dbcfai7c8/Xre3nKSiN04ZSQXRVFUmVp5UMaqdjulHbpiTez RfyDsaMM6inFdpU2xYkx8bfm259rJXRBQGl6qJ4OwnLnBWfyMW2Vkyd5HKrcZOueISo5 ubgOwMmWWh3kJbK9E9pOr/iWEGPu7YA150SHr2CFOOgPaKX7HHbZPMotDFy9tGJ0h2Vj +2gkAHDagwWYg4swwGxZe582hNN0RxEnC5tN41E0ghdlrFKLvjCQ1ZMTAg+BlzrHp5Vy Ai8Q== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:from:to:subject:date:message-id:in-reply-to :references:mime-version:content-type:content-transfer-encoding; bh=5gzbx+eswN4DRlE/AD9bW8/CVlhIyb39naRer7BbSj0=; b=WUPz38EaCI+/y2Z+58SjmEJeSIodbtukIxKsuI8hCh3fRe5ozvB4oiWZzybdG4uBfV si9VTRYZyG+Zz8en3rNKiRaodlcqZYS/7P56Ybn0Q0ahooT6oPxv4pdV/fWWZlEx/bk7 sOc8rwfq5JROTMKMNYRD1niXNixDVFBF8LaUdRoAJ1i1IoOCNAKO5lcgkEo6z1KAEM7F nqX+OwXh8OXKab6qfAOS14lXslz8mXQjPoiomKlFs81Np3OcFNLGwyLkRHSnZPDaibP+ 8HAXKPwbm07t182eFRPB0qHOd21UWLzvutcdJuOQHTFKLK4ruSU0XVrE5phRRlAVPUvT IGbw== X-Gm-Message-State: ALoCoQlZUFWVWDcJX7bnvv6LrIYV7lNikS6SA07zzSs70J9ldjrNaxw5exPvC1g6jILDvpM1zq7G X-Received: by 10.194.62.19 with SMTP id u19mr9280468wjr.0.1418233790131; Wed, 10 Dec 2014 09:49:50 -0800 (PST) Original-Received: from mpn-glaptop.corp.google.com ([2620:0:105f:310:381f:eb80:e0ce:71dc]) by mx.google.com with ESMTPSA id ly9sm6744297wjb.24.2014.12.10.09.49.48 for <19338@debbugs.gnu.org> (version=TLSv1.2 cipher=ECDHE-RSA-AES128-SHA bits=128/128); Wed, 10 Dec 2014 09:49:49 -0800 (PST) X-Mailer: git-send-email 2.2.0.rc0.207.ga3a616c In-Reply-To: <1418233785-18020-1-git-send-email-mpn@google.com> X-Mailman-Approved-At: Wed, 10 Dec 2014 12:53:34 -0500 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:97154 Archived-At: From: 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 | 4 ++ lisp/descr-text.el | 96 +++++++++++++++++++++++++++++++++++++++ test/automated/descr-text-test.el | 94 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 194 insertions(+) create mode 100644 test/automated/descr-text-test.el diff --git a/etc/NEWS b/etc/NEWS index 50338cf..77a2f9b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -203,6 +203,10 @@ result of the calculation into the current buffer. *** `eldoc-documentation-function' now defaults to nil *** Default value of `eldoc-documentation-function now' is consulted if local function does not return any documentation. +*** `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..d435fe6 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. + +If NAME consists of white space only, return an empty string. + +Otherwise, if NAME consists of a single word (where word is defined as sequence +of non-white space characters), return that word even if it's longer than WIDTH. + +Otherwise, if first word in NAME is longer or equal WIDTH, return that word with +ellipsis character (\"…\") appended; this results in a string longer than WIDTH. + +Otherwise, take as many words from NAME as possible, separating them with +a single space character, while not exceeding WIDTH characters length limit. If +not all words fit, append ellipsis character (\"…\") at the end; the ellipsis is +counted towards WIDTH." + (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) 2 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+: (: )\" +format where: +- is a hexadecimal codepoint of the character (zero-padded to at least + four digits), +- is name of the character. +- is a two-letter abbreviation of the general-category of the character, + and +- 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 () + "Returns a description of character at point for use by ElDoc mode. + +If character at point is a printable ASCII character (i.e. codepoint between 32 +and 127 inclusively), nil is returned. Otherwise a description formatted by +`describe-char-eldoc--format' function is returned 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..81a4375 --- /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 + +;; 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 . + +;;; 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" (1+ (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