Mercurial > emacs
changeset 109590:3c9de3b961fe
Merge from mainline.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Wed, 28 Jul 2010 22:44:58 +0000 |
| parents | 9cdc0ac3ecda (current diff) 0fc9f7a0d319 (diff) |
| children | 1fb35da4a097 |
| files | |
| diffstat | 13 files changed, 278 insertions(+), 132 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/ChangeLog Wed Jul 28 00:36:24 2010 +0000 +++ b/doc/misc/ChangeLog Wed Jul 28 22:44:58 2010 +0000 @@ -1,3 +1,7 @@ +2010-07-28 Michael Albinus <michael.albinus@gmx.de> + + * tramp.texi (Traces and Profiles): Describe verbose level 9. + 2010-07-27 Chong Yidong <cyd@stupidchicken.com> * nxml-mode.texi (Limitations): Remove obsolete discussion (Bug#6708).
--- a/lisp/ChangeLog Wed Jul 28 00:36:24 2010 +0000 +++ b/lisp/ChangeLog Wed Jul 28 22:44:58 2010 +0000 @@ -1,3 +1,56 @@ +2010-07-28 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-load-list, package-archives) + (package-archive-contents, package-user-dir) + (package-directory-list, package--builtins, package-alist) + (package-activated-list, package-obsolete-alist): Mark as risky. + +2010-07-28 Phil Hagelberg <phil@evri.com> + + Add support for non-default package repositories. + * emacs-lisp/package.el (package-archive-base): Var deleted. + (package-archives): New variable. + (package-archive-contents): Doc fix. + (package-load-descriptor): Do nothing if descriptor file is + missing. + (package--write-file-no-coding): New function. + (package-unpack-single): Use it. + (package-archive-id): New function. + (package-download-single, package-download-tar) + (package-menu-view-commentary): Use it. + (package-installed-p): Make second argument optional. + (package-read-all-archive-contents): New function. + (package-initialize): Use it. + (package-read-archive-contents): Add ARCHIVE argument. + (package--add-to-archive-contents): New function. + (package-install): Don't call package-read-archive-contents. + (package--download-one-archive): Store archive file in a + subdirectory of package-user-dir. + (package-menu-execute): Remove spurious line movement. + +2010-07-28 Jan Djärv <jan.h.d@swipnet.se> + + * cus-start.el (tool-bar-style): Add text-image-horiz. + +2010-07-28 Michael Albinus <michael.albinus@gmx.de> + + * progmodes/gud.el (gud-common-init): Check for remoteness of + `file', and not of `default-directory'. + +2010-07-28 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-methods): Move hostname to the end in all + ssh `tramp-login-args'. + (tramp-verbose): Describe verbose level 9. + (tramp-open-shell): Check for tty if `tramp-verbose' >= 9. + (tramp-open-connection-setup-interactive-shell): Trace stty + settings if `tramp-verbose' >= 9. + (tramp-handle-start-file-process): Implement tty setting. + (Bug#4604, Bug#6360) + + * net/tramp-cmds.el (tramp-bug): Recommend setting of + `tramp-verbose' to 9. + 2010-07-27 Aaron S. Hawley <ashawley@burlingtontelecom.net> * emacs-lisp/re-builder.el (reb-re-syntax, reb-lisp-mode)
--- a/lisp/cus-start.el Wed Jul 28 00:36:24 2010 +0000 +++ b/lisp/cus-start.el Wed Jul 28 22:44:58 2010 +0000 @@ -345,6 +345,7 @@ (const :tag "Text" :value text) (const :tag "Both" :value both) (const :tag "Both-horiz" :value both-horiz) + (const :tag "Text-image-horiz" :value text-image-horiz) (const :tag "System default" :value nil)) "23.3") (tool-bar-max-label-size frames integer "23.3")
--- a/lisp/emacs-lisp/package.el Wed Jul 28 00:36:24 2010 +0000 +++ b/lisp/emacs-lisp/package.el Wed Jul 28 22:44:58 2010 +0000 @@ -43,9 +43,6 @@ ;; currently register any of these, so this feature does not actually ;; work.) -;; This code supports a single package repository, ELPA. All packages -;; must be registered there. - ;; A package is described by its name and version. The distribution ;; format is either a tar file or a single .el file. @@ -55,11 +52,13 @@ ;; which consists of a call to define-package. It may also contain a ;; "dir" file and the info files it references. -;; A .el file will be named "NAME-VERSION.el" in ELPA, but will be +;; A .el file is named "NAME-VERSION.el" in the remote archive, but is ;; installed as simply "NAME.el" in a directory named "NAME-VERSION". -;; The downloader will download all dependent packages. It will also -;; byte-compile the package's lisp at install time. +;; The downloader downloads all dependent packages. By default, +;; packages come from the official GNU sources, but others may be +;; added by customizing the `package-archives' alist. Packages get +;; byte-compiled at install time. ;; At activation time we will set up the load-path and the info path, ;; and we will load the package's autoloads. If a package's @@ -207,6 +206,7 @@ Hence, the package is \"held\" at that version. If VERSION is nil, the package is not loaded (it is \"disabled\")." :type '(repeat symbol) + :risky t :group 'package :version "24.1") @@ -217,10 +217,16 @@ (declare-function lm-commentary "lisp-mnt" (&optional file)) (declare-function dired-delete-file "dired" (file &optional recursive trash)) -(defconst package-archive-base "http://elpa.gnu.org/packages/" - "Base URL for the Emacs Lisp Package Archive (ELPA). -Ordinarily you should not need to change this. -Note that some code in package.el assumes that this is an http: URL.") +(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/")) + "An alist of archives from which to fetch. +The default value points to the GNU Emacs package repository. +Each element has the form (ID . URL), where ID is an identifier +string for an archive and URL is a http: URL (a string)." + :type '(alist :key-type (string :tag "Archive name") + :value-type (string :tag "Archive URL")) + :risky t + :group 'package + :version "24.1") (defconst package-archive-version 1 "Version number of the package archive understood by this file. @@ -234,8 +240,10 @@ "Cache of the contents of the Emacs Lisp Package Archive. This is an alist mapping package names (symbols) to package descriptor vectors. These are like the vectors for `package-alist' -but have an extra entry which is 'tar for tar packages and -'single for single-file packages.") +but have extra entries: one which is 'tar for tar packages and +'single for single-file packages, and one which is the name of +the archive from which it came.") +(put 'package-archive-contents 'risky-local-variable t) (defcustom package-user-dir (locate-user-emacs-file "elpa") "Directory containing the user's Emacs Lisp packages. @@ -243,6 +251,7 @@ Apart from this directory, Emacs also looks for system-wide packages in `package-directory-list'." :type 'directory + :risky t :group 'package :version "24.1") @@ -259,6 +268,7 @@ These directories contain packages intended for system-wide; in contrast, `package-user-dir' contains packages for personal use." :type '(repeat directory) + :risky t :group 'package :version "24.1") @@ -293,6 +303,7 @@ (bubbles . [(0 5) nil "Puzzle game for Emacs."]))))) "Alist of all built-in packages. Maps the package name to a vector [VERSION REQS DOCSTRING].") +(put 'package--builtins 'risky-local-variable t) (defvar package-alist package--builtins "Alist of all packages available for activation. @@ -301,15 +312,18 @@ The value is generated by `package-load-descriptor', usually called via `package-initialize'. For user customizations of which packages to load/activate, see `package-load-list'.") +(put 'package-archive-contents 'risky-local-variable t) (defvar package-activated-list (mapcar #'car package-alist) "List of the names of currently activated packages.") +(put 'package-activated-list 'risky-local-variable t) (defvar package-obsolete-alist nil "Representation of obsolete packages. Like `package-alist', but maps package name to a second alist. The inner alist is keyed by version.") +(put 'package-obsolete-alist 'risky-local-variable t) (defconst package-subdirectory-regexp "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" @@ -361,16 +375,14 @@ (match-string 1 dirname))) (defun package-load-descriptor (dir package) - "Load the description file for a package. -DIR is the directory in which to find the package subdirectory, -and PACKAGE is the name of the package subdirectory. -Return nil if the package could not be found." - (let ((pkg-dir (expand-file-name package dir))) - (if (file-directory-p pkg-dir) - (load (expand-file-name (concat (package-strip-version package) - "-pkg") - pkg-dir) - nil t)))) + "Load the description file in directory DIR for package PACKAGE." + (let* ((pkg-dir (expand-file-name package dir)) + (pkg-file (expand-file-name + (concat (package-strip-version package) "-pkg") + pkg-dir))) + (when (and (file-directory-p pkg-dir) + (file-exists-p (concat pkg-file ".el"))) + (load pkg-file nil t)))) (defun package-load-all-descriptors () "Load descriptors for installed Emacs Lisp packages. @@ -613,20 +625,23 @@ (let ((load-path (cons pkg-dir load-path))) (byte-recompile-directory pkg-dir 0 t))))) +(defun package--write-file-no-coding (file-name excl) + (let ((buffer-file-coding-system 'no-conversion)) + (write-region (point-min) (point-max) file-name nil nil nil excl))) + (defun package-unpack-single (file-name version desc requires) "Install the contents of the current buffer as a package." ;; Special case "package". (if (string= file-name "package") - (write-region (point-min) (point-max) - (expand-file-name (concat file-name ".el") - package-user-dir) - nil nil nil nil) + (package--write-file-no-coding + (expand-file-name (concat file-name ".el") package-user-dir) + nil) (let* ((pkg-dir (expand-file-name (concat file-name "-" version) package-user-dir)) (el-file (expand-file-name (concat file-name ".el") pkg-dir)) (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) (make-directory pkg-dir t) - (write-region (point-min) (point-max) el-file nil nil nil 'excl) + (package--write-file-no-coding el-file 'excl) (let ((print-level nil) (print-length nil)) (write-region @@ -670,7 +685,7 @@ (defun package-download-single (name version desc requires) "Download and install a single-file package." (let ((buffer (url-retrieve-synchronously - (concat package-archive-base + (concat (package-archive-id name) (symbol-name name) "-" version ".el")))) (with-current-buffer buffer (package-handle-response) @@ -683,7 +698,7 @@ (defun package-download-tar (name version) "Download and install a tar package." (let ((tar-buffer (url-retrieve-synchronously - (concat package-archive-base + (concat (package-archive-id name) (symbol-name name) "-" version ".tar")))) (with-current-buffer tar-buffer (package-handle-response) @@ -692,12 +707,12 @@ (package-unpack name version) (kill-buffer tar-buffer)))) -(defun package-installed-p (package version) +(defun package-installed-p (package &optional min-version) (let ((pkg-desc (assq package package-alist))) (and pkg-desc - (package-version-compare version + (package-version-compare min-version (package-desc-vers (cdr pkg-desc)) - '>=)))) + '<=)))) (defun package-compute-transaction (result requirements) (dolist (elt requirements) @@ -772,16 +787,13 @@ (car contents) package-archive-version)) (cdr contents)))))) -(defun package-read-archive-contents () +(defun package-read-all-archive-contents () "Re-read `archive-contents' and `builtin-packages', if they exist. Set `package-archive-contents' and `package--builtins' if successful. Throw an error if the archive version is too new." - (let ((archive-contents (package--read-archive-file "archive-contents")) - (builtins (package--read-archive-file "builtin-packages"))) - (if archive-contents - ;; Version 1 of 'archive-contents' is identical to our - ;; internal representation. - (setq package-archive-contents archive-contents)) + (dolist (archive package-archives) + (package-read-archive-contents (car archive))) + (let ((builtins (package--read-archive-file "builtin-packages"))) (if builtins ;; Version 1 of 'builtin-packages' is a list where the car is ;; a split emacs version and the cdr is an alist suitable for @@ -793,6 +805,33 @@ (if (package-version-compare our-version (car elt) '>=) (setq result (append (cdr elt) result))))))))) +(defun package-read-archive-contents (archive) + "Re-read `archive-contents' and `builtin-packages' for ARCHIVE. +If successful, set `package-archive-contents' and `package--builtins'. +If the archive version is too new, signal an error." + (let ((archive-contents (package--read-archive-file + (concat "archives/" archive + "/archive-contents")))) + (if archive-contents + ;; Version 1 of 'archive-contents' is identical to our + ;; internal representation. + ;; TODO: merge archive lists + (dolist (package archive-contents) + (package--add-to-archive-contents package archive))))) + +(defun package--add-to-archive-contents (package archive) + "Add the PACKAGE from the given ARCHIVE if necessary. +Also, add the originating archive to the end of the package vector." + (let* ((name (car package)) + (version (aref (cdr package) 0)) + (entry (cons (car package) + (vconcat (cdr package) (vector archive)))) + (existing-package (cdr (assq name package-archive-contents)))) + (when (or (not existing-package) + (package-version-compare version + (aref existing-package 0) '>)) + (add-to-list 'package-archive-contents entry)))) + (defun package-download-transaction (transaction) "Download and install all the packages in the given transaction." (dolist (elt transaction) @@ -817,26 +856,21 @@ (defun package-install (name) "Install the package named NAME. Interactively, prompt for the package name. -The package is found on the archive site, see `package-archive-base'." +The package is found on one of the archives in `package-archive-base'." (interactive - (list (progn - ;; Make sure we're using the most recent download of the - ;; archive. Maybe we should be updating the archive first? - (package-read-archive-contents) - (intern (completing-read "Install package: " - (mapcar (lambda (elt) - (cons (symbol-name (car elt)) - nil)) - package-archive-contents) - nil t))))) + (list (intern (completing-read "Install package: " + (mapcar (lambda (elt) + (cons (symbol-name (car elt)) + nil)) + package-archive-contents) + nil t)))) (let ((pkg-desc (assq name package-archive-contents))) (unless pkg-desc - (error "Package '%s' not available for installation" + (error "Package '%s' is not available for installation" (symbol-name name))) - (let ((transaction - (package-compute-transaction (list name) - (package-desc-reqs (cdr pkg-desc))))) - (package-download-transaction transaction))) + (package-download-transaction + (package-compute-transaction (list name) + (package-desc-reqs (cdr pkg-desc))))) ;; Try to activate it. (package-initialize)) @@ -996,20 +1030,28 @@ ;; FIXME: query user? 'always)) -(defun package--download-one-archive (file) - "Download a single archive file and cache it locally." - (let ((buffer (url-retrieve-synchronously - (concat package-archive-base file)))) +(defun package-archive-id (name) + "Return the archive containing the package NAME." + (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) + (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) + +(defun package--download-one-archive (archive file) + "Download an archive file FILE from ARCHIVE, and cache it locally." + (let* ((archive-name (car archive)) + (archive-url (cdr archive)) + (dir (expand-file-name "archives" package-user-dir)) + (dir (expand-file-name archive-name dir)) + (buffer (url-retrieve-synchronously (concat archive-url file)))) (with-current-buffer buffer (package-handle-response) (re-search-forward "^$" nil 'move) (forward-char) (delete-region (point-min) (point)) - (setq buffer-file-name (concat (file-name-as-directory package-user-dir) - file)) + (make-directory dir t) + (setq buffer-file-name (expand-file-name file dir)) (let ((version-control 'never)) - (save-buffer)) - (kill-buffer buffer)))) + (save-buffer))) + (kill-buffer buffer))) (defun package-refresh-contents () "Download the ELPA archive description if needed. @@ -1019,9 +1061,9 @@ (interactive) (unless (file-exists-p package-user-dir) (make-directory package-user-dir t)) - (package--download-one-archive "archive-contents") - (package--download-one-archive "builtin-packages") - (package-read-archive-contents)) + (dolist (archive package-archives) + (package--download-one-archive archive "archive-contents")) + (package-read-all-archive-contents)) ;;;###autoload (defun package-initialize () @@ -1030,7 +1072,7 @@ (interactive) (setq package-obsolete-alist nil) (package-load-all-descriptors) - (package-read-archive-contents) + (package-read-all-archive-contents) ;; Try to activate all our packages. (mapc (lambda (elt) (package-activate (car elt) (package-desc-vers (cdr elt)))) @@ -1306,11 +1348,12 @@ For single-file packages, shows the commentary section from the header. For larger packages, shows the README file." (interactive) - (let* (start-point ok - (pkg-name (package-menu-get-package)) - (buffer (url-retrieve-synchronously (concat package-archive-base - pkg-name - "-readme.txt")))) + (let* ((pkg-name (package-menu-get-package)) + (buffer (url-retrieve-synchronously + (concat (package-archive-id pkg-name) + pkg-name + "-readme.txt"))) + start-point ok) (with-current-buffer buffer ;; FIXME: it would be nice to work with any URL type. (setq start-point url-http-end-of-headers) @@ -1322,7 +1365,7 @@ (insert "Package information for " pkg-name "\n\n") (if ok (insert-buffer-substring buffer start-point) - (insert "This package does not have a README file or commentary comment.\n")) + (insert "This package lacks a README file or commentary.\n")) (goto-char (point-min)) (view-mode))) (display-buffer new-buffer t)))) @@ -1355,7 +1398,6 @@ Emacs." (interactive) (goto-char (point-min)) - (forward-line 2) (while (not (eobp)) (let ((cmd (char-after)) (pkg-name (package-menu-get-package))
--- a/lisp/net/tramp-cmds.el Wed Jul 28 00:36:24 2010 +0000 +++ b/lisp/net/tramp-cmds.el Wed Jul 28 22:44:58 2010 +0000 @@ -225,7 +225,7 @@ This allows to investigate from a clean environment. Another useful thing to do is to put - (setq tramp-verbose 8) + (setq tramp-verbose 9) in the ~/.emacs file and to repeat the bug. Then, include the contents of the *tramp/foo* buffer and the *debug tramp/foo*
--- a/lisp/net/tramp.el Wed Jul 28 00:36:24 2010 +0000 +++ b/lisp/net/tramp.el Wed Jul 28 22:44:58 2010 +0000 @@ -200,6 +200,7 @@ 6 sent and received strings 7 file caching 8 connection properties + 9 test commands 10 traces (huge)." :group 'tramp :type 'integer) @@ -332,8 +333,8 @@ (tramp-copy-recursive t) (tramp-password-end-of-line nil)) ("scp" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") @@ -348,8 +349,8 @@ ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("scp1" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-1" "-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-1") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") @@ -364,8 +365,8 @@ ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("scp2" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-2" "-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-2") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") @@ -400,8 +401,8 @@ (tramp-copy-recursive t) (tramp-password-end-of-line nil)) ("sftp" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "sftp") @@ -409,8 +410,8 @@ (tramp-copy-keep-date nil) (tramp-password-end-of-line nil)) ("rsync" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "rsync") @@ -421,10 +422,10 @@ (tramp-password-end-of-line nil)) ("rsyncc" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") + (tramp-login-args (("-l" "%u") ("-p" "%p") ("-o" "ControlPath=%t.%%r@%%h:%%p") ("-o" "ControlMaster=yes") - ("-e" "none"))) + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "rsync") @@ -453,8 +454,8 @@ (tramp-copy-keep-date nil) (tramp-password-end-of-line nil)) ("ssh" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) @@ -467,8 +468,8 @@ ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("ssh1" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-1" "-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-1") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) @@ -481,8 +482,8 @@ ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("ssh2" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-2" "-e" "none"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-2") ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) @@ -545,10 +546,10 @@ (tramp-copy-keep-date nil) (tramp-password-end-of-line nil)) ("scpc" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") + (tramp-login-args (("-l" "%u") ("-p" "%p") ("-o" "ControlPath=%t.%%r@%%h:%%p") ("-o" "ControlMaster=yes") - ("-e" "none"))) + ("-e" "none") ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") @@ -563,8 +564,9 @@ ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("scpx" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none" "-t" "-t" "/bin/sh"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("-t" "-t") + ("%h") ("/bin/sh"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program "scp") @@ -577,8 +579,9 @@ ("-o" "StrictHostKeyChecking=no"))) (tramp-default-port 22)) ("sshx" (tramp-login-program "ssh") - (tramp-login-args (("%h") ("-l" "%u") ("-p" "%p") - ("-e" "none" "-t" "-t" "/bin/sh"))) + (tramp-login-args (("-l" "%u") ("-p" "%p") + ("-e" "none") ("-t" "-t") + ("%h") ("/bin/sh"))) (tramp-async-args (("-q"))) (tramp-remote-sh "/bin/sh") (tramp-copy-program nil) @@ -4506,14 +4509,16 @@ (defun tramp-handle-start-file-process (name buffer program &rest args) "Like `start-file-process' for Tramp files." (with-parsed-tramp-file-name default-directory nil - (unless (stringp program) - (tramp-error - v 'file-error "pty association is not supported for `%s'" name)) (unwind-protect - (let ((command (format "cd %s; exec %s" - (tramp-shell-quote-argument localname) - (mapconcat 'tramp-shell-quote-argument - (cons program args) " "))) + ;; When PROGRAM is nil, we just provide a tty. + (let ((command + (when (stringp program) + (format "cd %s; exec %s" + (tramp-shell-quote-argument localname) + (mapconcat 'tramp-shell-quote-argument + (cons program args) " ")))) + (tramp-process-connection-type + (or (null program) tramp-process-connection-type)) (name1 name) (i 0)) (unless buffer @@ -4533,9 +4538,16 @@ (with-current-buffer (tramp-get-connection-buffer v) (clear-visited-file-modtime) (narrow-to-region (point-max) (point-max))) - ;; Send the command. `tramp-send-command' opens a new - ;; connection. - (tramp-send-command v command nil t) ; nooutput + (if (stringp program) + ;; Send the command. `tramp-send-command' opens a new + ;; connection. + (tramp-send-command v command nil t) ; nooutput + ;; Check, whether a pty is associated, and set it as + ;; process property. + (condition-case nil + (tramp-send-command-and-read v "echo \\\"`tty`\\\"") + (tramp-error + v 'file-error "pty association is not supported for `%s'" name))) ;; Set query flag for this process. (tramp-set-process-query-on-exit-flag (tramp-get-connection-process v) t) @@ -6619,7 +6631,10 @@ vec (format "PS1=%s" (shell-quote-argument tramp-end-of-output)) t) (tramp-send-command vec "PS2=''" t) (tramp-send-command vec "PS3=''" t) - (tramp-send-command vec "PROMPT_COMMAND=''" t))) + (tramp-send-command vec "PROMPT_COMMAND=''" t) + ;; Dump tty in the traces. + (when (>= tramp-verbose 9) + (tramp-send-command vec "tty" t)))) (defun tramp-find-shell (vec) "Opens a shell on the remote host which groks tilde expansion." @@ -6984,7 +6999,7 @@ ;; stty, instead. (tramp-send-command vec "stty -onlcr" t)))) ;; Dump stty settings in the traces. - (when (>= tramp-verbose 10) + (when (>= tramp-verbose 9) (tramp-send-command vec "stty -a" t)) (tramp-send-command vec "set +o vi +o emacs" t) @@ -8950,7 +8965,6 @@ ;; rsync). ;; * Keep a second connection open for out-of-band methods like scp or ;; rsync. -;; * Support ptys in `tramp-handle-start-file-process'. (Bug#4604, Bug#6360) ;; * IMHO, it's a drawback that currently Tramp doesn't support ;; Unicode in Dired file names by default. Is it possible to ;; improve Tramp to set LC_ALL to "C" only for commands where Tramp
--- a/lisp/progmodes/gud.el Wed Jul 28 00:36:24 2010 +0000 +++ b/lisp/progmodes/gud.el Wed Jul 28 22:44:58 2010 +0000 @@ -145,7 +145,7 @@ (gud-call "suspend")) ((eq gud-minor-mode 'gdbmi) (gud-call (gdb-gud-context-command "-exec-interrupt"))) - (t + (t (comint-interrupt-subjob))))) (easy-mmode-defmap gud-menu-map @@ -2513,7 +2513,7 @@ (setq w (cdr w))) (if w (setcar w - (if (file-remote-p default-directory) + (if (file-remote-p file) ;; Tramp has already been loaded if we are here. (setq file (tramp-file-name-localname (tramp-dissect-file-name file)))
--- a/src/ChangeLog Wed Jul 28 00:36:24 2010 +0000 +++ b/src/ChangeLog Wed Jul 28 22:44:58 2010 +0000 @@ -1,3 +1,17 @@ +2010-07-28 Jan Djärv <jan.h.d@swipnet.se> + + * xsettings.c (Ftool_bar_get_system_style): Also check for + Qtext_image_horiz. + + * xdisp.c (Qtext_image_horiz): Define. + (syms_of_xdisp): Initialize Qtext_image_horiz. Add text-image-horiz + to ducumentation of tool-bar-style. + + * lisp.h (Qtext_image_horiz): Declare. + + * gtkutil.c (xg_make_tool_item, xg_show_toolbar_item): Handle tool bar + style text_image_horiz. + 2010-07-27 Dan Nicolaescu <dann@ics.uci.edu> * emacs.c (Fkill_emacs): Remove return statement.
--- a/src/gtkutil.c Wed Jul 28 00:36:24 2010 +0000 +++ b/src/gtkutil.c Wed Jul 28 22:44:58 2010 +0000 @@ -3703,8 +3703,7 @@ gtk_widget_set_name (x->toolbar_widget, "emacs-toolbar"); gtk_toolbar_set_style (GTK_TOOLBAR (x->toolbar_widget), GTK_TOOLBAR_ICONS); - toolbar_set_orientation (x->toolbar_widget, - GTK_ORIENTATION_HORIZONTAL); + toolbar_set_orientation (x->toolbar_widget, GTK_ORIENTATION_HORIZONTAL); } @@ -3749,15 +3748,23 @@ int i) { GtkToolItem *ti = gtk_tool_item_new (); - GtkWidget *vb = EQ (Vtool_bar_style, Qboth_horiz) + Lisp_Object style = Ftool_bar_get_system_style (); + int both_horiz = EQ (style, Qboth_horiz); + int text_image = EQ (style, Qtext_image_horiz); + + GtkWidget *vb = both_horiz || text_image ? gtk_hbox_new (FALSE, 0) : gtk_vbox_new (FALSE, 0); GtkWidget *wb = gtk_button_new (); GtkWidget *weventbox = gtk_event_box_new (); - if (wimage) + if (wimage && ! text_image) gtk_box_pack_start (GTK_BOX (vb), wimage, TRUE, TRUE, 0); gtk_box_pack_start (GTK_BOX (vb), gtk_label_new (label), TRUE, TRUE, 0); + + if (wimage && text_image) + gtk_box_pack_start (GTK_BOX (vb), wimage, TRUE, TRUE, 0); + gtk_button_set_focus_on_click (GTK_BUTTON (wb), FALSE); gtk_button_set_relief (GTK_BUTTON (wb), GTK_RELIEF_NONE); gtk_container_add (GTK_CONTAINER (wb), vb); @@ -3819,11 +3826,12 @@ xg_show_toolbar_item (GtkToolItem *ti) { Lisp_Object style = Ftool_bar_get_system_style (); - - int show_label = EQ (style, Qboth) - || EQ (style, Qboth_horiz) || EQ (style, Qtext); + int both_horiz = EQ (style, Qboth_horiz); + int text_image = EQ (style, Qtext_image_horiz); + + int horiz = both_horiz || text_image; + int show_label = ! EQ (style, Qimage); int show_image = ! EQ (style, Qtext); - int horiz = EQ (style, Qboth_horiz); GtkWidget *weventbox = gtk_bin_get_child (GTK_BIN (ti)); GtkWidget *wbutton = gtk_bin_get_child (GTK_BIN (weventbox)); @@ -3836,15 +3844,21 @@ new_box = gtk_hbox_new (FALSE, 0); else if (GTK_IS_HBOX (vb) && !horiz && show_label && show_image) new_box = gtk_vbox_new (FALSE, 0); - if (new_box) + + if (!new_box && horiz) + gtk_box_reorder_child (GTK_BOX (vb), wlbl, text_image ? 0 : 1); + else if (new_box) { g_object_ref (G_OBJECT (wimage)); g_object_ref (G_OBJECT (wlbl)); gtk_container_remove (GTK_CONTAINER (vb), wimage); gtk_container_remove (GTK_CONTAINER (vb), wlbl); gtk_widget_destroy (GTK_WIDGET (vb)); - gtk_box_pack_start (GTK_BOX (new_box), wimage, TRUE, TRUE, 0); + if (! text_image) + gtk_box_pack_start (GTK_BOX (new_box), wimage, TRUE, TRUE, 0); gtk_box_pack_start (GTK_BOX (new_box), wlbl, TRUE, TRUE, 0); + if (text_image) + gtk_box_pack_start (GTK_BOX (new_box), wimage, TRUE, TRUE, 0); gtk_container_add (GTK_CONTAINER (wbutton), new_box); g_object_unref (G_OBJECT (wimage)); g_object_unref (G_OBJECT (wlbl));
--- a/src/lisp.h Wed Jul 28 00:36:24 2010 +0000 +++ b/src/lisp.h Wed Jul 28 22:44:58 2010 +0000 @@ -2631,7 +2631,7 @@ extern Lisp_Object Qinhibit_redisplay, Qdisplay; extern Lisp_Object Qinhibit_eval_during_redisplay; extern Lisp_Object Qmessage_truncate_lines; -extern Lisp_Object Qimage, Qtext, Qboth, Qboth_horiz; +extern Lisp_Object Qimage, Qtext, Qboth, Qboth_horiz, Qtext_image_horiz; extern Lisp_Object Qspace, Qcenter, QCalign_to; extern Lisp_Object Vmessage_log_max; extern Lisp_Object QCdata, QCfile;
--- a/src/xdisp.c Wed Jul 28 00:36:24 2010 +0000 +++ b/src/xdisp.c Wed Jul 28 22:44:58 2010 +0000 @@ -456,7 +456,7 @@ Lisp_Object Qrect, Qcircle, Qpoly; /* Tool bar styles */ -Lisp_Object Qtext, Qboth, Qboth_horiz; +Lisp_Object Qtext, Qboth, Qboth_horiz, Qtext_image_horiz; /* Non-zero means print newline to stdout before next mini-buffer message. */ @@ -25636,6 +25636,8 @@ staticpro (&Qboth); Qboth_horiz = intern_c_string ("both-horiz"); staticpro (&Qboth_horiz); + Qtext_image_horiz = intern_c_string ("text-image-horiz"); + staticpro (&Qtext_image_horiz); QCmap = intern_c_string (":map"); staticpro (&QCmap); QCpointer = intern_c_string (":pointer"); @@ -25979,11 +25981,12 @@ DEFVAR_LISP ("tool-bar-style", &Vtool_bar_style, doc: /* *Tool bar style to use. It can be one of - image - show images only - text - show text only - both - show both, text under image - both-horiz - show text to the right of the image - any other - use system default or image if no system default. */); + image - show images only + text - show text only + both - show both, text below image + both-horiz - show text to the right of the image + text-image-horiz - show text to the left of the image + any other - use system default or image if no system default. */); Vtool_bar_style = Qnil; DEFVAR_INT ("tool-bar-max-label-size", &tool_bar_max_label_size,
--- a/src/xsettings.c Wed Jul 28 00:36:24 2010 +0000 +++ b/src/xsettings.c Wed Jul 28 22:44:58 2010 +0000 @@ -730,7 +730,8 @@ if (EQ (Vtool_bar_style, Qimage) || EQ (Vtool_bar_style, Qtext) || EQ (Vtool_bar_style, Qboth) - || EQ (Vtool_bar_style, Qboth_horiz)) + || EQ (Vtool_bar_style, Qboth_horiz) + || EQ (Vtool_bar_style, Qtext_image_horiz)) return Vtool_bar_style; if (!NILP (current_tool_bar_style)) return current_tool_bar_style;