;;; telega-util.el --- Utility functions for telega -*- lexical-binding:t -*-

;; Copyright (C) 2018 by Zajcev Evgeny.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>

;; Created: Sat Apr 21 03:56:02 2018

;; Keywords:

;; telega 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.

;; telega 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 telega. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Utility functions to be used by telega

;;; Code:

(require 'ewoc)

(require 'cl-lib)

(require 'puny) ; `puny-decode-domain'

(require 'files) ; `locate-file'

(require 'rx) ; `rx'

(require 'svg)

(require 'color) ; `color-XXX'

(require 'dired-aux) ; `dired-dwim-target-directory'

(require 'ansi-color) ; `ansi-color-apply'

(require 'url-util) ; `url-unhex-string'

(require 'org) ; `org-read-date', `org-do-emphasis-faces'

(require 'org-element) ; for `org-do-emphasis-faces'

(require 'rainbow-identifiers)

(require 'transient)

(require 'telega-core)

(require 'telega-customize)

(require 'telega-media)

(require 'telega-topic)

(require 'telega-folders)

(declare-function telega-root--buffer "telega-root")

(declare-function telega-chatbuf--name "telega-chat" (chat))

(declare-function telega-describe-chat "telega-chat" (chat))

(declare-function telega-folder-names "telega-folders")

(declare-function telega-browse-url "telega-webpage" (url &optional in-web-browser))

(declare-function telega-user-list "telega-user" (&optional temex))

(declare-function telega-user> "telega-user" (user1 user2))

(defun telega-file-exists-p (filename)

"Return non-nil if FILENAME exists.

Unlike `file-exists-p' this return nil for empty string FILENAME.

Also return `nil' if FILENAME is `nil'."

(and filename

(not (string-empty-p filename))

(file-exists-p filename)))

(defun telega-plist-del (plist prop)

"From PLIST remove property PROP."

;; NOTE: `cl--plist-remove' has been removed in Emacs master

;; See https://t.me/emacs_telega/27687

;; Code taken from `org-plist-delete'

(let (p)

(while plist

(if (not (eq prop (car plist)))

(setq p (plist-put p (car plist) (nth 1 plist))))

(setq plist (cddr plist)))

p))

(defun telega-plist-map (func plist)

"Map FUNCTION on PLIST and return resulting list.

FUNCTION must accept two arguments: KEY and VALUE."

(let (result)

(telega--tl-dolist ((prop-name value) plist)

(setq result (cons (funcall func prop-name value) result)))

(nreverse result)))

(defun telega-face-height (face)

"Return float version of FACE height."

(let ((height (face-attribute face :height)))

(if (floatp height)

height

(/ (float height) (face-attribute 'default :height)))))

(defun telega-short-filename (filename)

"Shortens FILENAME by removing `telega-directory' prefix."

(if (and telega-use-short-filenames

(string-prefix-p (concat telega-directory "/") filename))

(substring filename (1+ (length telega-directory)))

(abbreviate-file-name filename)))

(defun telega-x-frame ()

"Return window system frame, if any.

Selected frame and frame displaying root buffer are examined first."

(or (when (display-graphic-p (selected-frame))

(selected-frame))

(when-let ((root-frame

(window-frame

(get-buffer-window (telega-root--buffer)))))

(when (display-graphic-p root-frame)

root-frame))

(cl-find-if #'display-graphic-p (frame-list))))

(defun telega-focus-state (&optional frame)

"Return non-nil if FRAME has focus.

Can be used as value for `telega-online-status-function'."

(if (fboundp 'frame-focus-state)

(funcall 'frame-focus-state frame)

;; NOTE: For tty frame always return non-nil

;; see https://t.me/emacs_telega/7419

(or (not (display-graphic-p frame))

(frame-parameter frame 'x-has-focus))))

(defun telega-buffer-p (&optional buffer)

"Return non-nil if BUFFER is some telega buffer.

If BUFFER is ommited, current buffer is used.

Could be used as value for `telega-online-status-function'."

(with-current-buffer (or buffer (current-buffer))

(when (or (derived-mode-p 'telega-root-mode)

(derived-mode-p 'telega-chat-mode)

(string-prefix-p "*Telega" (buffer-name))

(string-prefix-p "*Telegram" (buffer-name)))

t)))

(defun telega-chars-xwidth (n)

"Return pixel width for N characters.

`telega--default-face' is used for size calculation."

;; NOTE: Same (* n (window-font-width (get-buffer-window nil (telega-x-frame))))

;; but without tweaking on window configuration, which breaks inserters

(* n (if-let ((tframe (telega-x-frame)))

(let* ((info (font-info

(face-font telega--default-face tframe) tframe))

(width (aref info 11)))

(if (> width 0)

width

(aref info 10)))

(frame-char-width))))

(defun telega-chars-xheight (n)

"Return pixel height for N characters.

`telega--default-face' is used for size calculation."

(* n (if-let ((tframe (telega-x-frame)))

(aref (font-info (face-font telega--default-face tframe) tframe) 3)

(frame-char-height))))

(defun telega-chars-in-height (pixels)

"Return how many lines needed to cover PIXELS height."

(ceiling (/ pixels (float (telega-chars-xheight 1)))))

(defun telega-chars-in-width (pixels)

"Return how many characters needed to cover PIXELS width."

;; NOTE: Must not return negative result

(max 0 (ceiling (/ pixels (float (telega-chars-xwidth 1))))))

(defun telega-em-height-ratio ()

"Return font character ratio.

Used to calculate correct image `:height' in `em' elements."

(if-let ((tframe (telega-x-frame)))

(let ((info (font-info (face-font telega--default-face tframe) tframe)))

;; height / pixel size

(/ (float (aref info 3)) (aref info 2)))

1))

(defun telega-em-width-ratio ()

"Return font character ratio.

Used to calculate correct image `:width' in `em' elements."

(if-let ((tframe (telega-x-frame)))

(let ((info (font-info (face-font telega--default-face tframe) tframe)))

;; avg-width / pixel size

(/ (float (aref info 11)) (aref info 2)))

0.5))

(defun telega-strip-newlines (string)

"Strip STRING newlines from end and beginning."

(replace-regexp-in-string

(rx (or (: string-start (* (any ?\r ?\n)))

(: (* (any ?\r ?\n)) string-end)))

""

(or string "")))

(defun telega-window-current-column (&optional window)

"Return current column in the window."

(telega-chars-in-width

(car (window-text-pixel-size window (line-beginning-position) (point)))))

(defun telega-window-string-width (str)

"Return correct width in chars.

This function is very slow comparing to `string-width', however

returns precise value."

(with-temp-buffer

(telega-ins str)

(save-window-excursion

(set-window-dedicated-p nil nil)

(set-window-buffer nil (current-buffer))

(telega-window-current-column))))

(defun telega-current-column ()

"Same as `current-column', but take into account `line-prefix' property.

Also take into account `wrap-prefix' property.

Also take into account `:align-to' display property, used by

`telega-ins--move-to-column'."

(let* ((bol-point (line-beginning-position))

(spoint (point))

(dpoint spoint)

(ccolumn nil))

;; Search the first display with `:align-to' before the point

(while (and (not ccolumn)

(> dpoint bol-point)

(setq dpoint (previous-single-char-property-change

dpoint 'display nil bol-point)))

(let ((disp (get-text-property dpoint 'display)))

(when (and (listp disp) (> (length disp) 2)

(eq (nth 0 disp) 'space)

(eq (nth 1 disp) :align-to))

(setq ccolumn (+ (let ((align-val (nth 2 disp)))

(if (listp align-val)

;; specified in pixels

(/ (car align-val) (telega-chars-xwidth 1))

align-val))

(string-width (buffer-substring dpoint spoint)))))))

(+ (or ccolumn (current-column))

telega--column-offset

(or (when-let ((lwprefix (or (get-text-property bol-point 'line-prefix)

(get-text-property bol-point 'wrap-prefix))))

(string-width lwprefix))

0))))

(defun telega-canonicalize-number (value from-value)

"Canonicalize number VALUE.

VALUE can be a float, in this case take this fraction from FROM-VALUE.

Otherwise use VALUE as is.

MIN-VALUE specifies minimal value after canonicalization.

Used to calculate canonical values for with of some buttons such as

`telega-filter-button-width' and `telega-chat-button-width'."

(let* ((min-value (when (listp value) (nth 1 value)))

(max-value (when (listp value) (nth 2 value)))

(value (if (listp value) (nth 0 value) value))

(canon-value (if (floatp value)

(progn

(cl-assert (< 0 value 1))

(round (* value from-value)))

value))

(ret-min-value (if min-value

(max min-value canon-value)

canon-value)))

(if max-value

(min max-value ret-min-value)

ret-min-value)))

(defun telega-temp-name (prefix &optional ext)

"Generate unique temporary file name with PREFIX and extension EXT.

Specify EXT with leading `.'."

(concat (expand-file-name (make-temp-name prefix) telega-temp-dir) ext))

(defun telega-svg-width (svg)

(dom-attr svg 'width))

(defun telega-svg-height (svg)

(dom-attr svg 'height))

(defun telega-svg-raw-node (svg node-name node-attrs &rest node-childs)

"Add string as is to the SVG."

(svg--def svg (apply 'dom-node node-name node-attrs node-childs)))

(defun telega-svg-clip-path (svg id)

(let ((cp (dom-node 'clipPath `((id . ,id)))))

(svg--def svg cp)

cp))

(defun telega-svg-image-mask (svg mask-id image img-type datap &rest args)

"Create an svg mask using embedded IMAGE."

(let ((mask (dom-node 'mask `((id . ,mask-id)

,@(svg--arguments svg args)))))

(svg--def svg mask)

(apply #'telega-svg-embed mask image img-type datap args)

mask))

(defun telega-svg-path (svg d &rest args)

(svg--append svg (dom-node 'path

`((d . ,d)

,@(svg--arguments svg args)))))

(defun telega-svg-embed (svg image img-type datap &rest args)

"Embed IMAGE possible using `svg-embed-base-uri-image'.

IMAGE could be a list of two elements \\(RELATIVE-FNAME BASE-DIR\\),

so new Emacs `svg-embed-base-uri-image' functionality could be used."

(if (and telega-use-svg-base-uri

(not datap)

;; NOTE: embedding using `:base-uri' does not work under Windows

;; see https://github.com/zevlg/telega.el/issues/367

(not (eq (framep-on-display (telega-x-frame)) 'w32))

(listp image))

(apply #'svg-embed-base-uri-image svg (car image) args)

(apply #'svg-embed svg (if (listp image)

(apply #'expand-file-name image)

image)

img-type datap args)))

(defun telega-svg-gradient (svg id type stops)

"Same as `svg-gradient' but supports \"stop-opacity\" property."

(svg--def

svg

(apply

'dom-node

(if (eq type 'linear)

'linearGradient

'radialGradient)

`((id . ,id)

(x1 . 0)

(x2 . 0)

(y1 . 0)

(y2 . 1))

(mapcar

(lambda (stop)

(dom-node 'stop `((offset . ,(format "%s%%" (car stop)))

(stop-color . ,(cadr stop))

(stop-opacity . ,(plist-get (cddr stop) :opacity)))))

stops))))

(defun telega-svg-progress (svg progress &optional with-border-p)

"Insert progress circle into SVG."

(let* ((w (telega-svg-width svg))

(h (telega-svg-height svg))

(font-size (/ h 4)))

(telega-svg-append-glow-filter svg "glow")

(when with-border-p

(svg-rectangle svg 0 0 w h

:stroke-color "currentColor"

:stroke-width 1

:fill-color "none"))

(svg-text svg (format "%d%%" (round (* progress 100)))

:font-size font-size

:font-family "monospace"

:fill-color "currentColor"

:x "50%"

:text-anchor "middle"

:filter "url(#glow)"

;; Insane Y calculation

:y (+ (/ font-size 3) (/ h 2))

)

svg))

(defun telega-svg-squircle (svg x y width height &rest args)

"In SVG at X and Y positioon draw squircle of WIDTHxHEIGHT size.

X and Y denotes left up corner."

(declare (indent 5))

;; Values are taken from

;; https://upload.wikimedia.org/wikipedia/commons/5/58/Squircle2.svg

(let ((outline (concat "M304,592\n"

"C430.2,592,500.3563,592,546.1782,546.1782\n"

"C592,500.3563,592,430.2,592,304\n"

"C592,177.8,592,107.6437,546.1782,61.8218\n"

"C500.3563,16,430.2,16,304,16\n"

"C177.8,16,107.6437,16,61.8218,61.8218\n"

"C16,107.6437,16,177.8,16,304\n"

"C16,430.2,16,500.3563,61.8218,546.1782\n"

"C107.6437,592,177.8,592,304,592\n"

"Z")))

(setq args (plist-put args :transform

(concat (plist-get args :transform)

" "

(format "translate(%f,%f)" x y)

" "

(format "scale(%f,%f)"

(/ width 608.0) (/ height 608.0)))))

(apply #'telega-svg-path svg outline args)))

(defun telega-svg-apply-outline (svg outline ratio &optional args)

(setq args (plist-put args :transform

(concat (plist-get args :transform)

" "

(format "scale(%s)" ratio))))

(apply #'telega-svg-path svg outline args))

(defun telega-svg-telega-logo (svg width &rest args)

"Draw telega triangle of WIDTH."

(declare (indent 2))

(let ((ratio (/ width 32.0))

(outline (concat "M0,10.1891\n"

"l7.9819,5.5418\n"

"c0.8853,-0.322 1.8202,-0.6638 2.599,-0.9418"

" 1.9609,-0.7 7.0539,-3.4182 7.0539, -3.4182"

" -2.5145,2.2595 -4.6401,4.5613 -6.55, 6.8691\n"

"L17.5694,27\n"

"c0.2653,-0.9309 0.5279,-1.8618 0.9135,-2.9018\n"

"C20.4518,18.4196 32,0 32,0"

" 24.4744,2.555 10.7087,7.5896 7.8333,8.5782"

" 5.5816,9.3523 2.1946,10.5884 0,10.1892\n"

"z")))

(telega-svg-apply-outline svg outline ratio args)))

(defun telega-svg-round-square (svg x y width height radius &rest args)

"In SVG at X and Y positioon draw square with round corners.

RADIUS denotes radius for round corners.

X and Y denotes left up corner."

;; NOTE: Draw 8-corners polygon, and then circles in all four

;; corners

(let ((poly-points (list (cons (+ x radius) y)

(cons (- (+ x width) radius) y)

(cons (+ x width) (+ y radius))

(cons (+ x width) (- (+ y height) radius))

(cons (- (+ x width) radius) (+ y height))

(cons (+ x radius) (+ y height))

(cons x (- (+ y height) radius))

(cons x radius))))

(apply #'svg-polygon svg poly-points args)

;; Four round courners

(apply #'svg-circle svg (+ x radius) (+ y radius) radius args)

(apply #'svg-circle svg (- (+ x width) radius) (+ y radius) radius args)

(apply #'svg-circle svg (- (+ x width) radius) (- (+ height y) radius) radius args)

(apply #'svg-circle svg (+ x radius) (- (+ height y) radius) radius args)

))

(defun telega-svg-premium-logo (svg width &rest args)

"Draw Telegram Premium logo."

(declare (indent 2))

(let ((ratio (/ width 16.0))

(outline (concat "M7.9673,1.7397\n"

"c-0.8215,0.005 -1.3307,3.6214 -1.9924,4.1084"

" -0.6618,0.487 -4.266,-0.102 -4.5151,0.681"

" -0.1812,0.5691 2.5226,2.3763 2.5226,2.3763\n"

"s5.0903,-1.0188 5.181,-0.8892\n"

"c0.1049,0.15 -1.9601,1.3199 -4.5458,2.74"

" -0.3426,1.263 -1.1017,3.0947 -0.6124,3.4457"

" 0.6676,0.4789 3.2046,-2.1477 4.0261,-2.1524"

" 0.8216,-0.005 3.3918,2.5891 4.0535,2.1022"

" 0.6618,-0.487 -1.0488,-3.714 -0.7997,-4.4969"

" 0.2492,-0.7829 3.5078,-2.4236 3.2492,-3.2035"

" -0.2586,-0.7798 -3.852,-0.1518 -4.5196,-0.6306"

" -0.6676,-0.4789 -1.2258,-4.0856 -2.0474,-4.081\n"

"z")))

(telega-svg-apply-outline svg outline ratio args)))

(defun telega-svg-forum-topic-icon (svg width &rest args)

"Draw icon for a forum topic."

(declare (indent 2))

(let ((ratio (/ width 32.0))

(outline (concat "M16.013,3.6908\n"

"C8.426,3.1848 0.3523,10.7055 3.307,18.4956\n"

"c0.6111,2.1934 2.5766,3.9355 3.9238,5.39"

" -0.8542,1.6842 -2.045,3.1894 -3.4501,4.4478"

" 3.0964,0.006 6.2267,-0.6528 8.953,-2.1524"

" 7.2454,1.9045 16.545,-2.9693 16.584,-11.0625"

" 0.028,-6.8663 -6.9149,-11.585 -13.3046,-11.4277\n"

"z")))

(telega-svg-apply-outline svg outline ratio args)))

(defun telega-svg-create (width height &rest args)

"Create SVG image using `svg-create'.

Addresses some issues telega got with pure `svg-create' usage."

;; See https://t.me/emacs_telega/13764

;; Also see https://t.me/emacs_telega/20435

(cl-assert (and (integerp width) (integerp height)))

(apply #'svg-create width height

:xmlns:xlink "http://www.w3.org/1999/xlink" args))

(defun telega-svg-image (svg &rest props)

"Return an image object from SVG.

PROPS is passed on to `create-image' as its PROPS list."

(declare (indent 1))

;; NOTE: work around problem displaying unicode characters in some

;; librsvg versions (in my case 2.40.13). Encoded (in &#xxxx format)

;; text is only displayed correctly if <xml ..?> node is specified

(let ((svg-data (with-temp-buffer

(insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>")

(svg-print svg)

(buffer-string))))

;; NOTE: Do not check `svg' availability, so it will work when

;; `rsvg' is not compliled in and telega images is disabled.

;; See https://github.com/zevlg/telega.el/issues/219

(nconc (list 'image :type 'svg :data svg-data)

(unless (plist-member props :scale)

(list :scale

(image-compute-scaling-factor image-scaling-factor)))

props)))

(defun telega-svg-fit-into (width height fit-width fit-height)

"Fit rectangle of WIDTHxHEIGHT size into FIT-WIDTHxFIT-HEIGHT rect.

Do touch outsize scaling.

Return resulting x,y,width,height."

;; NOTE: workaround for zero values for width/height. In some cases

;; width/height might be 0 if photo is sent from tty Emacs instance

;; See https://github.com/zevlg/telega.el/issues/467

(when (telega-zerop width)

(setq width 100))

(when (telega-zerop height)

(setq height 100))

(let* ((w-ratio (/ (float fit-width) width))

(h-ratio (/ (float fit-height) height))

(fit-horiz-p (> (/ (float width) height)

(/ (float fit-width) fit-height)))

(ret-height (if fit-horiz-p

fit-height

(round (* height w-ratio))))

(ret-width (if (not fit-horiz-p)

fit-width

(round (* width h-ratio)))))

(list (- (/ (- ret-width fit-width) 2))

(- (/ (- ret-height fit-height) 2))

ret-width ret-height)))

(defun telega-poll-create-svg (cwidth percents &optional face)

"Create SVG for use in poll options inserter."

(cl-assert (<= percents 100))

(let* ((ndashes (ceiling (* cwidth (/ percents 100.0))))

(dashes-text (propertize

(if (> ndashes 0) (make-string ndashes ?\-) "·")

'face (or face 'bold)))

(telega-text

(concat dashes-text

(make-string (- cwidth (length dashes-text)) ?\s)))

(xheight (telega-chars-xheight 1))

(aw-chars (string-width telega-text))

(xwidth (telega-chars-xwidth aw-chars))

(stroke-xwidth (/ xheight 5))

(dashes-xwidth (* (- (telega-chars-xwidth cwidth) (* 2 stroke-xwidth))

(/ percents 100.0)))

(svg (telega-svg-create xwidth xheight)))

(svg-line svg stroke-xwidth (/ xheight 2)

(+ stroke-xwidth dashes-xwidth) (/ xheight 2)

:stroke-color "currentColor"

:stroke-width stroke-xwidth

:stroke-linecap "round")

(telega-svg-image svg

:scale 1

:width (telega-cw-width aw-chars)

:max-height (telega-ch-height 1)

:mask 'heuristic

:ascent 'center

:telega-text telega-text)))

(defun telega-self-destruct-create-svg (minithumb &optional emoji-symbol)

"Create svg image for the self destructing image with minithumbnail MINITHUMB.

EMOJI-SYMBOL is the emoji symbol to be used. (Default is `telega-symbol-flames')"

(let* ((xh (* (ceiling (/ (nth 3 telega-photo-size-limits) 1.5))

(telega-chars-xheight 1)))

(xw xh)

(svg (telega-svg-create xw xh)))

(when minithumb

(svg-embed svg (base64-decode-string (plist-get minithumb :data))

"image/jpeg" t

:x 0 :y 0 :width xw :height xh))

(svg-circle svg (/ xw 2) (/ xh 2) (/ xh 4)

:fill-color "white"

:fill-opacity "0.75")

(when telega-emoji-font-family

(let ((font-size (/ xw 4)))

(svg-text svg (or emoji-symbol telega-symbol-flames)

:font-family telega-emoji-font-family

:font-size font-size

:x (- (/ xw 2) (/ font-size 1.75))

:y (+ (/ font-size 3) (/ xh 2)))))

(telega-svg-image svg

:scale 1.0

;; TODO: move to `em' width/height

:width xw

:height xh

:ascent 'center)))

(defconst telega-spoiler-turbulence-attrs

'((baseFrequency . "0.1 0.1") (numOctaves . "2"))

"Attributes to the \"feTurbulence\" node.")

(defconst telega-spoiler-displacement-attrs

'((scale . "80"))

"Attributes to the \"feDisplacementMap\" node.")

(defun telega-svg-append-spoiler-node (svg node-id)

"Append spoiler noise node with NODE-ID into SVG."

(svg--append

svg

(dom-node 'filter

`((id . ,node-id))

(dom-node 'feTurbulence

`((type . "turbulence")

(result . "NOISE")

,@telega-spoiler-turbulence-attrs))

(dom-node 'feDisplacementMap

`((in . "SourceGraphic")

(in2 . "NOISE")

(xChannelSelector . "R")

(yChannelSelector . "G")

,@telega-spoiler-displacement-attrs))

)))

(defun telega-spoiler-create-svg (minithumb &optional width height limits)

"Create svg image for MINITHUMB that has spoiler."

(let* ((width (or width (plist-get minithumb :width)))

(height (or height (plist-get minithumb :height)))

(cheight (telega-media--cheight-for-limits width height limits))

(svg (telega-svg-create width height)))

(telega-svg-append-spoiler-node svg "noise")

(svg-embed svg (base64-decode-string (plist-get minithumb :data))

"image/jpeg" t

:x 0 :y 0 :width width :height height

:filter "url(#noise)")

(telega-svg-image svg

:scale 1.0

:height (telega-ch-height cheight)

:telega-nslices cheight

:ascent 'center)))

(defun telega-svg-append-glow-filter (svg node-id &optional std-deviation)

"Create glow filter."

(svg--append

svg

(dom-node 'filter

`((id . ,node-id))

(dom-node 'feGaussianBlur

`((stdDeviation . ,(or std-deviation "3"))

(result . "coloredBlur")))

(dom-node 'feMerge nil

(dom-node 'feMergeNode

`((in . "coloredBlur")))

(dom-node 'feMergeNode

`((in . "SourceGraphic"))))

)))

(defun telega-svg-embed-image-fitting (svg filename data-p img-width img-height

&rest embed-attrs)

"Create svg image by embedding FILENAME image into SVG fitting into its size."

(cl-destructuring-bind (x-fit y-fit w-fit h-fit)

(telega-svg-fit-into img-width img-height

(telega-svg-width svg) (telega-svg-height svg))

(apply #'telega-svg-embed

svg (if data-p

filename

(list (file-name-nondirectory filename)

(file-name-directory filename)))

(format "image/%s"

(if data-p

"jpeg"

(telega-image-supported-file-p filename t)))

data-p :x x-fit :y y-fit :width w-fit :height h-fit

embed-attrs)))

(defun telega-svg-red-play-triangle (svg &optional fill opacity)

"Draw play triangle at the SVG center."

(let* ((svg-w (telega-svg-width svg))

(svg-h (telega-svg-height svg))

(play-size (/ svg-w 3)))

(svg-polygon svg (list (cons (/ (- svg-w play-size) 2)

(/ (- svg-h play-size) 2))

(cons (/ (- svg-w play-size) 2)

(/ (+ svg-h play-size) 2))

(cons (/ (+ svg-w play-size) 2)

(/ svg-h 2)))

:fill (or fill "red")

:opacity (or opacity "0.75"))))

(defun telega-svg-white-play-triangle-in-circle (svg)

"Draw white play triangle in the black circle at the SVG center."

(let* ((width (telega-svg-width svg))

(height (telega-svg-height svg))

(play-size (/ height 8.0))

(xoff (/ play-size 8.0)))

(svg-circle svg (/ width 2) (/ height 2) play-size

:fill "black"

:opacity "0.65")

(svg-polygon svg (list (cons (+ xoff (/ (- width play-size) 2))

(/ (- height play-size) 2))

(cons (+ xoff (/ (- width play-size) 2))

(/ (+ height play-size) 2))

(cons (+ xoff (/ (+ width play-size) 2))

(/ height 2)))

:fill "white"

:opacity "0.65")

svg))

(defun telega-photo-preview--create-svg-one-line (filename data-p width height

&optional video-p)

"Function to create svg image for photo preview."

(let* ((svg-w (telega-chars-xwidth 2))

(svg-h (min svg-w (telega-chars-xheight 1)))

(svg (telega-svg-create svg-w svg-h))

(pclip (telega-svg-clip-path svg "pclip"))

(margin 1))

(telega-svg-round-square pclip margin margin

(- svg-w (* 2 margin)) (- svg-h (* 2 margin))

(/ svg-w 6))

(telega-svg-embed-image-fitting svg filename data-p width height

:clip-path "url(#pclip)")

(when video-p

(telega-svg-red-play-triangle svg))

(telega-svg-image svg

:scale 1.0

:max-height (telega-ch-height 1)

:width (telega-cw-width 2)

:telega-text "[]"

:ascent 'center

:mask 'heuristic

:base-uri (if data-p "" filename))))

(defun telega-video-preview--create-svg-one-line (filename data-p width height)

"Function to create svg image for video preview."

(telega-photo-preview--create-svg-one-line filename data-p width height t))

(defun telega-time-seconds (&optional as-is)

"Return current time as unix timestamp.

If AS-IS is non-nil, then do not apply time adjustment using

`telega-tdlib--unix-time'."

(let ((ctime (floor (time-to-seconds))))

(if as-is

ctime

(+ ctime (- (or (plist-get telega-tdlib--unix-time :remote) 0)

(or (plist-get telega-tdlib--unix-time :local) 0))))))

(defun telega-distance-human-readable (meters)

"Convert METERS to human readable string."

(cond ((not (integerp meters))

"unknown")

((> meters 10000)

(telega-i18n "lng_action_proximity_distance_km"

:count (/ meters 1000)))

((>= meters 1000)

(telega-i18n "lng_action_proximity_distance_km"

:count (telega-float-clamp (/ meters 1000.0) 1)))

(t

(telega-i18n "lng_action_proximity_distance_m"

:count meters))))

(defun telega-number-human-readable (num &optional fmt)

"Convert METERS to human readable string.

By default \"%.1f\" FMT format string is used."

(unless fmt

(setq fmt "%.1f"))

(cond ((and telega-use-short-numbers (>= num 1000000))

(concat (format fmt (/ num 1000000.0)) "M"))

((and telega-use-short-numbers (>= num 1000))

(concat (format fmt (/ num 1000.0)) "k"))

(t

(number-to-string num))))

(defun telega-duration-human-readable (seconds &optional n long-p)

"Convert SECONDS to human readable string.

If N is given, then use only N significant components.

For example if duration is 4h:20m:3s then with N=2 4H:20m will be returned.

By default N=3 (all components).

N can't be 0.

If LONG-P is specified, then use long form."

(cl-assert (or (null n) (> n 0)))

;; NOTE: force seconds to be a number, see

;; https://t.me/emacs_ru/283567?single

(setq seconds (round seconds))

(let ((ncomponents (or n 3))

(intervals

`((,(* 365 7 24 60 60) . ,(concat "lng_years" (unless long-p "_tiny")))

(,(round (* 30.5 7 24 60 60)) . ,(concat "lng_months" (unless long-p "_tiny")))

(,(* 7 24 60 60) . ,(concat "lng_weeks" (unless long-p "_tiny")))

(,(* 24 60 60) . ,(concat "lng_days" (unless long-p "_tiny")))

(,(* 60 60) . ,(concat "lng_hours" (unless long-p "_tiny")))

(60 . ,(concat "lng_minutes" (unless long-p "_tiny")))

(1 . ,(concat "lng_seconds" (unless long-p "_tiny")))))

comps)

(while (and (> ncomponents 0) intervals)

(let* ((ival (car intervals))

(ival-seconds (car ival)))

(when (or (>= seconds ival-seconds)

;; NOTE: special case for 0 SECONDS passed to

;; `telega-duration-human-readable'

(and (null comps) (= seconds 0) (= ival-seconds 1)))

;; NOTE: "lng_hours_tiny" for ru, has leading newline,

;; workaround this problem, looks like a typo on Telegram

;; translation platform

(setq comps (nconc comps (list (telega-strip-newlines

(telega-i18n (cdr ival)

:count (/ seconds ival-seconds)))))

seconds (% seconds ival-seconds)

ncomponents (1- ncomponents)))

(setq intervals (cdr intervals))))

(mapconcat #'identity comps ":")))

(defun telega-time-ago-human-readable (timestamp-ago)

(cond ((< timestamp-ago 60)

(telega-i18n "lng_mediaview_just_now"))

((< timestamp-ago 3600)

(telega-i18n "lng_mediaview_minutes_ago"

:count (/ timestamp-ago 60)))

(t

(telega-i18n "lng_mediaview_hours_ago"

:count (telega-float-clamp (/ timestamp-ago 3600.0) 1)))))

(defun telega-link-props (link-type link-to &rest props)

"Generate props for link button openable with `telega-link--button-action'."

(cl-assert (memq link-type '(url file username user sender hashtag)))

(nconc (list 'action 'telega-link--button-action

:telega-link (cons link-type link-to))

props))

(defun telega-link--button-action (button)

"Browse url at point."

(let ((link (button-get button :telega-link)))

(telega-debug "Action on link: %S" link)

(cl-ecase (car link)

(sender

(telega-describe-msg-sender (cdr link)))

(user

(telega-describe-user (telega-user-get (cdr link))))

(username

(let ((user (telega-user--by-username (cdr link))))

(if user

(telega-describe-user user)

(message (format "Fetching info about %s" (cdr link)))

(telega--searchPublicChat (cdr link)

(lambda (chat)

(if-let ((user (telega-chat-user chat)))

(telega-describe-user user)

(telega-describe-chat chat)))))))

(hashtag

(when telega-chatbuf--chat

(telega-chatbuf-filter-hashtag (cdr link))))

(url

(telega-browse-url (cdr link) current-prefix-arg))

(file

(telega-open-file (cdr link) (telega-msg-at button)))

)))

(defun telega-escape-underscores (text)

"Replace underscores in TEXT's urls and mentions."

;; NOTE: replace _ also in mentions

;; see https://github.com/zevlg/telega.el/issues/143

(let ((rep-rx (rx (and (or (and word-start

(or (and "http" (? "s") "://") "www\."))

(and "@" word-start))

(1+ (not (in " \t\n")))

word-end))))

(replace-regexp-in-string

rep-rx

(lambda (word-text)

(replace-regexp-in-string "_" "\\_" word-text nil t))

text nil t)))

(defun telega-puny-decode-url (url)

"Decode ULR according to the IDNA/punycode algorithm.

See `puny-decode-domain' for details."

(replace-regexp-in-string

(eval-when-compile (rx string-start

(? "http" (? "s") "://")

(group (1+ (regexp "[^/]")))))

(lambda (_)

(save-match-data

(puny-decode-domain (match-string 1 url))))

url nil 'literal 1))

(defun telega--entity-type-to-text-props (ent-type text)

"Convert telegram TextEntityType ENT-TYPE to Emacs text properties."

(nconc

(list :tl-entity-type ent-type)

(cl-case (telega--tl-type ent-type)

(textEntityTypeMention

(telega-link-props 'username text

'face

(if (and (plist-get telega-msg--current

:contains_unread_mention)

(telega-user-match-p (telega-user-me)

(list 'username

(concat "^"

(substring text 1) ;strip @

"$"))))

'(telega-entity-type-mention bold)

'telega-entity-type-mention)))

(textEntityTypeMentionName

(telega-link-props 'user (plist-get ent-type :user_id)

'face

(if (and (plist-get telega-msg--current

:contains_unread_mention)

(eq (plist-get ent-type :user_id)

telega--me-id))

'(telega-entity-type-mention bold)

'telega-entity-type-mention)))

(textEntityTypeHashtag

(telega-link-props 'hashtag text 'face 'telega-link))

(textEntityTypeBold

'(face telega-entity-type-bold))

(textEntityTypeItalic

'(face telega-entity-type-italic))

(textEntityTypeUnderline

'(face telega-entity-type-underline))

(textEntityTypeStrikethrough

'(face telega-entity-type-strikethrough))

(textEntityTypeCode

'(face telega-entity-type-code))

(textEntityTypePre

'(face telega-entity-type-pre))

(textEntityTypePreCode

(if (telega--inhibit-telega-display-p 'telega-core)

'(face telega-entity-type-code)

(let* ((vbar-face (if telega-msg--current

;; NOTE: Use only rainbow color

;; See https://t.me/emacs_telega/43270

(cdr (telega-msg-sender-title-faces

(telega-msg-sender telega-msg--current)))

(list 'telega-blue)))

(vbar (propertize (telega-symbol 'vertical-bar)

'face vbar-face))

(repr (telega-ins--as-string

(telega-ins vbar)

(telega-ins--with-face (nconc (list 'bold 'underline)

vbar-face)

(telega-ins (telega-symbol 'codeblock))

(telega-ins-prefix " "

(telega-ins

(capitalize (telega-tl-str ent-type :language)))))

(telega-ins "\n")

(telega-ins--line-wrap-prefix vbar

(telega-ins--with-face 'telega-entity-type-code

(telega-ins (telega--desurrogate-apply text)))))))

(list 'telega-display repr

'telega-display-by 'telega-core))))

(textEntityTypeUrl

;; - Unhexify url, using `telega-display' property to be

;; substituted at `telega--desurrogate-apply' time

;; - Convert "xn--" domains to non-ascii version

(nconc (unless (telega--inhibit-telega-display-p 'telega-core)

(list 'telega-display (telega-puny-decode-url

(decode-coding-string

(url-unhex-string text) 'utf-8))))

(telega-link-props 'url text

'face 'telega-entity-type-texturl)))

(textEntityTypeTextUrl

(telega-link-props 'url (telega-tl-str ent-type :url)

'face 'telega-entity-type-texturl

'help-echo (telega-tl-str ent-type :url)))

(textEntityTypeBotCommand

'(face telega-entity-type-botcommand))

(textEntityTypeMediaTimestamp

(list 'action (lambda (button)

(telega-msg-open-media-timestamp

(telega-msg-at button)

(plist-get ent-type :media_timestamp)))

'face 'telega-link))

(textEntityTypeSpoiler

(if (telega--inhibit-telega-display-p 'telega-core)

'(face telega-entity-type-spoiler)

(unless (plist-get ent-type :telega-show-spoiler)

(list :action #'telega-msg-remove-text-spoiler

'telega-display

(with-temp-buffer

(insert text)

(translate-region (point-min) (point-max)

telega-spoiler-translation-table)

(propertize (buffer-string)

'face 'telega-entity-type-spoiler))

'telega-display-by 'telega-core))))

(textEntityTypeCustomEmoji

(when telega-use-images

(when-let ((sticker (gethash (plist-get ent-type :custom_emoji_id)

telega--custom-emoji-stickers)))

(list 'display (telega-sticker--image sticker)))))

(textEntityTypeBlockQuote

(if (telega--inhibit-telega-display-p 'telega-core)

'(face telega-entity-type-blockquote)

(list 'telega-display

(telega-ins--as-string

(telega-ins--line-wrap-prefix (telega-symbol 'vertical-bar)

(telega-ins--with-face 'telega-entity-type-blockquote

(telega-ins (telega--desurrogate-apply text)))))

'telega-display-by 'telega-core)))

)))

;; https://core.telegram.org/bots/api#markdown-style

(defsubst telega--entity-to-markdown (entity-text)

"Convert ENTITY back to markdown syntax applied to TEXT.

ENTITY-TEXT is cons cell where car is the ENTITY and cdr is the TEXT.

Return now text with markdown syntax."

;; NOTE: text might have surrogated pairs, for example when editing

;; message with emojis

(let ((ent-type (plist-get (car entity-text) :type))

(text (cdr entity-text)))

(cl-case (and ent-type (telega--tl-type ent-type))

(textEntityTypeBold (concat "*" text "*"))

(textEntityTypeItalic (concat "_" text "_"))

(textEntityTypeUnderline (concat "__" text "__"))

(textEntityTypeStrikethrough (concat "~" text "~"))

(textEntityTypeCode (concat "`" text "`"))

((textEntityTypePreCode textEntityTypePre)

(concat "```" (plist-get ent-type :language) "\n" text "```"))

(textEntityTypeMentionName