commit d0079c9324e575107b8a90944c9012dd3842946c (HEAD, refs/remotes/origin/master) Author: Andreas Politz Date: Thu Aug 20 08:54:45 2015 +0200 In `widget-color--choose-action' quit *Color* window instead of deleting it * lisp/wid-edit.el (widget-color--choose-action): Quit *Color* window instead of deleting it. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index ac2e981..e98ac18 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3706,9 +3706,9 @@ example: (widget-value-set ',(widget-get widget :parent) color) (let* ((buf (get-buffer "*Colors*")) (win (get-buffer-window buf 0))) - (bury-buffer buf) - (and win (> (length (window-list)) 1) - (delete-window win))) + (if win + (quit-window nil win) + (bury-buffer buf))) (pop-to-buffer ,(current-buffer)))))) (defun widget-color-sample-face-get (widget) commit 186297de6e0e576af2c52ce96a7fc6af3ba3ffc3 Author: Martin Rudalics Date: Thu Aug 20 08:22:53 2015 +0200 In w32fns.c's Fx_frame_geometry rewrite check whether frame has a titlebar * src/w32fns.c (Fx_frame_geometry): Use title_bar.rgstate[0] to determine whether frame has a titlebar. Suggested by Eli Zaretskii diff --git a/src/w32fns.c b/src/w32fns.c index e91097b..a47f3f9 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -8065,24 +8065,26 @@ and width values are in pixels. external_border_width = window.cxWindowBorders; external_border_height = window.cyWindowBorders; /* Title bar. */ - if ((window.dwStyle & WS_CAPTION) == WS_CAPTION) + if (get_title_bar_info_fn) { - if (get_title_bar_info_fn) - { - TITLEBAR_INFO title_bar; + TITLEBAR_INFO title_bar; - title_bar.cbSize = sizeof (title_bar); - title_bar.rcTitleBar.left = title_bar.rcTitleBar.right = 0; - title_bar.rcTitleBar.top = title_bar.rcTitleBar.bottom = 0; - get_title_bar_info_fn (FRAME_W32_WINDOW (f), &title_bar); - title_bar_width + title_bar.cbSize = sizeof (title_bar); + title_bar.rcTitleBar.left = title_bar.rcTitleBar.right = 0; + title_bar.rcTitleBar.top = title_bar.rcTitleBar.bottom = 0; + for (int i = 0; i < 6; i++) + title_bar.rgstate[i] = 0; + if (get_title_bar_info_fn (FRAME_W32_WINDOW (f), &title_bar) + && !(title_bar.rgstate[0] & 0x00008001)) + { + title_bar_width = title_bar.rcTitleBar.right - title_bar.rcTitleBar.left; title_bar_height = title_bar.rcTitleBar.bottom - title_bar.rcTitleBar.top; } - else - title_bar_height = GetSystemMetrics (SM_CYCAPTION); } + else if ((window.dwStyle & WS_CAPTION) == WS_CAPTION) + title_bar_height = GetSystemMetrics (SM_CYCAPTION); /* Menu bar. */ menu_bar.cbSize = sizeof (menu_bar); menu_bar.rcBar.right = menu_bar.rcBar.left = 0; commit 88afeeeafcf018e3eecbcc9be46e227eb312d45a Author: Tassilo Horn Date: Thu Aug 20 07:56:09 2015 +0200 Add a prettify-symbols-alist for (La)TeX * tex-mode.el (tex-prettify-symbols-alist): New variable holding an alist suitable as prettify-symbols-alist in (La)TeX modes. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 535b885..5478386 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -2943,6 +2943,461 @@ There might be text before point." (setq-local syntax-propertize-function (syntax-propertize-rules doctex-syntax-propertize-rules))) +;;; Prettify Symbols Support + +(defvar tex-prettify-symbols-alist + '( ;; Lowercase Greek letters. + ("\\alpha" . ?α) + ("\\beta" . ?β) + ("\\gamma" . ?γ) + ("\\delta" . ?δ) + ("\\epsilon" . ?ε) + ("\\zeta" . ?ζ) + ("\\eta" . ?η) + ("\\theta" . ?θ) + ("\\iota" . ?ι) + ("\\kappa" . ?κ) + ("\\lambda" . ?λ) + ("\\mu" . ?μ) + ("\\nu" . ?ν) + ("\\xi" . ?ξ) + ;; There is no \omicron becase it looks like a latin o. + ("\\pi" . ?π) + ("\\rho" . ?ρ) + ("\\sigma" . ?σ) + ("\\tau" . ?τ) + ("\\upsilon" . ?υ) + ("\\phi" . ?φ) + ("\\chi" . ?χ) + ("\\psi" . ?ψ) + ("\\omega" . ?ω) + ;; Uppercase Greek letters. + ("\\Gamma" . ?Γ) + ("\\Delta" . ?Δ) + ("\\Lambda" . ?Λ) + ("\\Phi" . ?Φ) + ("\\Pi" . ?Π) + ("\\Psi" . ?Ψ) + ("\\Sigma" . ?Σ) + ("\\Theta" . ?Θ) + ("\\Upsilon" . ?Υ) + ("\\Xi" . ?Ξ) + ("\\Omega" . ?Ω) + + ;; Other math symbols (taken from leim/quail/latin-ltx.el). + ("\\Box" . ?□) + ("\\Bumpeq" . ?≎) + ("\\Cap" . ?⋒) + ("\\Cup" . ?⋓) + ("\\Diamond" . ?◇) + ("\\Downarrow" . ?⇓) + ("\\H{o}" . ?ő) + ("\\Im" . ?ℑ) + ("\\Join" . ?⋈) + ("\\Leftarrow" . ?⇐) + ("\\Leftrightarrow" . ?⇔) + ("\\Ll" . ?⋘) + ("\\Lleftarrow" . ?⇚) + ("\\Longleftarrow" . ?⇐) + ("\\Longleftrightarrow" . ?⇔) + ("\\Longrightarrow" . ?⇒) + ("\\Lsh" . ?↰) + ("\\Re" . ?ℜ) + ("\\Rightarrow" . ?⇒) + ("\\Rrightarrow" . ?⇛) + ("\\Rsh" . ?↱) + ("\\Subset" . ?⋐) + ("\\Supset" . ?⋑) + ("\\Uparrow" . ?⇑) + ("\\Updownarrow" . ?⇕) + ("\\Vdash" . ?⊩) + ("\\Vert" . ?‖) + ("\\Vvdash" . ?⊪) + ("\\aleph" . ?ℵ) + ("\\amalg" . ?∐) + ("\\angle" . ?∠) + ("\\approx" . ?≈) + ("\\approxeq" . ?≊) + ("\\ast" . ?∗) + ("\\asymp" . ?≍) + ("\\backcong" . ?≌) + ("\\backepsilon" . ?∍) + ("\\backprime" . ?‵) + ("\\backsim" . ?∽) + ("\\backsimeq" . ?⋍) + ("\\backslash" . ?\\) + ("\\barwedge" . ?⊼) + ("\\because" . ?∵) + ("\\beth" . ?ℶ) + ("\\between" . ?≬) + ("\\bigcap" . ?⋂) + ("\\bigcirc" . ?◯) + ("\\bigcup" . ?⋃) + ("\\bigstar" . ?★) + ("\\bigtriangledown" . ?▽) + ("\\bigtriangleup" . ?△) + ("\\bigvee" . ?⋁) + ("\\bigwedge" . ?⋀) + ("\\blacklozenge" . ?✦) + ("\\blacksquare" . ?▪) + ("\\blacktriangle" . ?▴) + ("\\blacktriangledown" . ?▾) + ("\\blacktriangleleft" . ?◂) + ("\\blacktriangleright" . ?▸) + ("\\bot" . ?⊥) + ("\\bowtie" . ?⋈) + ("\\boxminus" . ?⊟) + ("\\boxplus" . ?⊞) + ("\\boxtimes" . ?⊠) + ("\\bullet" . ?•) + ("\\bumpeq" . ?≏) + ("\\cap" . ?∩) + ("\\cdots" . ?⋯) + ("\\centerdot" . ?·) + ("\\checkmark" . ?✓) + ("\\chi" . ?χ) + ("\\circ" . ?∘) + ("\\circeq" . ?≗) + ("\\circlearrowleft" . ?↺) + ("\\circlearrowright" . ?↻) + ("\\circledR" . ?®) + ("\\circledS" . ?Ⓢ) + ("\\circledast" . ?⊛) + ("\\circledcirc" . ?⊚) + ("\\circleddash" . ?⊝) + ("\\clubsuit" . ?♣) + ("\\coloneq" . ?≔) + ("\\complement" . ?∁) + ("\\cong" . ?≅) + ("\\coprod" . ?∐) + ("\\cup" . ?∪) + ("\\curlyeqprec" . ?⋞) + ("\\curlyeqsucc" . ?⋟) + ("\\curlypreceq" . ?≼) + ("\\curlyvee" . ?⋎) + ("\\curlywedge" . ?⋏) + ("\\curvearrowleft" . ?↶) + ("\\curvearrowright" . ?↷) + ("\\dag" . ?†) + ("\\dagger" . ?†) + ("\\daleth" . ?ℸ) + ("\\dashv" . ?⊣) + ("\\ddag" . ?‡) + ("\\ddagger" . ?‡) + ("\\ddots" . ?⋱) + ("\\diamond" . ?⋄) + ("\\diamondsuit" . ?♢) + ("\\divideontimes" . ?⋇) + ("\\doteq" . ?≐) + ("\\doteqdot" . ?≑) + ("\\dotplus" . ?∔) + ("\\dotsquare" . ?⊡) + ("\\downarrow" . ?↓) + ("\\downdownarrows" . ?⇊) + ("\\downleftharpoon" . ?⇃) + ("\\downrightharpoon" . ?⇂) + ("\\ell" . ?ℓ) + ("\\emptyset" . ?∅) + ("\\eqcirc" . ?≖) + ("\\eqcolon" . ?≕) + ("\\eqslantgtr" . ?⋝) + ("\\eqslantless" . ?⋜) + ("\\equiv" . ?≡) + ("\\exists" . ?∃) + ("\\fallingdotseq" . ?≒) + ("\\flat" . ?♭) + ("\\forall" . ?∀) + ("\\frown" . ?⌢) + ("\\ge" . ?≥) + ("\\geq" . ?≥) + ("\\geqq" . ?≧) + ("\\geqslant" . ?≥) + ("\\gets" . ?←) + ("\\gg" . ?≫) + ("\\ggg" . ?⋙) + ("\\gimel" . ?ℷ) + ("\\gnapprox" . ?⋧) + ("\\gneq" . ?≩) + ("\\gneqq" . ?≩) + ("\\gnsim" . ?⋧) + ("\\gtrapprox" . ?≳) + ("\\gtrdot" . ?⋗) + ("\\gtreqless" . ?⋛) + ("\\gtreqqless" . ?⋛) + ("\\gtrless" . ?≷) + ("\\gtrsim" . ?≳) + ("\\gvertneqq" . ?≩) + ("\\hbar" . ?ℏ) + ("\\heartsuit" . ?♥) + ("\\hookleftarrow" . ?↩) + ("\\hookrightarrow" . ?↪) + ("\\iff" . ?⇔) + ("\\imath" . ?ı) + ("\\in" . ?∈) + ("\\infty" . ?∞) + ("\\int" . ?∫) + ("\\intercal" . ?⊺) + ("\\langle" . 10216) ; Literal ?⟨ breaks indentation. + ("\\lbrace" . ?{) + ("\\lbrack" . ?\[) + ("\\lceil" . ?⌈) + ("\\ldots" . ?…) + ("\\le" . ?≤) + ("\\leadsto" . ?↝) + ("\\leftarrow" . ?←) + ("\\leftarrowtail" . ?↢) + ("\\leftharpoondown" . ?↽) + ("\\leftharpoonup" . ?↼) + ("\\leftleftarrows" . ?⇇) + ;; ("\\leftparengtr" ?〈), see bug#12948. + ("\\leftrightarrow" . ?↔) + ("\\leftrightarrows" . ?⇆) + ("\\leftrightharpoons" . ?⇋) + ("\\leftrightsquigarrow" . ?↭) + ("\\leftthreetimes" . ?⋋) + ("\\leq" . ?≤) + ("\\leqq" . ?≦) + ("\\leqslant" . ?≤) + ("\\lessapprox" . ?≲) + ("\\lessdot" . ?⋖) + ("\\lesseqgtr" . ?⋚) + ("\\lesseqqgtr" . ?⋚) + ("\\lessgtr" . ?≶) + ("\\lesssim" . ?≲) + ("\\lfloor" . ?⌊) + ("\\lhd" . ?◁) + ("\\rhd" . ?▷) + ("\\ll" . ?≪) + ("\\llcorner" . ?⌞) + ("\\lnapprox" . ?⋦) + ("\\lneq" . ?≨) + ("\\lneqq" . ?≨) + ("\\lnsim" . ?⋦) + ("\\longleftarrow" . ?←) + ("\\longleftrightarrow" . ?↔) + ("\\longmapsto" . ?↦) + ("\\longrightarrow" . ?→) + ("\\looparrowleft" . ?↫) + ("\\looparrowright" . ?↬) + ("\\lozenge" . ?✧) + ("\\lq" . ?‘) + ("\\lrcorner" . ?⌟) + ("\\ltimes" . ?⋉) + ("\\lvertneqq" . ?≨) + ("\\maltese" . ?✠) + ("\\mapsto" . ?↦) + ("\\measuredangle" . ?∡) + ("\\mho" . ?℧) + ("\\mid" . ?∣) + ("\\models" . ?⊧) + ("\\mp" . ?∓) + ("\\multimap" . ?⊸) + ("\\nLeftarrow" . ?⇍) + ("\\nLeftrightarrow" . ?⇎) + ("\\nRightarrow" . ?⇏) + ("\\nVDash" . ?⊯) + ("\\nVdash" . ?⊮) + ("\\nabla" . ?∇) + ("\\napprox" . ?≉) + ("\\natural" . ?♮) + ("\\ncong" . ?≇) + ("\\ne" . ?≠) + ("\\nearrow" . ?↗) + ("\\neg" . ?¬) + ("\\neq" . ?≠) + ("\\nequiv" . ?≢) + ("\\newline" . ?
) + ("\\nexists" . ?∄) + ("\\ngeq" . ?≱) + ("\\ngeqq" . ?≱) + ("\\ngeqslant" . ?≱) + ("\\ngtr" . ?≯) + ("\\ni" . ?∋) + ("\\nleftarrow" . ?↚) + ("\\nleftrightarrow" . ?↮) + ("\\nleq" . ?≰) + ("\\nleqq" . ?≰) + ("\\nleqslant" . ?≰) + ("\\nless" . ?≮) + ("\\nmid" . ?∤) + ;; ("\\not" ?̸) ;FIXME: conflict with "NOT SIGN" ¬. + ("\\notin" . ?∉) + ("\\nparallel" . ?∦) + ("\\nprec" . ?⊀) + ("\\npreceq" . ?⋠) + ("\\nrightarrow" . ?↛) + ("\\nshortmid" . ?∤) + ("\\nshortparallel" . ?∦) + ("\\nsim" . ?≁) + ("\\nsimeq" . ?≄) + ("\\nsubset" . ?⊄) + ("\\nsubseteq" . ?⊈) + ("\\nsubseteqq" . ?⊈) + ("\\nsucc" . ?⊁) + ("\\nsucceq" . ?⋡) + ("\\nsupset" . ?⊅) + ("\\nsupseteq" . ?⊉) + ("\\nsupseteqq" . ?⊉) + ("\\ntriangleleft" . ?⋪) + ("\\ntrianglelefteq" . ?⋬) + ("\\ntriangleright" . ?⋫) + ("\\ntrianglerighteq" . ?⋭) + ("\\nvDash" . ?⊭) + ("\\nvdash" . ?⊬) + ("\\nwarrow" . ?↖) + ("\\odot" . ?⊙) + ("\\oint" . ?∮) + ("\\ominus" . ?⊖) + ("\\oplus" . ?⊕) + ("\\oslash" . ?⊘) + ("\\otimes" . ?⊗) + ("\\par" . ?
) + ("\\parallel" . ?∥) + ("\\partial" . ?∂) + ("\\perp" . ?⊥) + ("\\pitchfork" . ?⋔) + ("\\prec" . ?≺) + ("\\precapprox" . ?≾) + ("\\preceq" . ?≼) + ("\\precnapprox" . ?⋨) + ("\\precnsim" . ?⋨) + ("\\precsim" . ?≾) + ("\\prime" . ?′) + ("\\prod" . ?∏) + ("\\propto" . ?∝) + ("\\qed" . ?∎) + ("\\quad" . ? ) + ("\\rangle" . 10217) ; Literal ?⟩ breaks indentation. + ("\\rbrace" . ?}) + ("\\rbrack" . ?\]) + ("\\rceil" . ?⌉) + ("\\rfloor" . ?⌋) + ("\\rightarrow" . ?→) + ("\\rightarrowtail" . ?↣) + ("\\rightharpoondown" . ?⇁) + ("\\rightharpoonup" . ?⇀) + ("\\rightleftarrows" . ?⇄) + ("\\rightleftharpoons" . ?⇌) + ;; ("\\rightparengtr" ?⦔) ;; Was ?〉, see bug#12948. + ("\\rightrightarrows" . ?⇉) + ("\\rightthreetimes" . ?⋌) + ("\\risingdotseq" . ?≓) + ("\\rtimes" . ?⋊) + ("\\sbs" . ?﹨) + ("\\searrow" . ?↘) + ("\\setminus" . ?∖) + ("\\sharp" . ?♯) + ("\\shortmid" . ?∣) + ("\\shortparallel" . ?∥) + ("\\sim" . ?∼) + ("\\simeq" . ?≃) + ("\\smallamalg" . ?∐) + ("\\smallsetminus" . ?∖) + ("\\smallsmile" . ?⌣) + ("\\smile" . ?⌣) + ("\\spadesuit" . ?♠) + ("\\sphericalangle" . ?∢) + ("\\sqcap" . ?⊓) + ("\\sqcup" . ?⊔) + ("\\sqsubset" . ?⊏) + ("\\sqsubseteq" . ?⊑) + ("\\sqsupset" . ?⊐) + ("\\sqsupseteq" . ?⊒) + ("\\square" . ?□) + ("\\squigarrowright" . ?⇝) + ("\\star" . ?⋆) + ("\\straightphi" . ?φ) + ("\\subset" . ?⊂) + ("\\subseteq" . ?⊆) + ("\\subseteqq" . ?⊆) + ("\\subsetneq" . ?⊊) + ("\\subsetneqq" . ?⊊) + ("\\succ" . ?≻) + ("\\succapprox" . ?≿) + ("\\succcurlyeq" . ?≽) + ("\\succeq" . ?≽) + ("\\succnapprox" . ?⋩) + ("\\succnsim" . ?⋩) + ("\\succsim" . ?≿) + ("\\sum" . ?∑) + ("\\supset" . ?⊃) + ("\\supseteq" . ?⊇) + ("\\supseteqq" . ?⊇) + ("\\supsetneq" . ?⊋) + ("\\supsetneqq" . ?⊋) + ("\\surd" . ?√) + ("\\swarrow" . ?↙) + ("\\therefore" . ?∴) + ("\\thickapprox" . ?≈) + ("\\thicksim" . ?∼) + ("\\to" . ?→) + ("\\top" . ?⊤) + ("\\triangle" . ?▵) + ("\\triangledown" . ?▿) + ("\\triangleleft" . ?◃) + ("\\trianglelefteq" . ?⊴) + ("\\triangleq" . ?≜) + ("\\triangleright" . ?▹) + ("\\trianglerighteq" . ?⊵) + ("\\twoheadleftarrow" . ?↞) + ("\\twoheadrightarrow" . ?↠) + ("\\ulcorner" . ?⌜) + ("\\uparrow" . ?↑) + ("\\updownarrow" . ?↕) + ("\\upleftharpoon" . ?↿) + ("\\uplus" . ?⊎) + ("\\uprightharpoon" . ?↾) + ("\\upuparrows" . ?⇈) + ("\\urcorner" . ?⌝) + ("\\u{i}" . ?ĭ) + ("\\vDash" . ?⊨) + ("\\varprime" . ?′) + ("\\varpropto" . ?∝) + ;; ("\\varsigma" ?ς) ;FIXME: Looks reversed with the non\var. + ("\\vartriangleleft" . ?⊲) + ("\\vartriangleright" . ?⊳) + ("\\vdash" . ?⊢) + ("\\vdots" . ?⋮) + ("\\vee" . ?∨) + ("\\veebar" . ?⊻) + ("\\vert" . ?|) + ("\\wedge" . ?∧) + ("\\wp" . ?℘) + ("\\wr" . ?≀) + ("\\Bbb{N}" . ?ℕ) ; AMS commands for blackboard bold + ("\\Bbb{P}" . ?ℙ) ; Also sometimes \mathbb. + ("\\Bbb{R}" . ?ℝ) + ("\\Bbb{Z}" . ?ℤ) + ("--" . ?–) + ("---" . ?—) + ("\\ordfeminine" . ?ª) + ("\\ordmasculine" . ?º) + ("\\lambdabar" . ?ƛ) + ("\\celsius" . ?℃) + ("\\textmu" . ?µ) + ("\\textfractionsolidus" . ?⁄) + ("\\textbigcircle" . ?⃝) + ("\\textmusicalnote" . ?♪) + ("\\textdied" . ?✝) + ("\\textcolonmonetary" . ?₡) + ("\\textwon" . ?₩) + ("\\textnaira" . ?₦) + ("\\textpeso" . ?₱) + ("\\textlira" . ?₤) + ("\\textrecipe" . ?℞) + ("\\textinterrobang" . ?‽) + ("\\textpertenthousand" . ?‱) + ("\\textbaht" . ?฿) + ("\\textnumero" . ?№) + ("\\textdiscount" . ?⁒) + ("\\textestimated" . ?℮) + ("\\textopenbullet" . ?◦) + ("\\textlquill" . 8261) ; Literal ?⁅ breaks indentation. + ("\\textrquill" . 8262) ; Literal ?⁆ breaks indentation. + ("\\textcircledP" . ?℗) + ("\\textreferencemark" . ?※)) + "A `prettify-symbols-alist' usable for (La)TeX modes.") + (run-hooks 'tex-mode-load-hook) (provide 'tex-mode) commit 82a3da21ffece64ce9f4f99f35cbc0afe851e6ee Author: Alan Mackenzie Date: Wed Aug 19 16:47:10 2015 +0000 Make electric-pair-mode, delete-selection-mode and CC Mode cooperate. Fixes debbugs#21275. In Emacs >= 25, let electric-pair-mode take precedence over delete-selection-mode. delsel.el (delete-selection-uses-region-p): New function, previously a lambda expression in a property value for `self-insert-command'. (top-level) Set the `delete-selection' property of `self-insert-command' to `delete-selection-uses-region-p'. progmodes/cc-cmds.el (top-level): Give the `delete-selection' property for c-electric-\(brace\|paren\) the value `delete-selection-uses-region-p' when the latter function exists. diff --git a/lisp/delsel.el b/lisp/delsel.el index 740b603..586c130 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -231,10 +231,17 @@ See `delete-selection-helper'." (delete-selection-helper (and (symbolp this-command) (get this-command 'delete-selection))))) -(put 'self-insert-command 'delete-selection - (lambda () - (not (run-hook-with-args-until-success - 'self-insert-uses-region-functions)))) +(defun delete-selection-uses-region-p () + "Return t when the current command will be using the region +rather than having `delete-selection' delete it, nil otherwise. + +This function is intended for use as the value of the +`delete-selection' property of a command, and shouldn't be used +for anything else." + (not (run-hook-with-args-until-success + 'self-insert-uses-region-functions))) + +(put 'self-insert-command 'delete-selection 'delete-selection-uses-region-p) (put 'insert-char 'delete-selection t) (put 'quoted-insert 'delete-selection t) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index c9f5945..0beaf26 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -2853,19 +2853,28 @@ sentence motion in or near comments and multiline strings." ;; set up electric character functions to work with pending-del, ;; (a.k.a. delsel) mode. All symbols get the t value except -;; the functions which delete, which gets 'supersede. +;; the functions which delete, which gets 'supersede, and (from Emacs +;; 25) `c-electric-brace' and `c-electric-paren' get special handling +;; so as to work gracefully with `electric-pair-mode'. (mapc (function (lambda (sym) (put sym 'delete-selection t) ; for delsel (Emacs) (put sym 'pending-delete t))) ; for pending-del (XEmacs) '(c-electric-pound - c-electric-brace c-electric-slash c-electric-star c-electric-semi&comma c-electric-lt-gt - c-electric-colon + c-electric-colon)) +(mapc + (function + (lambda (sym) + (put sym 'delete-selection (if (fboundp 'delete-selection-uses-region-p) + 'delete-selection-uses-region-p + t)) + (put sym 'pending-delete t))) + '(c-electric-brace c-electric-paren)) (put 'c-electric-delete 'delete-selection 'supersede) ; delsel (put 'c-electric-delete 'pending-delete 'supersede) ; pending-del commit ec07cfbee12528b9800a8c8fa019af72e3c9cfe4 Author: Paul Eggert Date: Wed Aug 19 09:40:33 2015 -0700 Fix key binding quoting in tutorial *Help* * lisp/tutorial.el (tutorial--describe-nonstandard-key): When generating help for custom key bindings, use the user-preferred quoting style rather than hardcoding the grave style. diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 3b00761..9fea316 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -134,21 +134,19 @@ options: (eq map (symbol-value s)) ;; then save this value in mapsym (setq mapsym s))))) - (insert "The default Emacs binding for the key " - (key-description key) - " is the command `") - (insert (format "%s" db)) - (insert "'. " - "However, your customizations have " + (insert + (format + "The default Emacs binding for the key %s is the command ‘%s’. " + (key-description key) + db)) + (insert "However, your customizations have " (if cb - (format "rebound it to the command `%s'" cb) + (format "rebound it to the command ‘%s’" cb) "unbound it")) (insert ".") (when mapsym (insert " (For the more advanced user:" - " This binding is in the keymap `" - (format "%s" mapsym) - "'.)")) + (format " This binding is in the keymap ‘%s’.)" mapsym))) (if (string= where "") (unless (keymapp db) (insert "\n\nYou can use M-x " @@ -160,9 +158,7 @@ options: "" "the key") where - " to get the function `" - (format "%s" db) - "'."))) + (format " to get the function ‘%s’." db)))) (fill-region (point-min) (point))))) (help-print-return-message)))) @@ -454,7 +450,7 @@ where (lookup-key global-map [menu-bar])))) (stringp cwhere)) - (format "the `%s' menu" cwhere) + (format "the ‘%s’ menu" cwhere) "the menus")))) (setq where "")) (setq remark nil) commit ae7cfd0baf24fda984ff4c0631bcaa477ea11b7f Author: Eli Zaretskii Date: Wed Aug 19 18:04:22 2015 +0300 Improve and future-proof OTF fonts support in w32uniscribe.c * src/w32uniscribe.c (uniscribe_otf_capability): Add commentary about the expected results and why the new Uniscribe APIs are not used in this function. (ScriptGetFontScriptTags_Proc, ScriptGetFontLanguageTags_Proc) (ScriptGetFontFeatureTags_Proc): New function typedefs. (uniscribe_new_apis): New static variable. (uniscribe_check_features): New function, implements OTF features verification while correctly accounting for features in the list after the nil member, if any. (uniscribe_check_otf_1): New function, retrieves the features supported by the font for the requested script and language using the Uniscribe APIs available from Windows Vista onwards. (uniscribe_check_otf): If the new Uniscribe APIs are available, use them in preference to reading the font data directly. Call uniscribe_check_features to verify that the requested features are supported, replacing the original incomplete code. (syms_of_w32uniscribe): Initialize function pointers for the new Uniscribe APIs. (Bug#21260) (otf_features): Scan the script, langsys, and feature arrays back to front, so that the result we return has them in alphabetical order, like ftfont.c does. * src/w32fns.c (syms_of_w32fns) : New variable for debugging w32uniscribe.c code. diff --git a/src/w32fns.c b/src/w32fns.c index 189a27c..e91097b 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -9242,6 +9242,16 @@ Default is nil. This variable has effect only on NT family of systems, not on Windows 9X. */); w32_use_fallback_wm_chars_method = 0; + DEFVAR_BOOL ("w32-disable-new-uniscribe-apis", + w32_disable_new_uniscribe_apis, + doc: /* Non-nil means don't use new Uniscribe APIs. +The new APIs are used to access OTF features supported by fonts. +This is intended only for debugging of the new Uniscribe-related code. +Default is nil. + +This variable has effect only on Windows Vista and later. */); + w32_disable_new_uniscribe_apis = 0; + #if 0 /* TODO: Port to W32 */ defsubr (&Sx_change_window_property); defsubr (&Sx_delete_window_property); diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index 73c0410..b1056bc 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -141,7 +141,26 @@ uniscribe_close (struct font *font) } /* Return a list describing which scripts/languages FONT supports by - which GSUB/GPOS features of OpenType tables. */ + which GSUB/GPOS features of OpenType tables. + + Implementation note: otf_features called by this function uses + GetFontData to access the font tables directly, instead of using + ScriptGetFontScriptTags etc. APIs even if those are available. The + reason is that font-get, which uses the result of this function, + expects a cons cell (GSUB . GPOS) where the features are reported + separately for these 2 OTF tables, while the Uniscribe APIs report + the features as a single list. There doesn't seem to be a reason + for returning the features in 2 separate parts, except for + compatibility with libotf; the features are disjoint (each can + appear only in one of the 2 slots), and no client of this data + discerns between the two slots: the few that request this data all + look in both slots. If use of the Uniscribe APIs ever becomes + necessary here, and the 2 separate slots are still required, it + should be possible to split the feature list the APIs return into 2 + because each sub-list is alphabetically sorted, so the place where + the sorting order breaks is where the GSUB features end and GPOS + features begin. But for now, this is not necessary, so we leave + the original code in place. */ static Lisp_Object uniscribe_otf_capability (struct font *font) { @@ -643,7 +662,7 @@ add_opentype_font_name_to_list (ENUMLOGFONTEX *logical_font, /* :otf property handling. Since the necessary Uniscribe APIs for getting font tag information - are only available in Vista, we need to parse the font data directly + are only available in Vista, we may need to parse the font data directly according to the OpenType Specification. */ /* Push into DWORD backwards to cope with endianness. */ @@ -674,7 +693,171 @@ add_opentype_font_name_to_list (ENUMLOGFONTEX *logical_font, STR[4] = '\0'; \ } while (0) -#define SNAME(VAL) SDATA (SYMBOL_NAME (VAL)) +#define SNAME(VAL) SSDATA (SYMBOL_NAME (VAL)) + +/* Uniscribe APIs available only since Windows Vista. */ +typedef HRESULT (WINAPI *ScriptGetFontScriptTags_Proc) + (HDC, SCRIPT_CACHE *, SCRIPT_ANALYSIS *, int, OPENTYPE_TAG *, int *); + +typedef HRESULT (WINAPI *ScriptGetFontLanguageTags_Proc) + (HDC, SCRIPT_CACHE *, SCRIPT_ANALYSIS *, OPENTYPE_TAG, int, OPENTYPE_TAG *, int *); + +typedef HRESULT (WINAPI *ScriptGetFontFeatureTags_Proc) + (HDC, SCRIPT_CACHE *, SCRIPT_ANALYSIS *, OPENTYPE_TAG, OPENTYPE_TAG, int, OPENTYPE_TAG *, int *); + +ScriptGetFontScriptTags_Proc script_get_font_scripts_fn; +ScriptGetFontLanguageTags_Proc script_get_font_languages_fn; +ScriptGetFontFeatureTags_Proc script_get_font_features_fn; + +static bool uniscribe_new_apis; + +/* Verify that all the required features in FEATURES, each of whose + elements is a list or nil, can be found among the N feature tags in + FTAGS. Return 'true' if the required features are supported, + 'false' if not. Each list in FEATURES can include an element of + nil, which means all the elements after it must not be in FTAGS. */ +static bool +uniscribe_check_features (Lisp_Object features[2], OPENTYPE_TAG *ftags, int n) +{ + int j; + + for (j = 0; j < 2; j++) + { + bool negative = false; + Lisp_Object rest; + + for (rest = features[j]; CONSP (rest); rest = XCDR (rest)) + { + Lisp_Object feature = XCAR (rest); + + /* The font must NOT have any of the features after nil. + See the doc string of 'font-spec', under ':otf'. */ + if (NILP (feature)) + negative = true; + else + { + OPENTYPE_TAG feature_tag = OTF_TAG (SNAME (feature)); + int i; + + for (i = 0; i < n; i++) + { + if (ftags[i] == feature_tag) + { + /* Test fails if we find a feature that the font + must NOT have. */ + if (negative) + return false; + break; + } + } + + /* Test fails if we do NOT find a feature that the font + should have. */ + if (i >= n && !negative) + return false; + } + } + } + + return true; +} + +/* Check if font supports the required OTF script/language/features + using the Unsicribe APIs available since Windows Vista. We prefer + these APIs as a kind of future-proofing Emacs: they seem to + retrieve script tags that the old code (and also libotf) doesn't + seem to be able to get, e.g., some fonts that claim support for + "dev2" script don't show "deva", but the new APIs do report it. */ +static int +uniscribe_check_otf_1 (HDC context, Lisp_Object script, Lisp_Object lang, + Lisp_Object features[2], int *retval) +{ + SCRIPT_CACHE cache = NULL; + OPENTYPE_TAG tags[32], script_tag, lang_tag; + int max_tags = ARRAYELTS (tags); + int ntags, i, ret = 0; + HRESULT rslt; + Lisp_Object rest; + + *retval = 0; + + rslt = script_get_font_scripts_fn (context, &cache, NULL, max_tags, + tags, &ntags); + if (FAILED (rslt)) + { + DebPrint (("ScriptGetFontScriptTags failed with 0x%x\n", rslt)); + ret = -1; + goto no_support; + } + if (NILP (script)) + script_tag = OTF_TAG ("DFLT"); + else + script_tag = OTF_TAG (SNAME (script)); + for (i = 0; i < ntags; i++) + if (tags[i] == script_tag) + break; + + if (i >= ntags) + goto no_support; + + if (NILP (lang)) + lang_tag = OTF_TAG ("dflt"); + else + { + rslt = script_get_font_languages_fn (context, &cache, NULL, script_tag, + max_tags, tags, &ntags); + if (FAILED (rslt)) + { + DebPrint (("ScriptGetFontLanguageTags failed with 0x%x\n", rslt)); + ret = -1; + goto no_support; + } + if (ntags == 0) + lang_tag = OTF_TAG ("dflt"); + else + { + lang_tag = OTF_TAG (SNAME (lang)); + for (i = 0; i < ntags; i++) + if (tags[i] == lang_tag) + break; + + if (i >= ntags) + goto no_support; + } + } + + if (!NILP (features[0])) + { + /* Are the 2 feature lists valid? */ + if (!CONSP (features[0]) + || (!NILP (features[1]) && !CONSP (features[1]))) + goto no_support; + rslt = script_get_font_features_fn (context, &cache, NULL, + script_tag, lang_tag, + max_tags, tags, &ntags); + if (FAILED (rslt)) + { + DebPrint (("ScriptGetFontFeatureTags failed with 0x%x\n", rslt)); + ret = -1; + goto no_support; + } + + /* ScriptGetFontFeatureTags doesn't let us query features + separately for GSUB and GPOS, so we check them all together. + It doesn't really matter, since the features in GSUB and GPOS + are disjoint, i.e. no feature can appear in both tables. */ + if (!uniscribe_check_features (features, tags, ntags)) + goto no_support; + } + + ret = 1; + *retval = 1; + + no_support: + if (cache) + ScriptFreeCache (&cache); + return ret; +} /* Check if font supports the otf script/language/features specified. OTF_SPEC is in the format @@ -710,6 +893,18 @@ uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec) else features[1] = XCAR (rest); + /* Set up graphics context so we can use the font. */ + f = XFRAME (selected_frame); + context = get_frame_dc (f); + check_font = CreateFontIndirect (font); + old_font = SelectObject (context, check_font); + + /* If we are on Vista or later, use the new APIs. */ + if (uniscribe_new_apis + && !w32_disable_new_uniscribe_apis + && uniscribe_check_otf_1 (context, script, lang, features, &retval) != -1) + goto done; + /* Set up tags we will use in the search. */ feature_tables[0] = OTF_TAG ("GSUB"); feature_tables[1] = OTF_TAG ("GPOS"); @@ -721,12 +916,6 @@ uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec) if (!NILP (lang)) lang_tag = OTF_TAG (SNAME (lang)); - /* Set up graphics context so we can use the font. */ - f = XFRAME (selected_frame); - context = get_frame_dc (f); - check_font = CreateFontIndirect (font); - old_font = SelectObject (context, check_font); - /* Everything else is contained within otf_spec so should get marked along with it. */ GCPRO1 (otf_spec); @@ -739,6 +928,8 @@ uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec) unsigned short script_table, langsys_table, n_langs; unsigned short feature_index, n_features; DWORD tbl = feature_tables[i]; + DWORD feature_id, *ftags; + Lisp_Object farray[2]; /* Skip if no features requested from this table. */ if (NILP (features[i])) @@ -805,51 +996,49 @@ uniscribe_check_otf (LOGFONT *font, Lisp_Object otf_spec) /* Offset is from beginning of script table. */ langsys_table += script_table; - /* Check the features. Features may contain nil according to - documentation in font_prop_validate_otf, so count them. */ - n_match_features = 0; - for (rest = features[i]; CONSP (rest); rest = XCDR (rest)) - { - Lisp_Object feature = XCAR (rest); - if (!NILP (feature)) - n_match_features++; - } - /* If there are no features to check, skip checking. */ - if (!n_match_features) + if (NILP (features[i])) continue; + if (!CONSP (features[i])) + goto no_support; + + n_match_features = 0; - /* First check required feature (if any). */ + /* First get required feature (if any). */ OTF_INT16_VAL (tbl, langsys_table + 2, &feature_index); if (feature_index != 0xFFFF) + n_match_features = 1; + OTF_INT16_VAL (tbl, langsys_table + 4, &n_features); + n_match_features += n_features; + USE_SAFE_ALLOCA; + SAFE_NALLOCA (ftags, 1, n_match_features); + int k = 0; + if (feature_index != 0xFFFF) { - char feature_id[5]; - OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id); - OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id); - /* Assume no duplicates in the font table. This allows us to mark - the features off by simply decrementing a counter. */ - if (!NILP (Fmemq (intern (feature_id), features[i]))) - n_match_features--; + OTF_DWORDTAG_VAL (tbl, feature_table + 2 + feature_index * 6, + &feature_id); + ftags[k++] = feature_id; } - /* Now check all the other features. */ - OTF_INT16_VAL (tbl, langsys_table + 4, &n_features); + /* Now get all the other features. */ for (j = 0; j < n_features; j++) { - char feature_id[5]; OTF_INT16_VAL (tbl, langsys_table + 6 + j * 2, &feature_index); - OTF_TAG_VAL (tbl, feature_table + 2 + feature_index * 6, feature_id); - /* Assume no duplicates in the font table. This allows us to mark - the features off by simply decrementing a counter. */ - if (!NILP (Fmemq (intern (feature_id), features[i]))) - n_match_features--; + OTF_DWORDTAG_VAL (tbl, feature_table + 2 + feature_index * 6, + &feature_id); + ftags[k++] = feature_id; } - if (n_match_features > 0) + /* Check the features for this table. */ + farray[0] = features[i]; + farray[1] = Qnil; + if (!uniscribe_check_features (farray, ftags, n_match_features)) goto no_support; + SAFE_FREE (); } retval = 1; + done: no_support: font_table_error: /* restore graphics context. */ @@ -873,7 +1062,7 @@ otf_features (HDC context, char *table) OTF_INT16_VAL (tbl, 6, &feature_table); OTF_INT16_VAL (tbl, scriptlist_table, &n_scripts); - for (i = 0; i < n_scripts; i++) + for (i = n_scripts - 1; i >= 0; i--) { char script[5], lang[5]; unsigned short script_table, lang_count, langsys_table, feature_count; @@ -898,7 +1087,7 @@ otf_features (HDC context, char *table) langsys_tag = Qnil; feature_list = Qnil; OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count); - for (k = 0; k < feature_count; k++) + for (k = feature_count - 1; k >= 0; k--) { char feature[5]; unsigned short index; @@ -913,7 +1102,7 @@ otf_features (HDC context, char *table) /* List of supported languages. */ OTF_INT16_VAL (tbl, script_table + 2, &lang_count); - for (j = 0; j < lang_count; j++) + for (j = lang_count - 1; j >= 0; j--) { record_offset = script_table + 4 + j * 6; OTF_TAG_VAL (tbl, record_offset, lang); @@ -925,7 +1114,7 @@ otf_features (HDC context, char *table) langsys_tag = intern (lang); feature_list = Qnil; OTF_INT16_VAL (tbl, langsys_table + 4, &feature_count); - for (k = 0; k < feature_count; k++) + for (k = feature_count - 1; k >= 0; k--) { char feature[5]; unsigned short index; @@ -1003,4 +1192,17 @@ syms_of_w32uniscribe (void) uniscribe_available = 1; register_font_driver (&uniscribe_font_driver, NULL); + + script_get_font_scripts_fn = (ScriptGetFontScriptTags_Proc) + GetProcAddress (uniscribe, "ScriptGetFontScriptTags"); + script_get_font_languages_fn = (ScriptGetFontLanguageTags_Proc) + GetProcAddress (uniscribe, "ScriptGetFontLanguageTags"); + script_get_font_features_fn = (ScriptGetFontFeatureTags_Proc) + GetProcAddress (uniscribe, "ScriptGetFontFeatureTags"); + if (script_get_font_scripts_fn + && script_get_font_languages_fn + && script_get_font_features_fn) + uniscribe_new_apis = true; + else + uniscribe_new_apis = false; } commit 7eed7399358faecd719febae4dc720ef2be41155 Author: Artur Malabarba Date: Wed Aug 19 11:43:29 2015 +0100 * isearch.el (isearch-search-fun-default): Revert a5bdb87 Remove usage of `isearch-lax-whitespace' inside the `iearch-word' clause of `isearch-search-fun-default'. That lax variable does not refer to lax-whitespacing. Related to (bug#21777). This reverts commit a5bdb872edb9f031fe041faf9a8c0be432e5f64c. * character-fold.el (character-fold-search): Set to nil Default to nil for now, until someone implements proper lax-whitespacing with char-fold searching. diff --git a/lisp/character-fold.el b/lisp/character-fold.el index 6bbb3ec..988a506 100644 --- a/lisp/character-fold.el +++ b/lisp/character-fold.el @@ -24,7 +24,7 @@ ;;;###autoload -(defvar character-fold-search t +(defvar character-fold-search nil "Non-nil if searches should fold similar characters. This means some characters will match entire groups of characters. For instance, \" will match all variants of double quotes, and diff --git a/lisp/isearch.el b/lisp/isearch.el index 2d2f0ee..8d4bf24 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2607,12 +2607,11 @@ Can be changed via `isearch-search-fun-function' for special needs." ;; Use lax versions to not fail at the end of the word while ;; the user adds and removes characters in the search string ;; (or when using nonincremental word isearch) - (let ((lax (or isearch-lax-whitespace - (not (or isearch-nonincremental - (null (car isearch-cmds)) - (eq (length isearch-string) - (length (isearch--state-string - (car isearch-cmds))))))))) + (let ((lax (not (or isearch-nonincremental + (null (car isearch-cmds)) + (eq (length isearch-string) + (length (isearch--state-string + (car isearch-cmds)))))))) (funcall (if isearch-forward #'re-search-forward #'re-search-backward) (if (functionp isearch-word) commit 7047d3642fb20955b83c1dfb3d5a70d869072731 Author: Martin Rudalics Date: Wed Aug 19 11:33:25 2015 +0200 Fix doc-string of `help-mode-finish'. * lisp/help-mode.el (help-mode-finish): Fix doc-string. diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 37847e2..22e5386 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -300,7 +300,7 @@ Commands: ;;;###autoload (defun help-mode-finish () - "Exit Help Mode in the current buffer." + "Finalize Help Mode setup in current buffer." (when (derived-mode-p 'help-mode) (setq buffer-read-only t) (help-make-xrefs (current-buffer)))) commit 19cdde4aeadceb56b4ac08c69441fe52c6d2aa8f Author: Martin Rudalics Date: Wed Aug 19 11:26:37 2015 +0200 In nsimage.m include coding.h (Bug#21292) * src/nsimage.m (top-level): Include coding.h (Bug#21292). diff --git a/src/nsimage.m b/src/nsimage.m index 5d0871b..9eaeefe 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -33,6 +33,7 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) #include "dispextern.h" #include "nsterm.h" #include "frame.h" +#include "coding.h" /* call tracing */ #if 0 commit f5a14da109b1ddbcf0e9e31cf0f1d385a95c0b60 Author: Martin Rudalics Date: Wed Aug 19 11:20:44 2015 +0200 Move window edge functions to Elisp. * src/window.c (Fwindow_edges, Fwindow_pixel_edges) (Fwindow_absolute_pixel_edges, Fwindow_inside_edges) (Fwindow_inside_pixel_edges, Fwindow_inside_absolute_pixel_edges): Move to window.el. (calc_absolute_offset): Remove. * lisp/frame.el (frame-edges): New function. * lisp/window.el (window-edges, window-pixel-edges) (window-absolute-pixel-edges): Move here from window.c. (window-body-edges, window-body-pixel-edges) (window-absolute-body-pixel-edges): Move here from window.c and rename "inside" to "body". Keep old names as aliases. (window-absolute-pixel-position): New function. diff --git a/lisp/frame.el b/lisp/frame.el index d1e7c00..391f239 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1312,6 +1312,24 @@ live frame and defaults to the selected one." (setq vertical default-frame-scroll-bars)) (cons vertical (and horizontal 'bottom)))) +(defun frame-edges (&optional frame type) + "Return coordinates of FRAME's edges. +FRAME must be a live frame and defaults to the selected one. The +list returned has the form (LEFT TOP RIGHT BOTTOM) where all +values are in pixels relative to the origin - the position (0, 0) +- of FRAME's display. For terminal frames all values are +relative to LEFT and TOP which are both zero. + +Optional argument TYPE specifies the type of the edges. TYPE +`outer-edges' means to return the outer edges of FRAME. TYPE +`native-edges' (or nil) means to return the native edges of +FRAME. TYPE `inner-edges' means to return the inner edges of +FRAME." + (let ((frame (window-normalize-frame frame))) + (if (display-graphic-p (frame-parameter nil 'display)) + (x-frame-edges frame (or type 'native-edges)) + (list 0 0 (frame-width frame) (frame-height frame))))) + (defun frame-monitor-attributes (&optional frame) "Return the attributes of the physical monitor dominating FRAME. If FRAME is omitted or nil, describe the currently selected frame. diff --git a/lisp/window.el b/lisp/window.el index d9c0d0a..ebe7054 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -3422,6 +3422,134 @@ WINDOW pixelwise." (- (window-min-delta window t nil nil nil nil window-resize-pixelwise)) t nil window-resize-pixelwise)) +;;; Window edges +(defun window-edges (&optional window body absolute pixelwise) + "Return a list of the edge distances of WINDOW. +WINDOW must be a valid window and defaults to the selected one. +The list returned has the form (LEFT TOP RIGHT BOTTOM). + +If the optional argument BODY is nil, this means to return the +edges corresponding to the total size of WINDOW. BODY non-nil +means to return the edges of WINDOW's body (aka text area). If +BODY is non-nil, WINDOW must specify a live window. + +Optional argument ABSOLUTE nil means to return edges relative to +the position of WINDOW's native frame. ABSOLUTE non-nil means to +return coordinates relative to the origin - the position (0, 0) - +of FRAME's display. On non-graphical systems this argument has +no effect. + +Optional argument PIXELWISE nil means to return the coordinates +in terms of the canonical character width and height of WINDOW's +frame, rounded if necessary. PIXELWISE non-nil means to return +the coordinates in pixels where the values for RIGHT and BOTTOM +are one more than the actual value of these edges. Note that if +ABSOLUTE is non-nil, PIXELWISE is implicily non-nil too." + (let* ((window (window-normalize-window window body)) + (frame (window-frame window)) + (border-width (frame-border-width frame)) + (char-width (frame-char-width frame)) + (char-height (frame-char-height frame)) + (left (if pixelwise + (+ (window-pixel-left window) border-width) + (+ (window-left-column window) + (/ border-width char-width)))) + (left-body + (when body + (+ (window-pixel-left window) border-width + (if (eq (car (window-current-scroll-bars window)) 'left) + (window-scroll-bar-width window) + 0) + (nth 0 (window-fringes window)) + (* (or (nth 0 (window-margins window)) 0) char-width)))) + (top (if pixelwise + (+ (window-pixel-top window) border-width) + (+ (window-top-line window) + (/ border-width char-height)))) + (top-body + (when body + (+ (window-pixel-top window) border-width + (window-header-line-height window)))) + (right (+ left (if pixelwise + (window-pixel-width window) + (window-total-width window)))) + (right-body (and body (+ left-body (window-body-width window t)))) + (bottom (+ top (if pixelwise + (window-pixel-height window) + (window-total-height window)))) + (bottom-body (and body (+ top-body (window-body-height window t)))) + left-off right-off) + (if absolute + (let* ((native-edges (frame-edges frame 'native-edges)) + (left-off (nth 0 native-edges)) + (top-off (nth 1 native-edges))) + (if body + (list (+ left-body left-off) (+ top-body top-off) + (+ right-body left-off) (+ bottom-body top-off)) + (list (+ left left-off) (+ top top-off) + (+ right left-off) (+ bottom top-off)))) + (if body + (if pixelwise + (list left-body top-body right-body bottom-body) + (list (/ left-body char-width) (/ top-body char-height) + ;; Round up. + (/ (+ right-body char-width -1) char-width) + (/ (+ bottom-body char-height -1) char-height))) + (list left top right bottom))))) + +(defun window-body-edges (&optional window) + "Return a list of the edge coordinates of WINDOW's body. +The return value is that of `window-edges' called with argument +BODY non-nil." + (window-edges window t)) +(defalias 'window-inside-edges 'window-body-edges) + +(defun window-pixel-edges (&optional window) + "Return a list of the edge pixel coordinates of WINDOW. +The return value is that of `window-edges' called with argument +PIXELWISE non-nil." + (window-edges window nil nil t)) + +(defun window-body-pixel-edges (&optional window) + "Return a list of the edge pixel coordinates of WINDOW's body. +The return value is that of `window-edges' called with arguments +BODY and PIXELWISE non-nil." + (window-edges window t nil t)) +(defalias 'window-inside-pixel-edges 'window-body-pixel-edges) + +(defun window-absolute-pixel-edges (&optional window) + "Return a list of the edge pixel coordinates of WINDOW. +The return value is that of `window-edges' called with argument +ABSOLUTE non-nil." + (window-edges window nil t t)) + +(defun window-absolute-body-pixel-edges (&optional window) + "Return a list of the edge pixel coordinates of WINDOW's text area. +The return value is that of `window-edges' called with arguments +BODY and ABSOLUTE non-nil." + (window-edges window t t t)) +(defalias 'window-inside-absolute-pixel-edges 'window-absolute-body-pixel-edges) + +(defun window-absolute-pixel-position (&optional position window) + "Return display coordinates of POSITION in WINDOW. +If the buffer position POSITION is visible in window WINDOW, +return the display coordinates of the upper/left corner of the +glyph at POSITION. The return value is a cons of the X- and +Y-coordinates of that corner, relative to an origin at (0, 0) of +WINDOW's display. Return nil if POSITION is not visible in +WINDOW. + +WINDOW must be a live window and defaults to the selected window. +POSITION defaults to the value of `window-point' of WINDOW." + (let* ((window (window-normalize-window window t)) + (pos-in-window + (pos-visible-in-window-p + (or position (window-point window)) window t))) + (when pos-in-window + (let ((edges (window-absolute-body-pixel-edges window))) + (cons (+ (nth 0 edges) (nth 0 pos-in-window)) + (+ (nth 1 edges) (nth 1 pos-in-window))))))) + (defun frame-root-window-p (window) "Return non-nil if WINDOW is the root window of its frame." (eq window (frame-root-window window))) diff --git a/src/window.c b/src/window.c index ad5ac79..863a792 100644 --- a/src/window.c +++ b/src/window.c @@ -1101,186 +1101,6 @@ end-trigger value is reset to nil. */) return value; } -DEFUN ("window-edges", Fwindow_edges, Swindow_edges, 0, 1, 0, - doc: /* Return a list of the edge coordinates of WINDOW. -WINDOW must be a valid window and defaults to the selected one. - -The returned list has the form (LEFT TOP RIGHT BOTTOM). TOP and BOTTOM -count by lines, and LEFT and RIGHT count by columns, all relative to 0, -0 at top left corner of frame. - -RIGHT is one more than the rightmost column occupied by WINDOW. BOTTOM -is one more than the bottommost row occupied by WINDOW. The edges -include the space used by WINDOW's scroll bar, display margins, fringes, -header line, and/or mode line. For the edges of just the text area, use -`window-inside-edges'. */) - (Lisp_Object window) -{ - register struct window *w = decode_valid_window (window); - - return list4i (WINDOW_LEFT_EDGE_COL (w), WINDOW_TOP_EDGE_LINE (w), - WINDOW_RIGHT_EDGE_COL (w), WINDOW_BOTTOM_EDGE_LINE (w)); -} - -DEFUN ("window-pixel-edges", Fwindow_pixel_edges, Swindow_pixel_edges, 0, 1, 0, - doc: /* Return a list of the edge pixel coordinates of WINDOW. -WINDOW must be a valid window and defaults to the selected one. - -The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to -0, 0 at the top left corner of the frame. - -RIGHT is one more than the rightmost x position occupied by WINDOW. -BOTTOM is one more than the bottommost y position occupied by WINDOW. -The pixel edges include the space used by WINDOW's scroll bar, display -margins, fringes, header line, and/or mode line. For the pixel edges -of just the text area, use `window-inside-pixel-edges'. */) - (Lisp_Object window) -{ - register struct window *w = decode_valid_window (window); - - return list4i (WINDOW_LEFT_EDGE_X (w), WINDOW_TOP_EDGE_Y (w), - WINDOW_RIGHT_EDGE_X (w), WINDOW_BOTTOM_EDGE_Y (w)); -} - -static void -calc_absolute_offset (struct window *w, int *add_x, int *add_y) -{ - struct frame *f = XFRAME (w->frame); - *add_y = f->top_pos; -#ifdef FRAME_MENUBAR_HEIGHT - *add_y += FRAME_MENUBAR_HEIGHT (f); -#endif -#ifdef FRAME_TOOLBAR_TOP_HEIGHT - *add_y += FRAME_TOOLBAR_TOP_HEIGHT (f); -#elif defined (FRAME_TOOLBAR_HEIGHT) - *add_y += FRAME_TOOLBAR_HEIGHT (f); -#endif -#ifdef FRAME_NS_TITLEBAR_HEIGHT - *add_y += FRAME_NS_TITLEBAR_HEIGHT (f); -#endif - *add_x = f->left_pos; -#ifdef FRAME_TOOLBAR_LEFT_WIDTH - *add_x += FRAME_TOOLBAR_LEFT_WIDTH (f); -#endif -} - -DEFUN ("window-absolute-pixel-edges", Fwindow_absolute_pixel_edges, - Swindow_absolute_pixel_edges, 0, 1, 0, - doc: /* Return a list of the edge pixel coordinates of WINDOW. -WINDOW must be a valid window and defaults to the selected one. - -The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to -0, 0 at the top left corner of the display. - -RIGHT is one more than the rightmost x position occupied by WINDOW. -BOTTOM is one more than the bottommost y position occupied by WINDOW. -The pixel edges include the space used by WINDOW's scroll bar, display -margins, fringes, header line, and/or mode line. For the pixel edges -of just the text area, use `window-inside-absolute-pixel-edges'. */) - (Lisp_Object window) -{ - register struct window *w = decode_valid_window (window); - int add_x, add_y; - - calc_absolute_offset (w, &add_x, &add_y); - - return list4i (WINDOW_LEFT_EDGE_X (w) + add_x, - WINDOW_TOP_EDGE_Y (w) + add_y, - WINDOW_RIGHT_EDGE_X (w) + add_x, - WINDOW_BOTTOM_EDGE_Y (w) + add_y); -} - -DEFUN ("window-inside-edges", Fwindow_inside_edges, Swindow_inside_edges, 0, 1, 0, - doc: /* Return a list of the edge coordinates of WINDOW. -WINDOW must be a live window and defaults to the selected one. - -The returned list has the form (LEFT TOP RIGHT BOTTOM). TOP and BOTTOM -count by lines, and LEFT and RIGHT count by columns, all relative to 0, -0 at top left corner of frame. - -RIGHT is one more than the rightmost column of WINDOW's text area. -BOTTOM is one more than the bottommost row of WINDOW's text area. The -inside edges do not include the space used by the WINDOW's scroll bar, -display margins, fringes, header line, and/or mode line. */) - (Lisp_Object window) -{ - register struct window *w = decode_live_window (window); - - return list4i ((WINDOW_BOX_LEFT_EDGE_COL (w) - + WINDOW_LEFT_MARGIN_COLS (w) - + ((WINDOW_LEFT_FRINGE_WIDTH (w) - + WINDOW_FRAME_COLUMN_WIDTH (w) - 1) - / WINDOW_FRAME_COLUMN_WIDTH (w))), - (WINDOW_TOP_EDGE_LINE (w) - + WINDOW_HEADER_LINE_LINES (w)), - (WINDOW_BOX_RIGHT_EDGE_COL (w) - - WINDOW_RIGHT_MARGIN_COLS (w) - - ((WINDOW_RIGHT_FRINGE_WIDTH (w) - + WINDOW_FRAME_COLUMN_WIDTH (w) - 1) - / WINDOW_FRAME_COLUMN_WIDTH (w))), - (WINDOW_BOTTOM_EDGE_LINE (w) - - WINDOW_MODE_LINE_LINES (w))); -} - -DEFUN ("window-inside-pixel-edges", Fwindow_inside_pixel_edges, Swindow_inside_pixel_edges, 0, 1, 0, - doc: /* Return a list of the edge pixel coordinates of WINDOW's text area. -WINDOW must be a live window and defaults to the selected one. - -The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to -(0,0) at the top left corner of the frame's window area. - -RIGHT is one more than the rightmost x position of WINDOW's text area. -BOTTOM is one more than the bottommost y position of WINDOW's text area. -The inside edges do not include the space used by WINDOW's scroll bar, -display margins, fringes, header line, and/or mode line. */) - (Lisp_Object window) -{ - register struct window *w = decode_live_window (window); - - return list4i ((WINDOW_BOX_LEFT_EDGE_X (w) - + WINDOW_LEFT_MARGIN_WIDTH (w) - + WINDOW_LEFT_FRINGE_WIDTH (w)), - (WINDOW_TOP_EDGE_Y (w) - + WINDOW_HEADER_LINE_HEIGHT (w)), - (WINDOW_BOX_RIGHT_EDGE_X (w) - - WINDOW_RIGHT_MARGIN_WIDTH (w) - - WINDOW_RIGHT_FRINGE_WIDTH (w)), - (WINDOW_BOTTOM_EDGE_Y (w) - - WINDOW_MODE_LINE_HEIGHT (w))); -} - -DEFUN ("window-inside-absolute-pixel-edges", - Fwindow_inside_absolute_pixel_edges, - Swindow_inside_absolute_pixel_edges, 0, 1, 0, - doc: /* Return a list of the edge pixel coordinates of WINDOW's text area. -WINDOW must be a live window and defaults to the selected one. - -The returned list has the form (LEFT TOP RIGHT BOTTOM), all relative to -(0,0) at the top left corner of the frame's window area. - -RIGHT is one more than the rightmost x position of WINDOW's text area. -BOTTOM is one more than the bottommost y position of WINDOW's text area. -The inside edges do not include the space used by WINDOW's scroll bar, -display margins, fringes, header line, and/or mode line. */) - (Lisp_Object window) -{ - register struct window *w = decode_live_window (window); - int add_x, add_y; - - calc_absolute_offset (w, &add_x, &add_y); - - return list4i ((WINDOW_BOX_LEFT_EDGE_X (w) - + WINDOW_LEFT_MARGIN_WIDTH (w) - + WINDOW_LEFT_FRINGE_WIDTH (w) + add_x), - (WINDOW_TOP_EDGE_Y (w) - + WINDOW_HEADER_LINE_HEIGHT (w) + add_y), - (WINDOW_BOX_RIGHT_EDGE_X (w) - - WINDOW_RIGHT_MARGIN_WIDTH (w) - - WINDOW_RIGHT_FRINGE_WIDTH (w) + add_x), - (WINDOW_BOTTOM_EDGE_Y (w) - - WINDOW_MODE_LINE_HEIGHT (w) + add_y)); -} - /* Test if the character at column X, row Y is within window W. If it is not, return ON_NOTHING; if it is on the window's vertical divider, return @@ -7548,18 +7368,12 @@ displayed after a scrolling operation to be somewhat inaccurate. */); defsubr (&Sset_window_hscroll); defsubr (&Swindow_redisplay_end_trigger); defsubr (&Sset_window_redisplay_end_trigger); - defsubr (&Swindow_edges); - defsubr (&Swindow_pixel_edges); - defsubr (&Swindow_absolute_pixel_edges); defsubr (&Swindow_mode_line_height); defsubr (&Swindow_header_line_height); defsubr (&Swindow_right_divider_width); defsubr (&Swindow_bottom_divider_width); defsubr (&Swindow_scroll_bar_width); defsubr (&Swindow_scroll_bar_height); - defsubr (&Swindow_inside_edges); - defsubr (&Swindow_inside_pixel_edges); - defsubr (&Swindow_inside_absolute_pixel_edges); defsubr (&Scoordinates_in_window_p); defsubr (&Swindow_at); defsubr (&Swindow_point); commit a83be20b2f3b1ad499c7584caa08434cc66bb98f Author: Katsumi Yamaoka Date: Wed Aug 19 09:06:40 2015 +0000 [Gnus]: Use overlay functions directly * lisp/gnus/gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part) (gnus-insert-mime-button, gnus-mime-buttonize-attachments-in-header) (gnus-article-highlight-signature, gnus-article-extend-url-button) (gnus-article-add-button, gnus-insert-prev-page-button) (gnus-insert-next-page-button, gnus-insert-mime-security-button): * lisp/gnus/gnus-cite.el (gnus-cite-delete-overlays) (gnus-cite-add-face): * lisp/gnus/gnus-html.el (gnus-html-wash-tags): * lisp/gnus/gnus-salt.el (gnus-tree-read-summary-keys) (gnus-tree-recenter, gnus-highlight-selected-tree): * lisp/gnus/gnus-sum.el (gnus-summary-show-all-threads) (gnus-summary-show-thread, gnus-summary-hide-thread) (gnus-highlight-selected-summary): * lisp/gnus/gnus-util.el (gnus-put-overlay-excluding-newlines): * lisp/gnus/message.el (message-fix-before-sending) (message-toggle-image-thumbnails): * lisp/gnus/mm-decode.el (mm-convert-shr-links): * lisp/gnus/sieve.el (sieve-highlight, sieve-insert-scripts): Use overlay functions directly instead of using gnus-overlay-*, message-overlay-*, and sieve-overlay-*. * lisp/gnus/gnus-sum.el (gnus-remove-overlays): * lisp/gnus/gnus.el (gnus-make-overlay, gnus-copy-overlay) (gnus-delete-overlay, gnus-overlay-get, gnus-overlay-put) (gnus-move-overlay, gnus-overlay-buffer, gnus-overlay-start) (gnus-overlay-end, gnus-overlays-at, gnus-overlays-in): * lisp/gnus/message.el (message-delete-overlay, message-make-overlay) (message-overlay-get, message-overlay-put, message-overlays-in): * lisp/gnus/sieve.el (sieve-make-overlay, sieve-overlay-put) (sieve-overlays-at): Remove. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index ffe9a21..b26fe06 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5403,9 +5403,9 @@ Compressed files like .gz and .bz2 are decompressed." 'gnus-undeletable t)))) ;; We're in the article header. (delete-char -1) - (dolist (ovl (gnus-overlays-in btn (point))) - (gnus-overlay-put ovl 'gnus-button-attachment-extra t) - (gnus-overlay-put ovl 'face nil)) + (dolist (ovl (overlays-in btn (point))) + (overlay-put ovl 'gnus-button-attachment-extra t) + (overlay-put ovl 'face nil)) (save-restriction (message-narrow-to-field) (let ((gnus-treatment-function-alist @@ -5798,9 +5798,9 @@ all parts." 'gnus-undeletable t)))) ;; We're in the article header. (delete-char -1) - (dolist (ovl (gnus-overlays-in point (point))) - (gnus-overlay-put ovl 'gnus-button-attachment-extra t) - (gnus-overlay-put ovl 'face nil)) + (dolist (ovl (overlays-in point (point))) + (overlay-put ovl 'gnus-button-attachment-extra t) + (overlay-put ovl 'face nil)) (save-restriction (message-narrow-to-field) (let ((gnus-treatment-function-alist @@ -5889,8 +5889,8 @@ all parts." (1- (point)) (point))) (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay b e nil t) - 'face gnus-article-button-face)) + (overlay-put (make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :mime-handle handle @@ -6452,9 +6452,9 @@ in the body. Use `gnus-header-face-alist' to highlight buttons." (insert "\n") (end-of-line))) (insert "\n") - (dolist (ovl (gnus-overlays-in (point-min) (point))) - (gnus-overlay-put ovl 'gnus-button-attachment-extra t) - (gnus-overlay-put ovl 'face nil)) + (dolist (ovl (overlays-in (point-min) (point))) + (overlay-put ovl 'gnus-button-attachment-extra t) + (overlay-put ovl 'face nil)) (let ((gnus-treatment-function-alist '((gnus-treat-highlight-headers gnus-article-highlight-headers)))) @@ -8037,8 +8037,8 @@ It does this by highlighting everything after (save-restriction (when (and gnus-signature-face (gnus-article-narrow-to-signature)) - (gnus-overlay-put (gnus-make-overlay (point-min) (point-max) nil t) - 'face gnus-signature-face) + (overlay-put (make-overlay (point-min) (point-max) nil t) + 'face gnus-signature-face) (widen) (gnus-article-search-signature) (let ((start (match-beginning 0)) @@ -8136,12 +8136,12 @@ url is put as the `gnus-button-url' overlay property on the button." 'gnus-button-push (list beg (assq 'gnus-button-url-regexp gnus-button-alist))))) - (let ((overlay (gnus-make-overlay start end))) - (gnus-overlay-put overlay 'evaporate t) - (gnus-overlay-put overlay 'gnus-button-url - (list (mapconcat 'identity (nreverse url) ""))) + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'gnus-button-url + (list (mapconcat 'identity (nreverse url) ""))) (when gnus-article-mouse-face - (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))) + (overlay-put overlay 'mouse-face gnus-article-mouse-face))) t) (goto-char opoint)))) @@ -8180,8 +8180,8 @@ url is put as the `gnus-button-url' overlay property on the button." (defun gnus-article-add-button (from to fun &optional data text) "Create a button between FROM and TO with callback FUN and data DATA." (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to nil t) - 'face gnus-article-button-face)) + (overlay-put (make-overlay from to nil t) + 'face gnus-article-button-face)) (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face @@ -8520,8 +8520,8 @@ url is put as the `gnus-button-url' overlay property on the button." (1- (point)) (point))) (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay b e nil t) - 'face gnus-article-button-face)) + (overlay-put (make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :action 'gnus-button-prev-page @@ -8556,8 +8556,8 @@ url is put as the `gnus-button-url' overlay property on the button." (1- (point)) (point))) (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay b e nil t) - 'face gnus-article-button-face)) + (overlay-put (make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :action 'gnus-button-next-page @@ -8952,8 +8952,8 @@ For example: (1- (point)) (point))) (when gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay b e nil t) - 'face gnus-article-button-face)) + (overlay-put (make-overlay b e nil t) + 'face gnus-article-button-face)) (widget-convert-button 'link b e :mime-handle handle diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index d8ee35d..57fc281 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -786,12 +786,12 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-cite-delete-overlays () (dolist (overlay gnus-cite-overlay-list) (ignore-errors - (when (or (not (gnus-overlay-end overlay)) - (and (>= (gnus-overlay-end overlay) (point-min)) - (<= (gnus-overlay-end overlay) (point-max)))) + (when (or (not (overlay-end overlay)) + (and (>= (overlay-end overlay) (point-min)) + (<= (overlay-end overlay) (point-max)))) (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list)) (ignore-errors - (gnus-delete-overlay overlay)))))) + (delete-overlay overlay)))))) (defun gnus-cite-parse-wrapper () ;; Wrap chopped gnus-cite-parse. @@ -1096,10 +1096,10 @@ See also the documentation for `gnus-article-highlight-citation'." (skip-chars-backward " \t") (setq to (point)) (when (< from to) - (push (setq overlay (gnus-make-overlay from to nil t)) + (push (setq overlay (make-overlay from to nil t)) gnus-cite-overlay-list) - (gnus-overlay-put overlay 'evaporate t) - (gnus-overlay-put overlay 'face face)))))) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'face face)))))) (defun gnus-cite-toggle (prefix) (with-current-buffer gnus-article-buffer diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index b706de7..bedf7e4 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -307,12 +307,12 @@ Use ALT-TEXT for the image string." (gnus-article-add-button start end 'browse-url (mm-url-decode-entities-string url) url) - (let ((overlay (gnus-make-overlay start end))) - (gnus-overlay-put overlay 'evaporate t) - (gnus-overlay-put overlay 'gnus-button-url url) + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'gnus-button-url url) (gnus-put-text-property start end 'gnus-string url) (when gnus-article-mouse-face - (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) + (overlay-put overlay 'mouse-face gnus-article-mouse-face))))) ;; The upper-case IMG_ALT is apparently just an artifact that ;; should be deleted. ((equal tag "IMG_ALT") @@ -320,19 +320,19 @@ Use ALT-TEXT for the image string." ;; w3m does not normalize the case ((or (equal tag "b") (equal tag "B")) - (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-bold)) + (overlay-put (make-overlay start end) 'face 'gnus-emphasis-bold)) ((or (equal tag "u") (equal tag "U")) - (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-underline)) + (overlay-put (make-overlay start end) 'face 'gnus-emphasis-underline)) ((or (equal tag "i") (equal tag "I")) - (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-italic)) + (overlay-put (make-overlay start end) 'face 'gnus-emphasis-italic)) ((or (equal tag "s") (equal tag "S")) - (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-strikethru)) + (overlay-put (make-overlay start end) 'face 'gnus-emphasis-strikethru)) ((or (equal tag "ins") (equal tag "INS")) - (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-underline)) + (overlay-put (make-overlay start end) 'face 'gnus-emphasis-underline)) ;; Handle different UL types ((equal tag "_SYMBOL") (when (string-match "TYPE=\\(.+\\)" parameters) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index e071543..5776b0a 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -504,7 +504,7 @@ Two predefined functions are available: (when (setq win (get-buffer-window buf)) (select-window win) (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) + (goto-char (or (overlay-end gnus-selected-tree-overlay) 1))) (gnus-tree-minimize))))) (defun gnus-tree-show-summary () @@ -547,7 +547,7 @@ Two predefined functions are available: (when tree-window (select-window tree-window) (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) + (goto-char (or (overlay-end gnus-selected-tree-overlay) 1))) (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) (t 2))) @@ -858,12 +858,12 @@ it in the environment specified by BINDINGS." (when (or (not gnus-selected-tree-overlay) (gnus-extent-detached-p gnus-selected-tree-overlay)) ;; Create a new overlay. - (gnus-overlay-put + (overlay-put (setq gnus-selected-tree-overlay - (gnus-make-overlay (point-min) (1+ (point-min)))) + (make-overlay (point-min) (1+ (point-min)))) 'face gnus-selected-tree-face)) ;; Move the overlay to the article. - (gnus-move-overlay + (move-overlay gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) (gnus-tree-minimize) (gnus-tree-recenter) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 37a707e..f98f485 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -11695,20 +11695,10 @@ If ARG is positive number, turn showing conversation threads on." (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off")) (gnus-summary-position-point))) -(eval-and-compile - (if (fboundp 'remove-overlays) - (defalias 'gnus-remove-overlays 'remove-overlays) - (defun gnus-remove-overlays (beg end name val) - "Clear BEG and END of overlays whose property NAME has value VAL. -For compatibility with XEmacs." - (dolist (ov (gnus-overlays-in beg end)) - (when (eq (gnus-overlay-get ov name) val) - (gnus-delete-overlay ov)))))) - (defun gnus-summary-show-all-threads () "Show all threads." (interactive) - (gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum) + (remove-overlays (point-min) (point-max) 'invisible 'gnus-sum) (gnus-summary-position-point)) (defsubst gnus-summary--inv (p) @@ -11735,7 +11725,7 @@ Returns nil if no thread was there to be shown." 'gnus-sum)))) (point))))) (when eoi - (gnus-remove-overlays beg eoi 'invisible 'gnus-sum) + (remove-overlays beg eoi 'invisible 'gnus-sum) (goto-char orig) (gnus-summary-position-point) eoi))) @@ -11804,10 +11794,10 @@ Returns nil if no threads were there to be hidden." (search-backward "\n" start t)) (progn (when (> (point) starteol) - (gnus-remove-overlays starteol (point) 'invisible 'gnus-sum) - (let ((ol (gnus-make-overlay starteol (point) nil t nil))) - (gnus-overlay-put ol 'invisible 'gnus-sum) - (gnus-overlay-put ol 'evaporate t))) + (remove-overlays starteol (point) 'invisible 'gnus-sum) + (let ((ol (make-overlay starteol (point) nil t nil))) + (overlay-put ol 'invisible 'gnus-sum) + (overlay-put ol 'evaporate t))) (gnus-summary-goto-subject article) (when (> start (point)) (message "Hiding the thread moved us backwards, aborting!") @@ -12626,11 +12616,11 @@ If REVERSE, save parts that do not match TYPE." (setq to end)) (if gnus-newsgroup-selected-overlay ;; Move old overlay. - (gnus-move-overlay + (move-overlay gnus-newsgroup-selected-overlay from to (current-buffer)) ;; Create new overlay. - (gnus-overlay-put - (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) + (overlay-put + (setq gnus-newsgroup-selected-overlay (make-overlay from to)) 'face gnus-summary-selected-face)))))) (defvar gnus-summary-highlight-line-cached nil) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index b75d9ef..12b319b 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -853,10 +853,6 @@ If there's no subdirectory, delete DIRECTORY as well." (setq beg (point))) (gnus-put-text-property beg (point) prop val))))) -(declare-function gnus-overlay-put "gnus" (overlay prop value)) -(declare-function gnus-make-overlay "gnus" - (beg end &optional buffer front-advance rear-advance)) - (defsubst gnus-put-overlay-excluding-newlines (beg end prop val) "The same as `put-text-property', but don't put this prop on any newlines in the region." (save-match-data @@ -864,11 +860,9 @@ If there's no subdirectory, delete DIRECTORY as well." (save-restriction (goto-char beg) (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) - (gnus-overlay-put - (gnus-make-overlay beg (match-beginning 0)) - prop val) + (overlay-put (make-overlay beg (match-beginning 0)) prop val) (setq beg (point))) - (gnus-overlay-put (gnus-make-overlay beg (point)) prop val))))) + (overlay-put (make-overlay beg (point)) prop val))))) (defun gnus-put-text-property-excluding-characters-with-faces (beg end prop val) "The same as `put-text-property', except where `gnus-face' is set. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 30c89f5..4545ed0 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -304,17 +304,6 @@ be set in `.emacs' instead." :type 'boolean) (unless (featurep 'gnus-xmas) - (defalias 'gnus-make-overlay 'make-overlay) - (defalias 'gnus-copy-overlay 'copy-overlay) - (defalias 'gnus-delete-overlay 'delete-overlay) - (defalias 'gnus-overlay-get 'overlay-get) - (defalias 'gnus-overlay-put 'overlay-put) - (defalias 'gnus-move-overlay 'move-overlay) - (defalias 'gnus-overlay-buffer 'overlay-buffer) - (defalias 'gnus-overlay-start 'overlay-start) - (defalias 'gnus-overlay-end 'overlay-end) - (defalias 'gnus-overlays-at 'overlays-at) - (defalias 'gnus-overlays-in 'overlays-in) (defalias 'gnus-extent-detached-p 'ignore) (defalias 'gnus-extent-start-open 'ignore) (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index a5196c8..0a11bf0 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2008,13 +2008,8 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (eval-and-compile (if (featurep 'emacs) (progn - (defalias 'message-delete-overlay 'delete-overlay) (defun message-kill-all-overlays () (mapcar #'delete-overlay (overlays-in (point-min) (point-max)))) - (defalias 'message-make-overlay 'make-overlay) - (defalias 'message-overlay-get 'overlay-get) - (defalias 'message-overlay-put 'overlay-put) - (defalias 'message-overlays-in 'overlays-in) (defalias 'message-window-inside-pixel-edges 'window-inside-pixel-edges)) (defun message-kill-all-overlays () @@ -4396,8 +4391,7 @@ conformance." to (cdar regions) regions (cdr regions)) (put-text-property from to 'invisible nil) - (message-overlay-put (message-make-overlay from to) - 'face 'highlight)) + (overlay-put (make-overlay from to) 'face 'highlight)) (unless (yes-or-no-p "Invisible text found and made visible; continue sending? ") (error "Invisible text found and made visible"))))) @@ -4424,8 +4418,7 @@ conformance." control-1)) (not (get-text-property (point) 'untranslated-utf-8)))) - (message-overlay-put (message-make-overlay (point) (1+ (point))) - 'face 'highlight) + (overlay-put (make-overlay (point) (1+ (point))) 'face 'highlight) (setq found t)) (forward-char)) (when found @@ -8567,12 +8560,12 @@ Used in `message-simplify-recipients'." (defun message-toggle-image-thumbnails () "For any included image files, insert a thumbnail of that image." (interactive) - (let ((overlays (message-overlays-in (point-min) (point-max))) + (let ((overlays (overlays-in (point-min) (point-max))) (displayed nil)) (while overlays (let ((overlay (car overlays))) - (when (message-overlay-get overlay 'put-image) - (message-delete-overlay overlay) + (when (overlay-get overlay 'put-image) + (delete-overlay overlay) (setq displayed t))) (setq overlays (cdr overlays))) (unless displayed diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index bce9abd..b0ec16e 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -31,9 +31,6 @@ (autoload 'gnus-replace-in-string "gnus-util") (autoload 'gnus-read-shell-command "gnus-util") -(autoload 'gnus-overlays-at "gnus") -(autoload 'gnus-overlay-put "gnus") - (autoload 'mm-inline-partial "mm-partial") (autoload 'mm-inline-external-body "mm-extern") (autoload 'mm-extern-cache-contents "mm-extern") @@ -1915,8 +1912,8 @@ If RECURSIVE, search recursively." :keymap shr-map (get-text-property start 'shr-url)) (put-text-property start end 'local-map nil) - (dolist (overlay (gnus-overlays-at start)) - (gnus-overlay-put overlay 'face nil)) + (dolist (overlay (overlays-at start)) + (overlay-put overlay 'face nil)) (setq start end))))) (defun mm-handle-filename (handle) diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el index 6eef569..8d40fa4 100644 --- a/lisp/gnus/sieve.el +++ b/lisp/gnus/sieve.el @@ -275,21 +275,9 @@ Used to bracket operations which move point in the sieve-buffer." (interactive "d") (get-char-property (or pos (point)) 'script-name)) -(eval-and-compile - (defalias 'sieve-make-overlay (if (featurep 'xemacs) - 'make-extent - 'make-overlay)) - (defalias 'sieve-overlay-put (if (featurep 'xemacs) - 'set-extent-property - 'overlay-put)) - (defalias 'sieve-overlays-at (if (featurep 'xemacs) - 'extents-at - 'overlays-at))) - (defun sieve-highlight (on) "Turn ON or off highlighting on the current language overlay." - (sieve-overlay-put (car (sieve-overlays-at (point))) - 'face (if on 'highlight 'default))) + (overlay-put (car (overlays-at (point))) 'face (if on 'highlight 'default))) (defun sieve-insert-scripts (scripts) "Format and insert LANGUAGE-LIST strings into current buffer at point." @@ -300,11 +288,11 @@ Used to bracket operations which move point in the sieve-buffer." (if (consp script) (insert (format " ACTIVE %s" (cdr script))) (insert (format " %s" script))) - (setq ext (sieve-make-overlay p (point))) - (sieve-overlay-put ext 'mouse-face 'highlight) - (sieve-overlay-put ext 'script-name (if (consp script) - (cdr script) - script)) + (setq ext (make-overlay p (point))) + (overlay-put ext 'mouse-face 'highlight) + (overlay-put ext 'script-name (if (consp script) + (cdr script) + script)) (insert "\n")))) (defun sieve-open-server (server &optional port) commit 62661fe759dfc826f31b032e49f0f15b40a207d5 Author: Martin Rudalics Date: Wed Aug 19 08:49:41 2015 +0200 In w32fns.c condition TITLEBAR_INFO declaration on WINDOWS version. * src/w32fns.c (TITLEBAR_INFO): Make it a typedef so MinGW64 builds can use the declaration from the system headers. (GetTitleBarInfo_Proc, Fx_frame_geometry): Adapt to new definition of TITLEBAR_INFO. Suggested by Eli Zaretskii diff --git a/src/w32fns.c b/src/w32fns.c index 8f0bde7..189a27c 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -138,13 +138,18 @@ struct MONITOR_INFO DWORD dwFlags; }; +#if _WIN32_WINDOWS >= 0x0410 +#define C_CHILDREN_TITLEBAR CCHILDREN_TITLEBAR +typedef TITLEBARINFO TITLEBAR_INFO; +#else #define C_CHILDREN_TITLEBAR 5 -struct TITLEBAR_INFO +typedef struct { DWORD cbSize; RECT rcTitleBar; DWORD rgstate[C_CHILDREN_TITLEBAR+1]; -}; +} TITLEBAR_INFO, *PTITLEBAR_INFO; +#endif #ifndef CCHDEVICENAME #define CCHDEVICENAME 32 @@ -181,7 +186,7 @@ typedef BOOL CALLBACK (* MonitorEnum_Proc) typedef BOOL (WINAPI * EnumDisplayMonitors_Proc) (IN HDC hdc, IN RECT *rcClip, IN MonitorEnum_Proc fnEnum, IN LPARAM dwData); typedef BOOL (WINAPI * GetTitleBarInfo_Proc) - (IN HWND hwnd, OUT struct TITLEBAR_INFO* info); + (IN HWND hwnd, OUT TITLEBAR_INFO* info); TrackMouseEvent_Proc track_mouse_event_fn = NULL; ImmGetCompositionString_Proc get_composition_string_fn = NULL; @@ -8064,7 +8069,7 @@ and width values are in pixels. { if (get_title_bar_info_fn) { - struct TITLEBAR_INFO title_bar; + TITLEBAR_INFO title_bar; title_bar.cbSize = sizeof (title_bar); title_bar.rcTitleBar.left = title_bar.rcTitleBar.right = 0; commit f814775b41ccbfc4777c5223704c44707328f404 Author: Glenn Morris Date: Tue Aug 18 23:34:16 2015 -0700 * lisp/gnus/nnmaildir.el (nnmaildir-flag-mark-mapping): Add "P". diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 097d4f8..5b72b52 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -75,6 +75,7 @@ (defconst nnmaildir-flag-mark-mapping '((?F . tick) + (?P . forward) (?R . reply) (?S . read)) "Alist mapping Maildir filename flags to Gnus marks. commit 87fbe1a6cb6d212c69546bd10864288fcf034cc1 Author: Paul Eggert Date: Tue Aug 18 23:04:58 2015 -0700 Use new q ‘format’ flag when fixing quotes in C * src/image.c (image_size_error): New function. All uses of image_error with "Invalid image size ..." changed to use it. * src/image.c (image_size_error, xbm_load_image, xbm_load) (xpm_load, xpm_load_image, xpm_load, pbm_load, png_load_body) (jpeg_load_body, tiff_load, gif_load, imagemagick_load_image) (imagemagick_load, svg_load, svg_load_image, gs_load) (x_kill_gs_process): * src/lread.c (load_warn_old_style_backquotes): * src/xfaces.c (load_pixmap): * src/xselect.c (x_clipboard_manager_error_1): Use %qs, not uLSQM and uRSQM. * src/syntax.c (Finternal_describe_syntax_value): Prefer Fsubstitute_command_keys to Fformat, as this lets us use AUTO_STRING. * src/xdisp.c (vadd_to_log): Use AUTO_STRING on the format argument, as it's now guaranteed to be ASCII. * src/xselect.c (x_clipboard_manager_error_2): Avoid grave accent in low-level stderr diagnostic. diff --git a/src/image.c b/src/image.c index 8f9b06c..63089a9 100644 --- a/src/image.c +++ b/src/image.c @@ -644,6 +644,11 @@ image_error (const char *format, ...) va_end (ap); } +static void +image_size_error (void) +{ + image_error ("Invalid image size (see %qs)", "max-image-size"); +} /*********************************************************************** @@ -2802,7 +2807,7 @@ xbm_read_bitmap_data (struct frame *f, unsigned char *contents, unsigned char *e if (!check_image_size (f, *width, *height)) { if (!inhibit_image_error) - image_error ("Invalid image size (see "uLSQM"max-image-size"uRSQM")"); + image_size_error (); goto failure; } else if (data == NULL) @@ -2947,14 +2952,13 @@ xbm_load_image (struct frame *f, struct image *img, unsigned char *contents, if (img->pixmap == NO_PIXMAP) { x_clear_image (f, img); - image_error ("Unable to create X pixmap for "uLSQM"%s"uRSQM, - img->spec); + image_error ("Unable to create X pixmap for %qs", img->spec); } else success_p = 1; } else - image_error ("Error loading XBM image "uLSQM"%s"uRSQM, img->spec); + image_error ("Error loading XBM image %qs", img->spec); return success_p; } @@ -2992,7 +2996,7 @@ xbm_load (struct frame *f, struct image *img) Lisp_Object file = x_find_image_fd (file_name, &fd); if (!STRINGP (file)) { - image_error ("Cannot find image file "uLSQM"%s"uRSQM, file_name); + image_error ("Cannot find image file %qs", file_name); return 0; } @@ -3000,7 +3004,7 @@ xbm_load (struct frame *f, struct image *img) unsigned char *contents = slurp_file (fd, &size); if (contents == NULL) { - image_error ("Error loading XBM image "uLSQM"%s"uRSQM, file); + image_error ("Error loading XBM image %qs", file); return 0; } @@ -3035,8 +3039,7 @@ xbm_load (struct frame *f, struct image *img) eassert (img->width > 0 && img->height > 0); if (!check_image_size (f, img->width, img->height)) { - image_error ("Invalid image size (see " - uLSQM"max-image-size"uRSQM")"); + image_size_error (); return 0; } } @@ -3113,8 +3116,7 @@ xbm_load (struct frame *f, struct image *img) success_p = 1; else { - image_error (("Unable to create pixmap for XBM image " - uLSQM"%s"uRSQM), + image_error ("Unable to create pixmap for XBM image %qs", img->spec); x_clear_image (f, img); } @@ -3637,8 +3639,7 @@ xpm_load (struct frame *f, struct image *img) Lisp_Object file = x_find_image_file (specified_file); if (!STRINGP (file)) { - image_error ("Cannot find image file "uLSQM"%s"uRSQM, - specified_file); + image_error ("Cannot find image file %qs", specified_file); #ifdef ALLOC_XPM_COLORS xpm_free_color_cache (); #endif @@ -3670,7 +3671,7 @@ xpm_load (struct frame *f, struct image *img) Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (buffer)) { - image_error ("Invalid image data "uLSQM"%s"uRSQM, buffer); + image_error ("Invalid image data %qs", buffer); #ifdef ALLOC_XPM_COLORS xpm_free_color_cache (); #endif @@ -4114,7 +4115,7 @@ xpm_load_image (struct frame *f, if (!check_image_size (f, width, height)) { - image_error ("Invalid image size (see "uLSQM"max-image-size"uRSQM")"); + image_size_error (); goto failure; } @@ -4301,7 +4302,7 @@ xpm_load (struct frame *f, Lisp_Object file = x_find_image_fd (file_name, &fd); if (!STRINGP (file)) { - image_error ("Cannot find image file "uLSQM"%s"uRSQM, file_name); + image_error ("Cannot find image file %qs", file_name); return 0; } @@ -4309,7 +4310,7 @@ xpm_load (struct frame *f, unsigned char *contents = slurp_file (fd, &size); if (contents == NULL) { - image_error ("Error loading XPM image "uLSQM"%s"uRSQM, file); + image_error ("Error loading XPM image %qs", file); return 0; } @@ -4323,7 +4324,7 @@ xpm_load (struct frame *f, data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) { - image_error ("Invalid image data "uLSQM"%s"uRSQM, data); + image_error ("Invalid image data %qs", data); return 0; } success_p = xpm_load_image (f, img, SDATA (data), @@ -5277,8 +5278,7 @@ pbm_load (struct frame *f, struct image *img) Lisp_Object file = x_find_image_fd (specified_file, &fd); if (!STRINGP (file)) { - image_error ("Cannot find image file "uLSQM"%s"uRSQM, - specified_file); + image_error ("Cannot find image file %qs", specified_file); return 0; } @@ -5286,7 +5286,7 @@ pbm_load (struct frame *f, struct image *img) contents = slurp_file (fd, &size); if (contents == NULL) { - image_error ("Error reading "uLSQM"%s"uRSQM, file); + image_error ("Error reading %qs", file); return 0; } @@ -5299,7 +5299,7 @@ pbm_load (struct frame *f, struct image *img) data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) { - image_error ("Invalid image data "uLSQM"%s"uRSQM, data); + image_error ("Invalid image data %qs", data); return 0; } p = SDATA (data); @@ -5309,7 +5309,7 @@ pbm_load (struct frame *f, struct image *img) /* Check magic number. */ if (end - p < 2 || *p++ != 'P') { - image_error ("Not a PBM image: "uLSQM"%s"uRSQM, img->spec); + image_error ("Not a PBM image: %qs", img->spec); error: xfree (contents); img->pixmap = NO_PIXMAP; @@ -5343,7 +5343,7 @@ pbm_load (struct frame *f, struct image *img) break; default: - image_error ("Not a PBM image: "uLSQM"%s"uRSQM, img->spec); + image_error ("Not a PBM image: %qs", img->spec); goto error; } @@ -5369,7 +5369,7 @@ pbm_load (struct frame *f, struct image *img) if (!check_image_size (f, width, height)) { - image_error ("Invalid image size (see "uLSQM"max-image-size"uRSQM")"); + image_size_error (); goto error; } @@ -5442,8 +5442,7 @@ pbm_load (struct frame *f, struct image *img) x_destroy_x_image (ximg); #endif x_clear_image (f, img); - image_error (("Invalid image size in image " - uLSQM"%s"uRSQM), + image_error ("Invalid image size in image %qs", img->spec); goto error; } @@ -5478,8 +5477,7 @@ pbm_load (struct frame *f, struct image *img) x_destroy_x_image (ximg); #endif x_clear_image (f, img); - image_error ("Invalid image size in image "uLSQM"%s"uRSQM, - img->spec); + image_error ("Invalid image size in image %qs", img->spec); goto error; } @@ -5522,8 +5520,7 @@ pbm_load (struct frame *f, struct image *img) #else x_destroy_x_image (ximg); #endif - image_error ("Invalid pixel value in image "uLSQM"%s"uRSQM, - img->spec); + image_error ("Invalid pixel value in image %qs", img->spec); goto error; } @@ -5919,8 +5916,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) Lisp_Object file = x_find_image_fd (specified_file, &fd); if (!STRINGP (file)) { - image_error ("Cannot find image file "uLSQM"%s"uRSQM, - specified_file); + image_error ("Cannot find image file %qs", specified_file); return 0; } @@ -5928,7 +5924,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) fp = fdopen (fd, "rb"); if (!fp) { - image_error ("Cannot open image file "uLSQM"%s"uRSQM, file); + image_error ("Cannot open image file %qs", file); return 0; } @@ -5937,7 +5933,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) || png_sig_cmp (sig, 0, sizeof sig)) { fclose (fp); - image_error ("Not a PNG file: "uLSQM"%s"uRSQM, file); + image_error ("Not a PNG file: %qs", file); return 0; } } @@ -5945,7 +5941,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) { if (!STRINGP (specified_data)) { - image_error ("Invalid image data "uLSQM"%s"uRSQM, specified_data); + image_error ("Invalid image data %qs", specified_data); return 0; } @@ -5958,7 +5954,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) if (tbr.len < sizeof sig || png_sig_cmp (tbr.bytes, 0, sizeof sig)) { - image_error ("Not a PNG image: "uLSQM"%s"uRSQM, img->spec); + image_error ("Not a PNG image: %qs", img->spec); return 0; } @@ -6026,7 +6022,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) if (! (width <= INT_MAX && height <= INT_MAX && check_image_size (f, width, height))) { - image_error ("Invalid image size (see "uLSQM"max-image-size"uRSQM")"); + image_size_error (); goto error; } @@ -6685,21 +6681,20 @@ jpeg_load_body (struct frame *f, struct image *img, Lisp_Object file = x_find_image_fd (specified_file, &fd); if (!STRINGP (file)) { - image_error ("Cannot find image file "uLSQM"%s"uRSQM, - specified_file); + image_error ("Cannot find image file %qs", specified_file); return 0; } fp = fdopen (fd, "rb"); if (fp == NULL) { - image_error ("Cannot open "uLSQM"%s"uRSQM, file); + image_error ("Cannot open %qs", file); return 0; } } else if (!STRINGP (specified_data)) { - image_error ("Invalid image data "uLSQM"%s"uRSQM, specified_data); + image_error ("Invalid image data %qs", specified_data); return 0; } @@ -6715,14 +6710,13 @@ jpeg_load_body (struct frame *f, struct image *img, { char buf[JMSG_LENGTH_MAX]; mgr->cinfo.err->format_message ((j_common_ptr) &mgr->cinfo, buf); - image_error ("Error reading JPEG image "uLSQM"%s"uRSQM": %s", + image_error ("Error reading JPEG image %qs: %s", img->spec, build_string (buf)); break; } case MY_JPEG_INVALID_IMAGE_SIZE: - image_error ("Invalid image size (see " - uLSQM"max-image-size"uRSQM")"); + image_size_error (); break; case MY_JPEG_CANNOT_CREATE_X: @@ -7202,8 +7196,7 @@ tiff_load (struct frame *f, struct image *img) Lisp_Object file = x_find_image_file (specified_file); if (!STRINGP (file)) { - image_error ("Cannot find image file "uLSQM"%s"uRSQM, - specified_file); + image_error ("Cannot find image file %qs", specified_file); return 0; } @@ -7216,7 +7209,7 @@ tiff_load (struct frame *f, struct image *img) tiff = TIFFOpen (SSDATA (encoded_file), "r"); if (tiff == NULL) { - image_error ("Cannot open "uLSQM"%s"uRSQM, file); + image_error ("Cannot open %qs", file); return 0; } } @@ -7224,7 +7217,7 @@ tiff_load (struct frame *f, struct image *img) { if (!STRINGP (specified_data)) { - image_error ("Invalid image data "uLSQM"%s"uRSQM, specified_data); + image_error ("Invalid image data %qs", specified_data); return 0; } @@ -7244,8 +7237,7 @@ tiff_load (struct frame *f, struct image *img) if (!tiff) { - image_error ("Cannot open memory source for "uLSQM"%s"uRSQM, - img->spec); + image_error ("Cannot open memory source for %qs", img->spec); return 0; } } @@ -7257,9 +7249,8 @@ tiff_load (struct frame *f, struct image *img) if (! (TYPE_MINIMUM (tdir_t) <= ino && ino <= TYPE_MAXIMUM (tdir_t) && TIFFSetDirectory (tiff, ino))) { - image_error - ("Invalid image number "uLSQM"%s"uRSQM" in image "uLSQM"%s"uRSQM, - image, img->spec); + image_error ("Invalid image number %qs in image %qs", + image, img->spec); TIFFClose (tiff); return 0; } @@ -7272,7 +7263,7 @@ tiff_load (struct frame *f, struct image *img) if (!check_image_size (f, width, height)) { - image_error ("Invalid image size (see "uLSQM"max-image-size"uRSQM")"); + image_size_error (); TIFFClose (tiff); return 0; } @@ -7302,7 +7293,7 @@ tiff_load (struct frame *f, struct image *img) TIFFClose (tiff); if (!rc) { - image_error ("Error reading TIFF image "uLSQM"%s"uRSQM, img->spec); + image_error ("Error reading TIFF image %qs", img->spec); xfree (buf); return 0; } @@ -7638,8 +7629,7 @@ gif_load (struct frame *f, struct image *img) Lisp_Object file = x_find_image_file (specified_file); if (!STRINGP (file)) { - image_error ("Cannot find image file "uLSQM"%s"uRSQM, - specified_file); + image_error ("Cannot find image file %qs", specified_file); return 0; } @@ -7653,14 +7643,14 @@ gif_load (struct frame *f, struct image *img) gif = DGifOpenFileName (SSDATA (encoded_file)); if (gif == NULL) { - image_error ("Cannot open "uLSQM"%s"uRSQM, file); + image_error ("Cannot open %qs", file); return 0; } #else gif = DGifOpenFileName (SSDATA (encoded_file), &gif_err); if (gif == NULL) { - image_error ("Cannot open "uLSQM"%s"uRSQM": %s", + image_error ("Cannot open %qs: %s", file, build_string (GifErrorString (gif_err))); return 0; } @@ -7670,7 +7660,7 @@ gif_load (struct frame *f, struct image *img) { if (!STRINGP (specified_data)) { - image_error ("Invalid image data "uLSQM"%s"uRSQM, specified_data); + image_error ("Invalid image data %qs", specified_data); return 0; } @@ -7684,14 +7674,14 @@ gif_load (struct frame *f, struct image *img) gif = DGifOpen (&memsrc, gif_read_from_memory); if (!gif) { - image_error ("Cannot open memory source "uLSQM"%s"uRSQM, img->spec); + image_error ("Cannot open memory source %qs", img->spec); return 0; } #else gif = DGifOpen (&memsrc, gif_read_from_memory, &gif_err); if (!gif) { - image_error ("Cannot open memory source "uLSQM"%s"uRSQM": %s", + image_error ("Cannot open memory source %qs: %s", img->spec, build_string (GifErrorString (gif_err))); return 0; } @@ -7701,7 +7691,7 @@ gif_load (struct frame *f, struct image *img) /* Before reading entire contents, check the declared image size. */ if (!check_image_size (f, gif->SWidth, gif->SHeight)) { - image_error ("Invalid image size (see "uLSQM"max-image-size"uRSQM")"); + image_size_error (); gif_close (gif, NULL); return 0; } @@ -7710,7 +7700,7 @@ gif_load (struct frame *f, struct image *img) rc = DGifSlurp (gif); if (rc == GIF_ERROR || gif->ImageCount <= 0) { - image_error ("Error reading "uLSQM"%s"uRSQM, img->spec); + image_error ("Error reading %qs", img->spec); gif_close (gif, NULL); return 0; } @@ -7721,9 +7711,8 @@ gif_load (struct frame *f, struct image *img) idx = INTEGERP (image_number) ? XFASTINT (image_number) : 0; if (idx < 0 || idx >= gif->ImageCount) { - image_error - ("Invalid image number "uLSQM"%s"uRSQM" in image "uLSQM"%s"uRSQM, - image_number, img->spec); + image_error ("Invalid image number %qs in image %qs", + image_number, img->spec); gif_close (gif, NULL); return 0; } @@ -7741,7 +7730,7 @@ gif_load (struct frame *f, struct image *img) if (!check_image_size (f, width, height)) { - image_error ("Invalid image size (see "uLSQM"max-image-size"uRSQM")"); + image_size_error (); gif_close (gif, NULL); return 0; } @@ -7995,10 +7984,10 @@ gif_load (struct frame *f, struct image *img) char *error_text = GifErrorString (gif_err); if (error_text) - image_error ("Error closing "uLSQM"%s"uRSQM": %s", + image_error ("Error closing %qs: %s", img->spec, build_string (error_text)); #else - image_error ("Error closing "uLSQM"%s"uRSQM, img->spec); + image_error ("Error closing %qs", img->spec); #endif } @@ -8539,9 +8528,7 @@ imagemagick_load_image (struct frame *f, struct image *img, if (ino < 0 || ino >= MagickGetNumberImages (image_wand)) { - image_error - ("Invalid image number "uLSQM"%s"uRSQM" in image "uLSQM"%s"uRSQM, - image, img->spec); + image_error ("Invalid image number %qs in image %qs", image, img->spec); DestroyMagickWand (image_wand); return 0; } @@ -8675,7 +8662,7 @@ imagemagick_load_image (struct frame *f, struct image *img, if (! (image_width <= INT_MAX && image_height <= INT_MAX && check_image_size (f, image_width, image_height))) { - image_error ("Invalid image size (see "uLSQM"max-image-size"uRSQM")"); + image_size_error (); goto imagemagick_error; } @@ -8810,7 +8797,7 @@ imagemagick_load_image (struct frame *f, struct image *img, MagickWandTerminus (); /* TODO more cleanup. */ - image_error ("Error parsing IMAGEMAGICK image "uLSQM"%s"uRSQM, img->spec); + image_error ("Error parsing IMAGEMAGICK image %qs", img->spec); return 0; } @@ -8832,7 +8819,7 @@ imagemagick_load (struct frame *f, struct image *img) Lisp_Object file = x_find_image_file (file_name); if (!STRINGP (file)) { - image_error ("Cannot find image file "uLSQM"%s"uRSQM, file_name); + image_error ("Cannot find image file %qs", file_name); return 0; } file = ENCODE_FILE (file); @@ -8850,7 +8837,7 @@ imagemagick_load (struct frame *f, struct image *img) data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) { - image_error ("Invalid image data "uLSQM"%s"uRSQM, data); + image_error ("Invalid image data %qs", data); return 0; } success_p = imagemagick_load_image (f, img, SDATA (data), @@ -9111,7 +9098,7 @@ svg_load (struct frame *f, struct image *img) Lisp_Object file = x_find_image_fd (file_name, &fd); if (!STRINGP (file)) { - image_error ("Cannot find image file "uLSQM"%s"uRSQM, file_name); + image_error ("Cannot find image file %qs", file_name); return 0; } @@ -9120,7 +9107,7 @@ svg_load (struct frame *f, struct image *img) unsigned char *contents = slurp_file (fd, &size); if (contents == NULL) { - image_error ("Error loading SVG image "uLSQM"%s"uRSQM, file); + image_error ("Error loading SVG image %qs", file); return 0; } /* If the file was slurped into memory properly, parse it. */ @@ -9137,7 +9124,7 @@ svg_load (struct frame *f, struct image *img) data = image_spec_value (img->spec, QCdata, NULL); if (!STRINGP (data)) { - image_error ("Invalid image data "uLSQM"%s"uRSQM, data); + image_error ("Invalid image data %qs", data); return 0; } original_filename = BVAR (current_buffer, filename); @@ -9204,7 +9191,7 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. * rsvg_handle_get_dimensions (rsvg_handle, &dimension_data); if (! check_image_size (f, dimension_data.width, dimension_data.height)) { - image_error ("Invalid image size (see "uLSQM"max-image-size"uRSQM")"); + image_size_error (); goto rsvg_error; } @@ -9336,7 +9323,7 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. * g_object_unref (rsvg_handle); /* FIXME: Use error->message so the user knows what is the actual problem with the image. */ - image_error ("Error parsing SVG image "uLSQM"%s"uRSQM, img->spec); + image_error ("Error parsing SVG image %qs", img->spec); g_error_free (err); return 0; } @@ -9489,7 +9476,7 @@ gs_load (struct frame *f, struct image *img) if (! (in_width <= INT_MAX && in_height <= INT_MAX && check_image_size (f, in_width, in_height))) { - image_error ("Invalid image size (see "uLSQM"max-image-size"uRSQM")"); + image_size_error (); return 0; } img->width = in_width; @@ -9510,7 +9497,7 @@ gs_load (struct frame *f, struct image *img) if (!img->pixmap) { - image_error ("Unable to create pixmap for "uLSQM"%s"uRSQM, img->spec); + image_error ("Unable to create pixmap for %qs" , img->spec); return 0; } @@ -9622,8 +9609,7 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f) #endif } else - image_error (("Cannot get X image of "uLSQM"%s"uRSQM";" - " colors will not be freed"), + image_error ("Cannot get X image of %qs; colors will not be freed", img->spec); unblock_input (); diff --git a/src/lread.c b/src/lread.c index 77a6211..c342218 100644 --- a/src/lread.c +++ b/src/lread.c @@ -947,8 +947,7 @@ load_warn_old_style_backquotes (Lisp_Object file) { if (!NILP (Vold_style_backquotes)) { - Lisp_Object format = build_string ("Loading "uLSQM"%s"uRSQM - ": old-style backquotes detected!"); + AUTO_STRING (format, "Loading %qs: old-style backquotes detected!"); CALLN (Fmessage, format, file); } } diff --git a/src/syntax.c b/src/syntax.c index d543a5f..30560af 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -1333,10 +1333,11 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, insert_string (" (nestable)"); if (prefix) - insert1 (CALLN (Fformat, - (build_string - (",\n\t is a prefix character for " - uLSQM"backward-prefix-chars"uRSQM)))); + { + AUTO_STRING (prefixdoc, + ",\n\t is a prefix character for `backward-prefix-chars'"); + insert1 (Fsubstitute_command_keys (prefixdoc)); + } return syntax; } diff --git a/src/xdisp.c b/src/xdisp.c index 88e6c8d..8be7497 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9826,16 +9826,18 @@ add_to_log (const char *format, ...) void vadd_to_log (char const *format, va_list ap) { - ptrdiff_t nargs = 1 + format_nargs (format); + ptrdiff_t form_nargs = format_nargs (format); + ptrdiff_t nargs = 1 + form_nargs; Lisp_Object args[10]; eassert (nargs <= ARRAYELTS (args)); - args[0] = build_string (format); + AUTO_STRING (args0, format); + args[0] = args0; for (ptrdiff_t i = 1; i <= nargs; i++) args[i] = va_arg (ap, Lisp_Object); Lisp_Object msg = Qnil; struct gcpro gcpro1, gcpro2; - GCPRO2 (args, msg); - gcpro1.nvars = nargs; + GCPRO2 (args[1], msg); + gcpro1.nvars = form_nargs; msg = Fformat (nargs, args); ptrdiff_t len = SBYTES (msg) + 1; diff --git a/src/xfaces.c b/src/xfaces.c index d519578..b599e6a 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -797,7 +797,7 @@ load_pixmap (struct frame *f, Lisp_Object name) if (bitmap_id < 0) { - add_to_log ("Invalid or undefined bitmap "uLSQM"%s"uRSQM, name); + add_to_log ("Invalid or undefined bitmap %qs", name); bitmap_id = 0; } else diff --git a/src/xselect.c b/src/xselect.c index b54ddd8..d4d4dc0 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -2147,11 +2147,10 @@ x_clipboard_manager_save (Lisp_Object frame) static Lisp_Object x_clipboard_manager_error_1 (Lisp_Object err) { - Lisp_Object format - = build_string ("X clipboard manager error: %s\n" - "If the problem persists, set " - uLSQM"x-select-enable-clipboard-manager"uRSQM" to nil."); - CALLN (Fmessage, format, CAR (CDR (err))); + AUTO_STRING (format, "X clipboard manager error: %s\n\ +If the problem persists, set %qs to nil."); + AUTO_STRING (varname, "x-select-enable-clipboard-manager"); + CALLN (Fmessage, format, CAR (CDR (err)), varname); return Qnil; } @@ -2161,8 +2160,8 @@ static Lisp_Object x_clipboard_manager_error_2 (Lisp_Object err) { fprintf (stderr, "Error saving to X clipboard manager.\n\ -If the problem persists, set `x-select-enable-clipboard-manager' \ -to nil.\n"); +If the problem persists, set '%s' \ +to nil.\n", "x-select-enable-clipboard-manager"); return Qnil; } commit 67de1b6fa752df913ae00537234d1a18bca2543f Author: Paul Eggert Date: Tue Aug 18 23:04:58 2015 -0700 New q flag for ‘format’ * doc/lispref/processes.texi (Sentinels): Don't hardwire grave quoting style in example. * doc/lispref/strings.texi (Formatting Strings): * etc/NEWS: Document new q flag. * src/editfns.c (Fformat): Implement it. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 2bc6a18..98b3dfb 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1720,13 +1720,13 @@ sentinel, the eventual call to the sentinel will use the new one. @group (defun msg-me (process event) (princ - (format "Process: %s had the event `%s'" process event))) + (format "Process: %s had the event ‘%s’" process event))) (set-process-sentinel (get-process "shell") 'msg-me) @result{} msg-me @end group @group (kill-process (get-process "shell")) - @print{} Process: # had the event `killed' + @print{} Process: # had the event ‘killed’ @result{} # @end group @end smallexample diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 3093338..8de1473 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -936,7 +936,7 @@ where curved single quotes stand for themselves: (format "The name of this buffer is ‘%s’." (buffer-name)) @result{} "The name of this buffer is ‘strings.texi’." -(format "The buffer object prints as ‘%s’." (current-buffer)) +(format "The buffer object prints as %qs." (current-buffer)) @result{} "The buffer object prints as ‘strings.texi’." (format "The octal value of %d is %o, @@ -1011,13 +1011,16 @@ specifier, if any, to be inserted on the right rather than the left. If both @samp{-} and @samp{0} are present, the @samp{0} flag is ignored. + The flag @samp{q} quotes the printed representation as per the +variable @samp{text-quoting-style} described below. + @example @group (format "%06d is padded on the left with zeros" 123) @result{} "000123 is padded on the left with zeros" -(format "%-6d is padded on the right" 123) - @result{} "123 is padded on the right" +(format "%q-6d is padded on the right" 123) + @result{} "‘123 ’ is padded on the right" (format "The word ‘%-7s’ actually has %d letters in it." "foo" (length "foo")) diff --git a/etc/NEWS b/etc/NEWS index ec3d25c..6058f22 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -912,12 +912,17 @@ create a string, and may return its first argument if the argument already has the correct value. +++ +** New ‘format’ flag ‘q’ +The new ‘q’ flag causes ‘format’ to quote the output representation as +per the value of ‘text quoting-style’. E.g., (format "%qs failed" +"foo") might return "‘foo’ failed". + ++++ ** substitute-command-keys now replaces quotes. That is, it converts documentation strings' quoting style as per the -value of ‘text-quoting-style’ as described above. Doc strings in -source code can use either curved quotes or grave accent and -apostrophe. As before, isolated apostrophes and characters preceded -by \= are output as-is. +value of ‘text-quoting-style’. Doc strings in source code can use +either curved quotes or grave accent and apostrophe. As before, +isolated apostrophes and characters preceded by \= are output as-is. +++ ** The character classes [:alpha:] and [:alnum:] in regular expressions diff --git a/src/editfns.c b/src/editfns.c index ed57d8a..0e1b0c8 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3822,7 +3822,7 @@ specifiers, as follows: %character -where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+ +where flags is [+ #-0q]+, width is [0-9]+, and precision is .[0-9]+ The + flag character inserts a + before any positive number, while a space inserts a space before any positive number; these flags only @@ -3835,6 +3835,9 @@ The # flag means to use an alternate display form for %o, %x, %X, %e, for %e, %f, and %g, it causes a decimal point to be included even if the precision is zero. +The q flag means to quote the printed representation as per +‘text-quoting-style’. E.g., "%qs" is equivalent to "‘%s’". + The width specifier supplies a lower limit for the length of the printed representation. The padding, if any, normally goes on the left, but it goes on the right if the - flag is present. The padding @@ -3973,11 +3976,12 @@ usage: (format STRING &rest OBJECTS) */) digits to print after the '.' for floats, or the max. number of chars to print from a string. */ - bool minus_flag = 0; - bool plus_flag = 0; - bool space_flag = 0; - bool sharp_flag = 0; - bool zero_flag = 0; + bool minus_flag = false; + bool plus_flag = false; + bool space_flag = false; + bool sharp_flag = false; + bool zero_flag = false; + bool quote_flag = false; ptrdiff_t field_width; bool precision_given; uintmax_t precision = UINTMAX_MAX; @@ -3988,11 +3992,12 @@ usage: (format STRING &rest OBJECTS) */) { switch (*++format) { - case '-': minus_flag = 1; continue; - case '+': plus_flag = 1; continue; - case ' ': space_flag = 1; continue; - case '#': sharp_flag = 1; continue; - case '0': zero_flag = 1; continue; + case '-': minus_flag = true; continue; + case '+': plus_flag = true; continue; + case ' ': space_flag = true; continue; + case '#': sharp_flag = true; continue; + case '0': zero_flag = true; continue; + case 'q': quote_flag = true; continue; } break; } @@ -4121,6 +4126,20 @@ usage: (format STRING &rest OBJECTS) */) if (convbytes && multibyte && ! STRING_MULTIBYTE (args[n])) convbytes = count_size_as_multibyte (SDATA (args[n]), nbytes); + if (quote_flag) + { + convbytes += 2; + if (quoting_style == CURVE_QUOTING_STYLE) + { + if (!multibyte) + { + multibyte = true; + goto retry; + } + convbytes += 4; + } + } + padding = width < field_width ? field_width - width : 0; if (max_bufsize - padding <= convbytes) @@ -4128,6 +4147,27 @@ usage: (format STRING &rest OBJECTS) */) convbytes += padding; if (convbytes <= buf + bufsize - p) { + + if (quote_flag) + { + switch (quoting_style) + { + case CURVE_QUOTING_STYLE: + memcpy (p, uLSQM, 3); + p += 3; + break; + + case GRAVE_QUOTING_STYLE: + *p++ = '`'; + break; + + case STRAIGHT_QUOTING_STYLE: + *p++ = '\''; + break; + } + nchars++; + } + if (! minus_flag) { memset (p, ' ', padding); @@ -4157,6 +4197,22 @@ usage: (format STRING &rest OBJECTS) */) nchars += padding; } + if (quote_flag) + { + switch (quoting_style) + { + case CURVE_QUOTING_STYLE: + memcpy (p, uRSQM, 3); + p += 3; + break; + + default: + *p++ = '\''; + break; + } + nchars++; + } + /* If this argument has text properties, record where in the result string it appears. */ if (string_intervals (args[n])) commit 85bc107458601e305445d7ec6f5b209c01f5db0c Author: Daiki Ueno Date: Wed Aug 19 11:40:17 2015 +0900 pinentry.el: Add debugging support * lisp/net/pinentry.el (pinentry-debug): New variable. (pinentry-debug-buffer): New variable. (pinentry--process-filter): Send input to the debug buffer, if `pinentry-debug' is set. diff --git a/lisp/net/pinentry.el b/lisp/net/pinentry.el index d7161bb..eaa9fa4 100644 --- a/lisp/net/pinentry.el +++ b/lisp/net/pinentry.el @@ -63,6 +63,8 @@ :type 'integer :group 'pinentry) +(defvar pinentry-debug nil) +(defvar pinentry-debug-buffer nil) (defvar pinentry--server-process nil) (defvar pinentry--connection-process-list nil) @@ -293,6 +295,13 @@ Assuan protocol." (setq pinentry--read-point (point-min)) (make-local-variable 'pinentry--labels)))) (with-current-buffer (process-buffer process) + (when pinentry-debug + (with-current-buffer + (or pinentry-debug-buffer + (setq pinentry-debug-buffer (generate-new-buffer + " *pinentry-debug*"))) + (goto-char (point-max)) + (insert input))) (save-excursion (goto-char (point-max)) (insert input) commit 93fb1783a98ca31046f551ba1d33d67aa01e58b7 Author: Daiki Ueno Date: Wed Aug 19 11:38:32 2015 +0900 pinentry.el: Improve multiline prompt * lisp/net/pinentry.el (pinentry--prompt): Simplify the interface. (pinentry--process-filter): Use `pinentry--prompt' for CONFIRM command. diff --git a/lisp/net/pinentry.el b/lisp/net/pinentry.el index 13a15c9..d7161bb 100644 --- a/lisp/net/pinentry.el +++ b/lisp/net/pinentry.el @@ -108,9 +108,18 @@ If local sockets are not supported, this is nil.") (setq truncate-lines t buffer-read-only t)) -(defun pinentry--prompt (prompt short-prompt query-function &rest query-args) - (if (and (string-match "\n" prompt) - pinentry-popup-prompt-window) +(defun pinentry--prompt (labels query-function &rest query-args) + (let ((desc (cdr (assq 'desc labels))) + (error (cdr (assq 'error labels))) + (prompt (cdr (assq 'prompt labels)))) + (when (string-match "[ \n]*\\'" prompt) + (setq prompt (concat + (substring + prompt 0 (match-beginning 0)) " "))) + (when error + (setq desc (concat "Error: " (propertize error 'face 'error) + "\n" desc))) + (if (and desc pinentry-popup-prompt-window) (save-window-excursion (delete-other-windows) (unless (and pinentry--prompt-buffer @@ -122,7 +131,7 @@ If local sockets are not supported, this is nil.") (let ((inhibit-read-only t) buffer-read-only) (erase-buffer) - (insert prompt)) + (insert desc)) (pinentry-prompt-mode) (goto-char (point-min))) (if (> (window-height) @@ -135,13 +144,9 @@ If local sockets are not supported, this is nil.") (if (> (window-height) pinentry-prompt-window-height) (shrink-window (- (window-height) pinentry-prompt-window-height)))) - (prog1 (apply query-function short-prompt query-args) + (prog1 (apply query-function prompt query-args) (quit-window))) - (apply query-function - ;; Append a suffix to the prompt, which can be derived from - ;; SHORT-PROMPT. - (concat prompt (substring short-prompt -2)) - query-args))) + (apply query-function (concat desc "\n" prompt) query-args)))) ;;;###autoload (defun pinentry-start () @@ -312,29 +317,15 @@ Assuan protocol." (ignore-errors (process-send-string process "OK\n"))) ("GETPIN" - (let ((prompt - (or (cdr (assq 'desc pinentry--labels)) - (cdr (assq 'prompt pinentry--labels)) - "")) - (confirm (not (null (assq 'repeat pinentry--labels)))) - entry) - (if (setq entry (assq 'error pinentry--labels)) - (setq prompt (concat "Error: " - (propertize - (copy-sequence (cdr entry)) - 'face 'error) - "\n" - prompt))) - (if (setq entry (assq 'title pinentry--labels)) - (setq prompt (format "[%s] %s" - (cdr entry) prompt))) - (let (passphrase escaped-passphrase encoded-passphrase) - (unwind-protect - (condition-case nil - (progn - (setq passphrase - (pinentry--prompt prompt "Password: " - #'read-passwd confirm)) + (let ((confirm (not (null (assq 'repeat pinentry--labels)))) + passphrase escaped-passphrase encoded-passphrase) + (unwind-protect + (condition-case err + (progn + (setq passphrase + (pinentry--prompt + pinentry--labels + #'read-passwd confirm)) (setq escaped-passphrase (pinentry--escape-string passphrase)) @@ -345,7 +336,8 @@ Assuan protocol." (pinentry--send-data process encoded-passphrase) (process-send-string process "OK\n"))) - (error + (error + (message "GETPIN error %S" err) (ignore-errors (pinentry--send-error process @@ -356,59 +348,55 @@ Assuan protocol." (clear-string escaped-passphrase)) (if encoded-passphrase (clear-string encoded-passphrase)))) - (setq pinentry--labels nil))) + (setq pinentry--labels nil)) ("CONFIRM" (let ((prompt - (or (cdr (assq 'desc pinentry--labels)) - "")) + (or (cdr (assq 'prompt pinentry--labels)) + "Confirm? ")) (buttons - (pinentry--labels-to-shortcuts - (list (cdr (assq 'ok pinentry--labels)) - (cdr (assq 'notok pinentry--labels)) - (cdr (assq 'cancel pinentry--labels))))) + (delq nil + (pinentry--labels-to-shortcuts + (list (cdr (assq 'ok pinentry--labels)) + (cdr (assq 'notok pinentry--labels)) + (cdr (assq 'cancel pinentry--labels)))))) entry) - (if (setq entry (assq 'error pinentry--labels)) - (setq prompt (concat "Error: " - (propertize - (copy-sequence (cdr entry)) - 'face 'error) - "\n" - prompt))) - (if (setq entry (assq 'title pinentry--labels)) - (setq prompt (format "[%s] %s" - (cdr entry) prompt))) - (if (remq nil buttons) + (if buttons (progn (setq prompt (concat prompt " (" - (mapconcat #'cdr (remq nil buttons) + (mapconcat #'cdr buttons ", ") ") ")) + (if (setq entry (assq 'prompt pinentry--labels)) + (setcdr entry prompt) + (setq pinentry--labels (cons (cons 'prompt prompt) + pinentry--labels))) (condition-case nil - (let ((result (read-char prompt))) + (let ((result (pinentry--prompt pinentry--labels + #'read-char))) (if (eq result (caar buttons)) - (ignore-errors - (process-send-string process "OK\n")) + (ignore-errors + (process-send-string process "OK\n")) (if (eq result (car (nth 1 buttons))) - (ignore-errors - (pinentry--send-error - process - pinentry--error-not-confirmed)) - (ignore-errors - (pinentry--send-error - process - pinentry--error-cancelled))))) + (ignore-errors + (pinentry--send-error + process + pinentry--error-not-confirmed)) + (ignore-errors + (pinentry--send-error + process + pinentry--error-cancelled))))) (error - (ignore-errors + (ignore-errors (pinentry--send-error process pinentry--error-cancelled))))) - (if (string-match "[ \n]*\\'" prompt) - (setq prompt (concat - (substring - prompt 0 (match-beginning 0)) " "))) + (if (setq entry (assq 'prompt pinentry--labels)) + (setcdr entry prompt) + (setq pinentry--labels (cons (cons 'prompt prompt) + pinentry--labels))) (if (condition-case nil - (pinentry--prompt prompt "Confirm? " #'y-or-n-p) + (pinentry--prompt pinentry--labels #'y-or-n-p) (quit)) (ignore-errors (process-send-string process "OK\n")) commit aab8326b28f460a47f0a073612a8c8f9e9d8ec2f Author: Paul Eggert Date: Tue Aug 18 16:24:27 2015 -0700 Fix multibyte confusion in diagnostics * src/print.c (print_error_message): Don't assume that the caller's name is unibyte. * src/xdisp.c (vadd_to_log): Don't assume that the formatted diagnostic is unibyte. diff --git a/src/print.c b/src/print.c index f396151..af61574 100644 --- a/src/print.c +++ b/src/print.c @@ -902,7 +902,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, USE_SAFE_ALLOCA; char *name = SAFE_ALLOCA (cnamelen); memcpy (name, SDATA (cname), cnamelen); - message_dolog (name, cnamelen, 0, 0); + message_dolog (name, cnamelen, 0, STRING_MULTIBYTE (cname)); message_dolog (": ", 2, 0, 0); SAFE_FREE (); } diff --git a/src/xdisp.c b/src/xdisp.c index 6d747eb..88e6c8d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -9843,7 +9843,7 @@ vadd_to_log (char const *format, va_list ap) char *buffer = SAFE_ALLOCA (len); memcpy (buffer, SDATA (msg), len); - message_dolog (buffer, len - 1, true, false); + message_dolog (buffer, len - 1, true, STRING_MULTIBYTE (msg)); SAFE_FREE (); UNGCPRO; commit 636736861688abe73cc5dd4181fdb66de3fd8cfd Author: Paul Eggert Date: Tue Aug 18 16:17:30 2015 -0700 Fix file name encodings in diagnostics Also, close some minor races when opening image files, by opening them once instead of multiple times. * src/gtkutil.c (xg_get_image_for_pixmap): * src/image.c (xpm_load, tiff_load, gif_load, imagemagick_load) (svg_load): * src/nsimage.m (allocInitFromFile:): * src/xfns.c (xg_set_icon): Encode file name, since x_find_image_file no longer does that. * src/image.c (x_find_image_fd): New function. (x_find_image_file): Use it. Do not encode resulting file name, since callers sometimes need it decoded. (slurp_file): File arg is now a fd, not a file name. All callers changed. This saves us having to open the file twice. (xbm_load, xpm_load, pbm_load, png_load_body, jpeg_load_body) (svg_load): Use x_find_image_fd and fdopen to save a file-open. Report file name that failed. * src/lread.c (openp): If PREDICATE is t, open the file in binary mode. diff --git a/src/gtkutil.c b/src/gtkutil.c index a4b4331..d684cd9 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -382,10 +382,11 @@ xg_get_image_for_pixmap (struct frame *f, if (STRINGP (specified_file) && STRINGP (file = x_find_image_file (specified_file))) { + char *encoded_file = SSDATA (ENCODE_FILE (file)); if (! old_widget) - old_widget = GTK_IMAGE (gtk_image_new_from_file (SSDATA (file))); + old_widget = GTK_IMAGE (gtk_image_new_from_file (encoded_file)); else - gtk_image_set_from_file (old_widget, SSDATA (file)); + gtk_image_set_from_file (old_widget, encoded_file); return GTK_WIDGET (old_widget); } diff --git a/src/image.c b/src/image.c index fb8c6e7..8f9b06c 100644 --- a/src/image.c +++ b/src/image.c @@ -2270,11 +2270,13 @@ image_unget_x_image (struct image *img, bool mask_p, XImagePtr ximg) ***********************************************************************/ /* Find image file FILE. Look in data-directory/images, then - x-bitmap-file-path. Value is the encoded full name of the file - found, or nil if not found. */ + x-bitmap-file-path. Value is the full name of the file + found, or nil if not found. If PFD is nonnull store into *PFD a + readable file descriptor for the file, opened in binary mode. If + PFD is null, do not open the file. */ -Lisp_Object -x_find_image_file (Lisp_Object file) +static Lisp_Object +x_find_image_fd (Lisp_Object file, int *pfd) { Lisp_Object file_found, search_path; int fd; @@ -2286,29 +2288,35 @@ x_find_image_file (Lisp_Object file) Vx_bitmap_file_path); /* Try to find FILE in data-directory/images, then x-bitmap-file-path. */ - fd = openp (search_path, file, Qnil, &file_found, Qnil, false); - - if (fd == -1) - file_found = Qnil; - else - { - file_found = ENCODE_FILE (file_found); - if (fd != -2) - emacs_close (fd); - } - + fd = openp (search_path, file, Qnil, &file_found, + pfd ? Qt : make_number (R_OK), false); + if (fd < 0) + return Qnil; + if (pfd) + *pfd = fd; return file_found; } +/* Find image file FILE. Look in data-directory/images, then + x-bitmap-file-path. Value is the encoded full name of the file + found, or nil if not found. */ + +Lisp_Object +x_find_image_file (Lisp_Object file) +{ + return x_find_image_fd (file, 0); +} /* Read FILE into memory. Value is a pointer to a buffer allocated with xmalloc holding FILE's contents. Value is null if an error - occurred. *SIZE is set to the size of the file. */ + occurred. FD is a file descriptor open for reading FILE. Set + *SIZE to the size of the file. */ static unsigned char * -slurp_file (char *file, ptrdiff_t *size) +slurp_file (int fd, ptrdiff_t *size) { - FILE *fp = emacs_fopen (file, "rb"); + FILE *fp = fdopen (fd, "rb"); + unsigned char *buf = NULL; struct stat st; @@ -2980,21 +2988,19 @@ xbm_load (struct frame *f, struct image *img) file_name = image_spec_value (img->spec, QCfile, NULL); if (STRINGP (file_name)) { - Lisp_Object file; - unsigned char *contents; - ptrdiff_t size; - - file = x_find_image_file (file_name); + int fd; + Lisp_Object file = x_find_image_fd (file_name, &fd); if (!STRINGP (file)) { image_error ("Cannot find image file "uLSQM"%s"uRSQM, file_name); return 0; } - contents = slurp_file (SSDATA (file), &size); + ptrdiff_t size; + unsigned char *contents = slurp_file (fd, &size); if (contents == NULL) { - image_error ("Error loading XBM image "uLSQM"%s"uRSQM, img->spec); + image_error ("Error loading XBM image "uLSQM"%s"uRSQM, file); return 0; } @@ -3640,6 +3646,7 @@ xpm_load (struct frame *f, struct image *img) return 0; } + file = ENCODE_FILE (file); #ifdef HAVE_NTGUI #ifdef WINDOWSNT /* FILE is encoded in UTF-8, but image libraries on Windows @@ -4290,21 +4297,19 @@ xpm_load (struct frame *f, file_name = image_spec_value (img->spec, QCfile, NULL); if (STRINGP (file_name)) { - Lisp_Object file; - unsigned char *contents; - ptrdiff_t size; - - file = x_find_image_file (file_name); + int fd; + Lisp_Object file = x_find_image_fd (file_name, &fd); if (!STRINGP (file)) { image_error ("Cannot find image file "uLSQM"%s"uRSQM, file_name); return 0; } - contents = slurp_file (SSDATA (file), &size); + ptrdiff_t size; + unsigned char *contents = slurp_file (fd, &size); if (contents == NULL) { - image_error ("Error loading XPM image "uLSQM"%s"uRSQM, img->spec); + image_error ("Error loading XPM image "uLSQM"%s"uRSQM, file); return 0; } @@ -5253,11 +5258,10 @@ pbm_load (struct frame *f, struct image *img) bool raw_p; int x, y; int width, height, max_color_idx = 0; - Lisp_Object file, specified_file; + Lisp_Object specified_file; enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type; unsigned char *contents = NULL; unsigned char *end, *p; - ptrdiff_t size; #ifdef USE_CAIRO unsigned char *data = 0; uint32_t *dataptr; @@ -5269,7 +5273,8 @@ pbm_load (struct frame *f, struct image *img) if (STRINGP (specified_file)) { - file = x_find_image_file (specified_file); + int fd; + Lisp_Object file = x_find_image_fd (specified_file, &fd); if (!STRINGP (file)) { image_error ("Cannot find image file "uLSQM"%s"uRSQM, @@ -5277,7 +5282,8 @@ pbm_load (struct frame *f, struct image *img) return 0; } - contents = slurp_file (SSDATA (file), &size); + ptrdiff_t size; + contents = slurp_file (fd, &size); if (contents == NULL) { image_error ("Error reading "uLSQM"%s"uRSQM, file); @@ -5878,7 +5884,7 @@ struct png_load_context static bool png_load_body (struct frame *f, struct image *img, struct png_load_context *c) { - Lisp_Object file, specified_file; + Lisp_Object specified_file; Lisp_Object specified_data; int x, y; ptrdiff_t i; @@ -5909,7 +5915,8 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) if (NILP (specified_data)) { - file = x_find_image_file (specified_file); + int fd; + Lisp_Object file = x_find_image_fd (specified_file, &fd); if (!STRINGP (file)) { image_error ("Cannot find image file "uLSQM"%s"uRSQM, @@ -5918,7 +5925,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) } /* Open the image file. */ - fp = emacs_fopen (SSDATA (file), "rb"); + fp = fdopen (fd, "rb"); if (!fp) { image_error ("Cannot open image file "uLSQM"%s"uRSQM, file); @@ -6654,7 +6661,7 @@ static bool jpeg_load_body (struct frame *f, struct image *img, struct my_jpeg_error_mgr *mgr) { - Lisp_Object file, specified_file; + Lisp_Object specified_file; Lisp_Object specified_data; /* The 'volatile' silences a bogus diagnostic; see GCC bug 54561. */ FILE * IF_LINT (volatile) fp = NULL; @@ -6674,7 +6681,8 @@ jpeg_load_body (struct frame *f, struct image *img, if (NILP (specified_data)) { - file = x_find_image_file (specified_file); + int fd; + Lisp_Object file = x_find_image_fd (specified_file, &fd); if (!STRINGP (file)) { image_error ("Cannot find image file "uLSQM"%s"uRSQM, @@ -6682,7 +6690,7 @@ jpeg_load_body (struct frame *f, struct image *img, return 0; } - fp = emacs_fopen (SSDATA (file), "rb"); + fp = fdopen (fd, "rb"); if (fp == NULL) { image_error ("Cannot open "uLSQM"%s"uRSQM, file); @@ -7172,7 +7180,7 @@ tiff_warning_handler (const char *title, const char *format, va_list ap) static bool tiff_load (struct frame *f, struct image *img) { - Lisp_Object file, specified_file; + Lisp_Object specified_file; Lisp_Object specified_data; TIFF *tiff; int width, height, x, y, count; @@ -7191,19 +7199,21 @@ tiff_load (struct frame *f, struct image *img) if (NILP (specified_data)) { /* Read from a file */ - file = x_find_image_file (specified_file); + Lisp_Object file = x_find_image_file (specified_file); if (!STRINGP (file)) { image_error ("Cannot find image file "uLSQM"%s"uRSQM, specified_file); return 0; } + + Lisp_Object encoded_file = ENCODE_FILE (file); # ifdef WINDOWSNT - file = ansi_encode_filename (file); + encoded_file = ansi_encode_filename (encoded_file); # endif /* Try to open the image file. */ - tiff = TIFFOpen (SSDATA (file), "r"); + tiff = TIFFOpen (SSDATA (encoded_file), "r"); if (tiff == NULL) { image_error ("Cannot open "uLSQM"%s"uRSQM, file); @@ -7605,7 +7615,6 @@ static const int interlace_increment[] = {8, 8, 4, 2}; static bool gif_load (struct frame *f, struct image *img) { - Lisp_Object file; int rc, width, height, x, y, i, j; ColorMapObject *gif_color_map; unsigned long pixel_colors[256]; @@ -7626,27 +7635,29 @@ gif_load (struct frame *f, struct image *img) if (NILP (specified_data)) { - file = x_find_image_file (specified_file); + Lisp_Object file = x_find_image_file (specified_file); if (!STRINGP (file)) { image_error ("Cannot find image file "uLSQM"%s"uRSQM, specified_file); return 0; } + + Lisp_Object encoded_file = ENCODE_FILE (file); #ifdef WINDOWSNT - file = ansi_encode_filename (file); + encoded_file = ansi_encode_filename (encoded_file); #endif /* Open the GIF file. */ #if GIFLIB_MAJOR < 5 - gif = DGifOpenFileName (SSDATA (file)); + gif = DGifOpenFileName (SSDATA (encoded_file)); if (gif == NULL) { image_error ("Cannot open "uLSQM"%s"uRSQM, file); return 0; } #else - gif = DGifOpenFileName (SSDATA (file), &gif_err); + gif = DGifOpenFileName (SSDATA (encoded_file), &gif_err); if (gif == NULL) { image_error ("Cannot open "uLSQM"%s"uRSQM": %s", @@ -8818,14 +8829,13 @@ imagemagick_load (struct frame *f, struct image *img) file_name = image_spec_value (img->spec, QCfile, NULL); if (STRINGP (file_name)) { - Lisp_Object file; - - file = x_find_image_file (file_name); + Lisp_Object file = x_find_image_file (file_name); if (!STRINGP (file)) { image_error ("Cannot find image file "uLSQM"%s"uRSQM, file_name); return 0; } + file = ENCODE_FILE (file); #ifdef WINDOWSNT file = ansi_encode_filename (file); #endif @@ -9097,11 +9107,8 @@ svg_load (struct frame *f, struct image *img) file_name = image_spec_value (img->spec, QCfile, NULL); if (STRINGP (file_name)) { - Lisp_Object file; - unsigned char *contents; - ptrdiff_t size; - - file = x_find_image_file (file_name); + int fd; + Lisp_Object file = x_find_image_fd (file_name, &fd); if (!STRINGP (file)) { image_error ("Cannot find image file "uLSQM"%s"uRSQM, file_name); @@ -9109,14 +9116,16 @@ svg_load (struct frame *f, struct image *img) } /* Read the entire file into memory. */ - contents = slurp_file (SSDATA (file), &size); + ptrdiff_t size; + unsigned char *contents = slurp_file (fd, &size); if (contents == NULL) { - image_error ("Error loading SVG image "uLSQM"%s"uRSQM, img->spec); + image_error ("Error loading SVG image "uLSQM"%s"uRSQM, file); return 0; } /* If the file was slurped into memory properly, parse it. */ - success_p = svg_load_image (f, img, contents, size, SSDATA (file)); + success_p = svg_load_image (f, img, contents, size, + SSDATA (ENCODE_FILE (file))); xfree (contents); } /* Else its not a file, its a lisp object. Load the image from a diff --git a/src/lread.c b/src/lread.c index ebd594c..77a6211 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1403,7 +1403,8 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) SUFFIXES is a list of strings containing possible suffixes. The empty suffix is automatically added if the list is empty. - PREDICATE non-nil means don't open the files, + PREDICATE t means the files are binary. + PREDICATE non-nil and non-t means don't open the files, just look for one that satisfies the predicate. In this case, return 1 on success. The predicate can be a lisp function or an integer to pass to `access' (in which case file-name-handlers @@ -1418,7 +1419,7 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) If NEWER is true, try all SUFFIXes and return the result for the newest file that exists. Does not apply to remote files, - or if PREDICATE is specified. */ + or if a non-nil and non-t PREDICATE is specified. */ int openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, @@ -1520,10 +1521,11 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, else string = make_string (fn, fnlen); handler = Ffind_file_name_handler (string, Qfile_exists_p); - if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate)) + if ((!NILP (handler) || (!NILP (predicate) && !EQ (predicate, Qt))) + && !NATNUMP (predicate)) { bool exists; - if (NILP (predicate)) + if (NILP (predicate) || EQ (predicate, Qt)) exists = !NILP (Ffile_readable_p (string)); else { @@ -1577,7 +1579,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, } else { - fd = emacs_open (pfn, O_RDONLY, 0); + int oflags = O_RDONLY + (NILP (predicate) ? 0 : O_BINARY); + fd = emacs_open (pfn, oflags, 0); if (fd < 0) { if (errno != ENOENT) diff --git a/src/nsimage.m b/src/nsimage.m index 13e8504..5d0871b 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -169,6 +169,7 @@ ns_set_alpha (void *img, int x, int y, unsigned char a) found = x_find_image_file (file); if (!STRINGP (found)) return nil; + found = ENCODE_FILE (found); image = [[EmacsImage alloc] initByReferencingFile: [NSString stringWithUTF8String: SSDATA (found)]]; diff --git a/src/xfns.c b/src/xfns.c index 18fb343..3ef6762 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -548,7 +548,7 @@ xg_set_icon (struct frame *f, Lisp_Object file) { GdkPixbuf *pixbuf; GError *err = NULL; - char *filename = SSDATA (found); + char *filename = SSDATA (ENCODE_FILE (found)); block_input (); pixbuf = gdk_pixbuf_new_from_file (filename, &err); commit 345284f5e9eebb07536d12c08c72f1bab02ea55e Author: Dmitry Gutov Date: Tue Aug 18 23:31:52 2015 +0300 Allow blink-matching-paren to jump off screen * doc/emacs/programs.texi (Matching): Mention the `blink-matching-paren' value `jump-offscreen'. * lisp/simple.el (blink-matching-paren): New possible value. (blink-matching-paren-on-screen): Clarify the docstring. (blink-matching-open): Handle `jump-offscreen' (bug#21286). diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 2eb999d..8f78a1a 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -814,7 +814,8 @@ opening delimiter and closing delimiter are mismatched---such as in @code{blink-matching-paren} turns the feature on or off: @code{nil} disables it, but the default is @code{t} to enable it. Set it to @code{jump} to make indication work by momentarily moving the cursor -to the matching opening delimiter. +to the matching opening delimiter. Set it to @code{jump-offscreen} to +make the cursor jump, even if the opening delimiter is off screen. @item @code{blink-matching-delay} says how many seconds to keep indicating diff --git a/lisp/simple.el b/lisp/simple.el index 0d691ea..ea43975 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6873,17 +6873,22 @@ If called from Lisp, enable the mode if ARG is omitted or nil." (defcustom blink-matching-paren t "Non-nil means show matching open-paren when close-paren is inserted. -If t, highlight the paren. If `jump', move cursor to its position." +If t, highlight the paren. If `jump', briefly move cursor to its +position. If `jump-offscreen', move cursor there even if the +position is off screen. With any other non-nil value, the +off-screen position of the opening paren will be shown in the +echo area." :type '(choice (const :tag "Disable" nil) (const :tag "Highlight" t) - (const :tag "Move cursor" jump)) + (const :tag "Move cursor" jump) + (const :tag "Move cursor, even if off screen" jump-offscreen)) :group 'paren-blinking) (defcustom blink-matching-paren-on-screen t "Non-nil means show matching open-paren when it is on screen. If nil, don't show it (but the open-paren can still be shown -when it is off screen). +in the echo area when it is off screen). This variable has no effect if `blink-matching-paren' is nil. \(In that case, the open-paren is never shown.) @@ -6987,13 +6992,15 @@ The function should return non-nil if the two tokens do not match.") (minibuffer-message "No matching parenthesis found") (message "No matching parenthesis found")))) ((not blinkpos) nil) - ((pos-visible-in-window-p blinkpos) + ((or + (eq blink-matching-paren 'jump-offscreen) + (pos-visible-in-window-p blinkpos)) ;; Matching open within window, temporarily move to or highlight ;; char after blinkpos but only if `blink-matching-paren-on-screen' ;; is non-nil. (and blink-matching-paren-on-screen (not show-paren-mode) - (if (eq blink-matching-paren 'jump) + (if (memq blink-matching-paren '(jump jump-offscreen)) (save-excursion (goto-char blinkpos) (sit-for blink-matching-delay)) commit 9c1e7d5a2666cdf63abcc6623a8489d7bd47fe22 Author: Dmitry Gutov Date: Tue Aug 18 18:56:00 2015 +0300 Refine the previous change * lisp/simple.el (blink-matching-open): Use minibuffer-message outside of save-excursion (bug#21286). diff --git a/lisp/simple.el b/lisp/simple.el index afb2d4a..0d691ea 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -7004,12 +7004,9 @@ The function should return non-nil if the two tokens do not match.") (sit-for blink-matching-delay)) (delete-overlay blink-matching--overlay))))) (t - (save-excursion - (let* ((orig-pos (prog1 - (point) - (goto-char blinkpos))) - - (open-paren-line-string + (let ((open-paren-line-string + (save-excursion + (goto-char blinkpos) ;; Show what precedes the open in its line, if anything. (cond ((save-excursion (skip-chars-backward " \t") (not (bolp))) @@ -7036,13 +7033,10 @@ The function should return non-nil if the two tokens do not match.") "..." (buffer-substring blinkpos (1+ blinkpos)))) ;; There is nothing to show except the char itself. - (t (buffer-substring blinkpos (1+ blinkpos)))))) - ;; Because minibuffer-message causes a full redisplay, go back - ;; to the original point before that happens. - (goto-char orig-pos) - (minibuffer-message - "Matches %s" - (substring-no-properties open-paren-line-string))))))))) + (t (buffer-substring blinkpos (1+ blinkpos))))))) + (minibuffer-message + "Matches %s" + (substring-no-properties open-paren-line-string)))))))) (defvar blink-paren-function 'blink-matching-open "Function called, if non-nil, whenever a close parenthesis is inserted. commit c29a51df2de7eb800edf8e2235ee6c34bd1c9562 Author: Martin Rudalics Date: Tue Aug 18 16:45:27 2015 +0200 Rewrite and add frame geometry related functions. * src/frame.c (Fframe_position): New function. (Fset_frame_position): Rename parameters and rewrite doc-string. (syms_of_frame): Remove Qframe_position, Qframe_outer_size, Qtitle_height and Qframe_inner_size. Add Qouter_edges, Qouter_position, Qouter_size, Qnative_edges, Qinner_edges, Qtitle_bar_size. * src/nsfns.m (frame_geometry): New function. (Fx_frame_geometry): Call frame_geometry. (Fx_frame_edges): New function. * src/w32fns.c (C_CHILDREN_TITLEBAR, TITLEBAR_INFO) (GetTitleBarInfo_Proc): Define these so we can use the GetTitleBarInfo API. (Fw32_frame_menu_bar_size, Fw32_frame_rect): Remove. (Fx_frame_geometry): Rewrite. (Fx_frame_edges, Fx_mouse_absolute_pixel_position) (Fx_set_mouse_absolute_pixel_position): New functions. * src/xfns.c (frame_geometry): New function. (Fx_frame_geometry): Call frame_geometry. (Fx_frame_edges, Fx_mouse_absolute_pixel_position) (Fx_set_mouse_absolute_pixel_position): New functions. diff --git a/src/frame.c b/src/frame.c index 9e69598..2044048 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2977,24 +2977,40 @@ font height. */) return Qnil; } +DEFUN ("frame-position", Fframe_position, + Sframe_position, 0, 1, 0, + doc: /* Return top left corner of FRAME in pixels. +FRAME must be a live frame and defaults to the selected one. The return +value is a cons (x, y) of the coordinates of the top left corner of +FRAME's outer frame, in pixels relative to an origin (0, 0) of FRAME's +display. */) + (Lisp_Object frame) +{ + register struct frame *f = decode_live_frame (frame); + + return Fcons (make_number (f->left_pos), make_number (f->top_pos)); +} + DEFUN ("set-frame-position", Fset_frame_position, Sset_frame_position, 3, 3, 0, - doc: /* Sets position of FRAME in pixels to XOFFSET by YOFFSET. -If FRAME is nil, the selected frame is used. XOFFSET and YOFFSET are -actually the position of the upper left corner of the frame. Negative -values for XOFFSET or YOFFSET are interpreted relative to the rightmost -or bottommost possible position (that stays within the screen). */) - (Lisp_Object frame, Lisp_Object xoffset, Lisp_Object yoffset) + doc: /* Set position of FRAME to (X, Y). +FRAME must be a live frame and defaults to the selected one. X and Y, +if positive, specify the coordinate of the left and top edge of FRAME's +outer frame in pixels relative to an origin (0, 0) of FRAME's display. +If any of X or Y is negative, it specifies the coordinates of the right +or bottom edge of the outer frame of FRAME relative to the right or +bottom edge of FRAME's display. */) + (Lisp_Object frame, Lisp_Object x, Lisp_Object y) { register struct frame *f = decode_live_frame (frame); - CHECK_TYPE_RANGED_INTEGER (int, xoffset); - CHECK_TYPE_RANGED_INTEGER (int, yoffset); + CHECK_TYPE_RANGED_INTEGER (int, x); + CHECK_TYPE_RANGED_INTEGER (int, y); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f)) - x_set_offset (f, XINT (xoffset), XINT (yoffset), 1); + x_set_offset (f, XINT (x), XINT (y), 1); #endif return Qt; @@ -4890,15 +4906,17 @@ syms_of_frame (void) DEFSYM (Qframes, "frames"); DEFSYM (Qsource, "source"); - DEFSYM (Qframe_position, "frame-position"); - DEFSYM (Qframe_outer_size, "frame-outer-size"); + DEFSYM (Qouter_edges, "outer-edges"); + DEFSYM (Qouter_position, "outer-position"); + DEFSYM (Qouter_size, "outer-size"); + DEFSYM (Qnative_edges, "native-edges"); + DEFSYM (Qinner_edges, "inner-edges"); DEFSYM (Qexternal_border_size, "external-border-size"); - DEFSYM (Qtitle_height, "title-height"); + DEFSYM (Qtitle_bar_size, "title-bar-size"); DEFSYM (Qmenu_bar_external, "menu-bar-external"); DEFSYM (Qmenu_bar_size, "menu-bar-size"); DEFSYM (Qtool_bar_external, "tool-bar-external"); DEFSYM (Qtool_bar_size, "tool-bar-size"); - DEFSYM (Qframe_inner_size, "frame-inner-size"); /* The following are used for frame_size_history. */ DEFSYM (Qadjust_frame_size_1, "adjust-frame-size-1"); DEFSYM (Qadjust_frame_size_2, "adjust-frame-size-2"); @@ -5263,6 +5281,7 @@ in a more readable form. */); defsubr (&Sset_frame_height); defsubr (&Sset_frame_width); defsubr (&Sset_frame_size); + defsubr (&Sframe_position); defsubr (&Sset_frame_position); defsubr (&Sframe_pointer_visible_p); diff --git a/src/nsfns.m b/src/nsfns.m index 0fc867c..e945360 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -2836,91 +2836,142 @@ Value is t if tooltip was open, nil otherwise. */) return Qt; } -DEFUN ("x-frame-geometry", Fx_frame_geometry, Sx_frame_geometry, 0, 1, 0, - doc: /* Return geometric attributes of frame FRAME. +/* Return geometric attributes of FRAME. According to the value of + ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the inner + edges of FRAME, the root window edges of frame (Qroot_edges). Any + other value means to return the geometry as returned by + Fx_frame_geometry. */ +static Lisp_Object +frame_geometry (Lisp_Object frame, Lisp_Object attribute) +{ + struct frame *f = decode_live_frame (frame); + Lisp_Object fullscreen_symbol = Fframe_parameter (frame, Qfullscreen); + bool fullscreen = (EQ (fullscreen_symbol, Qfullboth) + || EQ (fullscreen_symbol, Qfullscreen)); + int border = fullscreen ? 0 : f->border_width; + int title_height = fullscreen ? 0 : FRAME_NS_TITLEBAR_HEIGHT (f); + int native_width = FRAME_PIXEL_WIDTH (f); + int native_height = FRAME_PIXEL_HEIGHT (f); + int outer_width = native_width + 2 * border; + int outer_height = native_height + 2 * border + title_height; + int native_left = f->left_pos + border; + int native_top = f->top_pos + border + title_height; + int native_right = f->left_pos + outer_width - border; + int native_bottom = f->top_pos + outer_height - border; + int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f); + int tool_bar_height = FRAME_TOOLBAR_HEIGHT (f); + int tool_bar_width = (tool_bar_height + ? outer_width - 2 * internal_border_width + : 0); + + /* Construct list. */ + if (EQ (attribute, Qouter_edges)) + return list4 (make_number (f->left_pos), make_number (f->top_pos), + make_number (f->left_pos + outer_width), + make_number (f->top_pos + outer_height)); + else if (EQ (attribute, Qnative_edges)) + return list4 (make_number (native_left), make_number (native_top), + make_number (native_right), make_number (native_bottom)); + else if (EQ (attribute, Qinner_edges)) + return list4 (make_number (native_left + internal_border_width), + make_number (native_top + + tool_bar_height + + internal_border_width), + make_number (native_right - internal_border_width), + make_number (native_bottom - internal_border_width)); + else + return + listn (CONSTYPE_HEAP, 10, + Fcons (Qouter_position, + Fcons (make_number (f->left_pos), + make_number (f->top_pos))), + Fcons (Qouter_size, + Fcons (make_number (outer_width), + make_number (outer_height))), + Fcons (Qexternal_border_size, + (fullscreen + ? Fcons (make_number (0), make_number (0)) + : Fcons (make_number (border), make_number (border)))), + Fcons (Qtitle_bar_size, + Fcons (make_number (0), make_number (title_height))), + Fcons (Qmenu_bar_external, Qnil), + Fcons (Qmenu_bar_size, Fcons (make_number (0), make_number (0))), + Fcons (Qtool_bar_external, + FRAME_EXTERNAL_TOOL_BAR (f) ? Qt : Qnil), + Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)), + Fcons (Qtool_bar_size, + Fcons (make_number (tool_bar_width), + make_number (tool_bar_height))), + Fcons (Qinternal_border_width, + make_number (internal_border_width))); +} -FRAME must be a live frame and defaults to the selected one. +DEFUN ("x-frame-geometry", Fx_frame_geometry, Sx_frame_geometry, 0, 1, 0, + doc: /* Return geometric attributes of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is an association list of the attributes listed below. All height +and width values are in pixels. -The return value is an association list containing the following -elements (all size values are in pixels). +`outer-position' is a cons of the outer left and top edges of FRAME + relative to the origin - the position (0, 0) - of FRAME's display. -- `frame-outer-size' is a cons of the outer width and height of FRAME. - The outer size include the title bar and the external borders as well - as any menu and/or tool bar of frame. +`outer-size' is a cons of the outer width and height of FRAME. The + outer size includes the title bar and the external borders as well as + any menu and/or tool bar of frame. -- `border' is a cons of the horizontal and vertical width of FRAME's - external borders. +`external-border-size' is a cons of the horizontal and vertical width of + FRAME's external borders as supplied by the window manager. -- `title-bar-height' is the height of the title bar of FRAME. +`title-bar-size' is a cons of the width and height of the title bar of + FRAME as supplied by the window manager. If both of them are zero, + FRAME has no title bar. If only the width is zero, Emacs was not + able to retrieve the width information. -- `menu-bar-external' if t means the menu bar is external (not +`menu-bar-external', if non-nil, means the menu bar is external (never included in the inner edges of FRAME). -- `menu-bar-size' is a cons of the width and height of the menu bar of +`menu-bar-size' is a cons of the width and height of the menu bar of FRAME. -- `tool-bar-external' if t means the tool bar is external (not +`tool-bar-external', if non-nil, means the tool bar is external (never included in the inner edges of FRAME). -- `tool-bar-side' tells tells on which side the tool bar on FRAME is and - can be one of `left', `top', `right' or `bottom'. +`tool-bar-position' tells on which side the tool bar on FRAME is and can + be one of `left', `top', `right' or `bottom'. If this is nil, FRAME + has no tool bar. -- `tool-bar-size' is a cons of the width and height of the tool bar of +`tool-bar-size' is a cons of the width and height of the tool bar of FRAME. -- `frame-inner-size' is a cons of the inner width and height of FRAME. - This excludes FRAME's title bar and external border as well as any - external menu and/or tool bar. */) +`internal-border-width' is the width of the internal border of + FRAME. */) (Lisp_Object frame) { - struct frame *f = decode_live_frame (frame); - int inner_width = FRAME_PIXEL_WIDTH (f); - int inner_height = FRAME_PIXEL_HEIGHT (f); - Lisp_Object fullscreen = Fframe_parameter (frame, Qfullscreen); - int border, title, outer_width, outer_height; - int tool_bar_height, tool_bar_width; - // Always 0 on NS. - int menu_bar_height = 0; - int menu_bar_width = 0; - - if (FRAME_INITIAL_P (f) || !FRAME_NS_P (f)) - return Qnil; + return frame_geometry (frame, Qnil); +} + +DEFUN ("x-frame-edges", Fx_frame_edges, Sx_frame_edges, 0, 2, 0, + doc: /* Return edge coordinates of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are +in pixels relative to the origin - the position (0, 0) - of FRAME's +display. - border = f->border_width; - title = FRAME_NS_TITLEBAR_HEIGHT (f); - outer_width = FRAME_PIXEL_WIDTH (f) + 2 * border; - outer_height = FRAME_PIXEL_HEIGHT (f) + 2 * border; - tool_bar_height = FRAME_TOOLBAR_HEIGHT (f); - tool_bar_width = tool_bar_height > 0 - ? outer_width - 2 * FRAME_INTERNAL_BORDER_WIDTH (f) - : 0; - - return - listn (CONSTYPE_HEAP, 10, - Fcons (Qframe_position, - Fcons (make_number (f->left_pos), make_number (f->top_pos))), - Fcons (Qframe_outer_size, - Fcons (make_number (outer_width), make_number (outer_height))), - Fcons (Qexternal_border_size, - ((EQ (fullscreen, Qfullboth) || EQ (fullscreen, Qfullscreen)) - ? Fcons (make_number (0), make_number (0)) - : Fcons (make_number (border), make_number (border)))), - Fcons (Qtitle_height, - ((EQ (fullscreen, Qfullboth) || EQ (fullscreen, Qfullscreen)) - ? make_number (0) - : make_number (title))), - Fcons (Qmenu_bar_external, FRAME_EXTERNAL_MENU_BAR (f) ? Qt : Qnil), - Fcons (Qmenu_bar_size, - Fcons (make_number (menu_bar_width), - make_number (menu_bar_height))), - Fcons (Qtool_bar_external, FRAME_EXTERNAL_TOOL_BAR (f) ? Qt : Qnil), - Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)), - Fcons (Qtool_bar_size, - Fcons (make_number (tool_bar_width), - make_number (tool_bar_height))), - Fcons (Qframe_inner_size, - Fcons (make_number (inner_width), - make_number (inner_height)))); +If optional argument TYPE is the symbol `outer-edges', return the outer +edges of FRAME. The outer edges comprise the decorations of the window +manager (like the title bar or external borders) as well as any external +menu or tool bar of FRAME. If optional argument TYPE is the symbol +`native-edges' or nil, return the native edges of FRAME. The native +edges exclude the decorations of the window manager and any external +menu or tool bar of FRAME. If TYPE is the symbol `inner-edges', return +the inner edges of FRAME. These edges exclude title bar, any borders, +menu bar or tool bar of FRAME. */) + (Lisp_Object frame, Lisp_Object type) +{ + return frame_geometry (frame, ((EQ (type, Qouter_edges) + || EQ (type, Qinner_edges)) + ? type + : Qnative_edges)); } /* ========================================================================== @@ -3106,6 +3157,7 @@ be used as the image of the icon representing the frame. */); defsubr (&Sx_display_pixel_height); defsubr (&Sns_display_monitor_attributes_list); defsubr (&Sx_frame_geometry); + defsubr (&Sx_frame_edges); defsubr (&Sx_display_mm_width); defsubr (&Sx_display_mm_height); defsubr (&Sx_display_screens); diff --git a/src/w32fns.c b/src/w32fns.c index 2cb99c9..8f0bde7 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -138,6 +138,14 @@ struct MONITOR_INFO DWORD dwFlags; }; +#define C_CHILDREN_TITLEBAR 5 +struct TITLEBAR_INFO +{ + DWORD cbSize; + RECT rcTitleBar; + DWORD rgstate[C_CHILDREN_TITLEBAR+1]; +}; + #ifndef CCHDEVICENAME #define CCHDEVICENAME 32 #endif @@ -172,6 +180,8 @@ typedef BOOL CALLBACK (* MonitorEnum_Proc) (IN HMONITOR monitor, IN HDC hdc, IN RECT *rcMonitor, IN LPARAM dwData); typedef BOOL (WINAPI * EnumDisplayMonitors_Proc) (IN HDC hdc, IN RECT *rcClip, IN MonitorEnum_Proc fnEnum, IN LPARAM dwData); +typedef BOOL (WINAPI * GetTitleBarInfo_Proc) + (IN HWND hwnd, OUT struct TITLEBAR_INFO* info); TrackMouseEvent_Proc track_mouse_event_fn = NULL; ImmGetCompositionString_Proc get_composition_string_fn = NULL; @@ -182,6 +192,7 @@ MonitorFromPoint_Proc monitor_from_point_fn = NULL; GetMonitorInfo_Proc get_monitor_info_fn = NULL; MonitorFromWindow_Proc monitor_from_window_fn = NULL; EnumDisplayMonitors_Proc enum_display_monitors_fn = NULL; +GetTitleBarInfo_Proc get_title_bar_info_fn = NULL; #ifdef NTGUI_UNICODE #define unicode_append_menu AppendMenuW @@ -7986,183 +7997,247 @@ This is a direct interface to the Windows API FindWindow function. */) return Qt; } -DEFUN ("w32-frame-menu-bar-size", Fw32_frame_menu_bar_size, Sw32_frame_menu_bar_size, 0, 1, 0, - doc: /* Return sizes of menu bar on frame FRAME. -The return value is a list of four elements: The current width and -height of FRAME's menu bar in pixels, the height of one menu bar line in -a wrapped menu bar in pixels, and the height of a single line menu bar -in pixels. - -If FRAME is omitted or nil, the selected frame is used. */) - (Lisp_Object frame) -{ - struct frame *f = decode_any_frame (frame); - MENUBARINFO menu_bar; - int width, height, single_height, wrapped_height; - - if (FRAME_INITIAL_P (f) || !FRAME_W32_P (f)) - return Qnil; - - block_input (); - - single_height = GetSystemMetrics (SM_CYMENU); - wrapped_height = GetSystemMetrics (SM_CYMENUSIZE); - menu_bar.cbSize = sizeof (menu_bar); - menu_bar.rcBar.right = menu_bar.rcBar.left = 0; - menu_bar.rcBar.top = menu_bar.rcBar.bottom = 0; - GetMenuBarInfo (FRAME_W32_WINDOW (f), 0xFFFFFFFD, 0, &menu_bar); - width = menu_bar.rcBar.right - menu_bar.rcBar.left; - height = menu_bar.rcBar.bottom - menu_bar.rcBar.top; - - unblock_input (); - - return list4 (make_number (width), make_number (height), - make_number (wrapped_height), make_number (single_height)); -} - -DEFUN ("w32-frame-rect", Fw32_frame_rect, Sw32_frame_rect, 0, 2, 0, - doc: /* Return boundary rectangle of FRAME in screen coordinates. -FRAME must be a live frame and defaults to the selected one. - -The boundary rectangle is a list of four elements, specifying the left, -top, right and bottom screen coordinates of FRAME including menu and -title bar and decorations. Optional argument CLIENT non-nil means to -return the boundaries of the client rectangle which excludes menu and -title bar and decorations. */) - (Lisp_Object frame, Lisp_Object client) -{ - struct frame *f = decode_live_frame (frame); - RECT rect; - - if (FRAME_INITIAL_P (f) || !FRAME_W32_P (f)) - return Qnil; - - block_input (); - - if (!NILP (client)) - GetClientRect (FRAME_W32_WINDOW (f), &rect); - else - GetWindowRect (FRAME_W32_WINDOW (f), &rect); - - unblock_input (); - - return list4 (make_number (rect.left), make_number (rect.top), - make_number (rect.right), make_number (rect.bottom)); -} - DEFUN ("x-frame-geometry", Fx_frame_geometry, Sx_frame_geometry, 0, 1, 0, - doc: /* Return geometric attributes of frame FRAME. -FRAME must be a live frame and defaults to the selected one. + doc: /* Return geometric attributes of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is an association list of the attributes listed below. All height +and width values are in pixels. -The return value is an association list containing the following -elements (all size values are in pixels). +`outer-position' is a cons of the outer left and top edges of FRAME + relative to the origin - the position (0, 0) - of FRAME's display. -- `frame-outer-size' is a cons of the outer width and height of FRAME. - The outer size includes the title bar and the external borders as well - as any menu and/or tool bar of frame. +`outer-size' is a cons of the outer width and height of FRAME. The + outer size includes the title bar and the external borders as well as + any menu and/or tool bar of frame. -- `border' is a cons of the horizontal and vertical width of FRAME's - external borders. +`external-border-size' is a cons of the horizontal and vertical width of + FRAME's external borders as supplied by the window manager. -- `title-bar-height' is the height of the title bar of FRAME. +`title-bar-size' is a cons of the width and height of the title bar of + FRAME as supplied by the window manager. If both of them are zero, + FRAME has no title bar. If only the width is zero, Emacs was not + able to retrieve the width information. -- `menu-bar-external' if t means the menu bar is by default external - (not included in the inner size of FRAME). +`menu-bar-external', if non-nil, means the menu bar is external (never + included in the inner edges of FRAME). -- `menu-bar-size' is a cons of the width and height of the menu bar of +`menu-bar-size' is a cons of the width and height of the menu bar of FRAME. -- `tool-bar-external' if t means the tool bar is by default external - (not included in the inner size of FRAME). +`tool-bar-external', if non-nil, means the tool bar is external (never + included in the inner edges of FRAME). -- `tool-bar-side' tells tells on which side the tool bar on FRAME is by - default and can be one of `left', `top', `right' or `bottom'. +`tool-bar-position' tells on which side the tool bar on FRAME is and can + be one of `left', `top', `right' or `bottom'. If this is nil, FRAME + has no tool bar. -- `tool-bar-size' is a cons of the width and height of the tool bar of +`tool-bar-size' is a cons of the width and height of the tool bar of FRAME. -- `frame-inner-size' is a cons of the inner width and height of FRAME. - This excludes FRAME's title bar and external border as well as any - external menu and/or tool bar. */) +`internal-border-width' is the width of the internal border of + FRAME. */) (Lisp_Object frame) { struct frame *f = decode_live_frame (frame); - Lisp_Object geometry = Qnil; - RECT frame_outer_edges, frame_inner_edges; + MENUBARINFO menu_bar; - int border_width, border_height, title_height; - int single_bar_height, wrapped_bar_height, menu_bar_height; - Lisp_Object fullscreen = Fframe_parameter (frame, Qfullscreen); + WINDOWINFO window; + int left, top, right, bottom; + unsigned int external_border_width, external_border_height; + int title_bar_width = 0, title_bar_height = 0; + int single_menu_bar_height, wrapped_menu_bar_height, menu_bar_height; + int tool_bar_height = FRAME_TOOL_BAR_HEIGHT (f); + int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f); + bool fullboth = EQ (get_frame_param (f, Qfullscreen), Qfullboth); if (FRAME_INITIAL_P (f) || !FRAME_W32_P (f)) return Qnil; block_input (); - - /* Outer frame rectangle, including outer borders and title bar. */ - GetWindowRect (FRAME_W32_WINDOW (f), &frame_outer_edges); - /* Inner frame rectangle, excluding borders and title bar. */ - GetClientRect (FRAME_W32_WINDOW (f), &frame_inner_edges); - /* Outer border. */ - border_width = GetSystemMetrics (SM_CXFRAME); - border_height = GetSystemMetrics (SM_CYFRAME); + /* Outer rectangle and borders. */ + window.cbSize = sizeof (window); + GetWindowInfo (FRAME_W32_WINDOW (f), &window); + external_border_width = window.cxWindowBorders; + external_border_height = window.cyWindowBorders; /* Title bar. */ - title_height = GetSystemMetrics (SM_CYCAPTION); + if ((window.dwStyle & WS_CAPTION) == WS_CAPTION) + { + if (get_title_bar_info_fn) + { + struct TITLEBAR_INFO title_bar; + + title_bar.cbSize = sizeof (title_bar); + title_bar.rcTitleBar.left = title_bar.rcTitleBar.right = 0; + title_bar.rcTitleBar.top = title_bar.rcTitleBar.bottom = 0; + get_title_bar_info_fn (FRAME_W32_WINDOW (f), &title_bar); + title_bar_width + = title_bar.rcTitleBar.right - title_bar.rcTitleBar.left; + title_bar_height + = title_bar.rcTitleBar.bottom - title_bar.rcTitleBar.top; + } + else + title_bar_height = GetSystemMetrics (SM_CYCAPTION); + } /* Menu bar. */ menu_bar.cbSize = sizeof (menu_bar); menu_bar.rcBar.right = menu_bar.rcBar.left = 0; menu_bar.rcBar.top = menu_bar.rcBar.bottom = 0; GetMenuBarInfo (FRAME_W32_WINDOW (f), 0xFFFFFFFD, 0, &menu_bar); - single_bar_height = GetSystemMetrics (SM_CYMENU); - wrapped_bar_height = GetSystemMetrics (SM_CYMENUSIZE); + single_menu_bar_height = GetSystemMetrics (SM_CYMENU); + wrapped_menu_bar_height = GetSystemMetrics (SM_CYMENUSIZE); unblock_input (); + left = window.rcWindow.left; + top = window.rcWindow.top; + right = window.rcWindow.right; + bottom = window.rcWindow.bottom; + + /* Menu bar. */ menu_bar_height = menu_bar.rcBar.bottom - menu_bar.rcBar.top; /* Fix menu bar height reported by GetMenuBarInfo. */ - if (menu_bar_height > single_bar_height) + if (menu_bar_height > single_menu_bar_height) /* A wrapped menu bar. */ - menu_bar_height += single_bar_height - wrapped_bar_height; + menu_bar_height += single_menu_bar_height - wrapped_menu_bar_height; else if (menu_bar_height > 0) /* A single line menu bar. */ - menu_bar_height = single_bar_height; - - return - listn (CONSTYPE_HEAP, 10, - Fcons (Qframe_position, - Fcons (make_number (frame_outer_edges.left), - make_number (frame_outer_edges.top))), - Fcons (Qframe_outer_size, - Fcons (make_number - (frame_outer_edges.right - frame_outer_edges.left), - make_number - (frame_outer_edges.bottom - frame_outer_edges.top))), + menu_bar_height = single_menu_bar_height; + + return listn (CONSTYPE_HEAP, 10, + Fcons (Qouter_position, + Fcons (make_number (left), make_number (top))), + Fcons (Qouter_size, + Fcons (make_number (right - left), + make_number (bottom - top))), Fcons (Qexternal_border_size, - ((EQ (fullscreen, Qfullboth) || EQ (fullscreen, Qfullscreen)) - ? Fcons (make_number (0), make_number (0)) - : Fcons (make_number (border_width), - make_number (border_height)))), - Fcons (Qtitle_height, - ((EQ (fullscreen, Qfullboth) || EQ (fullscreen, Qfullscreen)) - ? make_number (0) - : make_number (title_height))), + Fcons (make_number (external_border_width), + make_number (external_border_height))), + Fcons (Qtitle_bar_size, + Fcons (make_number (title_bar_width), + make_number (title_bar_height))), Fcons (Qmenu_bar_external, Qt), Fcons (Qmenu_bar_size, Fcons (make_number (menu_bar.rcBar.right - menu_bar.rcBar.left), make_number (menu_bar_height))), Fcons (Qtool_bar_external, Qnil), - Fcons (Qtool_bar_position, Qtop), + Fcons (Qtool_bar_position, tool_bar_height ? Qtop : Qnil), Fcons (Qtool_bar_size, - Fcons (make_number (FRAME_TOOL_BAR_LINES (f) - ? (FRAME_PIXEL_WIDTH (f) - - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)) + Fcons (make_number + (tool_bar_height + ? right - left - 2 * internal_border_width : 0), - make_number (FRAME_TOOL_BAR_HEIGHT (f)))), - Fcons (Qframe_inner_size, - Fcons (make_number - (frame_inner_edges.right - frame_inner_edges.left), - make_number - (frame_inner_edges.bottom - frame_inner_edges.top)))); + make_number (tool_bar_height))), + Fcons (Qinternal_border_width, + make_number (internal_border_width))); +} + +DEFUN ("x-frame-edges", Fx_frame_edges, Sx_frame_edges, 0, 2, 0, + doc: /* Return edge coordinates of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are +in pixels relative to the origin - the position (0, 0) - of FRAME's +display. + +If optional argument TYPE is the symbol `outer-edges', return the outer +edges of FRAME. The outer edges comprise the decorations of the window +manager (like the title bar or external borders) as well as any external +menu or tool bar of FRAME. If optional argument TYPE is the symbol +`native-edges' or nil, return the native edges of FRAME. The native +edges exclude the decorations of the window manager and any external +menu or tool bar of FRAME. If TYPE is the symbol `inner-edges', return +the inner edges of FRAME. These edges exclude title bar, any borders, +menu bar or tool bar of FRAME. */) + (Lisp_Object frame, Lisp_Object type) +{ + struct frame *f = decode_live_frame (frame); + + if (FRAME_INITIAL_P (f) || !FRAME_W32_P (f)) + return Qnil; + + if (EQ (type, Qouter_edges)) + { + RECT rectangle; + + block_input (); + /* Outer frame rectangle, including outer borders and title bar. */ + GetWindowRect (FRAME_W32_WINDOW (f), &rectangle); + unblock_input (); + + return list4 (make_number (rectangle.left), + make_number (rectangle.top), + make_number (rectangle.right), + make_number (rectangle.bottom)); + } + else + { + RECT rectangle; + POINT pt; + int left, top, right, bottom; + + block_input (); + /* Inner frame rectangle, excluding borders and title bar. */ + GetClientRect (FRAME_W32_WINDOW (f), &rectangle); + /* Get top-left corner of native rectangle in screen + coordinates. */ + pt.x = 0; + pt.y = 0; + ClientToScreen (FRAME_W32_WINDOW (f), &pt); + unblock_input (); + + left = pt.x; + top = pt.y; + right = left + rectangle.right; + bottom = top + rectangle.bottom; + + if (EQ (type, Qinner_edges)) + { + int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f); + + return list4 (make_number (left + internal_border_width), + make_number (top + + FRAME_TOOL_BAR_HEIGHT (f) + + internal_border_width), + make_number (right - internal_border_width), + make_number (bottom - internal_border_width)); + } + else + return list4 (make_number (left), make_number (top), + make_number (right), make_number (bottom)); + } +} + +DEFUN ("x-mouse-absolute-pixel-position", Fx_mouse_absolute_pixel_position, + Sx_mouse_absolute_pixel_position, 0, 0, 0, + doc: /* Return absolute position of mouse cursor in pixels. +The position is returned as a cons cell (X . Y) of the coordinates of +the mouse cursor position in pixels relative to a position (0, 0) of the +selected frame's display. */) + (void) +{ + POINT pt; + + block_input (); + GetCursorPos (&pt); + unblock_input (); + + return Fcons (make_number (pt.x), make_number (pt.y)); +} + +DEFUN ("x-set-mouse-absolute-pixel-position", Fx_set_mouse_absolute_pixel_position, + Sx_set_mouse_absolute_pixel_position, 2, 2, 0, + doc: /* Move mouse pointer to absolute pixel position (X, Y). +The coordinates X and Y are interpreted in pixels relative to a position +(0, 0) of the selected frame's display. */) + (Lisp_Object x, Lisp_Object y) +{ + CHECK_TYPE_RANGED_INTEGER (int, x); + CHECK_TYPE_RANGED_INTEGER (int, y); + + block_input (); + SetCursorPos (XINT (x), XINT (y)); + unblock_input (); + + return Qnil; } DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0, @@ -9189,6 +9264,9 @@ This variable has effect only on NT family of systems, not on Windows 9X. */); defsubr (&Sx_close_connection); defsubr (&Sx_display_list); defsubr (&Sx_frame_geometry); + defsubr (&Sx_frame_edges); + defsubr (&Sx_mouse_absolute_pixel_position); + defsubr (&Sx_set_mouse_absolute_pixel_position); defsubr (&Sx_synchronize); /* W32 specific functions */ @@ -9204,8 +9282,6 @@ This variable has effect only on NT family of systems, not on Windows 9X. */); defsubr (&Sw32_reconstruct_hot_key); defsubr (&Sw32_toggle_lock_key); defsubr (&Sw32_window_exists_p); - defsubr (&Sw32_frame_rect); - defsubr (&Sw32_frame_menu_bar_size); defsubr (&Sw32_battery_status); defsubr (&Sw32__menu_bar_in_use); @@ -9470,6 +9546,8 @@ globals_of_w32fns (void) GetProcAddress (user32_lib, "MonitorFromWindow"); enum_display_monitors_fn = (EnumDisplayMonitors_Proc) GetProcAddress (user32_lib, "EnumDisplayMonitors"); + get_title_bar_info_fn = (GetTitleBarInfo_Proc) + GetProcAddress (user32_lib, "GetTitleBarInfo"); { HMODULE imm32_lib = GetModuleHandle ("imm32.dll"); diff --git a/src/xfns.c b/src/xfns.c index 8137cea..18fb343 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4312,130 +4312,262 @@ Internal use only, use `display-monitor-attributes-list' instead. */) return attributes_list; } -DEFUN ("x-frame-geometry", Fx_frame_geometry, Sx_frame_geometry, 0, 1, 0, - doc: /* Return geometric attributes of frame FRAME. +/* Return geometric attributes of FRAME. According to the value of + ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the native + edges of FRAME (Qnative_edges), or the inner edges of frame + (Qinner_edges). Any other value means to return the geometry as + returned by Fx_frame_geometry. */ +static Lisp_Object +frame_geometry (Lisp_Object frame, Lisp_Object attribute) +{ + struct frame *f = decode_live_frame (frame); + /** XWindowAttributes atts; **/ + Window rootw; + unsigned int ign, native_width, native_height; + int xy_ign, xptr, yptr; + int left_off, right_off, top_off, bottom_off; + int outer_left, outer_top, outer_right, outer_bottom; + int native_left, native_top, native_right, native_bottom; + int inner_left, inner_top, inner_right, inner_bottom; + int internal_border_width; + bool menu_bar_external = false, tool_bar_external = false; + int menu_bar_height = 0, menu_bar_width = 0; + int tool_bar_height = 0, tool_bar_width = 0; + + if (FRAME_INITIAL_P (f) || !FRAME_X_P (f)) + return Qnil; + + block_input (); + XGetGeometry (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), + &rootw, &xy_ign, &xy_ign, &native_width, &native_height, + &ign, &ign); + /** XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &atts); **/ + x_real_pos_and_offsets (f, &left_off, &right_off, &top_off, &bottom_off, + NULL, NULL, &xptr, &yptr, NULL); + unblock_input (); + + /** native_width = atts.width; **/ + /** native_height = atts.height; **/ + + outer_left = xptr; + outer_top = yptr; + outer_right = outer_left + left_off + native_width + right_off; + outer_bottom = outer_top + top_off + native_height + bottom_off; + + native_left = outer_left + left_off; + native_top = outer_top + top_off; + native_right = native_left + native_width; + native_bottom = native_top + native_height; + + internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f); + inner_left = native_left + internal_border_width; + inner_top = native_top + internal_border_width; + inner_right = native_right - internal_border_width; + inner_bottom = native_bottom - internal_border_width; + +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) + menu_bar_external = true; + menu_bar_height = FRAME_MENUBAR_HEIGHT (f); + native_top += menu_bar_height; + inner_top += menu_bar_height; +#else + menu_bar_height = FRAME_MENU_BAR_HEIGHT (f); + inner_top += menu_bar_height; +#endif + menu_bar_width = menu_bar_height ? native_width : 0; + +#if defined (USE_GTK) + tool_bar_external = true; + if (EQ (FRAME_TOOL_BAR_POSITION (f), Qleft)) + { + tool_bar_width = FRAME_TOOLBAR_WIDTH (f); + native_left += tool_bar_width; + inner_left += tool_bar_width; + tool_bar_height + = tool_bar_width ? native_height - menu_bar_height : 0; + } + else if (EQ (FRAME_TOOL_BAR_POSITION (f), Qtop)) + { + tool_bar_height = FRAME_TOOLBAR_HEIGHT (f); + native_top += tool_bar_height; + inner_top += tool_bar_height; + tool_bar_width = tool_bar_height ? native_width : 0; + } + else if (EQ (FRAME_TOOL_BAR_POSITION (f), Qright)) + { + tool_bar_width = FRAME_TOOLBAR_WIDTH (f); + native_right -= tool_bar_width; + inner_right -= tool_bar_width; + tool_bar_height + = tool_bar_width ? native_height - menu_bar_height : 0; + } + else + { + tool_bar_height = FRAME_TOOLBAR_HEIGHT (f); + native_bottom -= tool_bar_height; + inner_bottom -= tool_bar_height; + tool_bar_width = tool_bar_height ? native_width : 0; + } +#else + tool_bar_height = FRAME_TOOL_BAR_HEIGHT (f); + tool_bar_width = tool_bar_height ? native_width : 0; + inner_top += tool_bar_height; +#endif + + /* Construct list. */ + if (EQ (attribute, Qouter_edges)) + return list4 (make_number (outer_left), make_number (outer_top), + make_number (outer_right), make_number (outer_bottom)); + else if (EQ (attribute, Qnative_edges)) + return list4 (make_number (native_left), make_number (native_top), + make_number (native_right), make_number (native_bottom)); + else if (EQ (attribute, Qinner_edges)) + return list4 (make_number (inner_left), make_number (inner_top), + make_number (inner_right), make_number (inner_bottom)); + else + return + listn (CONSTYPE_HEAP, 10, + Fcons (Qouter_position, + Fcons (make_number (outer_left), + make_number (outer_top))), + Fcons (Qouter_size, + Fcons (make_number (outer_right - outer_left), + make_number (outer_bottom - outer_top))), + /* Approximate. */ + Fcons (Qexternal_border_size, + Fcons (make_number (right_off), + make_number (bottom_off))), + /* Approximate. */ + Fcons (Qtitle_bar_size, + Fcons (make_number (0), + make_number (top_off - bottom_off))), + Fcons (Qmenu_bar_external, menu_bar_external ? Qt : Qnil), + Fcons (Qmenu_bar_size, + Fcons (make_number (menu_bar_width), + make_number (menu_bar_height))), + Fcons (Qtool_bar_external, tool_bar_external ? Qt : Qnil), + Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)), + Fcons (Qtool_bar_size, + Fcons (make_number (tool_bar_width), + make_number (tool_bar_height))), + Fcons (Qinternal_border_width, + make_number (internal_border_width))); +} -FRAME must be a live frame and defaults to the selected one. +DEFUN ("x-frame-geometry", Fx_frame_geometry, Sx_frame_geometry, 0, 1, 0, + doc: /* Return geometric attributes of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is an association list of the attributes listed below. All height +and width values are in pixels. -The return value is an association list containing the following -elements (all size values are in pixels). +`outer-position' is a cons of the outer left and top edges of FRAME + relative to the origin - the position (0, 0) - of FRAME's display. -- `frame-outer-size' is a cons of the outer width and height of FRAME. - The outer size include the title bar and the external borders as well - as any menu and/or tool bar of frame. +`outer-size' is a cons of the outer width and height of FRAME. The + outer size includes the title bar and the external borders as well as + any menu and/or tool bar of frame. -- `border' is a cons of the horizontal and vertical width of FRAME's - external borders. +`external-border-size' is a cons of the horizontal and vertical width of + FRAME's external borders as supplied by the window manager. -- `title-bar-height' is the height of the title bar of FRAME. +`title-bar-size' is a cons of the width and height of the title bar of + FRAME as supplied by the window manager. If both of them are zero, + FRAME has no title bar. If only the width is zero, Emacs was not + able to retrieve the width information. -- `menu-bar-external' if t means the menu bar is external (not +`menu-bar-external', if non-nil, means the menu bar is external (never included in the inner edges of FRAME). -- `menu-bar-size' is a cons of the width and height of the menu bar of +`menu-bar-size' is a cons of the width and height of the menu bar of FRAME. -- `tool-bar-external' if t means the tool bar is external (not +`tool-bar-external', if non-nil, means the tool bar is external (never included in the inner edges of FRAME). -- `tool-bar-side' tells tells on which side the tool bar on FRAME is and - can be one of `left', `top', `right' or `bottom'. +`tool-bar-position' tells on which side the tool bar on FRAME is and can + be one of `left', `top', `right' or `bottom'. If this is nil, FRAME + has no tool bar. -- `tool-bar-size' is a cons of the width and height of the tool bar of +`tool-bar-size' is a cons of the width and height of the tool bar of FRAME. -- `frame-inner-size' is a cons of the inner width and height of FRAME. - This excludes FRAME's title bar and external border as well as any - external menu and/or tool bar. */) +`internal-border-width' is the width of the internal border of + FRAME. */) (Lisp_Object frame) { - struct frame *f = decode_live_frame (frame); - int inner_width = FRAME_PIXEL_WIDTH (f); - int inner_height = FRAME_PIXEL_HEIGHT (f); - int outer_width, outer_height, border, title; - Lisp_Object fullscreen = Fframe_parameter (frame, Qfullscreen); - int menu_bar_height, menu_bar_width, tool_bar_height, tool_bar_width; + return frame_geometry (frame, Qnil); +} + +DEFUN ("x-frame-edges", Fx_frame_edges, Sx_frame_edges, 0, 2, 0, + doc: /* Return edge coordinates of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are +in pixels relative to the origin - the position (0, 0) - of FRAME's +display. + +If optional argument TYPE is the symbol `outer-edges', return the outer +edges of FRAME. The outer edges comprise the decorations of the window +manager (like the title bar or external borders) as well as any external +menu or tool bar of FRAME. If optional argument TYPE is the symbol +`native-edges' or nil, return the native edges of FRAME. The native +edges exclude the decorations of the window manager and any external +menu or tool bar of FRAME. If TYPE is the symbol `inner-edges', return +the inner edges of FRAME. These edges exclude title bar, any borders, +menu bar or tool bar of FRAME. */) + (Lisp_Object frame, Lisp_Object type) +{ + return frame_geometry (frame, ((EQ (type, Qouter_edges) + || EQ (type, Qinner_edges)) + ? type + : Qnative_edges)); +} - int left_off, right_off, top_off, bottom_off, outer_border; - XWindowAttributes atts; +DEFUN ("x-mouse-absolute-pixel-position", Fx_mouse_absolute_pixel_position, + Sx_mouse_absolute_pixel_position, 0, 0, 0, + doc: /* Return absolute position of mouse cursor in pixels. +The position is returned as a cons cell (X . Y) of the coordinates of +the mouse cursor position in pixels relative to a position (0, 0) of the +selected frame's display. */) + (void) +{ + struct frame *f = SELECTED_FRAME (); + Window root, dummy_window; + int x, y, dummy; if (FRAME_INITIAL_P (f) || !FRAME_X_P (f)) return Qnil; block_input (); - - XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), &atts); - - x_real_pos_and_offsets (f, &left_off, &right_off, &top_off, &bottom_off, - NULL, NULL, NULL, NULL, &outer_border); - - + XQueryPointer (FRAME_X_DISPLAY (f), + DefaultRootWindow (FRAME_X_DISPLAY (f)), + &root, &dummy_window, &x, &y, &dummy, &dummy, + (unsigned int *) &dummy); unblock_input (); - border = atts.border_width; - title = top_off; - - outer_width = atts.width + 2 * border + right_off + left_off - + 2 * outer_border; - outer_height = atts.height + 2 * border + top_off + bottom_off - + 2 * outer_border; + return Fcons (make_number (x), make_number (y)); +} -#if defined (USE_GTK) +DEFUN ("x-set-mouse-absolute-pixel-position", Fx_set_mouse_absolute_pixel_position, + Sx_set_mouse_absolute_pixel_position, 2, 2, 0, + doc: /* Move mouse pointer to absolute pixel position (X, Y). +The coordinates X and Y are interpreted in pixels relative to a position +(0, 0) of the selected frame's display. */) + (Lisp_Object x, Lisp_Object y) { - bool tool_bar_left_right = (EQ (FRAME_TOOL_BAR_POSITION (f), Qleft) - || EQ (FRAME_TOOL_BAR_POSITION (f), Qright)); - - tool_bar_width = (tool_bar_left_right - ? FRAME_TOOLBAR_WIDTH (f) - : FRAME_PIXEL_WIDTH (f)); - tool_bar_height = (tool_bar_left_right - ? FRAME_PIXEL_HEIGHT (f) - : FRAME_TOOLBAR_HEIGHT (f)); - } -#else - tool_bar_height = FRAME_TOOL_BAR_HEIGHT (f); - tool_bar_width = tool_bar_height > 0 ? FRAME_PIXEL_WIDTH (f) : 0; -#endif + struct frame *f = SELECTED_FRAME (); -#if defined (USE_X_TOOLKIT) || defined (USE_GTK) - menu_bar_height = FRAME_MENUBAR_HEIGHT (f); -#else - menu_bar_height = FRAME_MENU_BAR_HEIGHT (f); -#endif + if (FRAME_INITIAL_P (f) || !FRAME_X_P (f)) + return Qnil; + + CHECK_TYPE_RANGED_INTEGER (int, x); + CHECK_TYPE_RANGED_INTEGER (int, y); - menu_bar_width = menu_bar_height > 0 ? FRAME_PIXEL_WIDTH (f) : 0; - - if (!FRAME_EXTERNAL_MENU_BAR (f)) - inner_height -= menu_bar_height; - if (!FRAME_EXTERNAL_TOOL_BAR (f)) - inner_height -= tool_bar_height; - - return - listn (CONSTYPE_HEAP, 10, - Fcons (Qframe_position, - Fcons (make_number (f->left_pos), make_number (f->top_pos))), - Fcons (Qframe_outer_size, - Fcons (make_number (outer_width), make_number (outer_height))), - Fcons (Qexternal_border_size, - ((EQ (fullscreen, Qfullboth) || EQ (fullscreen, Qfullscreen)) - ? Fcons (make_number (0), make_number (0)) - : Fcons (make_number (border), make_number (border)))), - Fcons (Qtitle_height, - ((EQ (fullscreen, Qfullboth) || EQ (fullscreen, Qfullscreen)) - ? make_number (0) - : make_number (title))), - Fcons (Qmenu_bar_external, FRAME_EXTERNAL_MENU_BAR (f) ? Qt : Qnil), - Fcons (Qmenu_bar_size, - Fcons (make_number (menu_bar_width), - make_number (menu_bar_height))), - Fcons (Qtool_bar_external, FRAME_EXTERNAL_TOOL_BAR (f) ? Qt : Qnil), - Fcons (Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f)), - Fcons (Qtool_bar_size, - Fcons (make_number (tool_bar_width), - make_number (tool_bar_height))), - Fcons (Qframe_inner_size, - Fcons (make_number (inner_width), - make_number (inner_height)))); + block_input (); + XWarpPointer (FRAME_X_DISPLAY (f), None, DefaultRootWindow (FRAME_X_DISPLAY (f)), + 0, 0, 0, 0, XINT (x), XINT (y)); + unblock_input (); + + return Qnil; } /************************************************************************ @@ -6639,6 +6771,9 @@ When using Gtk+ tooltips, the tooltip face is not used. */); defsubr (&Sx_display_save_under); defsubr (&Sx_display_monitor_attributes_list); defsubr (&Sx_frame_geometry); + defsubr (&Sx_frame_edges); + defsubr (&Sx_mouse_absolute_pixel_position); + defsubr (&Sx_set_mouse_absolute_pixel_position); defsubr (&Sx_wm_set_size_hint); defsubr (&Sx_create_frame); defsubr (&Sx_open_connection); commit ab759c2241e759ba7783323bbfef137bc0a08634 Author: Michael Albinus Date: Tue Aug 18 14:25:45 2015 +0200 Improve Tramp's compatibility * lisp/net/tramp.el (tramp-get-method-parameter): * lisp/net/tramp-adb.el (tramp-adb-parse-device-names) (tramp-adb-get-device): * lisp/net/trampver.el (tramp-repository-get-version): Use `tramp-compat-replace-regexp-in-string'. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index a8f5294..746bd67 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -211,7 +211,7 @@ pass to the OPERATION." (lambda (elt) (setcar (cdr elt) - (replace-regexp-in-string + (tramp-compat-replace-regexp-in-string ":" tramp-prefix-port-format (car (cdr elt))))) result) result)))) @@ -1032,7 +1032,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" (host (tramp-file-name-host vec)) (port (tramp-file-name-port vec)) (devices (mapcar 'cadr (tramp-adb-parse-device-names nil)))) - (replace-regexp-in-string + (tramp-compat-replace-regexp-in-string tramp-prefix-port-format ":" (cond ((member host devices) host) ;; This is the case when the host is connected to the default port. @@ -1048,7 +1048,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" (not (zerop (length host))) (not (tramp-adb-execute-adb-command vec "connect" - (replace-regexp-in-string + (tramp-compat-replace-regexp-in-string tramp-prefix-port-format ":" host)))) ;; When new device connected, running other adb command (e.g. ;; adb shell) immediately will fail. To get around this diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e157321..e534b58 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1111,7 +1111,8 @@ If VEC is a vector, check first in connection properties. Afterwards, check in `tramp-methods'. If the `tramp-methods' entry does not exist, return nil." (let ((hash-entry - (replace-regexp-in-string "^tramp-" "" (symbol-name param)))) + (tramp-compat-replace-regexp-in-string + "^tramp-" "" (symbol-name param)))) (if (tramp-connection-property-p vec hash-entry) ;; We use the cached property. (tramp-get-connection-property vec hash-entry nil) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 2f575f9..ab67120 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -50,7 +50,8 @@ (ignore-errors (call-process "git" nil '(t nil) nil "rev-parse" "HEAD"))) (not (zerop (buffer-size))) - (replace-regexp-in-string "\n" "" (buffer-string))))))))) + (tramp-compat-replace-regexp-in-string + "\n" "" (buffer-string))))))))) ;; Check for (X)Emacs version. (let ((x (if (or (>= emacs-major-version 22) commit 0e1711a0e29428173a743d38bfaba82fd56d77be Author: Pierre Téchoueyres Date: Tue Aug 18 14:24:16 2015 +0200 * lisp/net/tramp-cmds.el (tramp-reporter-dump-variable): Encode/decode string. Copyright-paperwork-exempt: yes diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index fee74ee..22c1398 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -236,8 +236,11 @@ buffer in your bug report. (string-match (concat "[^" (symbol-value 'mm-7bit-chars) "]") val)) (with-current-buffer reporter-eval-buffer - (set varsym (format "(base64-decode-string \"%s\")" - (base64-encode-string val)))))) + (set + varsym + (format + "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)" + (base64-encode-string (encode-coding-string val 'raw-text))))))) ;; Dump variable. (tramp-compat-funcall 'reporter-dump-variable varsym mailbuf) commit 07ebe42546abbc9823c9ce3c7b2e397b551838a1 Author: Phillip Lord Date: Tue Aug 18 10:11:38 2015 +0100 ; Remove Entry from ChangeLog.2 This entry was about a formatting change to another ChangeLog entry and so shouldn't have been in the ChangeLog in the first place. diff --git a/ChangeLog.2 b/ChangeLog.2 index d4b7fd1..4803ff9 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -432,12 +432,6 @@ * test/automated/elisp-mode-tests.el: Add more tests of elisp--xref-find-definitions, improve current tests. -2015-08-10 Phillip Lord - - * ChangeLog.2: Formatting update. - Formatting for one change entry did not follow standard ChangeLog - conventions and has now been updated. - 2015-08-10 Eli Zaretskii Fix recording of events pushed onto unread-command-events