commit 10c0e1ca40237224aa229c538fe49983ec905748 (HEAD, refs/remotes/origin/master) Author: Alan Mackenzie Date: Fri Feb 19 17:10:57 2016 +0000 Await the final mouse event in C-h c and C-h k. * lisp/help.el (describe-key-briefly, describe-key): On receiving a mouse event, keep reading further events until a timeout occurs, to ensure we have the complete mouse event from the user. diff --git a/lisp/help.el b/lisp/help.el index 061daac..ce68cea 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -613,7 +613,15 @@ temporarily enables it to allow getting help on disabled items and buttons." (when (null (cdr yank-menu)) (setq saved-yank-menu (copy-sequence yank-menu)) (menu-bar-update-yank-menu "(any string)" nil)) - (setq key (read-key-sequence "Describe key (or click or menu item): ")) + (while + (progn + (setq key (read-key-sequence "Describe key (or click or menu item): ")) + (and (vectorp key) + (consp (aref key 0)) + (symbolp (car (aref key 0))) + (string-match "\\(mouse\\|down\\|click\\|drag\\)" + (symbol-name (car (aref key 0)))) + (not (sit-for (/ double-click-time 1000.0) t))))) ;; Clear the echo area message (Bug#7014). (message nil) ;; If KEY is a down-event, read and discard the @@ -750,7 +758,15 @@ temporarily enables it to allow getting help on disabled items and buttons." (when (null (cdr yank-menu)) (setq saved-yank-menu (copy-sequence yank-menu)) (menu-bar-update-yank-menu "(any string)" nil)) - (setq key (read-key-sequence "Describe key (or click or menu item): ")) + (while + (progn + (setq key (read-key-sequence "Describe key (or click or menu item): ")) + (and (vectorp key) + (consp (aref key 0)) + (symbolp (car (aref key 0))) + (string-match "\\(mouse\\|down\\|click\\|drag\\)" + (symbol-name (car (aref key 0)))) + (not (sit-for (/ double-click-time 1000.0) t))))) (list key (prefix-numeric-value current-prefix-arg) commit 5e8a62917ade3751a328aa90830b51bbed90e15d Author: Lars Ingebrigtsen Date: Fri Feb 19 16:04:11 2016 +1100 Add a library for creating and manipulating SVG images * doc/lispref/display.texi (SVG Images): New section. * lisp/svg.el: New file. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 26f3de4..17025cd 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4761,6 +4761,7 @@ displayed (@pxref{Display Feature Testing}). * XPM Images:: Special features for XPM format. * PostScript Images:: Special features for PostScript format. * ImageMagick Images:: Special features available through ImageMagick. +* SVG Images:: Creating and manipulating SVG images. * Other Image Types:: Various other formats are supported. * Defining Images:: Convenient ways to define an image for later use. * Showing Images:: Convenient ways to display an image once it is defined. @@ -5220,6 +5221,128 @@ Specifies a rotation angle in degrees. @xref{Multi-Frame Images}. @end table +@node SVG Images +@subsection SVG Images +@cindex SVG images + +SVG (Scalable Vector Graphics) is an XML format for specifying images. +If you build Emacs with SVG support, you can create and manipulate +these images with the following commands. + +@defun svg-create width height &rest args +Create a new, empty SVG image with the specified dimensions. +@var{args} is an argument plist with you can specify following: + +@table @code +@item :stroke-width +The default width (in pixels) of any lines created. + +@item :stroke +The default stroke color on any lines created. +@end table + +This function returns an SVG structure, and all the following commands +work on that structure. +@end defun + +@defun svg-gradient svg id type stops +Create a gradient in @var{svg} with identifier @var{id}. @var{type} +specifies the gradient type, and can be either @code{linear} or +@code{radial}. @var{stops} is a list of percentage/color pairs. + +The following will create a linear gradient that goes from red at the +start, to green 25% of the way, to blue at the end: + +@lisp +(svg-gradient svg "gradient1" 'linear + '((0 . "red") (25 . "green") (100 . "blue"))) +@end lisp + +The gradient created (and inserted into the SVG object) can later be +used by all functions that create shapes. +@end defun + +All the following functions take an optional list of keyword +parameters that alter the various attributes from their default +values. Valid attributes include: + +@table @code +@item :stroke-width +The width (in pixels) of lines drawn, and outlines around solid +shapes. + +@item :stroke-color +The color of lines drawn, and outlines around solid shapes. + +@item :fill-color +The color used for solid shapes. + +@item :id +The identified of the shape. + +@item :gradient +If given, this should be the identifier of a previously defined +gradient object. +@end table + +@defun svg-rectangle svg x y width height &rest args +Add a rectangle to @var{svg} where the upper left corner is at +position @var{x}/@var{y} and is of size @var{width}/@var{height}. + +@lisp +(svg-rectangle svg 100 100 500 500 :gradient "gradient1") +@end lisp +@end defun + +@defun svg-circle svg x y radius &rest args +Add a circle to @var{svg} where the center is at @var{x}/@var{y} +and the radius is @var{radius}. +@end defun + +@defun svg-ellipse svg x y x-radius y-radius &rest args +Add a circle to @var{svg} where the center is at @var{x}/@var{y} and +the horizontal radius is @var{x-radius} and the vertical radius is +@var{y-radius}. +@end defun + +@defun svg-line svg x1 y1 x2 y2 &rest args +Add a line to @var{svg} that starts at @var{x1}/@var{y1} and extends +to @var{x2}/@var{y2}. +@end defun + +@defun svg-polyline svg points &rest args +Add a multiple segment line to @var{svg} that goes through +@var{points}, which is a list of X/Y position pairs. + +@lisp +(svg-polyline svg '((200 . 100) (500 . 450) (80 . 100)) + :stroke-color "green") +@end lisp +@end defun + +@defun svg-polygon svg points &rest args +Add a polygon to @var{svg} where @var{points} is a list of X/Y pairs +that describe the outer circumference of the polygon. + +@lisp +(svg-polygon svg '((100 . 100) (200 . 150) (150 . 90)) + :stroke-color "blue" :fill-color "red"") +@end lisp +@end defun + +Finally, the @code{svg-image} takes an SVG object as its parameter and +returns an image object suitable for use in functions like +@code{insert-image}. Here's a complete example that creates and +inserts an image with a circle: + +@lisp +(let ((svg (svg-create 400 400 :stroke-width 10))) + (svg-gradient svg "gradient1" 'linear '((0 . "red") (100 . "blue"))) + (svg-circle svg 200 200 100 :gradient "gradient1" :stroke-color "green") + (insert-image (svg-image svg))) +@end lisp + + @node Other Image Types @subsection Other Image Types @cindex PBM @@ -5256,9 +5379,6 @@ Image type @code{jpeg}. @item PNG Image type @code{png}. -@item SVG -Image type @code{svg}. - @item TIFF Image type @code{tiff}. Supports the @code{:index} property. @xref{Multi-Frame Images}. diff --git a/etc/NEWS b/etc/NEWS index cc99dbd..c3c3eba 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -851,6 +851,10 @@ keymap put into the text properties (or overlays) that span the image. This keymap binds keystrokes for manipulating size and rotation, as well as saving the image to a file. ++++ +*** A new library for creating and manipulating SVG images has been +added. See the "SVG Images" section in the lispref manual for details. + ** Lisp mode --- diff --git a/lisp/svg.el b/lisp/svg.el new file mode 100644 index 0000000..b6beaad --- /dev/null +++ b/lisp/svg.el @@ -0,0 +1,230 @@ +;;; svg.el --- SVG image creation functions -*- lexical-binding: t -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Keywords: image + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'cl-lib) +(require 'xml) +(require 'dom) + +(defun svg-create (width height &rest args) + "Create a new, empty SVG image with dimentions WIDTHxHEIGHT. +ARGS can be used to provide `stroke' and `stroke-width' parameters to +any further elements added." + (dom-node 'svg + `((width . ,width) + (height . ,height) + (version . "1.1") + (xmlsn . "http://www.w3.org/2000/svg") + ,@(svg--arguments nil args)))) + +(defun svg-gradient (svg id type stops) + "Add a gradient with ID to SVG. +TYPE is `linear' or `radial'. STOPS is a list of percentage/color +pairs." + (svg--def + svg + (apply + 'dom-node + (if (eq type 'linear) + 'linearGradient + 'radialGradient) + `((id . ,id) + (x1 . 0) + (x2 . 0) + (y1 . 0) + (y2 . 1)) + (mapcar + (lambda (stop) + (dom-node 'stop `((offset . ,(format "%s%%" (car stop))) + (stop-color . ,(cdr stop))))) + stops)))) + +(defun svg-rectangle (svg x y width height &rest args) + "Create a rectangle on SVG, starting at position X/Y, of WIDTH/HEIGHT. +ARGS is a plist of modifiers. Possible values are + +:stroke-width PIXELS. The line width. +:stroke-color COLOR. The line color. +:gradient ID. The gradient ID to use." + (svg--append + svg + (dom-node 'rect + `((width . ,width) + (height . ,height) + (x . ,x) + (y . ,y) + ,@(svg--arguments svg args))))) + +(defun svg-circle (svg x y radius &rest args) + "Create a circle of RADIUS on SVG. +X/Y denote the center of the circle." + (svg--append + svg + (dom-node 'circle + `((cx . ,x) + (cy . ,y) + (r . ,radius) + ,@(svg--arguments svg args))))) + +(defun svg-ellipse (svg x y x-radius y-radius &rest args) + "Create an ellipse of X-RADIUS/Y-RADIUS on SVG. +X/Y denote the center of the ellipse." + (svg--append + svg + (dom-node 'ellipse + `((cx . ,x) + (cy . ,y) + (rx . ,x-radius) + (ry . ,y-radius) + ,@(svg--arguments svg args))))) + +(defun svg-line (svg x1 y1 x2 y2 &rest args) + "Create a line of starting in X1/Y1, ending at X2/Y2 in SVG." + (svg--append + svg + (dom-node 'line + `((x1 . ,x1) + (x2 . ,y1) + (y1 . ,x2) + (y2 . ,y2) + ,@(svg--arguments svg args))))) + +(defun svg-polyline (svg points &rest args) + "Create a polyline going through POINTS on SVG. +POINTS is a list of x/y pairs." + (svg--append + svg + (dom-node + 'polyline + `((points . ,(mapconcat (lambda (pair) + (format "%s %s" (car pair) (cdr pair))) + points + ", ")) + ,@(svg--arguments svg args))))) + +(defun svg-polygon (svg points &rest args) + "Create a polygon going through POINTS on SVG. +POINTS is a list of x/y pairs." + (svg--append + svg + (dom-node + 'polygon + `((points . ,(mapconcat (lambda (pair) + (format "%s %s" (car pair) (cdr pair))) + points + ", ")) + ,@(svg--arguments svg args))))) + +(defun svg--append (svg node) + (let ((old (and (dom-attr node 'id) + (dom-by-id svg + (concat "\\`" (regexp-quote (dom-attr node 'id)) + "\\'"))))) + (if old + (dom-set-attributes old (dom-attributes node)) + (dom-append-child svg node))) + (svg-possibly-update-image svg)) + +(defun svg--arguments (svg args) + (let ((stroke-width (or (plist-get args :stroke-width) + (dom-attr svg 'stroke-width))) + (stroke-color (or (plist-get args :stroke-color) + (dom-attr svg 'stroke-color))) + (fill-color (plist-get args :fill-color)) + attr) + (when stroke-width + (push (cons 'stroke-width stroke-width) attr)) + (when stroke-color + (push (cons 'stroke stroke-color) attr)) + (when fill-color + (push (cons 'fill fill-color) attr)) + (when (plist-get args :gradient) + (setq attr + (append + ;; We need a way to specify the gradient direction here... + `((x1 . 0) + (x2 . 0) + (y1 . 0) + (y2 . 1) + (fill . ,(format "url(#%s)" + (plist-get args :gradient)))) + attr))) + (cl-loop for (key value) on args by #'cddr + unless (memq key '(:stroke-color :stroke-width :gradient + :fill-color)) + ;; Drop the leading colon. + do (push (cons (intern (substring (symbol-name key) 1) obarray) + value) + attr)) + attr)) + +(defun svg--def (svg def) + (dom-append-child + (or (dom-by-tag svg 'defs) + (let ((node (dom-node 'defs))) + (dom-add-child-before svg node) + node)) + def) + svg) + +(defun svg-image (svg) + "Return an image object from SVG." + (create-image + (with-temp-buffer + (svg-print svg) + (buffer-string)) + 'svg t)) + +(defun svg-insert-image (svg) + "Insert SVG as an image at point. +If the SVG is later changed, the image will also be updated." + (let ((image (svg-image svg)) + (marker (point-marker))) + (insert-image image) + (dom-set-attribute svg :image marker))) + +(defun svg-possibly-update-image (svg) + (let ((marker (dom-attr svg :image))) + (when (and marker + (buffer-live-p (marker-buffer marker))) + (with-current-buffer (marker-buffer marker) + (put-text-property marker (1+ marker) 'display (svg-image svg)))))) + +(defun svg-print (dom) + "Convert DOM into a string containing the xml representation." + (insert (format "<%s" (car dom))) + (dolist (attr (nth 1 dom)) + ;; Ignore attributes that start with a colon. + (unless (= (aref (format "%s" (car attr)) 0) ?:) + (insert (format " %s=\"%s\"" (car attr) (cdr attr))))) + (insert ">") + (dolist (elem (nthcdr 2 dom)) + (insert " ") + (svg-print elem)) + (insert (format "" (car dom)))) + +(provide 'svg) + +;;; svg.el ends here commit 466fc43182d1677c107856d4752ef4b6812baefe Author: Michael Albinus Date: Thu Feb 18 13:58:12 2016 +0100 Reference `tramp-theme' in GNU ELPA. * doc/misc/tramp.texi (Frequently Asked Questions): Reference `tramp-theme' in GNU ELPA. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 294a3a9..0eb7334 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2913,70 +2913,13 @@ the following code in @file{~/.emacs} file. @item -How to get a Visual Warning when working with @samp{root} privileges +How to get a Visual Warning when working with @samp{root} privileges? +Host indication in the mode line? -Get a modeline indication when working with @samp{root} privileges -with the following code (tested with Emacs 22.1) in @file{~/.emacs} -file: - -@lisp -(defun my-mode-line-function () - (when (string-match "^/su\\(do\\)?:" default-directory) - (setq mode-line-format - (format-mode-line mode-line-format 'font-lock-warning-face)))) - -(add-hook 'find-file-hook 'my-mode-line-function) -(add-hook 'dired-mode-hook 'my-mode-line-function) -@end lisp - - -@item -How to get host indication in the mode line? - -The following code (tested with Emacs 22.1) in @file{~/.emacs} file -shows it: - -@lisp -(defconst my-mode-line-buffer-identification - (list - '(:eval - (let ((host-name - (if (file-remote-p default-directory) - (tramp-file-name-host - (tramp-dissect-file-name default-directory)) - (system-name)))) - (if (string-match "^[^0-9][^.]*\\(\\..*\\)" host-name) - (substring host-name 0 (match-beginning 1)) - host-name))) - ": %12b")) - -(setq-default - mode-line-buffer-identification - my-mode-line-buffer-identification) - -(add-hook - 'dired-mode-hook - (lambda () - (setq - mode-line-buffer-identification - my-mode-line-buffer-identification))) -@end lisp - -The mode line in Emacs 23.1 and later versions now contains an -indication if @code{default-directory} for the current buffer is on a -remote host. Moreover, the corresponding tool-tip shows the remote -host name. The above @code{:eval} clause can also be simplified to -show the host name in the mode line: - -@lisp - '(:eval - (let ((host-name - (or (file-remote-p default-directory 'host) - (system-name)))) - (if (string-match "^[^0-9][^.]*\\(\\..*\\)" host-name) - (substring host-name 0 (match-beginning 1)) - host-name))) -@end lisp +Install @file{tramp-theme} from GNU ELPA via Emacs' Package Manager. +Enable it via @kbd{M-x load-theme @key{RET} tramp}. Further +customization is explained in variable +@code{tramp-theme-face-remapping-alist}. @item