diff options
| author | Eli Zaretskii <eliz@gnu.org> | 2012-10-09 20:28:06 +0200 |
|---|---|---|
| committer | Eli Zaretskii <eliz@gnu.org> | 2012-10-09 20:28:06 +0200 |
| commit | b97f22cdad55a0964758cef3a19ce3fa1098657d (patch) | |
| tree | 8d078a5b2aab3f55708a5f8eeaf8ca0f022e6ee3 | |
| parent | 87c141ce9750881f6203148e3c49d00710cd472e (diff) | |
| parent | b15736e6e33a52021a2a91b0b3360cd5a9803405 (diff) | |
| download | emacs-b97f22cdad55a0964758cef3a19ce3fa1098657d.tar.gz | |
Merge from trunk.
45 files changed, 546 insertions, 420 deletions
diff --git a/admin/ChangeLog b/admin/ChangeLog index 7d4921887ce..c10ec67147b 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,8 @@ +2012-10-09 Glenn Morris <rgm@gnu.org> + + * admin.el (cusver-scan-cus-start): New function. + (cusver-check): Scan old cus-start.el. + 2012-10-07 Glenn Morris <rgm@gnu.org> * admin.el (cusver-new-version): Set default. diff --git a/admin/admin.el b/admin/admin.el index 3e3fbba7202..59d085b6405 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -446,8 +446,6 @@ If optional OLD is non-nil, also include defvars." (1+ emacs-minor-version)) "Version number that new defcustoms should have.") -;; TODO do something about renamed variables with aliases to the old name? -;; Scan old cus-start.el to find variables moved from C to lisp? (defun cusver-scan (file &optional old) "Scan FILE for `defcustom' calls. Return a list with elements of the form (VAR . VER), @@ -486,6 +484,21 @@ If optional argument OLD is non-nil, also scan for defvars." (message "%sdone" m) alist)) +(defun cusver-scan-cus-start (file) + "Scan cus-start.el and return an alist with elements (VAR . VER)." + (if (file-readable-p file) + (with-temp-buffer + (insert-file-contents file) + (when (search-forward "(let ((all '(" nil t) + (backward-char 1) + (let (var ver alist) + (dolist (elem (ignore-errors (read (current-buffer)))) + (when (symbolp (setq var (car-safe elem))) + (or (stringp (setq ver (nth 3 elem))) + (setq ver nil)) + (setq alist (cons (cons var ver) alist)))) + alist))))) + (define-button-type 'cusver-xref 'action #'cusver-goto-xref) (defun cusver-goto-xref (button) @@ -501,11 +514,9 @@ If optional argument OLD is non-nil, also scan for defvars." (pop-to-buffer (current-buffer)))))) ;; You should probably at least do a grep over the old directory -;; to check the results of this look sensible. Eg cus-start if -;; something moved from C to Lisp. -;; TODO handle renamed things with aliases to the old names. -;; What to do about new files? Does everything in there need a :version, -;; or eg just the defgroup? +;; to check the results of this look sensible. +;; TODO Check cus-start if something moved from C to Lisp. +;; TODO Handle renamed things with aliases to the old names. (defun cusver-check (newdir olddir version) "Check that defcustoms have :version tags where needed. NEWDIR is the current lisp/ directory, OLDDIR is that from the previous @@ -537,6 +548,8 @@ changes (in a non-trivial way). This function does not check for that." (message "Reading old defcustoms...") (dolist (file oldfiles) (setq oldcus (append oldcus (cusver-scan file t)))) + (setq oldcus (append oldcus (cusver-scan-cus-start + (expand-file-name "cus-start.el" olddir)))) ;; newcus has elements (FILE (VAR VER) ... ). ;; oldcus just (VAR . VER). (message "Checking for version tags...") diff --git a/autogen/config.in b/autogen/config.in index 7aaf6650fa0..c5f32371dd7 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -692,7 +692,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ Mac OS X. */ #undef HAVE_NS -/* Define to use native Windows GUI. */ +/* Define to use native MS Windows GUI. */ #undef HAVE_NTGUI /* Define to 1 if libotf has OTF_get_variation_glyphs. */ diff --git a/autogen/configure b/autogen/configure index 163bbaf8719..67e1039d54c 100755 --- a/autogen/configure +++ b/autogen/configure @@ -2084,7 +2084,7 @@ Optional Packages: --without-xaw3d don't use Xaw3d --without-xim don't use X11 XIM --with-ns use NeXTstep (Cocoa or GNUstep) windowing system - --with-w32 use native Windows GUI + --with-w32 use native MS Windows GUI --without-gpm don't use -lgpm for mouse support on a GNU/Linux console --without-dbus don't compile with D-Bus support diff --git a/configure.ac b/configure.ac index 3679424e664..5520dd6a903 100644 --- a/configure.ac +++ b/configure.ac @@ -177,7 +177,7 @@ OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif or Xaw3d scroll bars]) OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d]) OPTION_DEFAULT_ON([xim],[don't use X11 XIM]) OPTION_DEFAULT_OFF([ns],[use NeXTstep (Cocoa or GNUstep) windowing system]) -OPTION_DEFAULT_OFF([w32], [use native Windows GUI]) +OPTION_DEFAULT_OFF([w32], [use native MS Windows GUI]) OPTION_DEFAULT_ON([gpm],[don't use -lgpm for mouse support on a GNU/Linux console]) OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support]) @@ -1586,7 +1586,7 @@ if test "${with_w32}" != no; then AC_CHECK_HEADER([windows.h], [HAVE_W32=yes], [AC_MSG_ERROR([`--with-w32' was specified, but windows.h cannot be found.])]) - AC_DEFINE(HAVE_NTGUI, 1, [Define to use native Windows GUI.]) + AC_DEFINE(HAVE_NTGUI, 1, [Define to use native MS Windows GUI.]) W32_OBJ="w32fns.o w32menu.o w32reg.o w32font.o w32term.o" W32_OBJ="$W32_OBJ w32xfns.o w32select.o w32uniscribe.o" W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32" diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 5fdd4acde95..3ee183ff255 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,7 @@ +2012-10-09 Michael Albinus <michael.albinus@gmx.de> + + * trampver.texi: Update release number. + 2012-10-06 Glenn Morris <rgm@gnu.org> * erc.texi: Include emacsver.texi, and use EMACSVER rather than diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index d902ac0fb97..96043a07300 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.2.6 +@set trampver 2.2.7-pre @c Other flags from configuration @set instprefix /usr/local @@ -431,6 +431,9 @@ The option `follow-intercept-processes' has been removed. specifying URL types which should be converted to remote file names at the FFAP prompt. The default is now '("ftp"). +** Generic-x +`javascript-generic-mode' is now an obsolete alias for `js-mode'. + ** Ibuffer *** New `derived-mode' filter, bound to `/ M'. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 406c50ee9c8..ef9e06b7d58 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,85 @@ +2012-10-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * newcomment.el (comment-start-skip, comment-end-skip, comment-end): + Don't document nil as a useful value (bug#12583). + +2012-10-09 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-debug-message): + Remove "tramp-with-progress-reporter" from regexp of ignored functions. + (with-tramp-progress-reporter): Rename from + `tramp-with-progress-reporter'. + (with-tramp-file-property, with-tramp-connection-property): + Move from tramp-cache.el, rename from `with-file-property' and + `with-connection-property', respectively. + + * net/tramp-cache.el: Remove `with-file-property' and + `with-connection-property'. + + * net/tramp.el: + * net/tramp-gvfs.el: + * net/tramp-sh.el: + * net/tramp-smb.el: Adapt callees. + + * net/trampver.el: Update release number. + +2012-10-09 Glenn Morris <rgm@gnu.org> + + * w32-fns.el (set-message-beep): + * term/w32-win.el (set-message-beep): Update declarations. + +2012-10-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * bindings.el (mode-line-toggle-read-only, mode-line-toggle-modified) + (mode-line-widen, mode-line-input-method-map) + (mode-line-coding-system-map, mode-line-remote) + (mode-line-unbury-buffer, mode-line-bury-buffer) + (mode-line-next-buffer, mode-line-previous-buffer): + Replace save-selected-window+select-window => with-selected-window. + + * progmodes/cc-bytecomp.el (cc-bytecomp-defmacro): Remove, unused. + * progmodes/cc-vars.el (bq-process): Remove, unused. + + * emacs-lisp/cl-macs.el (cl-defstruct): Obey the :read-only property. + +2012-10-09 Fabián Ezequiel Gallina <fgallina@cuca> + + Implemented `backward-up-list'-like navigation. + * progmodes/python.el (python-nav-up-list) + (python-nav-backward-up-list): New functions. + (python-mode-map): Define substitute key for backward-up-list to + python-nav-backward-up-list. + +2012-10-08 Fabián Ezequiel Gallina <fgallina@cuca> + + * progmodes/python.el (python-fill-paragraph): Rename from + python-fill-paragraph-function. Fixed fill-paragraph for + decorators (Bug#12605). + +2012-10-08 Fabián Ezequiel Gallina <fgallina@cuca> + + * progmodes/python.el (python-shell-output-filter): Handle extra + carriage return in OSX (Bug#12409). + +2012-10-08 Fabián Ezequiel Gallina <fgallina@cuca> + + Fix shell handling of unbalanced quotes and parens in output. + * progmodes/python.el (python-rx-constituents): Add string-delimiter. + (python-syntax-propertize-function): Use it. + (python-shell-output-syntax-table): New var. + (inferior-python-mode): Prevent unbalanced parens/quotes from + previous output mess with current input context. + +2012-10-08 Juanma Barranquero <lekktu@gmail.com> + + * generic-x.el (javascript-generic-mode, javascript-generic-mode-hook): + Make obsolete aliases of js-mode and js-mode-hook (from js.el). + +2012-10-08 Michael Albinus <michael.albinus@gmx.de> + + * ffap.el (ffap-replace-file-component): Support Tramp file name + syntax, not only ange-ftp's one. + 2012-10-08 Glenn Morris <rgm@gnu.org> * cus-start.el (message-log-max): Set :version. diff --git a/lisp/bindings.el b/lisp/bindings.el index b4f9d29fe52..de5dd48c291 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -38,23 +38,20 @@ corresponding to the mode line clicked." (defun mode-line-toggle-read-only (event) "Like `toggle-read-only', for the mode-line." (interactive "e") - (save-selected-window - (select-window (posn-window (event-start event))) + (with-selected-window (posn-window (event-start event)) (read-only-mode 'toggle))) (defun mode-line-toggle-modified (event) "Toggle the buffer-modified flag from the mode-line." (interactive "e") - (save-selected-window - (select-window (posn-window (event-start event))) + (with-selected-window (posn-window (event-start event)) (set-buffer-modified-p (not (buffer-modified-p))) (force-mode-line-update))) (defun mode-line-widen (event) "Widen a buffer from the mode-line." (interactive "e") - (save-selected-window - (select-window (posn-window (event-start event))) + (with-selected-window (posn-window (event-start event)) (widen) (force-mode-line-update))) @@ -63,17 +60,13 @@ corresponding to the mode line clicked." (define-key map [mode-line mouse-2] (lambda (e) (interactive "e") - (save-selected-window - (select-window - (posn-window (event-start e))) + (with-selected-window (posn-window (event-start e)) (toggle-input-method) (force-mode-line-update)))) (define-key map [mode-line mouse-3] (lambda (e) (interactive "e") - (save-selected-window - (select-window - (posn-window (event-start e))) + (with-selected-window (posn-window (event-start e)) (describe-current-input-method)))) (purecopy map))) @@ -82,16 +75,14 @@ corresponding to the mode line clicked." (define-key map [mode-line mouse-1] (lambda (e) (interactive "e") - (save-selected-window - (select-window (posn-window (event-start e))) + (with-selected-window (posn-window (event-start e)) (when (and enable-multibyte-characters buffer-file-coding-system) (describe-coding-system buffer-file-coding-system))))) (define-key map [mode-line mouse-3] (lambda (e) (interactive "e") - (save-selected-window - (select-window (posn-window (event-start e))) + (with-selected-window (posn-window (event-start e)) (call-interactively 'set-buffer-file-coding-system)))) (purecopy map)) "Local keymap for the coding-system part of the mode line.") @@ -237,8 +228,7 @@ mnemonics of the following coding systems: 'mouse-face 'mode-line-highlight 'help-echo (purecopy (lambda (window _object _point) (format "%s" - (save-selected-window - (select-window window) + (with-selected-window window (concat (if (file-remote-p default-directory) "Current directory is remote: " @@ -474,15 +464,13 @@ By default, this shows the information specified by (defun mode-line-unbury-buffer (event) "\ Call `unbury-buffer' in this window." (interactive "e") - (save-selected-window - (select-window (posn-window (event-start event))) + (with-selected-window (posn-window (event-start event)) (unbury-buffer))) (defun mode-line-bury-buffer (event) "\ Like `bury-buffer', but temporarily select EVENT's window." (interactive "e") - (save-selected-window - (select-window (posn-window (event-start event))) + (with-selected-window (posn-window (event-start event)) (bury-buffer))) (defun mode-line-other-buffer () "\ @@ -493,15 +481,13 @@ Switch to the most recently selected buffer other than the current one." (defun mode-line-next-buffer (event) "Like `next-buffer', but temporarily select EVENT's window." (interactive "e") - (save-selected-window - (select-window (posn-window (event-start event))) + (with-selected-window (posn-window (event-start event)) (next-buffer))) (defun mode-line-previous-buffer (event) "Like `previous-buffer', but temporarily select EVENT's window." (interactive "e") - (save-selected-window - (select-window (posn-window (event-start event))) + (with-selected-window (posn-window (event-start event)) (previous-buffer))) (defmacro bound-and-true-p (var) diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index ea102dddf2f..14e8d6c1d64 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,9 @@ +2012-10-08 David Engster <deng@randomsample.de>> + + * semantic/bovine/el.el: Add `semantic-default-elisp-setup' to + `emacs-lisp-mode-hook'. This was accidentally removed during the + CEDET update (2012-10-01T18:10:29Z!cyd@gnu.org). + 2012-10-07 David Engster <deng@randomsample.de> * semantic/wisent/python.el (semantic-ctxt-current-function) diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index 7bad1483dc3..ea99df9edb9 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -944,6 +944,8 @@ ELisp variables can be pretty long, so track this one too.") "Setup hook function for Emacs Lisp files and Semantic." ) +(add-hook 'emacs-lisp-mode-hook 'semantic-default-elisp-setup) + ;;; LISP MODE ;; ;; @TODO: Lisp supports syntaxes that Emacs Lisp does not. diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index e25ac5f9708..d05fbc42060 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -260,7 +260,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value. ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "6951d080daefb5194b1d21fe9b2deae4") +;;;;;; "cl-macs" "cl-macs.el" "885919e79dbcd11081cfb2e039b470c7") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 99bae1944e8..592c33d21c5 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2324,26 +2324,29 @@ value, that slot cannot be set via `setf'. (if (= pos 0) '(car cl-x) `(nth ,pos cl-x)))) forms) (push (cons accessor t) side-eff) - ;; Don't bother defining a setf-expander, since gv-get can use - ;; the compiler macro to get the same result. - ;;(push `(gv-define-setter ,accessor (cl-val cl-x) - ;; ,(if (cadr (memq :read-only (cddr desc))) - ;; `(progn (ignore cl-x cl-val) - ;; (error "%s is a read-only slot" - ;; ',accessor)) - ;; ;; If cl is loaded only for compilation, - ;; ;; the call to cl--struct-setf-expander would - ;; ;; cause a warning because it may not be - ;; ;; defined at run time. Suppress that warning. - ;; `(progn - ;; (declare-function - ;; cl--struct-setf-expander "cl-macs" - ;; (x name accessor pred-form pos)) - ;; (cl--struct-setf-expander - ;; cl-val cl-x ',name ',accessor - ;; ,(and pred-check `',pred-check) - ;; ,pos)))) - ;; forms) + (if (cadr (memq :read-only (cddr desc))) + (push `(gv-define-expander ,accessor + (lambda (_cl-do _cl-x) + (error "%s is a read-only slot" ',accessor))) + forms) + ;; For normal slots, we don't need to define a setf-expander, + ;; since gv-get can use the compiler macro to get the + ;; same result. + ;; (push `(gv-define-setter ,accessor (cl-val cl-x) + ;; ;; If cl is loaded only for compilation, + ;; ;; the call to cl--struct-setf-expander would + ;; ;; cause a warning because it may not be + ;; ;; defined at run time. Suppress that warning. + ;; (progn + ;; (declare-function + ;; cl--struct-setf-expander "cl-macs" + ;; (x name accessor pred-form pos)) + ;; (cl--struct-setf-expander + ;; cl-val cl-x ',name ',accessor + ;; ,(and pred-check `',pred-check) + ;; ,pos))) + ;; forms) + ) (if print-auto (nconc print-func (list `(princ ,(format " %s" slot) cl-s) diff --git a/lisp/ffap.el b/lisp/ffap.el index f3e8d4c194e..4c75609fe01 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -482,18 +482,12 @@ Returned values: (defun ffap-replace-file-component (fullname name) "In remote FULLNAME, replace path with NAME. May return nil." - ;; Use ange-ftp or efs if loaded, but do not load them otherwise. - (let (found) - (mapc - (function (lambda (sym) (and (fboundp sym) (setq found sym)))) - '( - efs-replace-path-component - ange-ftp-replace-path-component - ange-ftp-replace-name-component - )) - (and found - (fset 'ffap-replace-file-component found) - (funcall found fullname name)))) + ;; Use efs if loaded, but do not load it otherwise. + (if (fboundp 'efs-replace-path-component) + (funcall efs-replace-path-component fullname name) + (and (stringp fullname) + (stringp name) + (concat (file-remote-p fullname) name)))) ;; (ffap-replace-file-component "/who@foo.com:/whatever" "/new") (defun ffap-file-suffix (file) diff --git a/lisp/generic-x.el b/lisp/generic-x.el index ce1599b9010..878021ec5c5 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -646,83 +646,10 @@ like an INI file. You can add this hook to `find-file-hook'." "Generic mode for Sys V pkginfo files.")) ;; Javascript mode -;; Includes extra keywords from Armando Singer [asinger@MAIL.COLGATE.EDU] +;; Obsolete; defer to js-mode from js.el. (when (memq 'javascript-generic-mode generic-extras-enable-list) - -(define-generic-mode javascript-generic-mode - '("//" ("/*" . "*/")) - '("break" - "case" - "continue" - "default" - "delete" - "do" - "else" - "export" - "for" - "function" - "if" - "import" - "in" - "new" - "return" - "switch" - "this" - "typeof" - "var" - "void" - "while" - "with" - ;; words reserved for ECMA extensions below - "catch" - "class" - "const" - "debugger" - "enum" - "extends" - "finally" - "super" - "throw" - "try" - ;; Java Keywords reserved by JavaScript - "abstract" - "boolean" - "byte" - "char" - "double" - "false" - "final" - "float" - "goto" - "implements" - "instanceof" - "int" - "interface" - "long" - "native" - "null" - "package" - "private" - "protected" - "public" - "short" - "static" - "synchronized" - "throws" - "transient" - "true") - '(("^\\s-*function\\s-+\\([A-Za-z0-9_]+\\)" - (1 font-lock-function-name-face)) - ("^\\s-*var\\s-+\\([A-Za-z0-9_]+\\)" - (1 font-lock-variable-name-face))) - '("\\.js\\'") - (list - (function - (lambda () - (setq imenu-generic-expression - '((nil "^function\\s-+\\([A-Za-z0-9_]+\\)" 1) - ("*Variables*" "^var\\s-+\\([A-Za-z0-9_]+\\)" 1)))))) - "Generic mode for JavaScript files.")) + (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3") + (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3")) ;; VRML files (when (memq 'vrml-generic-mode generic-extras-enable-list) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index f79353ebfb3..c6b2a4c37a7 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2012-10-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-insert): \r is also not inserted, so don't try to delete + it. + 2012-10-06 Glenn Morris <rgm@gnu.org> * gnus-notifications.el (gnus-notifications): diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index e7a6c5d2081..03704554459 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -391,7 +391,7 @@ size, and full-buffer size." (shr-indent)) (end-of-line)) (insert " "))) - (unless (string-match "[ \t\n ]\\'" text) + (unless (string-match "[ \t\r\n ]\\'" text) (delete-char -1))))) (defun shr-find-fill-point () diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index fe5eb0049d0..e4fca46ce2d 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -139,27 +139,6 @@ Returns VALUE." value)) ;;;###tramp-autoload -(defmacro with-file-property (vec file property &rest body) - "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. -FILE must be a local file name on a connection identified via VEC." - `(if (file-name-absolute-p ,file) - (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) - (when (eq value 'undef) - ;; We cannot pass @body as parameter to - ;; `tramp-set-file-property' because it mangles our - ;; debug messages. - (setq value (progn ,@body)) - (tramp-set-file-property ,vec ,file ,property value)) - value) - ,@body)) - -;;;###tramp-autoload -(put 'with-file-property 'lisp-indent-function 3) -(put 'with-file-property 'edebug-form-spec t) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-file-property\\>")) - -;;;###tramp-autoload (defun tramp-flush-file-property (vec file) "Remove all properties of FILE in the cache context of VEC." ;; Remove file property of symlinks. @@ -250,24 +229,6 @@ PROPERTY is set persistent when KEY is a vector." value)) ;;;###tramp-autoload -(defmacro with-connection-property (key property &rest body) - "Check in Tramp for property PROPERTY, otherwise executes BODY and set." - `(let ((value (tramp-get-connection-property ,key ,property 'undef))) - (when (eq value 'undef) - ;; We cannot pass ,@body as parameter to - ;; `tramp-set-connection-property' because it mangles our debug - ;; messages. - (setq value (progn ,@body)) - (tramp-set-connection-property ,key ,property value)) - value)) - -;;;###tramp-autoload -(put 'with-connection-property 'lisp-indent-function 2) -(put 'with-connection-property 'edebug-form-spec t) -(tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<with-connection-property\\>")) - -;;;###tramp-autoload (defun tramp-flush-connection-property (key) "Remove all properties identified by KEY. KEY identifies the connection, it is either a process or a vector." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index f78122ec704..60b39606d86 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -537,7 +537,7 @@ is no information where to trace the message.") "Like `copy-file' for Tramp files." (with-parsed-tramp-file-name (if (tramp-tramp-file-p filename) filename newname) nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 0 (format "Copying %s to %s" filename newname) (condition-case err (let ((args @@ -741,7 +741,7 @@ is no information where to trace the message.") "Like `rename-file' for Tramp files." (with-parsed-tramp-file-name (if (tramp-tramp-file-p filename) filename newname) nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 0 (format "Renaming %s to %s" filename newname) (condition-case err (rename-file @@ -1056,7 +1056,7 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"." (catch 'mounted (dolist (elt - (with-file-property vec "/" "list-mounts" + (with-tramp-file-property vec "/" "list-mounts" (with-tramp-dbus-call-method vec t :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker tramp-gvfs-interface-mounttracker "listMounts")) @@ -1199,7 +1199,7 @@ connection if a previous connection has died for some reason." (tramp-gvfs-object-path (tramp-make-tramp-file-name method user host "")))) - (tramp-with-progress-reporter + (with-tramp-progress-reporter vec 3 (if (zerop (length user)) (format "Opening connection for %s using %s" host method) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2c1af3e83fa..ec321d00506 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1058,7 +1058,7 @@ target of the symlink differ." "Like `file-truename' for Tramp files." (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-make-tramp-file-name method user host - (with-file-property v localname "file-truename" + (with-tramp-file-property v localname "file-truename" (let ((result nil)) ; result steps in reverse order (tramp-message v 4 "Finding true name for `%s'" filename) (cond @@ -1167,7 +1167,7 @@ target of the symlink differ." (defun tramp-sh-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-exists-p" + (with-tramp-file-property v localname "file-exists-p" (or (not (null (tramp-get-file-property v localname "file-attributes-integer" nil))) (not (null (tramp-get-file-property @@ -1185,7 +1185,8 @@ target of the symlink differ." ;; Don't modify `last-coding-system-used' by accident. (let ((last-coding-system-used last-coding-system-used)) (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-file-property v localname (format "file-attributes-%s" id-format) + (with-tramp-file-property + v localname (format "file-attributes-%s" id-format) (save-excursion (tramp-convert-file-attributes v @@ -1481,7 +1482,8 @@ and gid of the corresponding user is taken. Both parameters must be integers." (defun tramp-remote-selinux-p (vec) "Check, whether SELINUX is enabled on the remote host." - (with-connection-property (tramp-get-connection-process vec) "selinux-p" + (with-tramp-connection-property + (tramp-get-connection-process vec) "selinux-p" (let ((result (tramp-find-executable vec "getenforce" (tramp-get-remote-path vec) t t))) (and result @@ -1493,7 +1495,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (defun tramp-sh-handle-file-selinux-context (filename) "Like `file-selinux-context' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-selinux-context" + (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) (regexp (concat "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\):" "\\([a-z0-9_]+\\)"))) @@ -1537,7 +1539,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (defun tramp-sh-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-executable-p" + (with-tramp-file-property v localname "file-executable-p" ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. (or (tramp-check-cached-permissions v ?x) @@ -1546,7 +1548,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (defun tramp-sh-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-readable-p" + (with-tramp-file-property v localname "file-readable-p" ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. (or (tramp-check-cached-permissions v ?r) @@ -1600,13 +1602,13 @@ and gid of the corresponding user is taken. Both parameters must be integers." ;; desirable to return t immediately for "/method:foo:". It can ;; be expected that this is always a directory. (or (zerop (length localname)) - (with-file-property v localname "file-directory-p" + (with-tramp-file-property v localname "file-directory-p" (tramp-run-test "-d" filename))))) (defun tramp-sh-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-writable-p" + (with-tramp-file-property v localname "file-writable-p" (if (file-exists-p filename) ;; Examine `file-attributes' cache to see if request can be ;; satisfied without remote operation. @@ -1619,7 +1621,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (defun tramp-sh-handle-file-ownership-preserved-p (filename) "Like `file-ownership-preserved-p' for Tramp files." (with-parsed-tramp-file-name filename nil - (with-file-property v localname "file-ownership-preserved-p" + (with-tramp-file-property v localname "file-ownership-preserved-p" (let ((attributes (file-attributes filename))) ;; Return t if the file doesn't exist, since it's true that no ;; information would be lost by an (attempted) delete and create. @@ -1637,7 +1639,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." (let* ((temp (copy-tree (with-parsed-tramp-file-name directory nil - (with-file-property + (with-tramp-file-property v localname (format "directory-files-and-attributes-%s" id-format) (save-excursion @@ -1987,7 +1989,7 @@ file names." (tramp-error v 'file-already-exists "File %s already exists" newname)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 0 (format "%s %s to %s" (if (eq op 'copy) "Copying" "Renaming") filename newname) @@ -2505,7 +2507,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." nil) ((and suffix (nth 2 suffix)) ;; We found an uncompression rule. - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 0 (format "Uncompressing %s" file) (when (tramp-send-command-and-check v (concat (nth 2 suffix) " " @@ -2517,7 +2519,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." (t ;; We don't recognize the file as compressed, so compress it. ;; Try gzip. - (tramp-with-progress-reporter v 0 (format "Compressing %s" file) + (with-tramp-progress-reporter v 0 (format "Compressing %s" file) (when (tramp-send-command-and-check v (concat "gzip -f " (tramp-shell-quote-argument localname))) @@ -2673,7 +2675,7 @@ the result will be a local, non-Tramp, filename." (string-match "\\`su\\(do\\)?\\'" method)) (setq uname (concat uname user))) (setq uname - (with-connection-property v uname + (with-tramp-connection-property v uname (tramp-send-command v (format "cd %s; pwd" (tramp-shell-quote-argument uname))) (with-current-buffer (tramp-get-buffer v) @@ -2943,7 +2945,7 @@ the result will be a local, non-Tramp, filename." ;; Use inline encoding for file transfer. (rem-enc (save-excursion - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Encoding remote file %s" filename) (tramp-barf-unless-okay v (format rem-enc (tramp-shell-quote-argument localname)) @@ -2957,7 +2959,7 @@ the result will be a local, non-Tramp, filename." (with-temp-buffer (set-buffer-multibyte nil) (insert-buffer-substring (tramp-get-buffer v)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Decoding remote file %s with function %s" filename loc-dec) (funcall loc-dec (point-min) (point-max)) @@ -2975,7 +2977,7 @@ the result will be a local, non-Tramp, filename." (let (file-name-handler-alist (coding-system-for-write 'binary)) (write-region (point-min) (point-max) tmpfile2)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Decoding remote file %s with command %s" filename loc-dec) (unwind-protect @@ -3203,7 +3205,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (set-buffer-multibyte nil) ;; Use encoding function or command. (if (functionp loc-enc) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Encoding region using function `%s'" loc-enc) (let ((coding-system-for-read 'binary)) @@ -3221,7 +3223,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (tramp-compat-temporary-file-directory))) (funcall loc-enc (point-min) (point-max)))) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Encoding region using command `%s'" loc-enc) (unless (zerop (tramp-call-local-coding-command @@ -3235,7 +3237,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." ;; Send buffer into remote decoding command which ;; writes to remote file. Because this happens on ;; the remote host, we cannot use the function. - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Decoding region into remote file %s" filename) (goto-char (point-max)) @@ -3335,7 +3337,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." "Like `vc-registered' for Tramp files." (tramp-compat-with-temp-message "" (with-parsed-tramp-file-name file nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Checking `vc-registered' for %s" file) ;; There could be new files, created by the vc backend. We @@ -3433,7 +3435,7 @@ Only send the definition if it has not already been done." (let ((scripts (tramp-get-connection-property (tramp-get-connection-process vec) "scripts" nil))) (unless (member name scripts) - (tramp-with-progress-reporter vec 5 (format "Sending script `%s'" name) + (with-tramp-progress-reporter vec 5 (format "Sending script `%s'" name) ;; The script could contain a call of Perl. This is masked with `%s'. (tramp-barf-unless-okay vec @@ -3602,7 +3604,7 @@ file exists and nonzero exit status otherwise." (defun tramp-open-shell (vec shell) "Opens shell SHELL." - (tramp-with-progress-reporter + (with-tramp-progress-reporter vec 5 (format "Opening remote shell `%s'" shell) ;; Find arguments for this shell. (let ((tramp-end-of-output tramp-initial-end-of-output) @@ -3638,7 +3640,7 @@ file exists and nonzero exit status otherwise." (tramp-file-name-method vec) 'tramp-remote-shell))) shell) (setq shell - (with-connection-property vec "remote-shell" + (with-tramp-connection-property vec "remote-shell" ;; CCC: "root" does not exist always, see QNAP 459. ;; Which check could we apply instead? (tramp-send-command vec "echo ~root" t) @@ -3673,7 +3675,7 @@ file exists and nonzero exit status otherwise." (tramp-open-shell vec shell)) ;; Busyboxes tend to behave strange. We check for the existence. - (with-connection-property vec "busybox" + (with-tramp-connection-property vec "busybox" (tramp-send-command vec (format "%s --version" shell) t) (let ((case-fold-search t)) (and (string-match "busybox" (buffer-string)) t)))))) @@ -3798,7 +3800,7 @@ process to set up. VEC specifies the connection." ;; successfully, sending 625 bytes failed. Emacs makes a hack when ;; this host type is detected locally. It cannot handle remote ;; hosts, though. - (with-connection-property proc "chunksize" + (with-tramp-connection-property proc "chunksize" (cond ((and (integerp tramp-chunksize) (> tramp-chunksize 0)) tramp-chunksize) @@ -4327,7 +4329,7 @@ connection if a previous connection has died for some reason." (when (and (boundp 'non-essential) (symbol-value 'non-essential)) (throw 'non-essential 'non-essential)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter vec 3 (if (zerop (length (tramp-file-name-user vec))) (format "Opening connection for %s using %s" @@ -4773,7 +4775,7 @@ This is used internally by `tramp-file-mode-from-int'." ;; Variables local to connection. (defun tramp-get-remote-path (vec) - (with-connection-property + (with-tramp-connection-property ;; When `tramp-own-remote-path' is in `tramp-remote-path', we ;; cache the result for the session only. Otherwise, the result ;; is cached persistently. @@ -4845,7 +4847,7 @@ This is used internally by `tramp-file-mode-from-int'." remote-path))))) (defun tramp-get-ls-command (vec) - (with-connection-property vec "ls" + (with-tramp-connection-property vec "ls" (tramp-message vec 5 "Finding a suitable `ls' command") (or (catch 'ls-found @@ -4871,7 +4873,7 @@ This is used internally by `tramp-file-mode-from-int'." (defun tramp-get-ls-command-with-dired (vec) (save-match-data - (with-connection-property vec "ls-dired" + (with-tramp-connection-property vec "ls-dired" (tramp-message vec 5 "Checking, whether `ls --dired' works") ;; Some "ls" versions are sensible wrt the order of arguments, ;; they fail when "-al" is after the "--dired" argument (for @@ -4880,7 +4882,7 @@ This is used internally by `tramp-file-mode-from-int'." vec (format "%s --dired -al /dev/null" (tramp-get-ls-command vec)))))) (defun tramp-get-test-command (vec) - (with-connection-property vec "test" + (with-tramp-connection-property vec "test" (tramp-message vec 5 "Finding a suitable `test' command") (if (tramp-send-command-and-check vec "test 0") "test" @@ -4890,7 +4892,7 @@ This is used internally by `tramp-file-mode-from-int'." ;; Does `test A -nt B' work? Use abominable `find' construct if it ;; doesn't. BSD/OS 4.0 wants the parentheses around the command, ;; for otherwise the shell crashes. - (with-connection-property vec "test-nt" + (with-tramp-connection-property vec "test-nt" (or (progn (tramp-send-command @@ -4908,17 +4910,17 @@ This is used internally by `tramp-file-mode-from-int'." "tramp_test_nt %s %s")))) (defun tramp-get-file-exists-command (vec) - (with-connection-property vec "file-exists" + (with-tramp-connection-property vec "file-exists" (tramp-message vec 5 "Finding command to check if file exists") (tramp-find-file-exists-command vec))) (defun tramp-get-remote-ln (vec) - (with-connection-property vec "ln" + (with-tramp-connection-property vec "ln" (tramp-message vec 5 "Finding a suitable `ln' command") (tramp-find-executable vec "ln" (tramp-get-remote-path vec)))) (defun tramp-get-remote-perl (vec) - (with-connection-property vec "perl" + (with-tramp-connection-property vec "perl" (tramp-message vec 5 "Finding a suitable `perl' command") (let ((result (or (tramp-find-executable vec "perl5" (tramp-get-remote-path vec)) @@ -4926,16 +4928,16 @@ This is used internally by `tramp-file-mode-from-int'." vec "perl" (tramp-get-remote-path vec))))) ;; We must check also for some Perl modules. (when result - (with-connection-property vec "perl-file-spec" + (with-tramp-connection-property vec "perl-file-spec" (tramp-send-command-and-check vec (format "%s -e 'use File::Spec;'" result))) - (with-connection-property vec "perl-cwd-realpath" + (with-tramp-connection-property vec "perl-cwd-realpath" (tramp-send-command-and-check vec (format "%s -e 'use Cwd \"realpath\";'" result)))) result))) (defun tramp-get-remote-stat (vec) - (with-connection-property vec "stat" + (with-tramp-connection-property vec "stat" (tramp-message vec 5 "Finding a suitable `stat' command") (let ((result (tramp-find-executable vec "stat" (tramp-get-remote-path vec))) @@ -4953,7 +4955,7 @@ This is used internally by `tramp-file-mode-from-int'." result))) (defun tramp-get-remote-readlink (vec) - (with-connection-property vec "readlink" + (with-tramp-connection-property vec "readlink" (tramp-message vec 5 "Finding a suitable `readlink' command") (let ((result (tramp-find-executable vec "readlink" (tramp-get-remote-path vec)))) @@ -4963,12 +4965,12 @@ This is used internally by `tramp-file-mode-from-int'." result)))) (defun tramp-get-remote-trash (vec) - (with-connection-property vec "trash" + (with-tramp-connection-property vec "trash" (tramp-message vec 5 "Finding a suitable `trash' command") (tramp-find-executable vec "trash" (tramp-get-remote-path vec)))) (defun tramp-get-remote-id (vec) - (with-connection-property vec "id" + (with-tramp-connection-property vec "id" (tramp-message vec 5 "Finding POSIX `id' command") (or (catch 'id-found @@ -4982,7 +4984,7 @@ This is used internally by `tramp-file-mode-from-int'." (tramp-error vec 'file-error "Couldn't find a POSIX `id' command")))) (defun tramp-get-remote-uid (vec id-format) - (with-connection-property vec (format "uid-%s" id-format) + (with-tramp-connection-property vec (format "uid-%s" id-format) (let ((res (tramp-send-command-and-read vec (format "%s -u%s %s" @@ -4994,7 +4996,7 @@ This is used internally by `tramp-file-mode-from-int'." (if (and (equal id-format 'integer) (not (integerp res))) -1 res)))) (defun tramp-get-remote-gid (vec id-format) - (with-connection-property vec (format "gid-%s" id-format) + (with-tramp-connection-property vec (format "gid-%s" id-format) (let ((res (tramp-send-command-and-read vec (format "%s -g%s %s" @@ -5020,7 +5022,7 @@ the length of the file to be compressed. If no corresponding command is found, nil is returned." (when (and (integerp tramp-inline-compress-start-size) (> size tramp-inline-compress-start-size)) - (with-connection-property (tramp-get-connection-process vec) prop + (with-tramp-connection-property (tramp-get-connection-process vec) prop (tramp-find-inline-compress vec) (tramp-get-connection-property (tramp-get-connection-process vec) prop nil)))) @@ -5041,7 +5043,8 @@ function cell is returned to be applied on a buffer." ;; no inline coding is found. (ignore-errors (let ((coding - (with-connection-property (tramp-get-connection-process vec) prop + (with-tramp-connection-property + (tramp-get-connection-process vec) prop (tramp-find-inline-encoding vec) (tramp-get-connection-property (tramp-get-connection-process vec) prop nil))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index f1d54b6fd3c..567f8f2969a 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -355,7 +355,7 @@ pass to the OPERATION." (let ((t1 (tramp-tramp-file-p dirname)) (t2 (tramp-tramp-file-p newname))) (with-parsed-tramp-file-name (if t1 dirname newname) nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 0 (format "Copying %s to %s" dirname newname) (cond ;; We must use a local temporary directory. @@ -491,7 +491,7 @@ KEEP-DATE has no effect in case NEWNAME resides on an SMB server. PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." (setq filename (expand-file-name filename) newname (expand-file-name newname)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) 0 (format "Copying %s to %s" filename newname) @@ -642,7 +642,8 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." (unless id-format (setq id-format 'integer)) (ignore-errors (with-parsed-tramp-file-name filename nil - (with-file-property v localname (format "file-attributes-%s" id-format) + (with-tramp-file-property + v localname (format "file-attributes-%s" id-format) (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v)) (tramp-smb-do-file-attributes-with-stat v id-format) ;; Reading just the filename entry via "dir localname" is not @@ -753,7 +754,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." v 'file-error "Cannot make local copy of non-existing file `%s'" filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Fetching %s to tmp file %s" filename tmpfile) (unless (tramp-smb-send-command v (format "get \"%s\" \"%s\"" @@ -771,7 +772,7 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." (all-completions filename (with-parsed-tramp-file-name directory nil - (with-file-property v localname "file-name-all-completions" + (with-tramp-file-property v localname "file-name-all-completions" (save-match-data (let ((entries (tramp-smb-get-file-entries directory))) (mapcar @@ -1119,7 +1120,7 @@ target of the symlink differ." (if (file-remote-p filename) filename newname)) 'file-already-exists newname)) - (tramp-with-progress-reporter + (with-tramp-progress-reporter (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) 0 (format "Renaming %s to %s" filename newname) @@ -1253,7 +1254,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (list start end tmpfile append 'no-message lockname confirm) (list start end tmpfile append 'no-message lockname))) - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Moving tmp file %s to %s" tmpfile filename) (unwind-protect (unless (tramp-smb-send-command @@ -1312,7 +1313,7 @@ Either the shares are listed, or the `dir' command is executed. Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." (with-parsed-tramp-file-name (file-name-as-directory directory) nil (setq localname (or localname "/")) - (with-file-property v localname "file-entries" + (with-tramp-file-property v localname "file-entries" (with-current-buffer (tramp-get-connection-buffer v) (let* ((share (tramp-smb-get-share v)) (cache (tramp-get-connection-property v "share-cache" nil)) @@ -1497,7 +1498,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." ;; When we are not logged in yet, we return nil. (if (let ((p (tramp-get-connection-process vec))) (and p (processp p) (memq (process-status p) '(run open)))) - (with-connection-property + (with-tramp-connection-property (tramp-get-connection-process vec) "cifs-capabilities" (save-match-data (when (tramp-smb-send-command vec "posix") @@ -1515,7 +1516,7 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." ;; When we are not logged in yet, we return nil. (if (let ((p (tramp-get-connection-process vec))) (and p (processp p) (memq (process-status p) '(run open)))) - (with-connection-property + (with-tramp-connection-property (tramp-get-connection-process vec) "stat-capability" (tramp-smb-send-command vec "stat .")))) @@ -1625,7 +1626,7 @@ If ARGUMENT is non-nil, use it as argument for (setq args (append args (list argument)))) ;; OK, let's go. - (tramp-with-progress-reporter + (with-tramp-progress-reporter vec 3 (format "Opening connection for //%s%s/%s" (if (not (zerop (length user))) (concat user "@") "") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b1532eb2ae4..874c0aa7fef 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1353,8 +1353,7 @@ ARGS to actually emit the message (if applicable)." "tramp-debug-message" "tramp-error" "tramp-error-with-buffer" - "tramp-message" - "tramp-with-progress-reporter") + "tramp-message") t) "$") fn))) @@ -1498,7 +1497,7 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (when (string-match message (or (current-message) "")) (tramp-compat-funcall 'progress-reporter-update reporter value)))) -(defmacro tramp-with-progress-reporter (vec level message &rest body) +(defmacro with-tramp-progress-reporter (vec level message &rest body) "Executes BODY, spinning a progress reporter with MESSAGE. If LEVEL does not fit for visible messages, or if this is a nested call of the macro, there are only traces without a visible @@ -1527,7 +1526,42 @@ progress reporter." (tramp-message ,vec ,level "%s...done" ,message)))) (tramp-compat-font-lock-add-keywords - 'emacs-lisp-mode '("\\<tramp-with-progress-reporter\\>")) + 'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>")) + +(defmacro with-tramp-file-property (vec file property &rest body) + "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. +FILE must be a local file name on a connection identified via VEC." + `(if (file-name-absolute-p ,file) + (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass @body as parameter to + ;; `tramp-set-file-property' because it mangles our + ;; debug messages. + (setq value (progn ,@body)) + (tramp-set-file-property ,vec ,file ,property value)) + value) + ,@body)) + +(put 'with-tramp-file-property 'lisp-indent-function 3) +(put 'with-tramp-file-property 'edebug-form-spec t) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\<with-tramp-file-property\\>")) + +(defmacro with-tramp-connection-property (key property &rest body) + "Check in Tramp for property PROPERTY, otherwise executes BODY and set." + `(let ((value (tramp-get-connection-property ,key ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass ,@body as parameter to + ;; `tramp-set-connection-property' because it mangles our debug + ;; messages. + (setq value (progn ,@body)) + (tramp-set-connection-property ,key ,property value)) + value)) + +(put 'with-tramp-connection-property 'lisp-indent-function 2) +(put 'with-tramp-connection-property 'edebug-form-spec t) +(tramp-compat-font-lock-add-keywords + 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>")) (defalias 'tramp-drop-volume-letter (if (memq system-type '(cygwin windows-nt)) @@ -2860,7 +2894,7 @@ User is always nil." (setq filename (expand-file-name filename)) (let (result local-copy remote-copy) (with-parsed-tramp-file-name filename nil - (tramp-with-progress-reporter + (with-tramp-progress-reporter v 3 (format "Inserting `%s'" filename) (unwind-protect (if (not (file-exists-p filename)) @@ -2983,7 +3017,7 @@ User is always nil." (if (not (file-exists-p file)) nil (let ((tramp-message-show-message (not nomessage))) - (tramp-with-progress-reporter v 0 (format "Loading %s" file) + (with-tramp-progress-reporter v 0 (format "Loading %s" file) (let ((local-copy (file-local-copy file))) ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil. (unwind-protect @@ -3127,7 +3161,7 @@ beginning of local filename are not substituted." "Send the login name." (when (not (stringp tramp-current-user)) (setq tramp-current-user - (with-connection-property vec "login-as" + (with-tramp-connection-property vec "login-as" (save-window-excursion (let ((enable-recursive-minibuffers t)) (pop-to-buffer (tramp-get-connection-buffer vec)) @@ -3417,13 +3451,13 @@ the remote host use line-endings as defined in the variable (defun tramp-get-inode (vec) "Returns the virtual inode number. If it doesn't exist, generate a new one." - (with-file-property vec (tramp-file-name-localname vec) "inode" + (with-tramp-file-property vec (tramp-file-name-localname vec) "inode" (setq tramp-inodes (1+ tramp-inodes)))) (defun tramp-get-device (vec) "Returns the virtual device number. If it doesn't exist, generate a new one." - (with-connection-property (tramp-get-connection-process vec) "device" + (with-tramp-connection-property (tramp-get-connection-process vec) "device" (cons -1 (setq tramp-devices (1+ tramp-devices))))) (defun tramp-equal-remote (file1 file2) @@ -3545,7 +3579,7 @@ would yield `t'. On the other hand, the following check results in nil: (defun tramp-get-remote-tmpdir (vec) "Return directory for temporary files on the remote host identified by VEC." - (with-connection-property vec "tmpdir" + (with-tramp-connection-property vec "tmpdir" (let ((dir (tramp-make-tramp-file-name (tramp-file-name-method vec) (tramp-file-name-user vec) @@ -3833,7 +3867,6 @@ Only works for Bourne-like shells." ;; * In Emacs 21, `insert-directory' shows total number of bytes used ;; by the files in that directory. Add this here. ;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman) -;; * Make ffap.el grok Tramp filenames. (Eli Tziperman) ;; * abbreviate-file-name ;; * Better error checking. At least whenever we see something ;; strange when doing zerop, we should kill the process and start diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 2d0a8e3d23d..331884691f4 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -31,7 +31,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.6" +(defconst tramp-version "2.2.7-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -44,7 +44,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.6 is not fit for %s" + (format "Tramp 2.2.7-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 6d2eed71948..a754c89c4ae 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -117,20 +117,20 @@ Comments might be indented to a different value in order not to go beyond If there are any \\(...\\) pairs, the comment delimiter text is held to begin at the place matched by the close of the first pair.") ;;;###autoload -(put 'comment-start-skip 'safe-local-variable 'string-or-null-p) +(put 'comment-start-skip 'safe-local-variable 'stringp) ;;;###autoload (defvar comment-end-skip nil "Regexp to match the end of a comment plus everything back to its body.") ;;;###autoload -(put 'comment-end-skip 'safe-local-variable 'string-or-null-p) +(put 'comment-end-skip 'safe-local-variable 'stringp) ;;;###autoload (defvar comment-end (purecopy "") "String to insert to end a new comment. Should be an empty string if comments are terminated by end-of-line.") ;;;###autoload -(put 'comment-end 'safe-local-variable 'string-or-null-p) +(put 'comment-end 'safe-local-variable 'stringp) ;;;###autoload (defvar comment-indent-function 'comment-indent-default @@ -327,9 +327,9 @@ terminated by the end of line (i.e. `comment-end' is empty)." ;;;###autoload (defun comment-normalize-vars (&optional noerror) "Check and setup the variables needed by other commenting functions. -Any command calling functions from newcomment.el, being entry points, should -call this function before any other, so the rest of the code can assume that -the variables are properly set." +Any command calling functions from newcomment.el should call this function +before any other, so the rest of the code can assume that the variables are +properly set." (unless (and (not comment-start) noerror) (unless comment-start (let ((cs (read-string "No comment syntax is defined. Use: "))) diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index bd9805673a4..4236f1c983f 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -338,30 +338,6 @@ at compile time, e.g. for macros and inline functions." (cc-bytecomp-debug-msg "cc-bytecomp-defun: Covered function %s" ',fun)))))) -(put 'cc-bytecomp-defmacro 'lisp-indent-function 'defun) -(defmacro cc-bytecomp-defmacro (fun &rest temp-macro) - "Bind the symbol as a macro during compilation (and evaluation) of the -file. Don't use outside `eval-when-compile'." - `(let ((orig-fun (assq ',fun cc-bytecomp-original-functions))) - (if (not orig-fun) - (setq orig-fun - (list ',fun - nil - (if (fboundp ',fun) - (progn - (cc-bytecomp-debug-msg - "cc-bytecomp-defmacro: Saving %s" ',fun) - (symbol-function ',fun)) - (cc-bytecomp-debug-msg - "cc-bytecomp-defmacro: Saving %s as unbound" ',fun) - 'unbound)) - cc-bytecomp-original-functions - (cons orig-fun cc-bytecomp-original-functions))) - (defmacro ,fun ,@temp-macro) - (cc-bytecomp-debug-msg - "cc-bytecomp-defmacro: Bound macro %s" ',fun) - (setcar (cdr orig-fun) (symbol-function ',fun)))) - (defmacro cc-bytecomp-put (symbol propname value) "Set a property on a symbol during compilation (and evaluation) of the file. Don't use outside `eval-when-compile'." diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 5201e4a26ed..d56c1124a9c 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -49,16 +49,6 @@ (require 'custom) (require 'widget)) -(cc-eval-when-compile - ;; Need the function form of `backquote', which isn't standardized - ;; between Emacsen. It's called `bq-process' in XEmacs, and - ;; `backquote-process' in Emacs. `backquote-process' returns a - ;; slightly more convoluted form, so let `bq-process' be the norm. - (if (fboundp 'backquote-process) - (cc-bytecomp-defmacro bq-process (form) - `(cdr (backquote-process ,form))))) - - ;;; Helpers ;; This widget exists in newer versions of the Custom library diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 6b0dc954ca7..5bf64c18f99 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -235,6 +235,9 @@ (substitute-key-definition 'forward-sentence 'python-nav-forward-block map global-map) + (substitute-key-definition 'backward-up-list + 'python-nav-backward-up-list + map global-map) (define-key map "\C-c\C-j" 'imenu) ;; Indent specific (define-key map "\177" 'python-indent-dedent-line-backspace) @@ -337,19 +340,28 @@ "==" ">=" "is" "not"))) ;; FIXME: Use regexp-opt. (assignment-operator . ,(rx (or "=" "+=" "-=" "*=" "/=" "//=" "%=" "**=" - ">>=" "<<=" "&=" "^=" "|=")))) - "Additional Python specific sexps for `python-rx'")) - -(defmacro python-rx (&rest regexps) - "Python mode specialized rx macro. + ">>=" "<<=" "&=" "^=" "|="))) + (string-delimiter . ,(rx (and + ;; Match even number of backslashes. + (or (not (any ?\\ ?\' ?\")) point + ;; Quotes might be preceded by a escaped quote. + (and (or (not (any ?\\)) point) ?\\ + (* ?\\ ?\\) (any ?\' ?\"))) + (* ?\\ ?\\) + ;; Match single or triple quotes of any kind. + (group (or "\"" "\"\"\"" "'" "'''")))))) + "Additional Python specific sexps for `python-rx'") + + (defmacro python-rx (&rest regexps) + "Python mode specialized rx macro. This variant of `rx' supports common python named REGEXPS." - (let ((rx-constituents (append python-rx-constituents rx-constituents))) - (cond ((null regexps) - (error "No regexp")) - ((cdr regexps) - (rx-to-string `(and ,@regexps) t)) - (t - (rx-to-string (car regexps) t))))) + (let ((rx-constituents (append python-rx-constituents rx-constituents))) + (cond ((null regexps) + (error "No regexp")) + ((cdr regexps) + (rx-to-string `(and ,@regexps) t)) + (t + (rx-to-string (car regexps) t)))))) ;;; Font-lock and syntax @@ -498,16 +510,7 @@ The type returned can be `comment', `string' or `paren'." (defconst python-syntax-propertize-function (syntax-propertize-rules - ((rx - (and - ;; Match even number of backslashes. - (or (not (any ?\\ ?\' ?\")) point - ;; Quotes might be preceded by a escaped quote. - (and (or (not (any ?\\)) point) ?\\ - (* ?\\ ?\\) (any ?\' ?\"))) - (* ?\\ ?\\) - ;; Match single or triple quotes of any kind. - (group (or "\"" "\"\"\"" "'" "'''")))) + ((python-rx string-delimiter) (0 (ignore (python-syntax-stringify)))))) (defsubst python-syntax-count-quotes (quote-char &optional point limit) @@ -1409,6 +1412,67 @@ move backward N times." (python-nav--backward-sexp) (setq arg (1+ arg)))) +(defun python-nav--up-list (&optional dir) + "Internal implementation of `python-nav-up-list'. +DIR is always 1 or -1 and comes sanitized from +`python-nav-up-list' calls." + (let ((context (python-syntax-context-type)) + (forward-p (> dir 0))) + (cond + ((memq context '(string comment))) + ((eq context 'paren) + (let ((forward-sexp-function)) + (up-list dir))) + ((and forward-p (python-info-end-of-block-p)) + (let ((parent-end-pos + (save-excursion + (let ((indentation (and + (python-nav-beginning-of-block) + (current-indentation)))) + (while (and indentation + (> indentation 0) + (>= (current-indentation) indentation) + (python-nav-backward-block))) + (python-nav-end-of-block))))) + (and (> (or parent-end-pos (point)) (point)) + (goto-char parent-end-pos)))) + (forward-p (python-nav-end-of-block)) + ((and (not forward-p) + (> (current-indentation) 0) + (python-info-beginning-of-block-p)) + (let ((prev-block-pos + (save-excursion + (let ((indentation (current-indentation))) + (while (and (python-nav-backward-block) + (> (current-indentation) indentation)))) + (point)))) + (and (> (point) prev-block-pos) + (goto-char prev-block-pos)))) + ((not forward-p) (python-nav-beginning-of-block))))) + +(defun python-nav-up-list (&optional arg) + "Move forward out of one level of parentheses (or blocks). +With ARG, do this that many times. +A negative argument means move backward but still to a less deep spot. +This command assumes point is not in a string or comment." + (interactive "^p") + (or arg (setq arg 1)) + (while (> arg 0) + (python-nav--up-list 1) + (setq arg (1- arg))) + (while (< arg 0) + (python-nav--up-list -1) + (setq arg (1+ arg)))) + +(defun python-nav-backward-up-list (&optional arg) + "Move backward out of one level of parentheses (or blocks). +With ARG, do this that many times. +A negative argument means move backward but still to a less deep spot. +This command assumes point is not in a string or comment." + (interactive "^p") + (or arg (setq arg 1)) + (python-nav-up-list (- arg))) + ;;; Shell integration @@ -1609,6 +1673,20 @@ OUTPUT is a string with the contents of the buffer." (defvar python-shell--parent-buffer nil) +(defvar python-shell-output-syntax-table + (let ((table (make-syntax-table python-dotty-syntax-table))) + (modify-syntax-entry ?\' "." table) + (modify-syntax-entry ?\" "." table) + (modify-syntax-entry ?\( "." table) + (modify-syntax-entry ?\[ "." table) + (modify-syntax-entry ?\{ "." table) + (modify-syntax-entry ?\) "." table) + (modify-syntax-entry ?\] "." table) + (modify-syntax-entry ?\} "." table) + table) + "Syntax table for shell output. +It makes parens and quotes be treated as punctuation chars.") + (define-derived-mode inferior-python-mode comint-mode "Inferior Python" "Major mode for Python inferior process. Runs a Python interpreter as a subprocess of Emacs, with Python @@ -1637,7 +1715,6 @@ variable. python-shell-prompt-regexp python-shell-prompt-block-regexp python-shell-prompt-pdb-regexp)) - (set-syntax-table python-mode-syntax-table) (setq mode-line-process '(":%s")) (make-local-variable 'comint-output-filter-functions) (add-hook 'comint-output-filter-functions @@ -1658,10 +1735,21 @@ variable. (make-local-variable 'python-pdbtrack-tracked-buffer) (make-local-variable 'python-shell-internal-last-output) (when python-shell-enable-font-lock + (set-syntax-table python-mode-syntax-table) (set (make-local-variable 'font-lock-defaults) '(python-font-lock-keywords nil nil nil nil)) (set (make-local-variable 'syntax-propertize-function) - python-syntax-propertize-function)) + (syntax-propertize-rules + (comint-prompt-regexp + (0 (ignore + (put-text-property + comint-last-input-start end 'syntax-table + python-shell-output-syntax-table) + (font-lock-unfontify-region comint-last-input-start end)))) + ((python-rx string-delimiter) + (0 (ignore + (and (not (eq (get-text-property start 'field) 'output)) + (python-syntax-stringify)))))))) (compilation-shell-minor-mode 1)) (defun python-shell-make-comint (cmd proc-name &optional pop internal) @@ -1842,7 +1930,9 @@ detecting a prompt at the end of the buffer." python-shell-output-filter-buffer (concat python-shell-output-filter-buffer string)) (when (string-match - (format "\n\\(?:%s\\|%s\\|%s\\)$" + ;; XXX: It seems on OSX an extra carriage return is attached + ;; at the end of output, this handles that too. + (format "\r?\n\\(?:%s\\|%s\\|%s\\)$" python-shell-prompt-regexp python-shell-prompt-block-regexp python-shell-prompt-pdb-regexp) @@ -2246,28 +2336,28 @@ inferior python process is updated properly." (defcustom python-fill-comment-function 'python-fill-comment "Function to fill comments. -This is the function used by `python-fill-paragraph-function' to +This is the function used by `python-fill-paragraph' to fill comments." :type 'symbol :group 'python) (defcustom python-fill-string-function 'python-fill-string "Function to fill strings. -This is the function used by `python-fill-paragraph-function' to +This is the function used by `python-fill-paragraph' to fill strings." :type 'symbol :group 'python) (defcustom python-fill-decorator-function 'python-fill-decorator "Function to fill decorators. -This is the function used by `python-fill-paragraph-function' to +This is the function used by `python-fill-paragraph' to fill decorators." :type 'symbol :group 'python) (defcustom python-fill-paren-function 'python-fill-paren "Function to fill parens. -This is the function used by `python-fill-paragraph-function' to +This is the function used by `python-fill-paragraph' to fill parens." :type 'symbol :group 'python) @@ -2344,7 +2434,7 @@ SYMMETRIC: :safe (lambda (val) (memq val '(django onetwo pep-257 pep-257-nn symmetric nil)))) -(defun python-fill-paragraph-function (&optional justify) +(defun python-fill-paragraph (&optional justify) "`fill-paragraph-function' handling multi-line strings and possibly comments. If any of the current line is in or at the end of a multi-line string, fill the string or the paragraph of it that point is in, preserving @@ -2363,8 +2453,7 @@ Optional argument JUSTIFY defines if the paragraph should be justified." (funcall python-fill-string-function justify)) ;; Decorators ((equal (char-after (save-excursion - (back-to-indentation) - (point))) ?@) + (python-nav-beginning-of-statement))) ?@) (funcall python-fill-decorator-function justify)) ;; Parens ((or (python-syntax-context 'paren) @@ -2376,12 +2465,12 @@ Optional argument JUSTIFY defines if the paragraph should be justified." (t t)))) (defun python-fill-comment (&optional justify) - "Comment fill function for `python-fill-paragraph-function'. + "Comment fill function for `python-fill-paragraph'. JUSTIFY should be used (if applicable) as in `fill-paragraph'." (fill-comment-paragraph justify)) (defun python-fill-string (&optional justify) - "String fill function for `python-fill-paragraph-function'. + "String fill function for `python-fill-paragraph'. JUSTIFY should be used (if applicable) as in `fill-paragraph'." (let* ((marker (point-marker)) (str-start-pos @@ -2451,12 +2540,12 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (indent-according-to-mode))))) t) (defun python-fill-decorator (&optional justify) - "Decorator fill function for `python-fill-paragraph-function'. + "Decorator fill function for `python-fill-paragraph'. JUSTIFY should be used (if applicable) as in `fill-paragraph'." t) (defun python-fill-paren (&optional justify) - "Paren fill function for `python-fill-paragraph-function'. + "Paren fill function for `python-fill-paragraph'. JUSTIFY should be used (if applicable) as in `fill-paragraph'." (save-restriction (narrow-to-region (progn @@ -3107,7 +3196,7 @@ if that value is non-nil." (set (make-local-variable 'paragraph-start) "\\s-*$") (set (make-local-variable 'fill-paragraph-function) - 'python-fill-paragraph-function) + 'python-fill-paragraph) (set (make-local-variable 'beginning-of-defun-function) #'python-beginning-of-defun-function) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 841a45c23a2..ad6e1125027 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -89,7 +89,7 @@ (make-obsolete 'w32-default-color-map nil "24.1") (declare-function w32-send-sys-command "w32fns.c") -(declare-function set-message-beep "w32console.c") +(declare-function set-message-beep "w32fns.c") ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles (if (fboundp 'new-fontset) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 813a8fd4d96..5d9b68e9de5 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -32,7 +32,7 @@ ;;;; Function keys -(declare-function set-message-beep "w32console.c") +(declare-function set-message-beep "w32fns.c") (declare-function w32-get-locale-info "w32proc.c") (declare-function w32-get-valid-locale-ids "w32proc.c") diff --git a/nt/ChangeLog b/nt/ChangeLog index b0dcb9982f1..e659b87eb76 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,8 @@ +2012-10-08 Juanma Barranquero <lekktu@gmail.com> + + * config.nt: Sync with autogen/config.in. + (HAVE_NTGUI): New macro. + 2012-10-02 Eli Zaretskii <eliz@gnu.org> * preprep.c (RVA_TO_PTR): Cast the result to 'void *', to avoid diff --git a/nt/config.nt b/nt/config.nt index e342c78e20f..cd695bc4e34 100644 --- a/nt/config.nt +++ b/nt/config.nt @@ -701,6 +701,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ Mac OS X. */ #undef HAVE_NS +/* Define to use native Windows GUI. */ +#define HAVE_NTGUI 1 + /* Define to 1 if libotf has OTF_get_variation_glyphs. */ #undef HAVE_OTF_GET_VARIATION_GLYPHS diff --git a/src/ChangeLog b/src/ChangeLog index d0670d05af3..25a4e92a1ca 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,15 +1,52 @@ +2012-10-09 Eli Zaretskii <eliz@gnu.org> + + * w32fns.c (w32_last_error): Change the return value to DWORD, to + match what GetLastError returns. Explain why the function is + needed. + + * frame.c (delete_frame): Rename local variable 'tooltip_frame' to + 'is_tooltip_frame', to avoid confusion with its global namesake. + +2012-10-08 Daniel Colascione <dancol@dancol.org> + + * xdisp.c (start_hourglass): Call w32_note_current_window when + HAVE_NTGUI, not just WINDOWSNT, resolving a problem in the cygw32 + build that caused Emacs to display the hourglass cursor forever. + + * w32fns.c (Fx_display_color_cells): Instead of using NCOLORS, + which is broken under remote desktop, calculate the number of + colors available for a display based on the display's number of + planes and number of bits per pixel per plane. (bug#10397). + +2012-10-08 Jan Djärv <jan.h.d@swipnet.se> + + * nsfont.m (Vfonts_in_cache): New variable. + (nsfont_open): Use unsignedLongLongValue for cache in case wide ints + are used. Add cached fonts to Vfonts_in_cache. + (syms_of_nsfont): Initialize and staticpro Vfonts_in_cache. + +2012-10-08 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in (LOCAL_FLAGS): Don't define HAVE_NTGUI, it's now + in nt/config.nt. + (FONT_H): Define after FRAME_H. + ($(BLD)/emacs.$(O), $(BLD)/process.$(O), $(BLD)/w32heap.$(O)): + Update dependencies. + + * w32term.c: Remove leftover declaration of keyboard_codepage. + 2012-10-08 Eli Zaretskii <eliz@gnu.org> * makefile.w32-in (FONT_H): Add $(FRAME_H). (W32TERM_H): Add $(ATIMER_H) and $(FRAME_H). ($(BLD)/emacs.$(O), $(BLD)/w32console.$(O)): Update dependencies. (GLOBAL_SOURCES): Add cygw32.c. - ($(BLD)/unexw32.$(O)): - ($(BLD)/w32.$(O)): - ($(BLD)/w32console.$(O)): - ($(BLD)/w32fns.$(O)): - ($(BLD)/w32heap.$(O)): - ($(BLD)/w32menu.$(O)): + ($(BLD)/unexw32.$(O)): + ($(BLD)/w32.$(O)): + ($(BLD)/w32console.$(O)): + ($(BLD)/w32fns.$(O)): + ($(BLD)/w32heap.$(O)): + ($(BLD)/w32menu.$(O)): ($(BLD)/w32proc.$(O)): Add w32common.h. * w32fns.c (w32_color_map_lookup, x_to_w32_color): Argument is now diff --git a/src/conf_post.h b/src/conf_post.h index 53fc941f464..aa008107ba6 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -142,19 +142,19 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ #endif #endif -#if defined(HAVE_NTGUI) && !defined(DebPrint) -# if defined(EMACSDEBUG) +#if defined HAVE_NTGUI && !defined DebPrint +# ifdef EMACSDEBUG extern void _DebPrint (const char *fmt, ...); # define DebPrint(stuff) _DebPrint stuff # else # define DebPrint(stuff) -# endif /* EMACSDEBUG */ -#endif /* DebPrint */ +# endif +#endif -#if defined(CYGWIN) && defined(HAVE_NTGUI) -#define NTGUI_UNICODE /* Cygwin runs only on UNICODE-supporting systems */ -#define _WIN32_WINNT 0x500 /* Win2k */ -#endif /* CYGWIN && HAVE_NTGUI */ +#if defined CYGWIN && defined HAVE_NTGUI +# define NTGUI_UNICODE /* Cygwin runs only on UNICODE-supporting systems */ +# define _WIN32_WINNT 0x500 /* Win2k */ +#endif #ifdef emacs /* Don't do this for lib-src. */ /* Tell regex.c to use a type compatible with Emacs. */ diff --git a/src/emacs.c b/src/emacs.c index 1d416984d2d..c84da7411ad 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -34,18 +34,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #ifdef WINDOWSNT #include <fcntl.h> #include "w32.h" -#endif - -#if defined (WINDOWSNT) #include "w32heap.h" #endif -#if defined (WINDOWSNT) || defined (HAVE_NTGUI) +#if defined WINDOWSNT || defined HAVE_NTGUI #include "w32select.h" #include "w32font.h" #endif -#if defined (HAVE_NTGUI) && defined (CYGWIN) +#if defined HAVE_NTGUI && defined CYGWIN #include "cygw32.h" #endif @@ -179,7 +176,7 @@ static uprintmax_t heap_bss_diff; We mark being in the exec'd process by a daemon name argument of form "--daemon=\nFD0,FD1\nNAME" where FD are the pipe file descriptors, NAME is the original daemon name, if any. */ -#if defined (NS_IMPL_COCOA) || (defined (HAVE_NTGUI) && defined (CYGWIN)) +#if defined NS_IMPL_COCOA || (defined HAVE_NTGUI && defined CYGWIN) # define DAEMON_MUST_EXEC #endif @@ -698,7 +695,7 @@ main (int argc, char **argv) char *dname_arg = 0; #ifdef DAEMON_MUST_EXEC char dname_arg2[80]; -#endif /* DAEMON_MUST_EXEC */ +#endif char *ch_to_dir; #if GC_MARK_STACK @@ -1378,9 +1375,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #ifdef WINDOWSNT syms_of_ntproc (); #endif /* WINDOWSNT */ -#if defined (CYGWIN) && defined (HAVE_NTGUI) +#if defined CYGWIN && defined HAVE_NTGUI syms_of_cygw32 (); -#endif /* defined(CYGWIN) && defined (HAVE_NTGUI) */ +#endif syms_of_window (); syms_of_xdisp (); syms_of_font (); @@ -1415,9 +1412,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_fontset (); #endif /* HAVE_NTGUI */ -#if defined (WINDOWSNT) || defined (HAVE_NTGUI) +#if defined WINDOWSNT || defined HAVE_NTGUI syms_of_w32select (); -#endif /* WINDOWSNT || HAVE_NTGUI */ +#endif #ifdef MSDOS syms_of_xmenu (); @@ -1466,10 +1463,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem globals_of_w32menu (); #endif /* HAVE_NTGUI */ -#if defined (WINDOWSNT) || defined (HAVE_NTGUI) +#if defined WINDOWSNT || defined HAVE_NTGUI globals_of_w32select (); -#endif /* WINDOWSNT || HAVE_NTGUI */ - +#endif } init_charset (); diff --git a/src/frame.c b/src/frame.c index 599d8879169..017d051fc1d 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1124,7 +1124,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) struct frame *sf = SELECTED_FRAME (); struct kboard *kb; - int minibuffer_selected, tooltip_frame; + int minibuffer_selected, is_tooltip_frame; if (EQ (frame, Qnil)) { @@ -1176,13 +1176,13 @@ delete_frame (Lisp_Object frame, Lisp_Object force) } } - tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip"))); + is_tooltip_frame = !NILP (Fframe_parameter (frame, intern ("tooltip"))); /* Run `delete-frame-functions' unless FORCE is `noelisp' or frame is a tooltip. FORCE is set to `noelisp' when handling a disconnect from the terminal, so we don't dare call Lisp code. */ - if (NILP (Vrun_hooks) || tooltip_frame) + if (NILP (Vrun_hooks) || is_tooltip_frame) ; else if (EQ (force, Qnoelisp)) pending_funcalls @@ -1461,7 +1461,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) } /* Cause frame titles to update--necessary if we now have just one frame. */ - if (!tooltip_frame) + if (!is_tooltip_frame) update_mode_lines = 1; return Qnil; diff --git a/src/image.c b/src/image.c index 6058bdf444c..9b41cf74993 100644 --- a/src/image.c +++ b/src/image.c @@ -75,11 +75,12 @@ typedef struct x_bitmap_record Bitmap_Record; #endif /* HAVE_X_WINDOWS */ #ifdef HAVE_NTGUI -# ifdef WINDOWSNT -/* We only need (or want) w32.h when we're _not_ - * compiling for Cygwin */ + +/* We need (or want) w32.h only when we're _not_ compiling for Cygwin. */ +#ifdef WINDOWSNT # include "w32.h" -# endif /* WINDOWSNT */ +#endif + /* W32_TODO : Color tables on W32. */ #undef COLOR_TABLE_SUPPORT @@ -571,7 +572,7 @@ extern Lisp_Object Vlibrary_cache; do { Vlibrary_cache = Fcons (Fcons (type, status), Vlibrary_cache); } while (0) #else #define CACHE_IMAGE_TYPE(type, status) -#endif /* WINDOWSNT */ +#endif #define ADD_IMAGE_TYPE(type) \ do { Vimage_types = Fcons (type, Vimage_types); } while (0) @@ -594,7 +595,7 @@ define_image_type (struct image_type *type) if (type->init) { -#if defined (HAVE_NTGUI) && defined (WINDOWSNT) +#if defined HAVE_NTGUI && defined WINDOWSNT /* If we failed to load the library before, don't try again. */ Lisp_Object tested = Fassq (target_type, Vlibrary_cache); if (CONSP (tested) && NILP (XCDR (tested))) @@ -3013,7 +3014,7 @@ static const struct image_keyword xpm_format[XPM_LAST] = {":background", IMAGE_STRING_OR_NIL_VALUE, 0} }; -#if defined(HAVE_NTGUI) && defined(WINDOWSNT) +#if defined HAVE_NTGUI && defined WINDOWSNT static bool init_xpm_functions (void); #else #define init_xpm_functions NULL @@ -3240,7 +3241,7 @@ init_xpm_functions (void) #endif /* WINDOWSNT */ -#if defined (HAVE_NTGUI) && !defined (WINDOWSNT) +#if defined HAVE_NTGUI && !defined WINDOWSNT /* Glue for code below */ #define fn_XpmReadFileToImage XpmReadFileToImage #define fn_XpmCreateImageFromBuffer XpmCreateImageFromBuffer @@ -5352,7 +5353,7 @@ static const struct image_keyword png_format[PNG_LAST] = {":background", IMAGE_STRING_OR_NIL_VALUE, 0} }; -#if defined(HAVE_NTGUI) && defined (WINDOWSNT) +#if defined HAVE_NTGUI && defined WINDOWSNT static bool init_png_functions (void); #else #define init_png_functions NULL @@ -6011,7 +6012,7 @@ static const struct image_keyword jpeg_format[JPEG_LAST] = {":background", IMAGE_STRING_OR_NIL_VALUE, 0} }; -#if defined(HAVE_NTGUI) && defined(WINDOWSNT) +#if defined HAVE_NTGUI && defined WINDOWSNT static bool init_jpeg_functions (void); #else #define init_jpeg_functions NULL @@ -6075,7 +6076,7 @@ jpeg_image_p (Lisp_Object object) different name. This name, jpeg_boolean, remains in effect through the rest of image.c. */ -#if defined (CYGWIN) && defined (HAVE_NTGUI) +#if defined CYGWIN && defined HAVE_NTGUI #define boolean jpeg_boolean #endif #include <jpeglib.h> @@ -7071,7 +7072,7 @@ static const struct image_keyword gif_format[GIF_LAST] = {":background", IMAGE_STRING_OR_NIL_VALUE, 0} }; -#if defined(HAVE_NTGUI) && defined(WINDOWSNT) +#if defined HAVE_NTGUI && defined WINDOWSNT static bool init_gif_functions (void); #else #define init_gif_functions NULL diff --git a/src/keyboard.c b/src/keyboard.c index 8316223cd28..2a37e510ba4 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -313,7 +313,7 @@ static Lisp_Object Qmouse_fixup_help_message; /* Symbols to denote kinds of events. */ static Lisp_Object Qfunction_key; Lisp_Object Qmouse_click; -#if defined (HAVE_NTGUI) +#ifdef HAVE_NTGUI Lisp_Object Qlanguage_change; #ifdef WINDOWSNT Lisp_Object Qfile_notify; @@ -3950,7 +3950,7 @@ kbd_buffer_get_event (KBOARD **kbp, x_activate_menubar (XFRAME (event->frame_or_window)); } #endif -#if defined (HAVE_NTGUI) +#ifdef HAVE_NTGUI else if (event->kind == LANGUAGE_CHANGE_EVENT) { /* Make an event (language-change (FRAME CODEPAGE LANGUAGE-ID)). */ @@ -11407,7 +11407,7 @@ syms_of_keyboard (void) DEFSYM (Qconfig_changed_event, "config-changed-event"); DEFSYM (Qmenu_enable, "menu-enable"); -#if defined (HAVE_NTGUI) +#ifdef HAVE_NTGUI DEFSYM (Qlanguage_change, "language-change"); DEFSYM (Qfile_notify, "file-notify"); #endif diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 29b7925f1b9..f96f765a7fa 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -27,7 +27,7 @@ EMACSLOADPATH=$(CURDIR)/../lisp # Size in MBs of the static heap in temacs.exe. HEAPSIZE = $(EMACS_HEAPSIZE) -LOCAL_FLAGS = -Demacs=1 -I../lib -I../nt/inc -DHAVE_NTGUI=1 $(EMACS_EXTRA_C_FLAGS) +LOCAL_FLAGS = -Demacs=1 -I../lib -I../nt/inc $(EMACS_EXTRA_C_FLAGS) SRC = . EMACS = $(BLD)/emacs.exe @@ -424,11 +424,11 @@ DISPEXTERN_H = $(SRC)/dispextern.h \ $(W32GUI_H) FILEMODE_H = $(GNU_LIB)/filemode.h \ $(NT_INC)/sys/stat.h -FONT_H = $(SRC)/font.h \ - $(FRAME_H) \ - $(CCL_H) FRAME_H = $(SRC)/frame.h \ $(DISPEXTERN_H) +FONT_H = $(SRC)/font.h \ + $(CCL_H) \ + $(FRAME_H) FTOASTR_H = $(GNU_LIB)/ftoastr.h \ $(GNU_LIB)/intprops.h GRP_H = $(NT_INC)/grp.h \ @@ -801,7 +801,6 @@ $(BLD)/emacs.$(O) : \ $(SRC)/w32.h \ $(SRC)/w32heap.h \ $(SRC)/w32select.h \ - $(SRC)/w32font.h \ $(NT_INC)/sys/file.h \ $(NT_INC)/unistd.h \ $(GNU_LIB)/ignore-value.h \ @@ -817,6 +816,7 @@ $(BLD)/emacs.$(O) : \ $(SYSSIGNAL_H) \ $(SYSTTY_H) \ $(TERMHOOKS_H) \ + $(W32FONT_H) \ $(W32TERM_H) \ $(WINDOW_H) @@ -1191,8 +1191,8 @@ $(BLD)/w32.$(O) : \ $(BLD)/w32heap.$(O) : \ $(SRC)/w32heap.c \ - $(SRC)/w32heap.h \ $(SRC)/w32common.h \ + $(SRC)/w32heap.h \ $(CONFIG_H) \ $(LISP_H) diff --git a/src/nsfont.m b/src/nsfont.m index b13c96aa6ed..20a8f5d4028 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -53,6 +53,9 @@ extern float ns_antialias_threshold; extern int ns_tmp_flags; extern struct nsfont_info *ns_tmp_font; +static Lisp_Object Vfonts_in_cache; + + /* font glyph and metrics caching functions, implemented at end */ static void ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block); @@ -799,8 +802,7 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size) { if (NSFONT_TRACE) fprintf(stderr, "*** nsfont_open CACHE HIT!\n"); - /* FIXME: Cast from (unsigned long) to Lisp_Object. */ - XHASH (font_object) = [cached unsignedLongValue]; + XHASH (font_object) = [cached unsignedLongLongValue]; return font_object; } else @@ -808,9 +810,13 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size) font_object = font_make_object (VECSIZE (struct nsfont_info), font_entity, pixel_size); if (!synthItal) - [fontCache setObject: [NSNumber numberWithUnsignedLong: - (unsigned long) XHASH (font_object)] - forKey: nsfont]; + { + [fontCache setObject: [NSNumber + numberWithUnsignedLongLong: + (unsigned long long) XHASH (font_object)] + forKey: nsfont]; + Vfonts_in_cache = Fcons (font_object, Vfonts_in_cache); + } } font_info = (struct nsfont_info *) XFONT_OBJECT (font_object); @@ -1529,4 +1535,7 @@ syms_of_nsfont (void) doc: /* Internal use: maps font registry to Unicode script. */); ascii_printable = NULL; + + Vfonts_in_cache = Qnil; + staticpro (&Vfonts_in_cache); } diff --git a/src/termhooks.h b/src/termhooks.h index 285a1824ecb..bac86423a4b 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -107,7 +107,7 @@ enum event_kind HORIZ_WHEEL_EVENT, /* A wheel event generated by a second horizontal wheel that is present on some mice. See WHEEL_EVENT. */ -#if defined (HAVE_NTGUI) +#ifdef HAVE_NTGUI LANGUAGE_CHANGE_EVENT, /* A LANGUAGE_CHANGE_EVENT is generated when HAVE_NTGUI or on Mac OS when the keyboard layout or input diff --git a/src/w32fns.c b/src/w32fns.c index 6eb12ee917e..aa1647fcaa4 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -4645,22 +4645,14 @@ If omitted or nil, that stands for the selected frame's display. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); - HDC hdc; int cap; - hdc = GetDC (dpyinfo->root_window); - if (dpyinfo->has_palette) - cap = GetDeviceCaps (hdc, SIZEPALETTE); - else - cap = GetDeviceCaps (hdc, NUMCOLORS); - - /* We force 24+ bit depths to 24-bit, both to prevent an overflow - and because probably is more meaningful on Windows anyway */ - if (cap < 0) - cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24); - - ReleaseDC (dpyinfo->root_window, hdc); + /* Don't use NCOLORS: it returns incorrect results under remote + * desktop. We force 24+ bit depths to 24-bit, both to prevent an + * overflow and because probably is more meaningful on Windows + * anyway. */ + cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24); return make_number (cap); } @@ -6994,8 +6986,10 @@ w32_strerror (int error_no) return buf; } -/* For convenience when debugging. */ -int +/* For convenience when debugging. (You cannot call GetLastError + directly from GDB: it will crash, because it uses the __stdcall + calling convention, not the _cdecl convention assumed by GDB.) */ +DWORD w32_last_error (void) { return GetLastError (); diff --git a/src/w32select.h b/src/w32select.h index e895c3d9bf2..4f4de59f7fe 100644 --- a/src/w32select.h +++ b/src/w32select.h @@ -1,6 +1,6 @@ /* Selection processing for Emacs on the Microsoft W32 API. -Copyright (C) 1993-1994, 2001-2011 Free Software Foundation, Inc. +Copyright (C) 1993-1994, 2001-2012 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/w32term.c b/src/w32term.c index b18d07135ed..806b82297f1 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -201,9 +201,6 @@ static int input_signal_count; int w32_message_fd = -1; #endif /* CYGWIN */ -/* Keyboard code page - may be changed by language-change events. */ -static int keyboard_codepage; - static void x_update_window_end (struct window *, int, int); static void w32_handle_tool_bar_click (struct frame *, struct input_event *); diff --git a/src/xdisp.c b/src/xdisp.c index 2047c0e78c1..1e61a74068b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -29379,9 +29379,10 @@ start_hourglass (void) else delay = make_emacs_time (DEFAULT_HOURGLASS_DELAY, 0); -#ifdef WINDOWSNT +#ifdef HAVE_NTGUI + extern void w32_note_current_window (void); w32_note_current_window (); -#endif +#endif /* HAVE_NTGUI */ hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay, show_hourglass, NULL); |