From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id QO0LMOUu9WHAIAAAgWs5BA (envelope-from ) for ; Sat, 29 Jan 2022 13:11:17 +0100 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id 2CKNLOUu9WFTOAEAauVa8A (envelope-from ) for ; Sat, 29 Jan 2022 13:11:17 +0100 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 32F94382A2 for ; Sat, 29 Jan 2022 13:11:17 +0100 (CET) Received: from localhost ([::1]:39884 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nDmZY-0003Ga-4D for larch@yhetil.org; Sat, 29 Jan 2022 07:11:16 -0500 Received: from eggs.gnu.org ([209.51.188.92]:59488) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nDm3b-0004io-L9 for emacs-orgmode@gnu.org; Sat, 29 Jan 2022 06:38:16 -0500 Received: from [2607:f8b0:4864:20::1035] (port=56075 helo=mail-pj1-x1035.google.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nDm3Y-0000x3-Kp; Sat, 29 Jan 2022 06:38:14 -0500 Received: by mail-pj1-x1035.google.com with SMTP id d5so9000691pjk.5; Sat, 29 Jan 2022 03:38:09 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=R3hW7Q4iSSqXnUm9FE7VBb3U22q2fvnAdThsvw6kum8=; b=hwQ809YR8AAdIkPnSrDnw6qqBMEXzxE+X7o2DbOTZpG9xBxXNioPuMvrdJjI3ogt3f BbaGFl1QFS7PzG4pk3SUJHTkl3v0NwAJp5ns/Q/jYAOAa9miOwRdTxAMPMq2bCV5W0H5 5FL2E/MISXdwlolVpn4p16ZqGPKPW+nj71OG47z5VH+cQcGIjIVv3xI68Vd/lYazOJWo MRcGCYMUYxFH2je4joDLHPnpz1xC/5icpL7bnilyMwJF/dwco/1VwkcpFpB/OiKo8tLK MKgViwNqFd9DgNrXHwSh4gCbx/ALUXPwEaoqCPhfN60m7G9yIv73VcUrP9PDhZ0CNNCB eOfg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=R3hW7Q4iSSqXnUm9FE7VBb3U22q2fvnAdThsvw6kum8=; b=G+nhHy83k95GNok9trR1H7YPy/+ipVzu673H9k7apoIzd7JQ68+XuLN4+RaXqsFh8O AHJIPkiGcjARN57hiny19+I8v6Ri8SEXZqUiX2Ag5FOQU3MHsWl9rNE5CSkTm/6mfwkO iRnuSJ7jp1ZqCjaTEDlHGH6vKzHCu2DYJZE7nP7ISMSNn1MUfmAU/C43XlFB5khvbuZs AdESlcOwS41Sw4tqKU0sy55+ltenLQmaQIrt6CFOhbTECLz+/aqUCAREKiBCEXuqWMzm Qu2uPZjM1KNiv2CVcL8FdFdqGdMsfU5/ngh7YhtGkPxvn43qaBZARXlCnHSa+fhm0O3k UxSg== X-Gm-Message-State: AOAM532i+dqkJX+dKyVEnVpvettXFHyp2CeAa2wz9T/lkX9l5DLX87+Q hBao5nmXGRoMaivgGFcTC1Apy3YRuIhlw9kB X-Google-Smtp-Source: ABdhPJxY/pcQj8PSbRy/QNK/Ds+R5D2I1z9owBrUMmm0HFzKYsJ+0Pm9Q2X1LuY15wasW/krF/0/nQ== X-Received: by 2002:a17:90b:3b42:: with SMTP id ot2mr14382759pjb.64.1643456288420; Sat, 29 Jan 2022 03:38:08 -0800 (PST) Received: from localhost ([209.95.60.92]) by smtp.gmail.com with ESMTPSA id h6sm12629782pfc.96.2022.01.29.03.38.05 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 29 Jan 2022 03:38:07 -0800 (PST) From: Ihor Radchenko To: Bastien , Kyle Meyer , Nicolas Goaziou , Karl Voit , Christian Heinrich , emacs-orgmode@gnu.org Subject: [PATCH 29/35] org-string-width: Work around `window-pixel-width' bug in old Emacs Date: Sat, 29 Jan 2022 19:38:21 +0800 Message-Id: <92dcc0bd7b0fc19c2f97245d457c7b9cf1967161.1643454546.git.yantar92@gmail.com> X-Mailer: git-send-email 2.34.1 In-Reply-To: References: <87y2cvloay.fsf@gnu.org> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="------------2.34.1" Content-Transfer-Encoding: 8bit X-Host-Lookup-Failed: Reverse DNS lookup failed for 2607:f8b0:4864:20::1035 (failed) 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: -10 X-Spam_score: -1.1 X-Spam_bar: - X-Spam_report: (-1.1 / 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, PDS_HP_HELO_NORDNS=0.001, RCVD_IN_DNSWL_NONE=-0.0001, RDNS_NONE=0.793, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=no 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: , Cc: Ihor Radchenko Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Migadu-Flow: FLOW_IN X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1643458277; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references:list-id:list-help: list-unsubscribe:list-subscribe:list-post:dkim-signature; bh=R3hW7Q4iSSqXnUm9FE7VBb3U22q2fvnAdThsvw6kum8=; b=cimbENhAPjN5YTFjg7neGwtHwpC6XRmfRCGUrJh+ZTXuquIQsnygkP9gavqpEk0Bs3Yum1 QkH3lN6Ei89+P+BNzgHgJS/P6MOf6jCCM8/sM21PBSWkub89N3C5Tz4DxKw4As4pJS1UNz bdKVlXvxjE3g8gsy5yuh29rH7UrOGak2nCglt9lfRPv5RpK7vopXoewbr92d7PiTldBHpr IsOyYrT12X4zyIXkngulgey30KauyHFM8Zy/BWqDHK0/aPr74gAf8gre7lq3w/ckyv0owo 5t3amsSRKkYnSMy5ZhzkEXynbT5v7Oi4KfCB4A8Ly30x0I0bb/NJzlJ+vnyM/A== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1643458277; a=rsa-sha256; cv=none; b=HdDUkoqoC0PFTj5RGNzKkR1iD8JvSQ39ebh30uXk1DPGLWVgH9syg83U0k8Br4e0cXrez6 eReZ/SGPTjmQKkcGE8ouh912u9R/TKejkfbpf3xq8j2QbIlOMhGRFHoQgCud1Zr78lrzhU q4deu//N9cqztKjUQTB6Nyti/k9GKaD+1QcOt3cqLwD8L+RSO+CAspnLrdPogMX1OEIeL0 YVG6jw8phFLeqAmSbzV47mhr59LlwHFXHLb9MvcvzoAmJmOLN2TKQk2E2m5chq6WpCs9B/ KVFCJRTuoYGc46yaxnJ5UrVN/tddkuTCrxuH30AJP5gBEdox/Fmpmii8597c6A== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20210112 header.b=hwQ809YR; 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.33 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=gmail.com header.s=20210112 header.b=hwQ809YR; 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: 32F94382A2 X-Spam-Score: -3.33 X-Migadu-Scanner: scn0.migadu.com X-TUID: MFX+6BLjASrz This is a multi-part message in MIME format. --------------2.34.1 Content-Type: text/plain; charset=UTF-8; format=fixed Content-Transfer-Encoding: 8bit --- lisp/org-macs.el | 188 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 129 insertions(+), 59 deletions(-) --------------2.34.1 Content-Type: text/x-patch; name="0029-org-string-width-Work-around-window-pixel-width-bug-.patch" Content-Transfer-Encoding: 8bit Content-Disposition: attachment; filename="0029-org-string-width-Work-around-window-pixel-width-bug-.patch" diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 0a7da0637..db98dd149 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -887,73 +887,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.34.1--