+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.
(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),
(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)
(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
(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...")
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. */
--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
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])
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"
+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
@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
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'.
+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.
(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)))
(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)))
(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.")
'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: "
(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 () "\
(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)
+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)
"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.
;;;;;; 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" "\
(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)
(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)
"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)
+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):
(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 ()
(set var (1+ val))))
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."
(tramp-message key 7 "%s %s" property value)
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.
"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
"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
(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"))
(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)
"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
(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
;; 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
(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
(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_]+\\)")))
(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)
(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)
;; 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.
(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.
(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
(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)
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) " "
(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)))
(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)
;; 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))
(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))
(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
(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))
(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
;; 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))
"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
(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
(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)
(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)
(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))))))
;; 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)
(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"
;; 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.
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
(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
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"
;; 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
"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))
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)))
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))))
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
(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"
(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"
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))))
;; 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)))
(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.
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)
(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
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\""
(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
(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)
(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
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))
;; 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")
;; 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 ."))))
(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 "@") "")
"tramp-debug-message"
"tramp-error"
"tramp-error-with-buffer"
- "tramp-message"
- "tramp-with-progress-reporter")
+ "tramp-message")
t)
"$")
fn)))
(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
(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))
(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))
(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
"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))
(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)
(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)
;; * 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
;; 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
(= 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)))
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
;;;###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: ")))
(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'."
(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)))))
-
-\f
;;; Helpers
;; This widget exists in newer versions of the Custom library
(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)
"==" ">=" "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))))))
\f
;;; Font-lock and syntax
(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)
(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)))
+
\f
;;; Shell integration
(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
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
(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)
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)
(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)
: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
(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)
(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
(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
(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)
(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)
;;;; 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")
+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
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
+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
#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. */
#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
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
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
#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 ();
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 ();
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 ();
struct frame *sf = SELECTED_FRAME ();
struct kboard *kb;
- int minibuffer_selected, tooltip_frame;
+ int minibuffer_selected, is_tooltip_frame;
if (EQ (frame, Qnil))
{
}
}
- 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
}
/* 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;
#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
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)
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)))
{":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
#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
{":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
{":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
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>
{":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
/* 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;
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)). */
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
# 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
$(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 \
$(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 \
$(SYSSIGNAL_H) \
$(SYSTTY_H) \
$(TERMHOOKS_H) \
+ $(W32FONT_H) \
$(W32TERM_H) \
$(WINDOW_H)
$(BLD)/w32heap.$(O) : \
$(SRC)/w32heap.c \
- $(SRC)/w32heap.h \
$(SRC)/w32common.h \
+ $(SRC)/w32heap.h \
$(CONFIG_H) \
$(LISP_H)
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);
{
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
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);
doc: /* Internal use: maps font registry to Unicode script. */);
ascii_printable = NULL;
+
+ Vfonts_in_cache = Qnil;
+ staticpro (&Vfonts_in_cache);
}
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
(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);
}
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 ();
/* 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.
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 *);
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);
HCoop / bpt / emacs.git / commitdiff