commit db43613307bb05d0f43d2d5649b5bb2f29876cee (HEAD, refs/remotes/origin/master) Author: Tino Calancha Date: Mon Nov 14 17:31:44 2016 +0900 tabulated-list: extend truncation into next align-right column See discussion on: https://lists.gnu.org/archive/html/emacs-devel/2016-10/msg01101.html * lisp/emacs-lisp/tabulated-list.el (tabulated-list--near-rows): New variable. (tabulated-list-print, tabulated-list-set-col): Use it. (tabulated-list--col-local-max-widths): New defsubst. (tabulated-list-print-col): Use it. If the next column is align-right, and has some space left then don't truncate to width, use some of the available space from the next column. diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 00b029d..cf297f1 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -102,6 +102,8 @@ It is called with two arguments, ID and COLS. ID is a Lisp object identifying the entry, and COLS is a vector of column descriptors, as documented in `tabulated-list-entries'.") +(defvar tabulated-list--near-rows) + (defvar-local tabulated-list-sort-key nil "Sort key for the current Tabulated List mode buffer. If nil, no additional sorting is performed. @@ -298,6 +300,14 @@ column. Negate the predicate that would be returned if (lambda (a b) (not (funcall sorter a b))) sorter)))) +(defsubst tabulated-list--col-local-max-widths (col) + "Return maximum entry widths at column COL around current row. +Check the current row, the previous one and the next row." + (apply #'max (mapcar (lambda (x) + (let ((nt (elt x col))) + (string-width (if (stringp nt) nt (car nt))))) + tabulated-list--near-rows))) + (defun tabulated-list-print (&optional remember-pos update) "Populate the current Tabulated List mode buffer. This sorts the `tabulated-list-entries' list if sorting is @@ -340,8 +350,14 @@ changing `tabulated-list-sort-key'." (unless tabulated-list-use-header-line (tabulated-list-print-fake-header))) ;; Finally, print the resulting list. - (dolist (elt entries) - (let ((id (car elt))) + (while entries + (let* ((elt (car entries)) + (tabulated-list--near-rows + (list + (or (tabulated-list-get-entry (point-at-bol 0)) (cadr elt)) + (cadr elt) + (or (cadr (cadr entries)) (cadr elt)))) + (id (car elt))) (and entry-id (equal entry-id id) (setq entry-id nil @@ -368,7 +384,8 @@ changing `tabulated-list-sort-key'." (t t))) (let ((old (point))) (forward-line 1) - (delete-region old (point))))))) + (delete-region old (point)))))) + (setq entries (cdr entries))) (set-buffer-modified-p nil) ;; If REMEMBER-POS was specified, move to the "old" location. (if saved-pt @@ -402,8 +419,6 @@ of column descriptors." N is the column number, COL-DESC is a column descriptor (see `tabulated-list-entries'), and X is the column number at point. Return the column number after insertion." - ;; TODO: don't truncate to `width' if the next column is align-right - ;; and has some space left. (let* ((format (aref tabulated-list-format n)) (name (nth 0 format)) (width (nth 1 format)) @@ -414,12 +429,29 @@ Return the column number after insertion." (label-width (string-width label)) (help-echo (concat (car format) ": " label)) (opoint (point)) - (not-last-col (< (1+ n) (length tabulated-list-format)))) + (not-last-col (< (1+ n) (length tabulated-list-format))) + available-space) + (when not-last-col + (let* ((next-col-format (aref tabulated-list-format (1+ n))) + (next-col-right-align (plist-get (nthcdr 3 next-col-format) + :right-align)) + (next-col-width (nth 1 next-col-format))) + (setq available-space + (if (and (not right-align) + next-col-right-align) + (- + (+ width next-col-width) + (min next-col-width + (tabulated-list--col-local-max-widths (1+ n)))) + width)))) ;; Truncate labels if necessary (except last column). - (and not-last-col - (> label-width width) - (setq label (truncate-string-to-width label width nil nil t) - label-width width)) + ;; Don't truncate to `width' if the next column is align-right + ;; and has some space left, truncate to `available-space' instead. + (when (and not-last-col + (> label-width available-space) + (setq label (truncate-string-to-width + label available-space nil nil t) + label-width available-space))) (setq label (bidi-string-mark-left-to-right label)) (when (and right-align (> width label-width)) (let ((shift (- width label-width))) @@ -437,7 +469,7 @@ Return the column number after insertion." (when not-last-col (when (> pad-right 0) (insert (make-string pad-right ?\s))) (insert (propertize - (make-string (- next-x x label-width pad-right) ?\s) + (make-string (- width (min width label-width)) ?\s) 'display `(space :align-to ,next-x)))) (put-text-property opoint (point) 'tabulated-list-column-name name) next-x))) @@ -494,7 +526,12 @@ this is the vector stored within it." (when (< pos eol) (delete-region pos (next-single-property-change pos prop nil eol)) (goto-char pos) - (tabulated-list-print-col col desc (current-column)) + (let ((tabulated-list--near-rows + (list + (tabulated-list-get-entry (point-at-bol 0)) + entry + (or (tabulated-list-get-entry (point-at-bol 2)) entry)))) + (tabulated-list-print-col col desc (current-column))) (if change-entry-data (aset entry col desc)) (put-text-property pos (point) 'tabulated-list-id id) commit 0bf888422d52a46985f68f6f8fd53cf7f889ee60 Author: Katsumi Yamaoka Date: Mon Nov 14 06:56:01 2016 +0000 * lisp/net/shr.el (shr-collect-extra-strings-in-table): Fix indentation. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 9628ac2..5660355 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1948,8 +1948,8 @@ boolean flags that control whether to collect or render objects." do (setq recurse nil) (shr-tag-table child) end end end end end end end end end - when recurse - append (shr-collect-extra-strings-in-table child flags))) + when recurse + append (shr-collect-extra-strings-in-table child flags))) (defun shr-insert-table (table widths) (let* ((collapse (equal (cdr (assq 'border-collapse shr-stylesheet)) commit 99e7b99e43ade2b0b653547f901b0891884b92f6 Author: Katsumi Yamaoka Date: Mon Nov 14 06:48:06 2016 +0000 * lisp/net/shr.el (shr-tag-table): Avoid duplication of images. (shr-collect-extra-strings-in-table): Render images as well. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index afe1908..9628ac2 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1895,65 +1895,61 @@ The preference is a float determined from `shr-prefer-media-type'." bgcolor)) ;; Finally, insert all the images after the table. The Emacs buffer ;; model isn't strong enough to allow us to put the images actually - ;; into the tables. + ;; into the tables. It inserts also non-td/th objects. (when (zerop shr-table-depth) (save-excursion (shr-expand-alignments start (point))) - ;; Insert also non-td/th objects. (save-restriction (narrow-to-region (point) (point)) (insert (mapconcat #'identity (shr-collect-extra-strings-in-table dom) "\n")) - (shr-fill-lines (point-min) (point-max))) - (dolist (elem (dom-by-tag dom 'object)) - (shr-tag-object elem)) - (dolist (elem (dom-by-tag dom 'img)) - (shr-tag-img elem))))) + (shr-fill-lines (point-min) (point-max)))))) (defun shr-collect-extra-strings-in-table (dom &optional flags) "Return extra strings in DOM of which the root is a table clause. -Render extra child tables of which the parent is not td or th as well. -FLAGS is a cons of two boolean flags that control whether to collect -or render objects." - ;; Currently this function supports extra strings and s that - ;; are children of
or clauses, not
nor . - ;; It runs recursively and collects strings or renders s if - ;; the cdr of FLAGS is nil. FLAGS becomes (t . nil) if a - ;; clause is found in the children of DOM, and becomes (t . t) if - ;; a
or a clause is found and the car is t then. - ;; When a clause is found, FLAGS becomes nil if the cdr is t - ;; then. But if the cdr is nil then, render the
. - (cl-loop for child in (dom-children dom) with tag with recurse +Render s and s, and strings and child
s of which +the parent is not
or as well. FLAGS is a cons of two +boolean flags that control whether to collect or render objects." + ;; As for strings and child s, it runs recursively and + ;; collects or renders those objects if the cdr of FLAGS is nil. + ;; FLAGS becomes (t . nil) if a clause is found in the children + ;; of DOM, and becomes (t . t) if a
or a clause is found + ;; and the car is t then. When a clause is found, FLAGS + ;; becomes nil if the cdr is t then. But if the cdr is nil then, + ;; it renders the
. + (cl-loop for child in (dom-children dom) with recurse with tag + do (setq recurse nil) if (stringp child) unless (cdr flags) when (string-match "\\(?:[^\t\n\r ]+[\t\n\r ]+\\)*[^\t\n\r ]+" child) collect (match-string 0 child) end end - else - do (setq tag (dom-tag child) - recurse t) - and - if (eq tag 'tr) - do (setq flags '(t . nil)) - else if (memq tag '(td th)) - when (car flags) - do (setq flags '(t . t)) - end - else if (eq tag 'table) - if (cdr flags) - do (setq flags nil) + else if (consp child) + do (setq tag (dom-tag child)) and + unless (memq tag '(comment style)) + if (eq tag 'img) + do (shr-tag-img child) + else if (eq tag 'object) + do (shr-tag-object child) else - do (setq recurse nil) - (shr-tag-table child) - end - else - when (memq tag '(comment style)) - do (setq recurse nil) - end end end end and - when recurse - append (shr-collect-extra-strings-in-table child flags))) + do (setq recurse t) and + if (eq tag 'tr) + do (setq flags '(t . nil)) + else if (memq tag '(td th)) + when (car flags) + do (setq flags '(t . t)) + end + else if (eq tag 'table) + if (cdr flags) + do (setq flags nil) + else + do (setq recurse nil) + (shr-tag-table child) + end end end end end end end end end + when recurse + append (shr-collect-extra-strings-in-table child flags))) (defun shr-insert-table (table widths) (let* ((collapse (equal (cdr (assq 'border-collapse shr-stylesheet)) commit cbed42838e44e54460a27e643858d34b53f74c99 Author: Ken Brown Date: Sun Nov 13 22:00:24 2016 -0500 Use the new 'file-name-case-insensitive-p' function * lisp/international/mule.el (auto-coding-alist-lookup): * lisp/files.el (file-truename): (abbreviate-file-name, set-auto-mode, file-relative-name): * package.el (package-untar-buffer): Use 'file-name-case-insensitive-p' instead of 'system-type' to test case-insensitivity. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index f669c31..ef129e9 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -792,7 +792,7 @@ untar into a directory named DIR; otherwise, signal an error." (tar-mode) ;; Make sure everything extracts into DIR. (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) - (case-fold-search (memq system-type '(windows-nt ms-dos cygwin)))) + (case-fold-search (file-name-case-insensitive-p dir))) (dolist (tar-data tar-parse-info) (let ((name (expand-file-name (tar-header-name tar-data)))) (or (string-match regexp name) diff --git a/lisp/files.el b/lisp/files.el index 8277877..7cfb20d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1212,7 +1212,7 @@ containing it, until no links are left at any level. (setq dirfile (directory-file-name dir)) ;; If these are equal, we have the (or a) root directory. (or (string= dir dirfile) - (and (memq system-type '(windows-nt ms-dos cygwin nacl)) + (and (file-name-case-insensitive-p dir) (eq (compare-strings dir 0 nil dirfile 0 nil t) t)) ;; If this is the same dir we last got the truename for, ;; save time--don't recalculate. @@ -1793,10 +1793,7 @@ home directory is a root directory) and removes automounter prefixes (substring filename (1- (match-end 0)))))) (setq filename (substring filename (1- (match-end 0))))) ;; Avoid treating /home/foo as /home/Foo during `~' substitution. - ;; To fix this right, we need a `file-name-case-sensitive-p' - ;; function, but we don't have that yet, so just guess. - (let ((case-fold-search - (memq system-type '(ms-dos windows-nt darwin cygwin)))) + (let ((case-fold-search (file-name-case-insensitive-p filename))) ;; If any elt of directory-abbrev-alist matches this name, ;; abbreviate accordingly. (dolist (dir-abbrev directory-abbrev-alist) @@ -2898,7 +2895,9 @@ we don't actually set it to the same mode the buffer already has." (unless done (if buffer-file-name (let ((name buffer-file-name) - (remote-id (file-remote-p buffer-file-name))) + (remote-id (file-remote-p buffer-file-name)) + (case-insensitive-p (file-name-case-insensitive-p + buffer-file-name))) ;; Remove backup-suffixes from file name. (setq name (file-name-sans-versions name)) ;; Remove remote file name identification. @@ -2908,12 +2907,12 @@ we don't actually set it to the same mode the buffer already has." (while name ;; Find first matching alist entry. (setq mode - (if (memq system-type '(windows-nt cygwin)) - ;; System is case-insensitive. + (if case-insensitive-p + ;; Filesystem is case-insensitive. (let ((case-fold-search t)) (assoc-default name auto-mode-alist 'string-match)) - ;; System is case-sensitive. + ;; Filesystem is case-sensitive. (or ;; First match case-sensitively. (let ((case-fold-search nil)) @@ -4691,7 +4690,7 @@ on a DOS/Windows machine, it returns FILENAME in expanded form." (setq filename (expand-file-name filename)) (let ((fremote (file-remote-p filename)) (dremote (file-remote-p directory)) - (fold-case (or (memq system-type '(ms-dos cygwin windows-nt)) + (fold-case (or (file-name-case-insensitive-p filename) read-file-name-completion-ignore-case))) (if ;; Conditions for separate trees (or diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 21ab7e1..5bc0e9c 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -1864,7 +1864,7 @@ files.") (defun auto-coding-alist-lookup (filename) "Return the coding system specified by `auto-coding-alist' for FILENAME." (let ((alist auto-coding-alist) - (case-fold-search (memq system-type '(windows-nt ms-dos cygwin))) + (case-fold-search (file-name-case-insensitive-p filename)) coding-system) (while (and alist (not coding-system)) (if (string-match (car (car alist)) filename) commit 181bd848eb9662759f076b31a32f6588e9eb58b4 Author: Glenn Morris Date: Sun Nov 13 15:46:31 2016 -0800 Include a systemd user unit file. (Bug#16507) * etc/emacs.service: New file. * doc/emacs/misc.texi (Emacs Server): Mention systemcl --user. * Makefile.in (libdir): New, set by configure. (systemdunitdir): New variable. (install-etc, uninstall): Handle the emacs.service file. diff --git a/Makefile.in b/Makefile.in index 3c1f29b..1095837 100644 --- a/Makefile.in +++ b/Makefile.in @@ -153,6 +153,9 @@ sharedstatedir=@sharedstatedir@ # a subdirectory of this. libexecdir=@libexecdir@ +# Currently only used for the systemd service file. +libdir=@libdir@ + # Where to install Emacs's man pages. # Note they contain cross-references that expect them to be in section 1. mandir=@mandir@ @@ -196,6 +199,17 @@ desktopdir=$(datarootdir)/applications # Where the etc/emacs.appdata.xml file is to be installed. appdatadir=$(datarootdir)/appdata +# Where the etc/emacs.service file is to be installed. +# The system value (typically /usr/lib/systemd/user) can be +# obtained with: pkg-config --variable=systemduserunitdir systemd +# but that does not respect configure's prefix. +# It is not clear where we should install this file when +# prefix != /usr (or /usr/local?) (eg for non-root installs). +# Other options include ~/.config/systemd/user/, +# $XDG_RUNTIME_DIR/systemd/user/ +# It seems the user may end up having to make a manual link... +systemdunitdir=$(libdir)/systemd/user + # Where the etc/images/icons/hicolor directory is to be installed. icondir=$(datarootdir)/icons @@ -714,6 +728,18 @@ install-etc: ${srcdir}/etc/emacs.appdata.xml > $${tmp}; \ ${INSTALL_DATA} $${tmp} "$(DESTDIR)${appdatadir}/${EMACS_NAME}.appdata.xml"; \ rm -f $${tmp} + umask 022; $(MKDIR_P) "$(DESTDIR)$(systemdunitdir)" + tmp=etc/emacs.tmpservice; rm -f $${tmp}; \ + emacs_name=`echo emacs | sed '$(TRANSFORM)'`; \ + exe_name=$${emacs_name}${EXEEXT}; \ + client_name=`echo emacsclient | sed '$(TRANSFORM)'`${EXEEXT}; \ + sed -e '/^##/d' \ + -e "/^Documentation/ s/emacs(1)/$${emacs_name}(1)/" \ + -e "/^ExecStart/ s|emacs|$(DESTDIR)${bindir}/$${exe_name}|" \ + -e "/^ExecStop/ s|emacsclient|$(DESTDIR)${bindir}/$${client_name}|" \ + ${srcdir}/etc/emacs.service > $${tmp}; \ + $(INSTALL_DATA) $${tmp} "$(DESTDIR)$(systemdunitdir)/${EMACS_NAME}.service"; \ + rm -f $${tmp} thisdir=`/bin/pwd`; \ cd ${iconsrcdir} || exit 1; umask 022 ; \ for dir in */*/apps */*/mimetypes; do \ @@ -779,6 +805,7 @@ uninstall: uninstall-$(NTDIR) uninstall-doc fi) -rm -f "$(DESTDIR)${desktopdir}/${EMACS_NAME}.desktop" -rm -f "$(DESTDIR)${appdatadir}/${EMACS_NAME}.appdata.xml" + -rm -f "$(DESTDIR)$(systemdunitdir)/${EMACS_NAME}.service" for file in snake-scores tetris-scores; do \ file="$(DESTDIR)${gamedir}/$${file}"; \ [ -s "$${file}" ] || rm -f "$$file"; \ diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index f38a797..cb0a116 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1570,7 +1570,7 @@ process. You can solve this problem by setting up Emacs as an @dfn{edit server}, so that it ``listens'' for external edit requests and acts -accordingly. There are two ways to start an Emacs server: +accordingly. There are various ways to start an Emacs server: @itemize @findex server-start @@ -1589,32 +1589,29 @@ calls @code{server-start} after initialization, and returns control to the calling terminal instead of opening an initial frame; it then waits in the background, listening for edit requests. +@cindex systemd unit file +@item +If your operating system uses @command{systemd} to manage startup, +you can automatically start Emacs in daemon mode when you login +using the supplied @dfn{systemd unit file}. To activate this: +@example +systemctl --user enable emacs +@end example +(If your Emacs was installed into a non-standard location, you may +need to copy the @file{emacs.service} file to a standard directory +such as @file{~/.config/systemd/user/}.) + @cindex socket activation, systemd, Emacs @item An external process can invoke the Emacs server when a connection event occurs upon a specified socket and pass the socket to the new -Emacs server process. An instance of this is @command{systemd}'s -socket functionality: the @command{systemd} service creates a socket and +Emacs server process. An instance of this is the socket functionality +of @command{systemd}: the @command{systemd} service creates a socket and listens for connections on it; when @command{emacsclient} connects to it for the first time, @command{systemd} can launch the Emacs server and hand over the socket to it for servicing @command{emacsclient} connections. A setup to use this functionality could be: -@file{~/.config/systemd/user/emacs.service}: -@example -[Unit] -Description=Emacs - -[Service] -Type=forking -ExecStart=/path/to/emacs --daemon -ExecStop=/path/to/emacsclient --eval "(kill-emacs)" -Restart=always - -[Install] -WantedBy=default.target -@end example - @file{~/.config/systemd/user/emacs.socket}: @example [Socket] @@ -1624,12 +1621,14 @@ ListenStream=/path/to/.emacs.socket WantedBy=sockets.target @end example +(The @file{emacs.service} file described above must also be installed.) + The @code{ListenStream} path will be the path that Emacs listens for connections from @command{emacsclient}; this is a file of your choice. @end itemize @cindex @env{TEXEDIT} environment variable - Either way, once an Emacs server is started, you can use a shell + Once an Emacs server is started, you can use a shell command called @command{emacsclient} to connect to the Emacs process and tell it to visit a file. You can then set the @env{EDITOR} environment variable to @samp{emacsclient}, so that external programs diff --git a/etc/NEWS b/etc/NEWS index fe76af5..03c4990 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -44,6 +44,12 @@ hand the socket over to Emacs. Emacs uses this socket to service emacsclient commands. This new functionality can be disabled with the configure option '--disable-libsystemd'. ++++ +** A systemd user unit file is provided. Use it in the standard way: +systemctl --user enable emacs +(If your Emacs is installed in a non-standard location, you may +need to copy the emacs.service file to eg ~/.config/systemd/user/) + ** New configure option '--disable-build-details' attempts to build an Emacs that is more likely to be reproducible; that is, if you build and install Emacs twice, the second Emacs is a copy of the first. diff --git a/etc/emacs.service b/etc/emacs.service new file mode 100644 index 0000000..92cdeb5 --- /dev/null +++ b/etc/emacs.service @@ -0,0 +1,17 @@ +## If your Emacs is installed in a non-standard location, you may need +## to copy this file to a standard directory, eg ~/.config/systemd/user/ . +## If you install this file by hand, change the "Exec" lines below +## to use absolute file names for the executables. +[Unit] +Description=Emacs text editor +Documentation=info:emacs man:emacs(1) https://gnu.org/software/emacs/ + +[Service] +Type=forking +ExecStart=emacs --daemon +ExecStop=emacsclient --eval "(kill-emacs)" +Environment=SSH_AUTH_SOCK=%t/keyring/ssh +Restart=on-failure + +[Install] +WantedBy=default.target commit 9b3a853ab2430503bb1e5bae57fc35e2cd555e1a Author: Paul Eggert Date: Sun Nov 13 12:15:25 2016 -0800 Port --enable-gcc-warnings to Ubuntu 16.10 * src/gmalloc.c: Include , so it declares hybrid_aligned_alloc (the definiens of the aligned_alloc macro), so that GCC doesn't complain that hybrid_aligned_alloc is defined without being declared. diff --git a/src/gmalloc.c b/src/gmalloc.c index 6ca35ec..3f7bbda 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -26,6 +26,7 @@ License along with this library. If not, see . #endif #include +#include #include #include #include commit a611d7d7b436fb40a32227995edd5fcad42d0109 Author: Ken Brown Date: Sun Nov 13 11:33:27 2016 -0500 Silence tramp warning * lisp/net/tramp.el (tramp-file-name-for-operation): Add 'file-name-case-insensitive-p' as a known file primitive. (Bug#24936) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 00ecb37..c92c705 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1910,7 +1910,8 @@ ARGS are the arguments OPERATION has been called with." file-accessible-directory-p file-attributes file-directory-p file-executable-p file-exists-p file-local-copy file-modes - file-name-as-directory file-name-directory + file-name-as-directory file-name-case-insensitive-p + file-name-directory file-name-nondirectory file-name-sans-versions file-ownership-preserved-p file-readable-p file-regular-p file-remote-p file-symlink-p file-truename