From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp11.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id AHXbNsUNYGI2IwEAbAwnHQ (envelope-from ) for ; Wed, 20 Apr 2022 15:42:29 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp11.migadu.com with LMTPS id 4NnSNsUNYGIMOwEA9RJhRA (envelope-from ) for ; Wed, 20 Apr 2022 15:42:29 +0200 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 6D5F32B0CF for ; Wed, 20 Apr 2022 15:42:29 +0200 (CEST) Received: from localhost ([::1]:49774 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nhAbE-0003yy-9x for larch@yhetil.org; Wed, 20 Apr 2022 09:42:28 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:37790) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nhAMG-0005fr-E5 for emacs-orgmode@gnu.org; Wed, 20 Apr 2022 09:27:00 -0400 Received: from mail-pj1-x1035.google.com ([2607:f8b0:4864:20::1035]:51721) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nhAME-0004Pk-2q for emacs-orgmode@gnu.org; Wed, 20 Apr 2022 09:26:59 -0400 Received: by mail-pj1-x1035.google.com with SMTP id bg24so1939695pjb.1 for ; Wed, 20 Apr 2022 06:26:57 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:subject:in-reply-to:references:message-id:date:mime-version; bh=Lfv2VudxatMtofEuE/fdO7RzRtXf46zFPkhabiE+B4Y=; b=I6sQee/LRI0wpC0ciEthIXmyHEegUGNPhKqns97caVRKsreLHBBAcBQTxWC+gzDJgK UATwi05Q4X6TAJXGtChsLzhErr0A4KvpzpdG6brt/juX1ZLY9VrXylyFZyGGSxZ7djWP inXRUziVp4Raj50ITvfQEywNGeok3o0vuX/DA64FkVXqLhOxCl5KhyNZQi3PbCaOZLun XcW2W78E7JMzeg/c1scLB6H/oZOBPF0Na/jp0A0cty7gt1oUqSgMBOYVwE99ezZH6CGK SZy12GjB+iVhRGwLpNfvcPHn/r81zjLabranFRUQkq9MXW7jkljpFjwROakjVFP2En1F rMqQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:subject:in-reply-to:references :message-id:date:mime-version; bh=Lfv2VudxatMtofEuE/fdO7RzRtXf46zFPkhabiE+B4Y=; b=Wo/z2HodbkZsDsHrdEBoTnJqcMqUVIpPYxXsw/pThAcCTH2UKIEflkfvm5BJPH9rEg 0SqdtcRWV8F9JNmKQw0zXk87ZONtrkz/j/cwQkm3Yf7stux/LgizN4JeABix0A1+IF5C LZZHIpNGrCTk0p339dwqOSTuwgv1kvajQQIalnfI8vcRWqB904l3K7eKomjGLECfyitz VhzM3xFdwuac7aO2fucc5TjOCojinlvSiVCE/MyzoLoezGnApoR58xZwcrHu77Avvvml Fgo+khg+Ucp0ooLAGpTiIuhpFReu8SZbh6+kOYFeYLqHdF1UxwZOU0DUnSZFtZPwARTO FX/w== X-Gm-Message-State: AOAM530ZOxzy1YX9vjPzSrKcJO3NLoQKKNRgb+2v7S8C/WfXQ1Roqirw 9mbGSgYHsGXMcvzAyy+yFm/IiY5gHznA6A== X-Google-Smtp-Source: ABdhPJxpQWzPgQrDv7M9C99vO1Wsnz3L81tW84IVGT6TZr9H61X3VwoZFp+O7o9ud7BozKQgF/oq6g== X-Received: by 2002:a17:903:1210:b0:14f:973e:188d with SMTP id l16-20020a170903121000b0014f973e188dmr20533649plh.61.1650461216165; Wed, 20 Apr 2022 06:26:56 -0700 (PDT) Received: from localhost ([64.32.23.62]) by smtp.gmail.com with ESMTPSA id y131-20020a626489000000b00505a8f36965sm20046853pfb.184.2022.04.20.06.26.54 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 20 Apr 2022 06:26:55 -0700 (PDT) From: Ihor Radchenko To: emacs-orgmode@gnu.org Subject: [PATCH v2 29/38] org-string-width: Work around `window-pixel-width' bug in old Emacs In-Reply-To: References: Message-Id: <1709cbb5a9fd6df82bd18921363f1bda8852b288.1650460489.git.yantar92@gmail.com> Date: Wed, 20 Apr 2022 21:27:48 +0800 MIME-Version: 1.0 Content-Type: text/plain Received-SPF: pass client-ip=2607:f8b0:4864:20::1035; envelope-from=yantar92@gmail.com; helo=mail-pj1-x1035.google.com X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_ENVFROM_END_DIGIT=0.25, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Migadu-Flow: FLOW_IN X-Migadu-To: larch@yhetil.org X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1650462149; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=Lfv2VudxatMtofEuE/fdO7RzRtXf46zFPkhabiE+B4Y=; b=caP58ALcYFwEaI7bm7G1nE3fvzQ0ELGStUkQDySRtqcy0SzirshuHXOU5dYKE6r7cJRN/A fZmBu9WfmGbpmUf4GJRB5MynH40oybTbwlK/BYKtU8ln5MU/eTGZvy72HHS6ENfh6eNHvH WUt0CZ/GYE9BVMVjldsfbKVrR1Rtr/LcD81lKy+1SmCmoaWlu6iRVTL9i8Z85ZoQmXBQHc 1lcMnzJ4PR2mk7BhF9/YIAHYVJU06gxiDFJDgrNE1B8VlIz0S11uO7e7obOBUBhD1kG/XI yD8j8Wb3qVjmQi0WRHjD4m/p3VIZJAGuQxYecLJ/aE0XY5KTcyGvv1rzBt7fLw== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1650462149; a=rsa-sha256; cv=none; b=tRV8OLIztnMFBDPAeAQhThC2nfajCco53Q+irQDiRILXA6MunOsD+6TWhDodslkbHkLPJB Ul5m+rUyz0jENlIAwpO/5EJj2RB03KD6HkAENzNWBR45OkYmPm6t8gRK8EqiT7YNi7gtxt ghhRejOBfQg7Idd1AmccVpViKXoIfB/NRh6agKaz7sFy5A1FP5B6l+SWz0P/bnwBW4qDY7 vlj22mnBGfN0WJDGxbgcGL/spX6OCG4/oXmvTPIVkvYrz/eLXF3XjXUwQHYvCbltYVDi2J S391+0TA5MhCPJqNmNtqrOrV9izlku9fi6ZkAm5fA/2dJdlLXwP4vxu3lppfpA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20210112 header.b="I6sQee/L"; dmarc=pass (policy=none) header.from=gmail.com; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -3.04 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20210112 header.b="I6sQee/L"; dmarc=pass (policy=none) header.from=gmail.com; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: 6D5F32B0CF X-Spam-Score: -3.04 X-Migadu-Scanner: scn1.migadu.com X-TUID: Jz/fG5lXjov4 --- lisp/org-macs.el | 188 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 129 insertions(+), 59 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index e56a234d3..a1d514d50 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -893,73 +893,143 @@ (defun org-split-string (string &optional separators) results ;skip trailing separator (cons (substring string i) results))))))) +(defun org--string-from-props (s property beg end) + "Return the visible part of string S. +Visible part is determined according to text PROPERTY, which is +either `invisible' or `display'. BEG and END are 0-indices +delimiting S." + (let ((width 0) + (cursor beg)) + (while (setq beg (text-property-not-all beg end property nil s)) + (let* ((next (next-single-property-change beg property s end)) + (props (text-properties-at beg s)) + (spec (plist-get props property)) + (value + (pcase property + (`invisible + ;; If `invisible' property in PROPS means text is to + ;; be invisible, return 0. Otherwise return nil so + ;; as to resume search. + (and (or (eq t buffer-invisibility-spec) + (assoc-string spec buffer-invisibility-spec)) + 0)) + (`display + (pcase spec + (`nil nil) + (`(space . ,props) + (let ((width (plist-get props :width))) + (and (wholenump width) width))) + (`(image . ,_) + (and (fboundp 'image-size) + (ceiling (car (image-size spec))))) + ((pred stringp) + ;; Displayed string could contain invisible parts, + ;; but no nested display. + (org--string-from-props spec 'invisible 0 (length spec))) + (_ + ;; Un-handled `display' value. Ignore it. + ;; Consider the original string instead. + nil))) + (_ (error "Unknown property: %S" property))))) + (when value + (cl-incf width + ;; When looking for `display' parts, we still need + ;; to look for `invisible' property elsewhere. + (+ (cond ((eq property 'display) + (org--string-from-props s 'invisible cursor beg)) + ((= cursor beg) 0) + (t (string-width (substring s cursor beg)))) + value)) + (setq cursor next)) + (setq beg next))) + (+ width + ;; Look for `invisible' property in the last part of the + ;; string. See above. + (cond ((eq property 'display) + (org--string-from-props s 'invisible cursor end)) + ((= cursor end) 0) + (t (string-width (substring s cursor end))))))) + +(defun org--string-width-1 (string) + "Return width of STRING when displayed in the current buffer. +Unlike `string-width', this function takes into consideration +`invisible' and `display' text properties. It supports the +latter in a limited way, mostly for combinations used in Org. +Results may be off sometimes if it cannot handle a given +`display' value." + (org--string-from-props string 'display 0 (length string))) + (defun org-string-width (string &optional pixels) "Return width of STRING when displayed in the current buffer. Return width in pixels when PIXELS is non-nil." - ;; Wrap/line prefix will make `window-text-pizel-size' return too - ;; large value including the prefix. - ;; Face should be removed to make sure that all the string symbols - ;; are using default face with constant width. Constant char width - ;; is critical to get right string width from pixel width. - (remove-text-properties 0 (length string) - '(wrap-prefix t line-prefix t face t) - string) - (let (;; We need to remove the folds to make sure that folded table - ;; alignment is not messed up. - (current-invisibility-spec - (or (and (not (listp buffer-invisibility-spec)) - buffer-invisibility-spec) - (let (result) - (dolist (el buffer-invisibility-spec) - (unless (or (memq el - '(org-fold-drawer - org-fold-block - org-fold-outline)) - (and (listp el) - (memq (car el) - '(org-fold-drawer - org-fold-block - org-fold-outline)))) - (push el result))) - result))) - (current-char-property-alias-alist char-property-alias-alist)) - (with-temp-buffer - (setq-local display-line-numbers nil) - (setq-local buffer-invisibility-spec - (if (listp current-invisibility-spec) - (mapcar (lambda (el) - ;; Consider elipsis to have 0 width. - ;; It is what Emacs 28+ does, but we have - ;; to force it in earlier Emacs versions. - (if (and (consp el) (cdr el)) - (list (car el)) - el)) - current-invisibility-spec) - current-invisibility-spec)) - (setq-local char-property-alias-alist - current-char-property-alias-alist) - (let (pixel-width symbol-width) - (with-silent-modifications - (setf (buffer-string) string) - (setq pixel-width - (if (get-buffer-window (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max))) - (set-window-buffer nil (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point-max))))) - (unless pixels - (setf (buffer-string) "a") - (setq symbol-width + (if (and (version< emacs-version "28") (not pixels)) + ;; FIXME: Fallback to old limited version, because + ;; `window-pixel-width' is buggy in older Emacs. + (org--string-width-1 string) + ;; Wrap/line prefix will make `window-text-pizel-size' return too + ;; large value including the prefix. + ;; Face should be removed to make sure that all the string symbols + ;; are using default face with constant width. Constant char width + ;; is critical to get right string width from pixel width. + (remove-text-properties 0 (length string) + '(wrap-prefix t line-prefix t face t) + string) + (let (;; We need to remove the folds to make sure that folded table + ;; alignment is not messed up. + (current-invisibility-spec + (or (and (not (listp buffer-invisibility-spec)) + buffer-invisibility-spec) + (let (result) + (dolist (el buffer-invisibility-spec) + (unless (or (memq el + '(org-fold-drawer + org-fold-block + org-fold-outline)) + (and (listp el) + (memq (car el) + '(org-fold-drawer + org-fold-block + org-fold-outline)))) + (push el result))) + result))) + (current-char-property-alias-alist char-property-alias-alist)) + (with-temp-buffer + (setq-local display-line-numbers nil) + (setq-local buffer-invisibility-spec + (if (listp current-invisibility-spec) + (mapcar (lambda (el) + ;; Consider elipsis to have 0 width. + ;; It is what Emacs 28+ does, but we have + ;; to force it in earlier Emacs versions. + (if (and (consp el) (cdr el)) + (list (car el)) + el)) + current-invisibility-spec) + current-invisibility-spec)) + (setq-local char-property-alias-alist + current-char-property-alias-alist) + (let (pixel-width symbol-width) + (with-silent-modifications + (setf (buffer-string) string) + (setq pixel-width (if (get-buffer-window (current-buffer)) (car (window-text-pixel-size nil (line-beginning-position) (point-max))) (set-window-buffer nil (current-buffer)) (car (window-text-pixel-size - nil (line-beginning-position) (point-max))))))) - (if pixels - pixel-width - (/ pixel-width symbol-width)))))) + nil (line-beginning-position) (point-max))))) + (unless pixels + (setf (buffer-string) "a") + (setq symbol-width + (if (get-buffer-window (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point-max))))))) + (if pixels + pixel-width + (/ pixel-width symbol-width))))))) (defun org-not-nil (v) "If V not nil, and also not the string \"nil\", then return V. -- 2.35.1 -- Ihor Radchenko, PhD, Center for Advancing Materials Performance from the Nanoscale (CAMP-nano) State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong University, Xi'an, China Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg