Now on revision 108188. ------------------------------------------------------------ revno: 108188 fixes bug(s): http://debbugs.gnu.org/9131 committer: Chong Yidong branch nick: trunk timestamp: Thu 2012-05-10 14:27:12 +0800 message: Cleanups and improvements for FFAP and URL. * ffap.el (ffap-url-unwrap-local): Make it work right. Use url-generic-parse-url, and handle host names and Windows filenames properly. (ffap-url-unwrap-remote): Use url-generic-parse-url. (ffap-url-unwrap-remote): Accept list values, specifying a list of URL schemes to work on. (ffap--toggle-read-only): New function. (ffap-read-only, ffap-read-only-other-window) (ffap-read-only-other-frame): Use it. (ffap-fixup-url): Don't check ffap-ftp-regexp, since it is not necessary for ffap-url-unwrap-remote. * url-parse.el (url-path-and-query, url-port-if-non-default): New functions. (url-generic-parse-url): Don't set the portspec slot if it is not specified; that is what `url-port' is for. (url-port): Only require the scheme to be specified to call url-scheme-get-property. * url-util.el (url-encode-url): Use url-path-and-query. * url-vars.el (url-mime-charset-string): Load mm-util lazily. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-05-10 02:54:07 +0000 +++ etc/NEWS 2012-05-10 06:27:12 +0000 @@ -150,6 +150,12 @@ ** erc will look up server/channel names via auth-source and use the channel keys found, if any. +** FFAP + +*** The option `ffap-url-unwrap-remote' can now be a list of strings, +specifying URL types which should be converted to remote file names at +the FFAP prompt. The default is now '("ftp"). + ** Follow mode *** The obsolete variable `follow-mode-off-hook' has been removed. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-05-10 00:55:57 +0000 +++ lisp/ChangeLog 2012-05-10 06:27:12 +0000 @@ -1,3 +1,17 @@ +2012-05-10 Chong Yidong + + * ffap.el (ffap-url-unwrap-local): Make it work right (Bug#9131). + Use url-generic-parse-url, and handle host names and Windows + filenames properly. + (ffap-url-unwrap-remote): Use url-generic-parse-url. + (ffap-url-unwrap-remote): Accept list values, specifying a list of + URL schemes to work on. + (ffap--toggle-read-only): New function. + (ffap-read-only, ffap-read-only-other-window) + (ffap-read-only-other-frame): Use it. + (ffap-fixup-url): Don't check ffap-ftp-regexp, since it is not + necessary for ffap-url-unwrap-remote. + 2012-05-10 Dave Abrahams * cus-start.el (create-lockfiles): Add it. === modified file 'lisp/ffap.el' --- lisp/ffap.el 2012-05-04 05:14:14 +0000 +++ lisp/ffap.el 2012-05-10 06:27:12 +0000 @@ -105,6 +105,8 @@ ;;; Code: +(require 'url-parse) + (define-obsolete-variable-alias 'ffap-version 'emacs-version "23.2") (defgroup ffap nil @@ -136,10 +138,7 @@ regexp) :group 'ffap) -(defcustom ffap-ftp-regexp - ;; This used to test for ange-ftp or efs being present, but it should be - ;; harmless (and simpler) to give it this value unconditionally. - "\\`/[^/:]+:" +(defcustom ffap-ftp-regexp "\\`/[^/:]+:" "File names matching this regexp are treated as remote ffap. If nil, ffap neither recognizes nor generates such names." :type '(choice (const :tag "Disable" nil) @@ -148,15 +147,20 @@ :group 'ffap) (defcustom ffap-url-unwrap-local t - "If non-nil, convert `file:' URL to local file name before prompting." + "If non-nil, convert some URLs to local file names before prompting. +Only \"file:\" and \"ftp:\" URLs are converted, and only if they +do not specify a host, or the host is either \"localhost\" or +equal to `system-name'." :type 'boolean :group 'ffap) -(defcustom ffap-url-unwrap-remote t - "If non-nil, convert `ftp:' URL to remote file name before prompting. -This is ignored if `ffap-ftp-regexp' is nil." - :type 'boolean - :group 'ffap) +(defcustom ffap-url-unwrap-remote '("ftp") + "If non-nil, convert URLs to remote file names before prompting. +If the value is a list of strings, that specifies a list of URL +schemes (e.g. \"ftp\"); in that case, only convert those URLs." + :type '(choice (repeat string) boolean) + :group 'ffap + :version "24.2") (defcustom ffap-ftp-default-user "anonymous" "User name in ftp file names generated by `ffap-host-to-path'. @@ -247,14 +251,14 @@ (defcustom ffap-file-finder 'find-file "The command called by `find-file-at-point' to find a file." :type 'function - :group 'ffap) -(put 'ffap-file-finder 'risky-local-variable t) + :group 'ffap + :risky t) (defcustom ffap-directory-finder 'dired "The command called by `dired-at-point' to find a directory." :type 'function - :group 'ffap) -(put 'ffap-directory-finder 'risky-local-variable t) + :group 'ffap + :risky t) (defcustom ffap-url-fetcher (if (fboundp 'browse-url) @@ -271,8 +275,28 @@ (const browse-url-netscape) (const browse-url-mosaic) function) + :group 'ffap + :risky t) + +(defcustom ffap-next-regexp + ;; If you want ffap-next to find URL's only, try this: + ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp) + ;; (concat "\\<" (substring ffap-url-regexp 2)))) + ;; + ;; It pays to put a big fancy regexp here, since ffap-guesser is + ;; much more time-consuming than regexp searching: + "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\." + "Regular expression governing movements of `ffap-next'." + :type 'regexp :group 'ffap) -(put 'ffap-url-fetcher 'risky-local-variable t) + +(defcustom dired-at-point-require-prefix nil + "If non-nil, reverse the prefix argument to `dired-at-point'. +This is nil so neophytes notice FFAP. Experts may prefer to +disable FFAP most of the time." + :type 'boolean + :group 'ffap + :version "20.3") ;;; Compatibility: @@ -293,18 +317,6 @@ ;; then, broke it up into ffap-next-guess (noninteractive) and ;; ffap-next (a command). It now work on files as well as url's. -(defcustom ffap-next-regexp - ;; If you want ffap-next to find URL's only, try this: - ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp) - ;; (concat "\\<" (substring ffap-url-regexp 2)))) - ;; - ;; It pays to put a big fancy regexp here, since ffap-guesser is - ;; much more time-consuming than regexp searching: - "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\." - "Regular expression governing movements of `ffap-next'." - :type 'regexp - :group 'ffap) - (defvar ffap-next-guess nil "Last value returned by `ffap-next-guess'.") @@ -606,28 +618,45 @@ string))) ;; Broke these out of ffap-fixup-url, for use of ffap-url package. -(defsubst ffap-url-unwrap-local (url) - "Return URL as a local file, or nil. Ignores `ffap-url-regexp'." - (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url) - (substring url (1+ (match-end 1))))) -(defsubst ffap-url-unwrap-remote (url) - "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'." - (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url) - (concat - (ffap-host-to-filename (substring url (match-beginning 2) (match-end 2))) - (substring url (match-beginning 3) (match-end 3))))) -;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz") +(defun ffap-url-unwrap-local (url) + "Return URL as a local file name, or nil." + (let* ((obj (url-generic-parse-url url)) + (host (url-host obj)) + (filename (car (url-path-and-query obj)))) + (when (and (member (url-type obj) '("ftp" "file")) + (member host `("" "localhost" ,(system-name)))) + ;; On Windows, "file:///C:/foo" should unwrap to "C:/foo" + (if (and (memq system-type '(ms-dos windows-nt cygwin)) + (string-match "\\`/[a-zA-Z]:" filename)) + (substring filename 1) + filename)))) + +(defun ffap-url-unwrap-remote (url) + "Return URL as a remote file name, or nil." + (let* ((obj (url-generic-parse-url url)) + (scheme (url-type obj)) + (valid-schemes (if (listp ffap-url-unwrap-remote) + ffap-url-unwrap-remote + '("ftp"))) + (host (url-host obj)) + (port (url-port-if-non-default obj)) + (user (url-user obj)) + (filename (car (url-path-and-query obj)))) + (when (and (member scheme valid-schemes) + (string-match "\\`[a-zA-Z][-a-zA-Z0-9+.]*\\'" scheme) + (not (equal host ""))) + (concat "/" scheme ":" + (if user (concat user "@")) + host + (if port (concat "#" (number-to-string port))) + ":" filename)))) (defun ffap-fixup-url (url) "Clean up URL and return it, maybe as a file name." (cond ((not (stringp url)) nil) - ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) - ((and ffap-url-unwrap-remote ffap-ftp-regexp - (ffap-url-unwrap-remote url))) - ;; All this seems to do is remove any trailing "#anchor" part (Bug#898). -;;; ((fboundp 'url-normalize-url) ; may autoload url (part of w3) -;;; (url-normalize-url url)) + ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) + ((and ffap-url-unwrap-remote (ffap-url-unwrap-remote url))) (url))) @@ -1076,38 +1105,33 @@ ;; ignore non-relative links, trim punctuation. The other will ;; actually look back if point is in whitespace, but I would rather ;; ffap be less aggressive in such situations. - (and - ffap-url-regexp - (or - ;; In a w3 buffer button? - (and (eq major-mode 'w3-mode) - ;; interface recommended by wmperry: - (w3-view-this-url t)) - ;; Is there a reason not to strip trailing colon? - (let ((name (ffap-string-at-point 'url))) - (cond - ((string-match "^url:" name) (setq name (substring name 4))) - ((and (string-match "\\`[^:@]+@[^:@]+[[:alnum:]]\\'" name) - ;; "foo@bar": could be "mailto" or "news" (a Message-ID). - ;; Without "<>" it must be "mailto". Otherwise could be - ;; either, so consult `ffap-foo-at-bar-prefix'. - (let ((prefix (if (and (equal (ffap-string-around) "<>") - ;; Expect some odd characters: - (string-match "[$.0-9].*[$.0-9].*@" name)) - ;; Could be news: - ffap-foo-at-bar-prefix - "mailto"))) - (and prefix (setq name (concat prefix ":" name)))))) - ((ffap-newsgroup-p name) (setq name (concat "news:" name))) - ((and (string-match "\\`[[:alnum:]]+\\'" name) ; - (equal (ffap-string-around) "<>") - ;; (ffap-user-p name): - (not (string-match "~" (expand-file-name (concat "~" name)))) - ) - (setq name (concat "mailto:" name))) - ) - (and (ffap-url-p name) name) - )))) + (when ffap-url-regexp + (or (and (eq major-mode 'w3-mode) ; In a w3 buffer button? + (w3-view-this-url t)) + ;; Is there a reason not to strip trailing colon? + (let ((name (ffap-string-at-point 'url))) + (cond + ((string-match "^url:" name) (setq name (substring name 4))) + ((and (string-match "\\`[^:@]+@[^:@]+[[:alnum:]]\\'" name) + ;; "foo@bar": could be "mailto" or "news" (a Message-ID). + ;; Without "<>" it must be "mailto". Otherwise could be + ;; either, so consult `ffap-foo-at-bar-prefix'. + (let ((prefix (if (and (equal (ffap-string-around) "<>") + ;; Expect some odd characters: + (string-match "[$.0-9].*[$.0-9].*@" name)) + ;; Could be news: + ffap-foo-at-bar-prefix + "mailto"))) + (and prefix (setq name (concat prefix ":" name)))))) + ((ffap-newsgroup-p name) (setq name (concat "news:" name))) + ((and (string-match "\\`[[:alnum:]]+\\'" name) ; + (equal (ffap-string-around) "<>") + ;; (ffap-user-p name): + (not (string-match "~" (expand-file-name (concat "~" name))))) + (setq name (concat "mailto:" name)))) + + (if (ffap-url-p name) + name))))) (defvar ffap-gopher-regexp "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$" @@ -1342,8 +1366,6 @@ ;;; Highlighting (`ffap-highlight'): -;; -;; Based on overlay highlighting in Emacs 19.28 isearch.el. (defvar ffap-highlight t "If non-nil, ffap highlights the current buffer substring.") @@ -1676,6 +1698,11 @@ (set-window-dedicated-p win wdp)) value)) +(defun ffap--toggle-read-only (buffer) + (with-current-buffer buffer + (with-no-warnings + (toggle-read-only 1)))) + (defun ffap-read-only () "Like `ffap', but mark buffer as read-only. Only intended for interactive use." @@ -1683,7 +1710,7 @@ (let ((value (call-interactively 'ffap))) (unless (or (bufferp value) (bufferp (car-safe value))) (setq value (current-buffer))) - (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (mapc #'ffap--toggle-read-only (if (listp value) value (list value))) value)) @@ -1692,7 +1719,7 @@ Only intended for interactive use." (interactive) (let ((value (ffap-other-window))) - (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (mapc #'ffap--toggle-read-only (if (listp value) value (list value))) value)) @@ -1701,7 +1728,7 @@ Only intended for interactive use." (interactive) (let ((value (ffap-other-frame))) - (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (mapc #'ffap--toggle-read-only (if (listp value) value (list value))) value)) @@ -1743,8 +1770,7 @@ (defun ffap-ro-mode-hook () "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp." (local-set-key "\M-l" 'ffap-next) - (local-set-key "\M-m" 'ffap-menu) - ) + (local-set-key "\M-m" 'ffap-menu)) (defun ffap-gnus-hook () "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp." @@ -1788,13 +1814,6 @@ (interactive) (ffap-gnus-wrapper '(ffap-menu))) -(defcustom dired-at-point-require-prefix nil - "If set, reverses the prefix argument to `dired-at-point'. -This is nil so neophytes notice ffap. Experts may prefer to disable -ffap most of the time." - :type 'boolean - :group 'ffap - :version "20.3") ;;;###autoload (defun dired-at-point (&optional filename) @@ -1901,7 +1920,7 @@ ;;; Hooks to put in `file-name-at-point-functions': ;;;###autoload -(progn (defun ffap-guess-file-name-at-point () +(defun ffap-guess-file-name-at-point () "Try to get a file name at point. This hook is intended to be put in `file-name-at-point-functions'." (when (fboundp 'ffap-guesser) @@ -1918,14 +1937,13 @@ (when guess (if (file-directory-p guess) (file-name-as-directory guess) - guess)))))) + guess))))) ;;; Offer default global bindings (`ffap-bindings'): (defvar ffap-bindings - '( - (global-set-key [S-mouse-3] 'ffap-at-mouse) + '((global-set-key [S-mouse-3] 'ffap-at-mouse) (global-set-key [C-S-mouse-3] 'ffap-menu) (global-set-key "\C-x\C-f" 'find-file-at-point) @@ -1945,9 +1963,7 @@ (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook) (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook) (add-hook 'vm-mode-hook 'ffap-ro-mode-hook) - (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook) - ;; (setq dired-x-hands-off-my-keys t) ; the default - ) + (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)) "List of binding forms evaluated by function `ffap-bindings'. A reasonable ffap installation needs just this one line: (ffap-bindings) === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2012-05-09 12:20:26 +0000 +++ lisp/url/ChangeLog 2012-05-10 06:27:12 +0000 @@ -1,3 +1,16 @@ +2012-05-10 Chong Yidong + + * url-parse.el (url-path-and-query, url-port-if-non-default): New + functions. + (url-generic-parse-url): Don't set the portspec slot if it is not + specified; that is what `url-port' is for. + (url-port): Only require the scheme to be specified to call + url-scheme-get-property. + + * url-util.el (url-encode-url): Use url-path-and-query. + + * url-vars.el (url-mime-charset-string): Load mm-util lazily. + 2012-05-09 Chong Yidong * url-util.el (url-encode-url): New function for URL quoting. @@ -12,6 +25,7 @@ whole path and query inside the FILENAME slot. Improve docstring. (url-recreate-url-attributes): Mark as obsolete. (url-recreate-url): Handle missing scheme and userinfo. + (url-path-and-query): New function. * url-http.el (url-http-create-request): Ignore obsolete attributes slot of url-object. === modified file 'lisp/url/url-parse.el' --- lisp/url/url-parse.el 2012-05-09 08:33:48 +0000 +++ lisp/url/url-parse.el 2012-05-10 06:27:12 +0000 @@ -39,22 +39,52 @@ silent (use-cookies t)) (defsubst url-port (urlobj) + "Return the port number for the URL specified by URLOBJ." (or (url-portspec urlobj) - (if (url-fullness urlobj) + (if (url-type urlobj) (url-scheme-get-property (url-type urlobj) 'default-port)))) (defsetf url-port (urlobj) (port) `(setf (url-portspec ,urlobj) ,port)) +(defun url-path-and-query (urlobj) + "Return the path and query components of URLOBJ. +These two components are store together in the FILENAME slot of +the object. The return value of this function is (PATH . QUERY), +where each of PATH and QUERY are strings or nil." + (let ((name (url-filename urlobj)) + path query) + (when name + (if (string-match "\\?" name) + (setq path (substring name 0 (match-beginning 0)) + query (substring name (match-end 0))) + (setq path name))) + (if (equal path "") (setq path nil)) + (if (equal query "") (setq query nil)) + (cons path query))) + +(defun url-port-if-non-default (urlobj) + "Return the port number specified by URLOBJ, if it is not the default. +If the specified port number is the default, return nil." + (let ((port (url-portspec urlobj)) + type) + (and port + (or (null (setq type (url-type urlobj))) + (not (equal port (url-scheme-get-property type 'default-port)))) + port))) + ;;;###autoload (defun url-recreate-url (urlobj) "Recreate a URL string from the parsed URLOBJ." - (let ((type (url-type urlobj)) - (user (url-user urlobj)) - (pass (url-password urlobj)) - (host (url-host urlobj)) - (port (url-portspec urlobj)) - (file (url-filename urlobj)) - (frag (url-target urlobj))) + (let* ((type (url-type urlobj)) + (user (url-user urlobj)) + (pass (url-password urlobj)) + (host (url-host urlobj)) + ;; RFC 3986: "omit the port component and its : delimiter if + ;; port is empty or if its value would be the same as that of + ;; the scheme's default." + (port (url-port-if-non-default urlobj)) + (file (url-filename urlobj)) + (frag (url-target urlobj))) (concat (if type (concat type ":")) (if (url-fullness urlobj) "//") (if (or user pass) @@ -62,15 +92,7 @@ (if pass (concat ":" pass)) "@")) host - ;; RFC 3986: "omit the port component and its : delimiter - ;; if port is empty or if its value would be the same as - ;; that of the scheme's default." - (and port - (or (null type) - (not (equal port - (url-scheme-get-property type - 'default-port)))) - (format ":%d" (url-port urlobj))) + (if port (format ":%d" (url-port urlobj))) (or file "/") (if frag (concat "#" frag))))) @@ -102,8 +124,8 @@ ATTRIBUTES is nil; this slot originally stored the attribute and value alists for IMAP URIs, but this feature was removed since it conflicts with RFC 3986. -FULLNESS is non-nil iff the authority component of the URI is - present. +FULLNESS is non-nil iff the hierarchical sequence component of + the URL starts with two slashes, \"//\". The parser follows RFC 3986, except that it also tries to handle URIs that are not fully specified (e.g. lacking TYPE), and it @@ -174,10 +196,6 @@ (setq port (string-to-number port)))) (setq host (downcase host))) - (and (null port) - scheme - (setq port (url-scheme-get-property scheme 'default-port))) - ;; Now point is on the / ? or # which terminates the ;; authority, or at the end of the URI, or (if there is no ;; authority) at the beginning of the absolute path. === modified file 'lisp/url/url-util.el' --- lisp/url/url-util.el 2012-05-09 12:20:26 +0000 +++ lisp/url/url-util.el 2012-05-10 06:27:12 +0000 @@ -418,31 +418,26 @@ (user (url-user obj)) (pass (url-password obj)) (host (url-host obj)) - (file (url-filename obj)) - (frag (url-target obj)) - path query) + (path-and-query (url-path-and-query obj)) + (path (car path-and-query)) + (query (cdr path-and-query)) + (frag (url-target obj))) (if user (setf (url-user obj) (url-hexify-string user))) (if pass (setf (url-password obj) (url-hexify-string pass))) - (when host - ;; No special encoding for IPv6 literals. - (unless (string-match "\\`\\[.*\\]\\'" host) - (setf (url-host obj) - (url-hexify-string host url-host-allowed-chars)))) - ;; Split FILENAME slot into its PATH and QUERY components, and - ;; encode them separately. The PATH component can contain - ;; unreserved characters, %-encodings, and /:@!$&'()*+,;= - (when file - (if (string-match "\\?" file) - (setq path (substring file 0 (match-beginning 0)) - query (substring file (match-end 0))) - (setq path file)) - (setq path (url-hexify-string path url-path-allowed-chars)) - (if query - (setq query (url-hexify-string query url-query-allowed-chars))) - (setf (url-filename obj) - (if query (concat path "?" query) path))) + ;; No special encoding for IPv6 literals. + (and host + (not (string-match "\\`\\[.*\\]\\'" host)) + (setf (url-host obj) + (url-hexify-string host url-host-allowed-chars))) + + (if path + (setq path (url-hexify-string path url-path-allowed-chars))) + (if query + (setq query (url-hexify-string query url-query-allowed-chars))) + (setf (url-filename obj) (if query (concat path "?" query) path)) + (if frag (setf (url-target obj) (url-hexify-string frag url-query-allowed-chars))) === modified file 'lisp/url/url-vars.el' --- lisp/url/url-vars.el 2012-05-09 08:33:48 +0000 +++ lisp/url/url-vars.el 2012-05-10 06:27:12 +0000 @@ -21,8 +21,6 @@ ;;; Code: -(require 'mm-util) - (defconst url-version "Emacs" "Version number of URL package.") @@ -221,6 +219,7 @@ (defun url-mime-charset-string () "Generate a list of preferred MIME charsets for HTTP requests. Generated according to current coding system priorities." + (require 'mm-util) (if (fboundp 'sort-coding-systems) (let ((ordered (sort-coding-systems (let (accum) ------------------------------------------------------------ revno: 108187 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-05-09 22:27:24 -0700 message: * xgselect.c (xg_select): Put maxfds+1 into a var. This is slightly clearer, and pacifies Ubuntu 12.04 gcc. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-10 05:00:53 +0000 +++ src/ChangeLog 2012-05-10 05:27:24 +0000 @@ -1,5 +1,8 @@ 2012-05-10 Paul Eggert + * xgselect.c (xg_select): Put maxfds+1 into a var. + This is slightly clearer, and pacifies Ubuntu 12.04 gcc. + * sound.c (DEFAULT_ALSA_SOUND_DEVICE): Define only if HAVE_ALSA. 2012-05-10 Dave Abrahams === modified file 'src/xgselect.c' --- src/xgselect.c 2012-01-19 07:21:25 +0000 +++ src/xgselect.c 2012-05-10 05:27:24 +0000 @@ -41,7 +41,7 @@ GMainContext *context = g_main_context_default (); int have_wfds = wfds != NULL; int n_gfds = 0, our_tmo = 0, retval = 0, our_fds = 0; - int i, nfds, tmo_in_millisec; + int i, nfds, fds_lim, tmo_in_millisec; if (rfds) memcpy (&all_rfds, rfds, sizeof (all_rfds)); else FD_ZERO (&all_rfds); @@ -97,14 +97,14 @@ if (our_tmo) tmop = &tmo; } - nfds = select (max_fds+1, &all_rfds, have_wfds ? &all_wfds : NULL, - efds, tmop); + fds_lim = max_fds + 1; + nfds = select (fds_lim, &all_rfds, have_wfds ? &all_wfds : NULL, efds, tmop); if (nfds < 0) retval = nfds; else if (nfds > 0) { - for (i = 0; i < max_fds+1; ++i) + for (i = 0; i < fds_lim; ++i) { if (FD_ISSET (i, &all_rfds)) { ------------------------------------------------------------ revno: 108186 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-05-09 22:00:53 -0700 message: * sound.c (DEFAULT_ALSA_SOUND_DEVICE): Define only if HAVE_ALSA. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-10 00:55:57 +0000 +++ src/ChangeLog 2012-05-10 05:00:53 +0000 @@ -1,3 +1,7 @@ +2012-05-10 Paul Eggert + + * sound.c (DEFAULT_ALSA_SOUND_DEVICE): Define only if HAVE_ALSA. + 2012-05-10 Dave Abrahams * filelock.c (syms_of_filelock): New boolean create-lockfiles. === modified file 'src/sound.c' --- src/sound.c 2012-01-19 07:21:25 +0000 +++ src/sound.c 2012-05-10 05:00:53 +0000 @@ -124,9 +124,6 @@ #ifndef DEFAULT_SOUND_DEVICE #define DEFAULT_SOUND_DEVICE "/dev/dsp" #endif -#ifndef DEFAULT_ALSA_SOUND_DEVICE -#define DEFAULT_ALSA_SOUND_DEVICE "default" -#endif /* Structure forward declarations. */ @@ -908,6 +905,10 @@ /* This driver is available on GNU/Linux. */ +#ifndef DEFAULT_ALSA_SOUND_DEVICE +#define DEFAULT_ALSA_SOUND_DEVICE "default" +#endif + static void alsa_sound_perror (const char *msg, int err) { ------------------------------------------------------------ revno: 108185 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-05-09 20:40:20 -0700 message: Install self-contained ns leim files directly to their final destination This is instead of installing them first in one place, then moving them. It also fixes the previous change, which was incorrect for the -disable-ns-self-contained case. * configure.in (LEIM_INSTALLDIR): New output variable. * leim/Makefile.in: (install_prefix): New. (LEIM_INSTALLDIR): New, set by configure. (install): Use LEIM_INSTALLDIR. diff: === modified file 'ChangeLog' --- ChangeLog 2012-05-09 03:06:08 +0000 +++ ChangeLog 2012-05-10 03:40:20 +0000 @@ -1,3 +1,7 @@ +2012-05-10 Glenn Morris + + * configure.in (LEIM_INSTALLDIR): New output variable. + 2012-05-08 Stefan Monnier * .dir-locals.el (log-edit-mode): Enable gnu-style checks. === modified file 'configure.in' --- configure.in 2012-05-09 03:06:08 +0000 +++ configure.in 2012-05-10 03:40:20 +0000 @@ -1636,6 +1636,7 @@ fi AC_SUBST(TEMACS_LDFLAGS2) +LEIM_INSTALLDIR="\${install_prefix}/leim" ns_frag=/dev/null NS_OBJ= NS_OBJC_OBJ= @@ -1651,6 +1652,7 @@ prefix=${ns_appresdir} exec_prefix=${ns_appbindir} libexecdir=${ns_appbindir}/libexec + LEIM_INSTALLDIR="\${ns_appresdir}/leim" fi ns_frag=$srcdir/src/ns.mk NS_OBJ="fontset.o fringe.o image.o" @@ -1658,6 +1660,7 @@ fi CFLAGS="$tmp_CFLAGS" CPPFLAGS="$tmp_CPPFLAGS" +AC_SUBST(LEIM_INSTALLDIR) AC_SUBST(NS_OBJ) AC_SUBST(NS_OBJC_OBJ) AC_SUBST(LIB_STANDARD) === modified file 'leim/ChangeLog' --- leim/ChangeLog 2012-05-10 02:46:58 +0000 +++ leim/ChangeLog 2012-05-10 03:40:20 +0000 @@ -1,5 +1,11 @@ 2012-05-10 Glenn Morris + * Makefile.in: Install self-contained ns files directly to + their final destination. + (install_prefix): New. + (LEIM_INSTALLDIR): New, set by configure. + (install): Use LEIM_INSTALLDIR. + * Makefile.in (MV_DIRS): Remove. (install): Simplify the --with-ns case. === modified file 'leim/Makefile.in' --- leim/Makefile.in 2012-05-10 02:46:58 +0000 +++ leim/Makefile.in 2012-05-10 03:40:20 +0000 @@ -34,9 +34,12 @@ srcdir=@srcdir@ ns_appresdir=@ns_appresdir@ +install_prefix=$(DESTDIR)${datadir}/emacs/${version} + # Where to install LEIM files. -# Should be $ns_appresdir/leim if $ns_appresdir is set. -INSTALLDIR=$(DESTDIR)${datadir}/emacs/${version}/leim +# For most builds, this is ${install_prefix}/leim. +# For self-contained ns builds, it is ${ns_appresdir}/leim. +LEIM_INSTALLDIR=@LEIM_INSTALLDIR@ GZIP_PROG = @GZIP_PROG@ @@ -176,49 +179,44 @@ done install: all - if [ ! -d ${INSTALLDIR} ] ; then \ - umask 022; ${srcdir}/../build-aux/install-sh -d ${INSTALLDIR}; \ + if [ ! -d ${LEIM_INSTALLDIR} ] ; then \ + umask 022; ${srcdir}/../build-aux/install-sh -d ${LEIM_INSTALLDIR}; \ else true; fi - if [ x`(cd ${INSTALLDIR} && /bin/pwd)` != x`(/bin/pwd)` ] ; then \ - rm -f ${INSTALLDIR}/leim-list.el; \ - rm -rf ${INSTALLDIR}/quail ${INSTALLDIR}/ja-dic ; \ - echo "Copying leim files to ${INSTALLDIR} ..." ; \ + if [ x`(cd ${LEIM_INSTALLDIR} && /bin/pwd)` != x`(/bin/pwd)` ] ; then \ + rm -f ${LEIM_INSTALLDIR}/leim-list.el; \ + rm -rf ${LEIM_INSTALLDIR}/quail ${LEIM_INSTALLDIR}/ja-dic ; \ + echo "Copying leim files to ${LEIM_INSTALLDIR} ..." ; \ if [ x`(cd ${srcdir} && /bin/pwd)` = x`(/bin/pwd)` ] ; then \ tar -chf - leim-list.el quail ja-dic \ - | (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\ + | (cd ${LEIM_INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\ else \ tar -chf - leim-list.el quail \ - | (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\ + | (cd ${LEIM_INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\ cd ${srcdir}; \ tar -chf - quail/* ja-dic \ - | (cd ${INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\ + | (cd ${LEIM_INSTALLDIR}; umask 0; tar -xvf - && cat > /dev/null) ;\ fi; \ - rm -f ${INSTALLDIR}/.gitignore ${INSTALLDIR}/*/.gitignore; \ - rm -f ${INSTALLDIR}/.arch-inventory ${INSTALLDIR}/*/.arch-inventory; \ - rm -f ${INSTALLDIR}/\#* ${INSTALLDIR}/*/\#* ; \ - rm -f ${INSTALLDIR}/.\#* ${INSTALLDIR}/*/.\#* ; \ - rm -f ${INSTALLDIR}/*~ ${INSTALLDIR}/*/*~ ; \ - rm -f ${INSTALLDIR}/*.orig ${INSTALLDIR}/*/*.orig ; \ + rm -f ${LEIM_INSTALLDIR}/.gitignore ${LEIM_INSTALLDIR}/*/.gitignore; \ + rm -f ${LEIM_INSTALLDIR}/.arch-inventory ${LEIM_INSTALLDIR}/*/.arch-inventory; \ + rm -f ${LEIM_INSTALLDIR}/\#* ${LEIM_INSTALLDIR}/*/\#* ; \ + rm -f ${LEIM_INSTALLDIR}/.\#* ${LEIM_INSTALLDIR}/*/.\#* ; \ + rm -f ${LEIM_INSTALLDIR}/*~ ${LEIM_INSTALLDIR}/*/*~ ; \ + rm -f ${LEIM_INSTALLDIR}/*.orig ${LEIM_INSTALLDIR}/*/*.orig ; \ else true; fi -unset CDPATH; \ if [ -n "${GZIP_PROG}" ]; \ then \ echo "Compressing *.el ..." ; \ - (cd ${INSTALLDIR}; for f in `find . -name "*.elc" -print`; do \ + (cd ${LEIM_INSTALLDIR}; for f in `find . -name "*.elc" -print`; do \ ${GZIP_PROG} -9n `echo $$f|sed 's/.elc$$/.el/'` ; \ done) \ else true; fi - -chmod -R a+r ${INSTALLDIR} + -chmod -R a+r ${LEIM_INSTALLDIR} for installuser in $${LOGNAME} $${USERNAME} $${USER} \ `id -un 2> /dev/null`; do \ [ -n "$${installuser}" ] && break ; \ done ; \ - find ${INSTALLDIR} -exec chown $${installuser} '{}' ';' - if [ "${ns_appresdir}" != "" ]; then \ - rm -rf ${ns_appresdir}/leim; \ - mv ${INSTALLDIR} ${ns_appresdir} || exit 1; \ - rmdir -p ${ns_appresdir}/share/emacs/${version} 2>/dev/null || true; \ - else true ; fi + find ${LEIM_INSTALLDIR} -exec chown $${installuser} '{}' ';' clean mostlyclean: rm -f ${TIT_MISC} ${TIT_MISC:.el=.elc} \ ------------------------------------------------------------ revno: 108184 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-05-09 19:57:10 -0700 message: * loading.texi (Loading Non-ASCII): Multibyte sessions no longer exist. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-05-10 02:54:07 +0000 +++ doc/lispref/ChangeLog 2012-05-10 02:57:10 +0000 @@ -2,6 +2,7 @@ * loading.texi (Loading Non-ASCII): Replace the obsolete "unibyte: t" with "coding: raw-text". + Concept of multibyte sessions no longer exists. * files.texi (File Locks): Mention create-lockfiles option. === modified file 'doc/lispref/loading.texi' --- doc/lispref/loading.texi 2012-05-10 02:54:07 +0000 +++ doc/lispref/loading.texi 2012-05-10 02:57:10 +0000 @@ -376,9 +376,8 @@ a particular Lisp file to be interpreted as unibyte by writing @samp{coding: raw-text} in a local variables section. With that designator, the file will unconditionally be interpreted as -unibyte, even in an ordinary multibyte Emacs session. This can matter -when making keybindings to non-@acronym{ASCII} characters written as -@code{?v@var{literal}}. +unibyte. This can matter when making keybindings to +non-@acronym{ASCII} characters written as @code{?v@var{literal}}. @node Autoload @section Autoload ------------------------------------------------------------ revno: 108183 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-05-09 19:54:07 -0700 message: Update doc for obsolescence of "unibyte: t" * doc/emacs/mule.texi (Disabling Multibyte): * doc/lispref/loading.texi (Loading Non-ASCII): Replace the obsolete "unibyte: t" with "coding: raw-text". * etc/NEWS: Related markup. diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2012-05-10 00:58:16 +0000 +++ doc/emacs/ChangeLog 2012-05-10 02:54:07 +0000 @@ -1,5 +1,8 @@ 2012-05-10 Glenn Morris + * mule.texi (Disabling Multibyte): Replace the obsolete "unibyte: t" + with "coding: raw-text". + * files.texi (Interlocking): Mention create-lockfiles option. 2012-05-09 Chong Yidong === modified file 'doc/emacs/mule.texi' --- doc/emacs/mule.texi 2012-05-09 03:06:08 +0000 +++ doc/emacs/mule.texi 2012-05-10 02:54:07 +0000 @@ -287,20 +287,17 @@ This includes the Emacs initialization file, @file{.emacs}, and the initialization files of packages such as Gnus. However, you can specify unibyte loading for a -particular Lisp file, by adding an entry @samp{unibyte: t} in a file -local variables section (@pxref{File Variables}). Then that file is -always loaded as unibyte text. Note that this does not represent a -real @code{unibyte} variable, rather it just acts as an indicator -to Emacs in the same way as @code{coding} does (@pxref{Specify Coding}). +particular Lisp file, by adding an entry @samp{coding: raw-text} in a file +local variables section. @xref{Specify Coding}. +Then that file is always loaded as unibyte text. @ignore @c I don't see the point of this statement: The motivation for these conventions is that it is more reliable to always load any particular Lisp file in the same way. @end ignore -Note also that this feature only applies to @emph{loading} Lisp files -for evaluation, not to visiting them for editing. You can also load a -Lisp file as unibyte, on any one occasion, by typing @kbd{C-x -@key{RET} c raw-text @key{RET}} immediately before loading it. +You can also load a Lisp file as unibyte, on any one occasion, by +typing @kbd{C-x @key{RET} c raw-text @key{RET}} immediately before +loading it. @c See http://debbugs.gnu.org/11226 for lack of unibyte tooltip. @vindex enable-multibyte-characters === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-05-10 00:58:16 +0000 +++ doc/lispref/ChangeLog 2012-05-10 02:54:07 +0000 @@ -1,5 +1,8 @@ 2012-05-10 Glenn Morris + * loading.texi (Loading Non-ASCII): Replace the obsolete "unibyte: t" + with "coding: raw-text". + * files.texi (File Locks): Mention create-lockfiles option. 2012-05-09 Glenn Morris === modified file 'doc/lispref/loading.texi' --- doc/lispref/loading.texi 2012-05-09 03:06:08 +0000 +++ doc/lispref/loading.texi 2012-05-10 02:54:07 +0000 @@ -374,7 +374,7 @@ inserting them in unibyte buffers converts them to unibyte automatically. However, if this does make a difference, you can force a particular Lisp file to be interpreted as unibyte by writing -@samp{unibyte: t} in a local variables section. With +@samp{coding: raw-text} in a local variables section. With that designator, the file will unconditionally be interpreted as unibyte, even in an ordinary multibyte Emacs session. This can matter when making keybindings to non-@acronym{ASCII} characters written as === modified file 'etc/NEWS' --- etc/NEWS 2012-05-10 00:58:16 +0000 +++ etc/NEWS 2012-05-10 02:54:07 +0000 @@ -69,6 +69,7 @@ ** You can prevent the creation of lock files by setting `create-lockfiles' to nil. Use with caution, and only if you really need to. ++++ ** Using "unibyte: t" in Lisp source files is obsolete. Use "coding: raw-text" instead. ------------------------------------------------------------ revno: 108182 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-05-09 19:46:58 -0700 message: Simply leim install rule for ns case * leim/Makefile.in (MV_DIRS): Remove. (install): Simplify the --with-ns case. diff: === modified file 'leim/ChangeLog' --- leim/ChangeLog 2012-04-09 20:37:08 +0000 +++ leim/ChangeLog 2012-05-10 02:46:58 +0000 @@ -1,3 +1,8 @@ +2012-05-10 Glenn Morris + + * Makefile.in (MV_DIRS): Remove. + (install): Simplify the --with-ns case. + 2012-04-09 Glenn Morris * Makefile.in (EMACS): Rename from BUILT_EMACS. @@ -2289,7 +2294,7 @@ ;; coding: utf-8 ;; End: - Copyright (C) 1997-1999, 2001-2012 Free Software Foundation, Inc. + Copyright (C) 1997-1999, 2001-2012 Free Software Foundation, Inc. This file is part of GNU Emacs. === modified file 'leim/Makefile.in' --- leim/Makefile.in 2012-04-09 20:37:08 +0000 +++ leim/Makefile.in 2012-05-10 02:46:58 +0000 @@ -35,6 +35,7 @@ ns_appresdir=@ns_appresdir@ # Where to install LEIM files. +# Should be $ns_appresdir/leim if $ns_appresdir is set. INSTALLDIR=$(DESTDIR)${datadir}/emacs/${version}/leim GZIP_PROG = @GZIP_PROG@ @@ -174,8 +175,6 @@ $(MAKE) $(MFLAGS) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \ done -MV_DIRS = for i in $$dir; do rm -fr `basename "$$i"` ; mv "$$i" . ; done - install: all if [ ! -d ${INSTALLDIR} ] ; then \ umask 022; ${srcdir}/../build-aux/install-sh -d ${INSTALLDIR}; \ @@ -216,9 +215,9 @@ done ; \ find ${INSTALLDIR} -exec chown $${installuser} '{}' ';' if [ "${ns_appresdir}" != "" ]; then \ - ( cd ${ns_appresdir} ; \ - if test -d share/emacs ; then dir=share/emacs/*/*; $(MV_DIRS); fi;\ - rm -fr share ) ; \ + rm -rf ${ns_appresdir}/leim; \ + mv ${INSTALLDIR} ${ns_appresdir} || exit 1; \ + rmdir -p ${ns_appresdir}/share/emacs/${version} 2>/dev/null || true; \ else true ; fi clean mostlyclean: ------------------------------------------------------------ revno: 108181 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-05-09 19:40:38 -0700 message: State that --prefix has no effect for a default --with-ns build. diff: === modified file 'nextstep/INSTALL' --- nextstep/INSTALL 2012-01-19 07:21:25 +0000 +++ nextstep/INSTALL 2012-05-10 02:40:38 +0000 @@ -16,7 +16,8 @@ make install -This will assemble the app in nextstep/Emacs.app. +This will assemble the app in nextstep/Emacs.app (i.e., the --prefix +argument has no effect in this case). If you pass the --disable-ns-self-contained option to configure, the lisp files will be installed under whatever 'prefix' is set to (defaults to ------------------------------------------------------------ revno: 108180 committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-05-09 20:58:16 -0400 message: Document new create-lockfiles option diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2012-05-09 03:30:51 +0000 +++ doc/emacs/ChangeLog 2012-05-10 00:58:16 +0000 @@ -1,3 +1,7 @@ +2012-05-10 Glenn Morris + + * files.texi (Interlocking): Mention create-lockfiles option. + 2012-05-09 Chong Yidong * frames.texi (Mouse References, Mouse Commands): Fix index === modified file 'doc/emacs/files.texi' --- doc/emacs/files.texi 2012-04-26 00:31:47 +0000 +++ doc/emacs/files.texi 2012-05-10 00:58:16 +0000 @@ -739,6 +739,11 @@ idea is that the file is locked whenever an Emacs buffer visiting it has unsaved changes. +@vindex create-lockfiles + You can prevent the creation of lock files by setting the variable +@code{create-lockfiles} to @code{nil}. @strong{Caution:} by +doing so you will lose the benefits that this feature provides. + @cindex collision If you begin to modify the buffer while the visited file is locked by someone else, this constitutes a @dfn{collision}. When Emacs detects a === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-05-09 03:30:51 +0000 +++ doc/lispref/ChangeLog 2012-05-10 00:58:16 +0000 @@ -1,3 +1,7 @@ +2012-05-10 Glenn Morris + + * files.texi (File Locks): Mention create-lockfiles option. + 2012-05-09 Glenn Morris * vol1.texi, vol2.texi: Remove files. === modified file 'doc/lispref/files.texi' --- doc/lispref/files.texi 2012-05-02 07:20:29 +0000 +++ doc/lispref/files.texi 2012-05-10 00:58:16 +0000 @@ -726,7 +726,12 @@ File locking is not supported on some systems. On systems that do not support it, the functions @code{lock-buffer}, @code{unlock-buffer} and -@code{file-locked-p} do nothing and return @code{nil}. +@code{file-locked-p} do nothing and return @code{nil}. It is also +possible to disable locking, by setting the variable @code{create-lockfiles}. + +@defopt create-lockfiles +If this variable is @code{nil}, Emacs does not lock files. +@end defopt @defun ask-user-about-lock file other-user This function is called when the user tries to modify @var{file}, but it === modified file 'etc/NEWS' --- etc/NEWS 2012-05-09 08:33:48 +0000 +++ etc/NEWS 2012-05-10 00:58:16 +0000 @@ -65,6 +65,10 @@ frames, if emacsclient is only told to open a new frame without specifying any file to visit or expression to evaluate. ++++ +** You can prevent the creation of lock files by setting `create-lockfiles' +to nil. Use with caution, and only if you really need to. + ** Using "unibyte: t" in Lisp source files is obsolete. Use "coding: raw-text" instead. ------------------------------------------------------------ revno: 108179 fixes bug(s): http://debbugs.gnu.org/11227 author: Dave Abrahams committer: Glenn Morris branch nick: trunk timestamp: Wed 2012-05-09 20:55:57 -0400 message: Add the option to not create lockfiles * src/filelock.c (syms_of_filelock): New boolean create-lockfiles. (lock_file): If create_lockfiles is 0, do nothing. * lisp/cus-start.el (create-lockfiles): Add it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-05-09 12:39:40 +0000 +++ lisp/ChangeLog 2012-05-10 00:55:57 +0000 @@ -1,3 +1,7 @@ +2012-05-10 Dave Abrahams + + * cus-start.el (create-lockfiles): Add it. + 2012-05-09 Chong Yidong * net/browse-url.el (browse-url-url-encode-chars): Use upper-case. === modified file 'lisp/cus-start.el' --- lisp/cus-start.el 2012-05-02 13:00:29 +0000 +++ lisp/cus-start.el 2012-05-10 00:55:57 +0000 @@ -204,6 +204,7 @@ (delete-by-moving-to-trash auto-save boolean "23.1") (auto-save-visited-file-name auto-save boolean) ;; filelock.c + (create-lockfiles files boolean "24.2") (temporary-file-directory ;; Darwin section added 24.1, does not seem worth :version bump. files directory nil === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-09 21:13:43 +0000 +++ src/ChangeLog 2012-05-10 00:55:57 +0000 @@ -1,3 +1,8 @@ +2012-05-10 Dave Abrahams + + * filelock.c (syms_of_filelock): New boolean create-lockfiles. + (lock_file): If create_lockfiles is 0, do nothing. (Bug#11227) + 2012-05-09 Michael Albinus * dbusbind.c (xd_registered_buses): New internal Lisp object. === modified file 'src/filelock.c' --- src/filelock.c 2012-01-19 07:21:25 +0000 +++ src/filelock.c 2012-05-10 00:55:57 +0000 @@ -550,6 +550,10 @@ struct gcpro gcpro1; USE_SAFE_ALLOCA; + /* Don't do locking if the user has opted out. */ + if (! create_lockfiles) + return; + /* Don't do locking while dumping Emacs. Uncompressing wtmp files uses call-process, which does not work in an uninitialized Emacs. */ @@ -722,6 +726,10 @@ doc: /* The directory for writing temporary files. */); Vtemporary_file_directory = Qnil; + DEFVAR_BOOL ("create-lockfiles", create_lockfiles, + doc: /* Non-nil means use lockfiles to avoid editing collisions. */); + create_lockfiles = 1; + #ifdef CLASH_DETECTION defsubr (&Sunlock_buffer); defsubr (&Slock_buffer); ------------------------------------------------------------ revno: 108178 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-05-09 17:27:32 -0700 message: etags: pacify gcc -Wstack-protector on Ubuntu 12.04 x86 * etags.c: Include . (error): Declare as printf-style, as that's what it really is. All uses changed. (add_regex): Use single char rather than array-of-one char. diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2012-05-05 04:32:58 +0000 +++ lib-src/ChangeLog 2012-05-10 00:27:32 +0000 @@ -1,3 +1,11 @@ +2012-05-10 Paul Eggert + + etags: pacify gcc -Wstack-protector on Ubuntu 12.04 x86 + * etags.c: Include . + (error): Declare as printf-style, as that's what it really is. + All uses changed. + (add_regex): Use single char rather than array-of-one char. + 2012-05-05 Jim Meyering * lib-src/pop.c (pop_stat, pop_list, pop_multi_first, pop_last): === modified file 'lib-src/etags.c' --- lib-src/etags.c 2012-01-19 07:21:25 +0000 +++ lib-src/etags.c 2012-05-10 00:27:32 +0000 @@ -158,6 +158,7 @@ # endif #endif /* HAVE_UNISTD_H */ +#include #include #include #include @@ -380,7 +381,7 @@ static void analyse_regex (char *); static void free_regexps (void); static void regex_tag_multiline (void); -static void error (const char *, const char *); +static void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); static void suggest_asking_for_help (void) NO_RETURN; void fatal (const char *, const char *) NO_RETURN; static void pfatal (const char *) NO_RETURN; @@ -1140,7 +1141,7 @@ case 'o': if (tagfile) { - error ("-o option may only be given once.", (char *)NULL); + error ("-o option may only be given once."); suggest_asking_for_help (); /* NOTREACHED */ } @@ -1224,7 +1225,7 @@ if (nincluded_files == 0 && file_count == 0) { - error ("no input files specified.", (char *)NULL); + error ("no input files specified."); suggest_asking_for_help (); /* NOTREACHED */ } @@ -1447,7 +1448,7 @@ language *lang; if (name == NULL) - error ("empty language name", (char *)NULL); + error ("empty language name"); else { for (lang = lang_names; lang->name != NULL; lang++) @@ -2233,7 +2234,7 @@ { /* Ctags mode */ if (np->name == NULL) - error ("internal error: NULL name in ctags mode.", (char *)NULL); + error ("internal error: NULL name in ctags mode."); if (cxref_style) { @@ -2773,7 +2774,7 @@ case dignorerest: return FALSE; default: - error ("internal error: definedef value.", (char *)NULL); + error ("internal error: definedef value."); } /* @@ -3061,7 +3062,7 @@ make_tag (concat ("INVALID TOKEN:-->", token_name.buffer, ""), token_name.len + 17, isfun, token.line, token.offset+token.length+1, token.lineno, token.linepos); - error ("INVALID TOKEN", NULL); + error ("INVALID TOKEN"); } token.valid = FALSE; @@ -5706,7 +5707,7 @@ { static struct re_pattern_buffer zeropattern; char sep, *pat, *name, *modifiers; - char empty[] = ""; + char empty = '\0'; const char *err; struct re_pattern_buffer *patbuf; regexp *rp; @@ -5719,7 +5720,7 @@ if (strlen (regexp_pattern) < 3) { - error ("null regexp", (char *)NULL); + error ("null regexp"); return; } sep = regexp_pattern[0]; @@ -5738,7 +5739,7 @@ if (modifiers == NULL) /* no terminating separator --> no name */ { modifiers = name; - name = empty; + name = ∅ } else modifiers += 1; /* skip separator */ @@ -5749,7 +5750,7 @@ { case 'N': if (modifiers == name) - error ("forcing explicit tag name but no name, ignoring", NULL); + error ("forcing explicit tag name but no name, ignoring"); force_explicit_name = TRUE; break; case 'i': @@ -5763,12 +5764,7 @@ need_filebuf = TRUE; break; default: - { - char wrongmod [2]; - wrongmod[0] = modifiers[0]; - wrongmod[1] = '\0'; - error ("invalid regexp modifier `%s', ignoring", wrongmod); - } + error ("invalid regexp modifier `%c', ignoring", modifiers[0]); break; } @@ -6423,13 +6419,16 @@ exit (EXIT_FAILURE); } -/* Print error message. `s1' is printf control string, `s2' is arg for it. */ +/* Output a diagnostic with printf-style FORMAT and args. */ static void -error (const char *s1, const char *s2) +error (const char *format, ...) { + va_list ap; + va_start (ap, format); fprintf (stderr, "%s: ", progname); - fprintf (stderr, s1, s2); + vfprintf (stderr, format, ap); fprintf (stderr, "\n"); + va_end (ap); } /* Return a newly-allocated string whose contents ------------------------------------------------------------ revno: 108177 committer: Michael Albinus branch nick: trunk timestamp: Wed 2012-05-09 23:13:43 +0200 message: * dbusbind.c (xd_registered_buses): New internal Lisp object. Rename all occurences of Vdbus_registered_buses to xd_registered_buses. (syms_of_dbusbind): Remove declaration of Vdbus_registered_buses. Initialize xd_registered_buses. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-09 17:51:30 +0000 +++ src/ChangeLog 2012-05-09 21:13:43 +0000 @@ -1,3 +1,10 @@ +2012-05-09 Michael Albinus + + * dbusbind.c (xd_registered_buses): New internal Lisp object. + Rename all occurences of Vdbus_registered_buses to xd_registered_buses. + (syms_of_dbusbind): Remove declaration of Vdbus_registered_buses. + Initialize xd_registered_buses. + 2012-05-09 Paul Eggert Untag more efficiently if USE_LSB_TAG. === modified file 'src/dbusbind.c' --- src/dbusbind.c 2012-05-09 15:07:46 +0000 +++ src/dbusbind.c 2012-05-09 21:13:43 +0000 @@ -64,6 +64,11 @@ static Lisp_Object QCdbus_registered_serial, QCdbus_registered_method; static Lisp_Object QCdbus_registered_signal; +/* Alist of D-Bus buses we are polling for messages. + The key is the symbol or string of the bus, and the value is the + connection address. */ +static Lisp_Object xd_registered_buses; + /* Whether we are reading a D-Bus event. */ static int xd_in_read_queued_messages = 0; @@ -903,7 +908,7 @@ DBusConnection *connection; Lisp_Object val; - val = CDR_SAFE (Fassoc (bus, Vdbus_registered_buses)); + val = CDR_SAFE (Fassoc (bus, xd_registered_buses)); if (NILP (val)) XD_SIGNAL2 (build_string ("No connection to bus"), bus); else @@ -1003,7 +1008,7 @@ Lisp_Object val; /* Check whether we are connected. */ - val = Fassoc (bus, Vdbus_registered_buses); + val = Fassoc (bus, xd_registered_buses); if (NILP (val)) return; @@ -1022,7 +1027,7 @@ dbus_connection_unref (connection); /* Remove bus from list of registered buses. */ - Vdbus_registered_buses = Fdelete (val, Vdbus_registered_buses); + xd_registered_buses = Fdelete (val, xd_registered_buses); /* Return. */ return; @@ -1115,7 +1120,7 @@ /* Add bus to list of registered buses. */ XSETFASTINT (val, (intptr_t) connection); - Vdbus_registered_buses = Fcons (Fcons (bus, val), Vdbus_registered_buses); + xd_registered_buses = Fcons (Fcons (bus, val), xd_registered_buses); /* We do not want to abort. */ putenv ((char *) "DBUS_FATAL_WARNINGS=0"); @@ -1608,7 +1613,7 @@ static void xd_read_queued_messages (int fd, void *data, int for_read) { - Lisp_Object busp = Vdbus_registered_buses; + Lisp_Object busp = xd_registered_buses; Lisp_Object bus = Qnil; Lisp_Object key; @@ -1728,14 +1733,6 @@ doc: /* Message type of a signal message. */); Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL); - DEFVAR_LISP ("dbus-registered-buses", - Vdbus_registered_buses, - doc: /* Alist of D-Bus buses we are polling for messages. - -The key is the symbol or string of the bus, and the value is the -connection address. */); - Vdbus_registered_buses = Qnil; - DEFVAR_LISP ("dbus-registered-objects-table", Vdbus_registered_objects_table, doc: /* Hash table of registered functions for D-Bus. @@ -1789,6 +1786,10 @@ Vdbus_debug = Qnil; #endif + /* Initialize internal objects. */ + xd_registered_buses = Qnil; + staticpro (&xd_registered_buses); + Fprovide (intern_c_string ("dbusbind"), Qnil); } ------------------------------------------------------------ revno: 108176 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-05-09 10:51:30 -0700 message: Untag more efficiently if USE_LSB_TAG. This is based on a proposal by YAMAMOTO Mitsuharu in . For an admittedly artificial (nth 8000 longlist) benchmark on Fedora 15 x86-64, this yields a 25% CPU speedup. Also, it shrinks Emacs's overall text size by 1%. * lisp.h (XUNTAG): New macro. (XCONS, XVECTOR, XSTRING, XSYMBOL, XFLOAT, XMISC, XPROCESS, XWINDOW) (XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE, XSUB_CHAR_TABLE, XBOOL_VECTOR) (XSETTYPED_PSEUDOVECTOR, XHASH_TABLE, TYPED_PSEUDOVECTORP): Use it. * eval.c (Fautoload): * font.h (XFONT_SPEC, XFONT_ENTITY, XFONT_OBJECT): * frame.h (XFRAME): Use XUNTAG. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-09 15:07:46 +0000 +++ src/ChangeLog 2012-05-09 17:51:30 +0000 @@ -1,5 +1,19 @@ 2012-05-09 Paul Eggert + Untag more efficiently if USE_LSB_TAG. + This is based on a proposal by YAMAMOTO Mitsuharu in + . + For an admittedly artificial (nth 8000 longlist) benchmark on + Fedora 15 x86-64, this yields a 25% CPU speedup. Also, it shrinks + Emacs's overall text size by 1%. + * lisp.h (XUNTAG): New macro. + (XCONS, XVECTOR, XSTRING, XSYMBOL, XFLOAT, XMISC, XPROCESS, XWINDOW) + (XTERMINAL, XSUBR, XBUFFER, XCHAR_TABLE, XSUB_CHAR_TABLE, XBOOL_VECTOR) + (XSETTYPED_PSEUDOVECTOR, XHASH_TABLE, TYPED_PSEUDOVECTORP): Use it. + * eval.c (Fautoload): + * font.h (XFONT_SPEC, XFONT_ENTITY, XFONT_OBJECT): + * frame.h (XFRAME): Use XUNTAG. + Port recent dbusbind.c changes to 32-bit --with-wide-int. * dbusbind.c (xd_append_arg, xd_retrieve_arg, Fdbus_message_internal): Remove unportable assumptions about print widths of types like === modified file 'src/eval.c' --- src/eval.c 2012-04-09 13:05:48 +0000 +++ src/eval.c 2012-05-09 17:51:30 +0000 @@ -2048,7 +2048,7 @@ We used to use 0 here, but that leads to accidental sharing in purecopy's hash-consing, so we use a (hopefully) unique integer instead. */ - docstring = make_number (XPNTR (function)); + docstring = make_number (XUNTAG (function, Lisp_Symbol)); return Ffset (function, Fpurecopy (list5 (Qautoload, file, docstring, interactive, type))); === modified file 'src/font.h' --- src/font.h 2012-01-19 07:21:25 +0000 +++ src/font.h 2012-05-09 17:51:30 +0000 @@ -469,11 +469,12 @@ } while (0) #define XFONT_SPEC(p) \ - (eassert (FONT_SPEC_P(p)), (struct font_spec *) XPNTR (p)) + (eassert (FONT_SPEC_P (p)), (struct font_spec *) XUNTAG (p, Lisp_Vectorlike)) #define XFONT_ENTITY(p) \ - (eassert (FONT_ENTITY_P(p)), (struct font_entity *) XPNTR (p)) + (eassert (FONT_ENTITY_P (p)), \ + (struct font_entity *) XUNTAG (p, Lisp_Vectorlike)) #define XFONT_OBJECT(p) \ - (eassert (FONT_OBJECT_P(p)), (struct font *) XPNTR (p)) + (eassert (FONT_OBJECT_P (p)), (struct font *) XUNTAG (p, Lisp_Vectorlike)) #define XSETFONT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FONT)) /* Number of pt per inch (from the TeXbook). */ === modified file 'src/frame.h' --- src/frame.h 2012-01-19 07:21:25 +0000 +++ src/frame.h 2012-05-09 17:51:30 +0000 @@ -501,7 +501,8 @@ typedef struct frame *FRAME_PTR; -#define XFRAME(p) (eassert (FRAMEP(p)),(struct frame *) XPNTR (p)) +#define XFRAME(p) \ + (eassert (FRAMEP (p)), (struct frame *) XUNTAG (p, Lisp_Vectorlike)) #define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME)) /* Given a window, return its frame as a Lisp_Object. */ === modified file 'src/lisp.h' --- src/lisp.h 2012-05-04 23:16:47 +0000 +++ src/lisp.h 2012-05-09 17:51:30 +0000 @@ -475,6 +475,7 @@ (var) = (type) | (intptr_t) (ptr)) #define XPNTR(a) ((intptr_t) ((a) & ~TYPEMASK)) +#define XUNTAG(a, type) ((intptr_t) ((a) - (type))) #else /* not USE_LSB_TAG */ @@ -581,6 +582,13 @@ # define XSETFASTINT(a, b) (XSETINT (a, b)) #endif +/* Extract the pointer value of the Lisp object A, under the + assumption that A's type is TYPE. This is a fallback + implementation if nothing faster is available. */ +#ifndef XUNTAG +# define XUNTAG(a, type) XPNTR (a) +#endif + #define EQ(x, y) (XHASH (x) == XHASH (y)) /* Number of bits in a fixnum, including the sign bit. */ @@ -607,15 +615,20 @@ /* Extract a value or address from a Lisp_Object. */ -#define XCONS(a) (eassert (CONSP (a)), (struct Lisp_Cons *) XPNTR (a)) -#define XVECTOR(a) (eassert (VECTORLIKEP (a)), (struct Lisp_Vector *) XPNTR (a)) -#define XSTRING(a) (eassert (STRINGP (a)), (struct Lisp_String *) XPNTR (a)) -#define XSYMBOL(a) (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) XPNTR (a)) -#define XFLOAT(a) (eassert (FLOATP (a)), (struct Lisp_Float *) XPNTR (a)) +#define XCONS(a) (eassert (CONSP (a)), \ + (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) +#define XVECTOR(a) (eassert (VECTORLIKEP (a)), \ + (struct Lisp_Vector *) XUNTAG (a, Lisp_Vectorlike)) +#define XSTRING(a) (eassert (STRINGP (a)), \ + (struct Lisp_String *) XUNTAG (a, Lisp_String)) +#define XSYMBOL(a) (eassert (SYMBOLP (a)), \ + (struct Lisp_Symbol *) XUNTAG (a, Lisp_Symbol)) +#define XFLOAT(a) (eassert (FLOATP (a)), \ + (struct Lisp_Float *) XUNTAG (a, Lisp_Float)) /* Misc types. */ -#define XMISC(a) ((union Lisp_Misc *) XPNTR (a)) +#define XMISC(a) ((union Lisp_Misc *) XUNTAG (a, Lisp_Misc)) #define XMISCANY(a) (eassert (MISCP (a)), &(XMISC (a)->u_any)) #define XMISCTYPE(a) (XMISCANY (a)->type) #define XMARKER(a) (eassert (MARKERP (a)), &(XMISC (a)->u_marker)) @@ -635,14 +648,24 @@ /* Pseudovector types. */ -#define XPROCESS(a) (eassert (PROCESSP (a)), (struct Lisp_Process *) XPNTR (a)) -#define XWINDOW(a) (eassert (WINDOWP (a)), (struct window *) XPNTR (a)) -#define XTERMINAL(a) (eassert (TERMINALP (a)), (struct terminal *) XPNTR (a)) -#define XSUBR(a) (eassert (SUBRP (a)), (struct Lisp_Subr *) XPNTR (a)) -#define XBUFFER(a) (eassert (BUFFERP (a)), (struct buffer *) XPNTR (a)) -#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR (a)) -#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), (struct Lisp_Sub_Char_Table *) XPNTR (a)) -#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR (a)) +#define XPROCESS(a) (eassert (PROCESSP (a)), \ + (struct Lisp_Process *) XUNTAG (a, Lisp_Vectorlike)) +#define XWINDOW(a) (eassert (WINDOWP (a)), \ + (struct window *) XUNTAG (a, Lisp_Vectorlike)) +#define XTERMINAL(a) (eassert (TERMINALP (a)), \ + (struct terminal *) XUNTAG (a, Lisp_Vectorlike)) +#define XSUBR(a) (eassert (SUBRP (a)), \ + (struct Lisp_Subr *) XUNTAG (a, Lisp_Vectorlike)) +#define XBUFFER(a) (eassert (BUFFERP (a)), \ + (struct buffer *) XUNTAG (a, Lisp_Vectorlike)) +#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), \ + (struct Lisp_Char_Table *) XUNTAG (a, Lisp_Vectorlike)) +#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), \ + ((struct Lisp_Sub_Char_Table *) \ + XUNTAG (a, Lisp_Vectorlike))) +#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), \ + ((struct Lisp_Bool_Vector *) \ + XUNTAG (a, Lisp_Vectorlike))) /* Construct a Lisp_Object from a value or address. */ @@ -669,7 +692,9 @@ /* The cast to struct vectorlike_header * avoids aliasing issues. */ #define XSETPSEUDOVECTOR(a, b, code) \ XSETTYPED_PSEUDOVECTOR(a, b, \ - ((struct vectorlike_header *) XPNTR (a))->size, \ + (((struct vectorlike_header *) \ + XUNTAG (a, Lisp_Vectorlike)) \ + ->size), \ code) #define XSETTYPED_PSEUDOVECTOR(a, b, size, code) \ (XSETVECTOR (a, b), \ @@ -1277,7 +1302,7 @@ #define XHASH_TABLE(OBJ) \ - ((struct Lisp_Hash_Table *) XPNTR (OBJ)) + ((struct Lisp_Hash_Table *) XUNTAG (OBJ, Lisp_Vectorlike)) #define XSET_HASH_TABLE(VAR, PTR) \ (XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE)) @@ -1735,7 +1760,7 @@ code is CODE. */ #define TYPED_PSEUDOVECTORP(x, t, code) \ (VECTORLIKEP (x) \ - && (((((struct t *) XPNTR (x))->size \ + && (((((struct t *) XUNTAG (x, Lisp_Vectorlike))->size \ & (PSEUDOVECTOR_FLAG | (code)))) \ == (PSEUDOVECTOR_FLAG | (code)))) ------------------------------------------------------------ revno: 108175 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-05-09 08:07:46 -0700 message: Port recent dbusbind.c changes to 32-bit --with-wide-int. * dbusbind.c (xd_append_arg, xd_retrieve_arg, Fdbus_message_internal): Remove unportable assumptions about print widths of types like dbus_uint32_t. (xd_get_connection_address, Fdbus_init_bus): Cast Emacs integer to intptr_t when converting between pointer and integer, to avoid GCC warnings about wrong width. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-05-09 03:06:08 +0000 +++ src/ChangeLog 2012-05-09 15:07:46 +0000 @@ -1,3 +1,13 @@ +2012-05-09 Paul Eggert + + Port recent dbusbind.c changes to 32-bit --with-wide-int. + * dbusbind.c (xd_append_arg, xd_retrieve_arg, Fdbus_message_internal): + Remove unportable assumptions about print widths of types like + dbus_uint32_t. + (xd_get_connection_address, Fdbus_init_bus): Cast Emacs integer to + intptr_t when converting between pointer and integer, to avoid GCC + warnings about wrong width. + 2012-05-09 Eli Zaretskii * w32proc.c (new_child): Force Windows to reserve only 64KB of === modified file 'src/dbusbind.c' --- src/dbusbind.c 2012-05-07 14:57:18 +0000 +++ src/dbusbind.c 2012-05-09 15:07:46 +0000 @@ -551,7 +551,7 @@ CHECK_NATNUM (object); { unsigned char val = XFASTINT (object) & 0xFF; - XD_DEBUG_MESSAGE ("%c %d", dtype, val); + XD_DEBUG_MESSAGE ("%c %u", dtype, val); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); return; @@ -570,7 +570,8 @@ CHECK_NUMBER (object); { dbus_int16_t val = XINT (object); - XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); + int pval = val; + XD_DEBUG_MESSAGE ("%c %d", dtype, pval); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); return; @@ -580,7 +581,8 @@ CHECK_NATNUM (object); { dbus_uint16_t val = XFASTINT (object); - XD_DEBUG_MESSAGE ("%c %u", dtype, (unsigned int) val); + unsigned int pval = val; + XD_DEBUG_MESSAGE ("%c %u", dtype, pval); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); return; @@ -589,7 +591,8 @@ case DBUS_TYPE_INT32: { dbus_int32_t val = extract_float (object); - XD_DEBUG_MESSAGE ("%c %d", dtype, val); + int pval = val; + XD_DEBUG_MESSAGE ("%c %d", dtype, pval); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); return; @@ -601,7 +604,8 @@ #endif { dbus_uint32_t val = extract_float (object); - XD_DEBUG_MESSAGE ("%c %u", dtype, val); + unsigned int pval = val; + XD_DEBUG_MESSAGE ("%c %u", dtype, pval); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); return; @@ -610,7 +614,8 @@ case DBUS_TYPE_INT64: { dbus_int64_t val = extract_float (object); - XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); + printmax_t pval = val; + XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); return; @@ -619,7 +624,8 @@ case DBUS_TYPE_UINT64: { dbus_uint64_t val = extract_float (object); - XD_DEBUG_MESSAGE ("%c %"pI"d", dtype, val); + uprintmax_t pval = val; + XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval); if (!dbus_message_iter_append_basic (iter, dtype, &val)) XD_SIGNAL2 (build_string ("Unable to append argument"), object); return; @@ -754,7 +760,7 @@ unsigned int val; dbus_message_iter_get_basic (iter, &val); val = val & 0xFF; - XD_DEBUG_MESSAGE ("%c %d", dtype, val); + XD_DEBUG_MESSAGE ("%c %u", dtype, val); return make_number (val); } @@ -769,24 +775,30 @@ case DBUS_TYPE_INT16: { dbus_int16_t val; + int pval; dbus_message_iter_get_basic (iter, &val); - XD_DEBUG_MESSAGE ("%c %d", dtype, val); + pval = val; + XD_DEBUG_MESSAGE ("%c %d", dtype, pval); return make_number (val); } case DBUS_TYPE_UINT16: { dbus_uint16_t val; + int pval; dbus_message_iter_get_basic (iter, &val); - XD_DEBUG_MESSAGE ("%c %d", dtype, val); + pval = val; + XD_DEBUG_MESSAGE ("%c %d", dtype, pval); return make_number (val); } case DBUS_TYPE_INT32: { dbus_int32_t val; + int pval; dbus_message_iter_get_basic (iter, &val); - XD_DEBUG_MESSAGE ("%c %d", dtype, val); + pval = val; + XD_DEBUG_MESSAGE ("%c %d", dtype, pval); return make_fixnum_or_float (val); } @@ -796,24 +808,30 @@ #endif { dbus_uint32_t val; + unsigned int pval = val; dbus_message_iter_get_basic (iter, &val); - XD_DEBUG_MESSAGE ("%c %d", dtype, val); + pval = val; + XD_DEBUG_MESSAGE ("%c %u", dtype, pval); return make_fixnum_or_float (val); } case DBUS_TYPE_INT64: { dbus_int64_t val; + printmax_t pval; dbus_message_iter_get_basic (iter, &val); - XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); + pval = val; + XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval); return make_fixnum_or_float (val); } case DBUS_TYPE_UINT64: { dbus_uint64_t val; + uprintmax_t pval; dbus_message_iter_get_basic (iter, &val); - XD_DEBUG_MESSAGE ("%c %d", dtype, (int) val); + pval = val; + XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval); return make_fixnum_or_float (val); } @@ -889,7 +907,7 @@ if (NILP (val)) XD_SIGNAL2 (build_string ("No connection to bus"), bus); else - connection = (DBusConnection *) XFASTINT (val); + connection = (DBusConnection *) (intptr_t) XFASTINT (val); if (!dbus_connection_get_is_connected (connection)) XD_SIGNAL2 (build_string ("No connection to bus"), bus); @@ -1096,7 +1114,7 @@ XD_SIGNAL1 (build_string ("Cannot add watch functions")); /* Add bus to list of registered buses. */ - XSETFASTINT (val, connection); + XSETFASTINT (val, (intptr_t) connection); Vdbus_registered_buses = Fcons (Fcons (bus, val), Vdbus_registered_buses); /* We do not want to abort. */ @@ -1174,6 +1192,7 @@ unsigned int dtype; unsigned int mtype; dbus_uint32_t serial = 0; + unsigned int ui_serial; int timeout = -1; ptrdiff_t count; char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; @@ -1249,11 +1268,12 @@ XD_OBJECT_TO_STRING (member)); break; default: /* DBUS_MESSAGE_TYPE_METHOD_RETURN, DBUS_MESSAGE_TYPE_ERROR */ + ui_serial = serial; XD_DEBUG_MESSAGE ("%s %s %s %u", XD_MESSAGE_TYPE_TO_STRING (mtype), XD_OBJECT_TO_STRING (bus), XD_OBJECT_TO_STRING (service), - serial); + ui_serial); } /* Retrieve bus address. */ ------------------------------------------------------------ revno: 108174 fixes bug(s): http://debbugs.gnu.org/6300 committer: Chong Yidong branch nick: trunk timestamp: Wed 2012-05-09 20:39:40 +0800 message: Encoding fix for browse-url-encode-url. * lisp/net/browse-url.el (browse-url-url-encode-chars): Use upper-case. (browse-url-encode-url): Encode spaces and quotes. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-05-09 03:30:51 +0000 +++ lisp/ChangeLog 2012-05-09 12:39:40 +0000 @@ -1,3 +1,8 @@ +2012-05-09 Chong Yidong + + * net/browse-url.el (browse-url-url-encode-chars): Use upper-case. + (browse-url-encode-url): Encode spaces and quotes (Bug#6300). + 2012-05-09 Stefan Monnier * shell.el (shell-completion-vars): Fix last change (bug#11348). === modified file 'lisp/net/browse-url.el' --- lisp/net/browse-url.el 2012-04-13 15:15:42 +0000 +++ lisp/net/browse-url.el 2012-05-09 12:39:40 +0000 @@ -642,7 +642,7 @@ (s 0)) (while (setq s (string-match chars encoded-text s)) (setq encoded-text - (replace-match (format "%%%x" + (replace-match (format "%%%X" (string-to-char (match-string 0 encoded-text))) t t encoded-text) s (1+ s))) @@ -655,7 +655,7 @@ ;; FIXME: Is there an actual example of a web browser getting ;; confused? (This used to encode commas, but at least Firefox ;; handles commas correctly and doesn't accept encoded commas.) - (browse-url-url-encode-chars url "[)$]")) + (browse-url-url-encode-chars url "[\")$] ")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; URL input ------------------------------------------------------------ revno: 108173 committer: Chong Yidong branch nick: trunk timestamp: Wed 2012-05-09 20:20:26 +0800 message: * url-util.el (url--allowed-chars): Use upper-case for percent-encoding. diff: === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2012-05-09 08:33:48 +0000 +++ lisp/url/ChangeLog 2012-05-09 12:20:26 +0000 @@ -3,7 +3,7 @@ * url-util.el (url-encode-url): New function for URL quoting. (url-encoding-table, url-host-allowed-chars) (url-path-allowed-chars): New constants. - (url--allowed-chars): New helper function. + (url--allowed-chars): New helper function. Use upper-case. (url-hexify-string): Use them. * url-parse.el: Improve RFC 3986 conformance. === modified file 'lisp/url/url-util.el' --- lisp/url/url-util.el 2012-05-09 08:33:48 +0000 +++ lisp/url/url-util.el 2012-05-09 12:20:26 +0000 @@ -343,7 +343,10 @@ (defconst url-encoding-table (let ((vec (make-vector 256 nil))) (dotimes (byte 256) - (aset vec byte (format "%%%02x" byte))) + ;; RFC 3986 (Section 2.1): For consistency, URI producers and + ;; normalizers should use uppercase hexadecimal digits for all + ;; percent-encodings. + (aset vec byte (format "%%%02X" byte))) vec) "Vector translating bytes to URI-encoded %-sequences.") @@ -362,7 +365,7 @@ If STRING is multibyte, it is first converted to a utf-8 byte string. Each byte corresponding to an allowed character is left as-is, while all other bytes are converted to a three-character -string: \"%\" followed by two lowercase hex digits. +string: \"%\" followed by two upper-case hex digits. The allowed characters are specified by ALLOWED-CHARS. If this argument is nil, the list `url-unreserved-chars' determines the ------------------------------------------------------------ revno: 108172 fixes bug(s): http://debbugs.gnu.org/7017 committer: Chong Yidong branch nick: trunk timestamp: Wed 2012-05-09 16:33:48 +0800 message: Improve RFC 3986 conformance of url package. Fix 2012-04-10 change to url.el. * url-http.el (url-http-create-request): Ignore obsolete attributes slot of url-object. * url-parse.el: Improve RFC 3986 conformance. (url-generic-parse-url): Do not populate the ATTRIBUTES slot, since this is not reliable for general RFC 3986 URIs. Keep the whole path and query inside the FILENAME slot. Improve docstring. (url-recreate-url-attributes): Mark as obsolete. (url-recreate-url): Handle missing scheme and userinfo. * url-util.el (url-encode-url): New function for URL quoting. (url-encoding-table, url-host-allowed-chars) (url-path-allowed-chars): New constants. (url--allowed-chars): New helper function. (url-hexify-string): Use them. * url-vars.el (url-nonrelative-link): Make the regexp stricter. * url.el (url-retrieve-internal): Use url-encode-url. diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-05-07 22:40:58 +0000 +++ etc/NEWS 2012-05-09 08:33:48 +0000 @@ -202,6 +202,18 @@ *** New command `tabulated-list-sort', bound to `S', sorts the column at point, or the Nth column if a numeric prefix argument is given. +** URL + +*** Structs made by `url-generic-parse-url' have nil `attributes' slot. +Previously, this slot stored semicolon-separated attribute-value pairs +appended to some imap URLs, but this is not compatible with RFC 3986. +So now the `filename' slot stores the entire path and query components +and the `attributes' slot is always nil. + +*** New function `url-encode-url' for encoding a URI string. +The `url-retrieve' function now uses this to encode its URL argument, +in case that is not properly encoded. + ** Obsolete packages: *** assoc.el === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2012-04-26 12:43:28 +0000 +++ lisp/url/ChangeLog 2012-05-09 08:33:48 +0000 @@ -1,3 +1,25 @@ +2012-05-09 Chong Yidong + + * url-util.el (url-encode-url): New function for URL quoting. + (url-encoding-table, url-host-allowed-chars) + (url-path-allowed-chars): New constants. + (url--allowed-chars): New helper function. + (url-hexify-string): Use them. + + * url-parse.el: Improve RFC 3986 conformance. + (url-generic-parse-url): Do not populate the ATTRIBUTES slot, + since this is not reliable for general RFC 3986 URIs. Keep the + whole path and query inside the FILENAME slot. Improve docstring. + (url-recreate-url-attributes): Mark as obsolete. + (url-recreate-url): Handle missing scheme and userinfo. + + * url-http.el (url-http-create-request): Ignore obsolete + attributes slot of url-object. + + * url-vars.el (url-nonrelative-link): Make the regexp stricter. + + * url.el (url-retrieve-internal): Use url-encode-url (Bug#7017). + 2012-04-26 Stefan Monnier * url.el (url-retrieve-synchronously): Replace lexical-let by === modified file 'lisp/url/url-http.el' --- lisp/url/url-http.el 2012-03-11 15:12:26 +0000 +++ lisp/url/url-http.el 2012-05-09 08:33:48 +0000 @@ -223,8 +223,7 @@ (let ((url-basic-auth-storage 'url-http-proxy-basic-auth-storage)) (url-get-authentication url-http-target-url nil 'any nil)))) - (real-fname (concat (url-filename url-http-target-url) - (url-recreate-url-attributes url-http-target-url))) + (real-fname (url-filename url-http-target-url)) (host (url-host url-http-target-url)) (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers)) nil === modified file 'lisp/url/url-parse.el' --- lisp/url/url-parse.el 2012-02-08 00:04:42 +0000 +++ lisp/url/url-parse.el 2012-05-09 08:33:48 +0000 @@ -48,21 +48,31 @@ ;;;###autoload (defun url-recreate-url (urlobj) "Recreate a URL string from the parsed URLOBJ." - (concat (url-type urlobj) ":" (if (url-host urlobj) "//" "") - (if (url-user urlobj) - (concat (url-user urlobj) - (if (url-password urlobj) - (concat ":" (url-password urlobj))) - "@")) - (url-host urlobj) - (if (and (url-port urlobj) - (not (equal (url-port urlobj) - (url-scheme-get-property (url-type urlobj) 'default-port)))) - (format ":%d" (url-port urlobj))) - (or (url-filename urlobj) "/") - (url-recreate-url-attributes urlobj) - (if (url-target urlobj) - (concat "#" (url-target urlobj))))) + (let ((type (url-type urlobj)) + (user (url-user urlobj)) + (pass (url-password urlobj)) + (host (url-host urlobj)) + (port (url-portspec urlobj)) + (file (url-filename urlobj)) + (frag (url-target urlobj))) + (concat (if type (concat type ":")) + (if (url-fullness urlobj) "//") + (if (or user pass) + (concat user + (if pass (concat ":" pass)) + "@")) + host + ;; RFC 3986: "omit the port component and its : delimiter + ;; if port is empty or if its value would be the same as + ;; that of the scheme's default." + (and port + (or (null type) + (not (equal port + (url-scheme-get-property type + 'default-port)))) + (format ":%d" (url-port urlobj))) + (or file "/") + (if frag (concat "#" frag))))) (defun url-recreate-url-attributes (urlobj) "Recreate the attributes of an URL string from the parsed URLOBJ." @@ -73,107 +83,129 @@ (concat (car x) "=" (cdr x)) (car x))) (url-attributes urlobj) ";")))) +(make-obsolete 'url-recreate-url-attributes nil "24.2") ;;;###autoload (defun url-generic-parse-url (url) "Return an URL-struct of the parts of URL. The CL-style struct contains the following fields: -TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS." - ;; See RFC 3986. - (cond - ((null url) - (url-parse-make-urlobj)) - ((or (not (string-match url-nonrelative-link url)) - (= ?/ (string-to-char url))) - ;; This isn't correct, as a relative URL can be a fragment link - ;; (e.g. "#foo") and many other things (see section 4.2). - ;; However, let's not fix something that isn't broken, especially - ;; when close to a release. - (url-parse-make-urlobj nil nil nil nil nil url)) - (t + +TYPE is the URI scheme (string or nil). +USER is the user name (string or nil). +PASSWORD is the password (string [deprecated] or nil). +HOST is the host (a registered name, IP literal in square + brackets, or IPv4 address in dotted-decimal form). +PORTSPEC is the specified port (a number), or nil. +FILENAME is the path AND the query component of the URI. +TARGET is the fragment identifier component (used to refer to a + subordinate resource, e.g. a part of a webpage). +ATTRIBUTES is nil; this slot originally stored the attribute and + value alists for IMAP URIs, but this feature was removed + since it conflicts with RFC 3986. +FULLNESS is non-nil iff the authority component of the URI is + present. + +The parser follows RFC 3986, except that it also tries to handle +URIs that are not fully specified (e.g. lacking TYPE), and it +does not check for or perform %-encoding. + +Here is an example. The URL + + foo://bob:pass@example.com:42/a/b/c.dtb?type=animal&name=narwhal#nose + +parses to + + TYPE = \"foo\" + USER = \"bob\" + PASSWORD = \"pass\" + HOST = \"example.com\" + PORTSPEC = 42 + FILENAME = \"/a/b/c.dtb?type=animal&name=narwhal\" + TARGET = \"nose\" + ATTRIBUTES = nil + FULLNESS = t" + (if (null url) + (url-parse-make-urlobj) (with-temp-buffer ;; Don't let those temp-buffer modifications accidentally ;; deactivate the mark of the current-buffer. (let ((deactivate-mark nil)) (set-syntax-table url-parse-syntax-table) - (let ((save-pos nil) - (prot nil) - (user nil) - (pass nil) - (host nil) - (port nil) - (file nil) - (refs nil) - (attr nil) - (full nil) + (erase-buffer) + (insert url) + (goto-char (point-min)) + (let ((save-pos (point)) + scheme user pass host port file fragment full (inhibit-read-only t)) - (erase-buffer) - (insert url) - (goto-char (point-min)) - (setq save-pos (point)) ;; 3.1. Scheme - (unless (looking-at "//") - (skip-chars-forward "a-zA-Z+.\\-") - (downcase-region save-pos (point)) - (setq prot (buffer-substring save-pos (point))) - (skip-chars-forward ":") - (setq save-pos (point))) + ;; This is nil for a URI that is not fully specified. + (when (looking-at "\\([a-zA-Z][-a-zA-Z0-9+.]*\\):") + (goto-char (match-end 0)) + (setq save-pos (point)) + (setq scheme (downcase (match-string 1)))) ;; 3.2. Authority (when (looking-at "//") (setq full t) (forward-char 2) (setq save-pos (point)) - (skip-chars-forward "^/") + (skip-chars-forward "^/?#") (setq host (buffer-substring save-pos (point))) + ;; 3.2.1 User Information (if (string-match "^\\([^@]+\\)@" host) (setq user (match-string 1 host) - host (substring host (match-end 0) nil))) - (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user)) + host (substring host (match-end 0)))) + (if (and user (string-match "\\`\\([^:]*\\):\\(.*\\)" user)) (setq pass (match-string 2 user) user (match-string 1 user))) - ;; This gives wrong results for IPv6 literal addresses. - (if (string-match ":\\([0-9+]+\\)" host) - (setq port (string-to-number (match-string 1 host)) - host (substring host 0 (match-beginning 0)))) - (if (string-match ":$" host) - (setq host (substring host 0 (match-beginning 0)))) - (setq host (downcase host) - save-pos (point))) - - (if (not port) - (setq port (url-scheme-get-property prot 'default-port))) - - ;; 3.3. Path - ;; Gross hack to preserve ';' in data URLs + (cond + ;; IPv6 literal address. + ((string-match "^\\(\\[[^]]+\\]\\)\\(?::\\([0-9]*\\)\\)?$" host) + (setq port (match-string 2 host) + host (match-string 1 host))) + ;; Registered name or IPv4 address. + ((string-match ":\\([0-9]*\\)$" host) + (setq port (match-string 1 host) + host (substring host 0 (match-beginning 0))))) + (cond ((equal port "") + (setq port nil)) + (port + (setq port (string-to-number port)))) + (setq host (downcase host))) + + (and (null port) + scheme + (setq port (url-scheme-get-property scheme 'default-port))) + + ;; Now point is on the / ? or # which terminates the + ;; authority, or at the end of the URI, or (if there is no + ;; authority) at the beginning of the absolute path. + (setq save-pos (point)) - - ;; 3.4. Query - (if (string= "data" prot) - (goto-char (point-max)) - ;; Now check for references - (skip-chars-forward "^#") - (if (eobp) - nil - (delete-region - (point) - (progn - (skip-chars-forward "#") - (setq refs (buffer-substring (point) (point-max))) - (point-max)))) - (goto-char save-pos) - (skip-chars-forward "^;") - (unless (eobp) - (setq attr (url-parse-args (buffer-substring (point) (point-max)) - t) - attr (nreverse attr)))) - - (setq file (buffer-substring save-pos (point))) + (if (string= "data" scheme) + ;; For the "data" URI scheme, all the rest is the FILE. + (setq file (buffer-substring save-pos (point-max))) + ;; For hysterical raisins, our data structure returns the + ;; path and query components together in one slot. + ;; 3.3. Path + (skip-chars-forward "^?#") + ;; 3.4. Query + (when (looking-at "?") + (skip-chars-forward "^#")) + (setq file (buffer-substring save-pos (point))) + ;; 3.5 Fragment + (when (looking-at "#") + (let ((opoint (point))) + (forward-char 1) + (unless (eobp) + (setq fragment (buffer-substring (point) (point-max)))) + (delete-region opoint (point-max))))) + (if (and host (string-match "%[0-9][0-9]" host)) (setq host (url-unhex-string host))) - (url-parse-make-urlobj - prot user pass host port file refs attr full))))))) + (url-parse-make-urlobj scheme user pass host port file + fragment nil full)))))) (defmacro url-bit-for-url (method lookfor url) `(let* ((urlobj (url-generic-parse-url url)) === modified file 'lisp/url/url-util.el' --- lisp/url/url-util.el 2012-04-10 17:03:34 +0000 +++ lisp/url/url-util.el 2012-05-09 08:33:48 +0000 @@ -333,40 +333,117 @@ (concat tmp str))) (defconst url-unreserved-chars - '( - ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z + '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 - ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)) - "A list of characters that are _NOT_ reserved in the URL spec. -This is taken from RFC 2396.") + ?- ?_ ?. ?~) + "List of characters that are unreserved in the URL spec. +This is taken from RFC 3986 (section 2.3).") + +(defconst url-encoding-table + (let ((vec (make-vector 256 nil))) + (dotimes (byte 256) + (aset vec byte (format "%%%02x" byte))) + vec) + "Vector translating bytes to URI-encoded %-sequences.") + +(defun url--allowed-chars (char-list) + "Return an \"allowed character\" mask (a 256-slot vector). +The Nth element is non-nil if character N is in CHAR-LIST. The +result can be passed as the second arg to `url-hexify-string'." + (let ((vec (make-vector 256 nil))) + (dolist (byte char-list) + (ignore-errors (aset vec byte t))) + vec)) ;;;###autoload -(defun url-hexify-string (string) - "Return a new string that is STRING URI-encoded. -First, STRING is converted to utf-8, if necessary. Then, for each -character in the utf-8 string, those found in `url-unreserved-chars' -are left as-is, all others are represented as a three-character -string: \"%\" followed by two lowercase hex digits." - ;; To go faster and avoid a lot of consing, we could do: - ;; - ;; (defconst url-hexify-table - ;; (let ((map (make-vector 256 nil))) - ;; (dotimes (byte 256) (aset map byte - ;; (if (memq byte url-unreserved-chars) - ;; (char-to-string byte) - ;; (format "%%%02x" byte)))) - ;; map)) - ;; - ;; (mapconcat (curry 'aref url-hexify-table) ...) +(defun url-hexify-string (string &optional allowed-chars) + "URI-encode STRING and return the result. +If STRING is multibyte, it is first converted to a utf-8 byte +string. Each byte corresponding to an allowed character is left +as-is, while all other bytes are converted to a three-character +string: \"%\" followed by two lowercase hex digits. + +The allowed characters are specified by ALLOWED-CHARS. If this +argument is nil, the list `url-unreserved-chars' determines the +allowed characters. Otherwise, ALLOWED-CHARS should be a vector +whose Nth element is non-nil if character N is allowed." + (unless allowed-chars + (setq allowed-chars (url--allowed-chars url-unreserved-chars))) (mapconcat (lambda (byte) - (if (memq byte url-unreserved-chars) - (char-to-string byte) - (format "%%%02x" byte))) - (if (multibyte-string-p string) - (encode-coding-string string 'utf-8) - string) - "")) + (if (aref allowed-chars byte) + (char-to-string byte) + (aref url-encoding-table byte))) + (if (multibyte-string-p string) + (encode-coding-string string 'utf-8) + string) + "")) + +(defconst url-host-allowed-chars + ;; Allow % to avoid re-encoding %-encoded sequences. + (url--allowed-chars (append '(?% ?! ?$ ?& ?' ?\( ?\) ?* ?+ ?, ?\; ?=) + url-unreserved-chars)) + "Allowed-character byte mask for the host segment of a URI. +These characters are specified in RFC 3986, Appendix A.") + +(defconst url-path-allowed-chars + (let ((vec (copy-sequence url-host-allowed-chars))) + (aset vec ?/ t) + (aset vec ?: t) + (aset vec ?@ t) + vec) + "Allowed-character byte mask for the path segment of a URI. +These characters are specified in RFC 3986, Appendix A.") + +(defconst url-query-allowed-chars + (let ((vec (copy-sequence url-path-allowed-chars))) + (aset vec ?? t) + vec) + "Allowed-character byte mask for the query segment of a URI. +These characters are specified in RFC 3986, Appendix A.") + +;;;###autoload +(defun url-encode-url (url) + "Return a properly URI-encoded version of URL. +This function also performs URI normalization, e.g. converting +the scheme to lowercase if it is uppercase. Apart from +normalization, if URL is already URI-encoded, this function +should return it unchanged." + (if (multibyte-string-p url) + (setq url (encode-coding-string url 'utf-8))) + (let* ((obj (url-generic-parse-url url)) + (user (url-user obj)) + (pass (url-password obj)) + (host (url-host obj)) + (file (url-filename obj)) + (frag (url-target obj)) + path query) + (if user + (setf (url-user obj) (url-hexify-string user))) + (if pass + (setf (url-password obj) (url-hexify-string pass))) + (when host + ;; No special encoding for IPv6 literals. + (unless (string-match "\\`\\[.*\\]\\'" host) + (setf (url-host obj) + (url-hexify-string host url-host-allowed-chars)))) + ;; Split FILENAME slot into its PATH and QUERY components, and + ;; encode them separately. The PATH component can contain + ;; unreserved characters, %-encodings, and /:@!$&'()*+,;= + (when file + (if (string-match "\\?" file) + (setq path (substring file 0 (match-beginning 0)) + query (substring file (match-end 0))) + (setq path file)) + (setq path (url-hexify-string path url-path-allowed-chars)) + (if query + (setq query (url-hexify-string query url-query-allowed-chars))) + (setf (url-filename obj) + (if query (concat path "?" query) path))) + (if frag + (setf (url-target obj) + (url-hexify-string frag url-query-allowed-chars))) + (url-recreate-url obj))) ;;;###autoload (defun url-file-extension (fname &optional x) === modified file 'lisp/url/url-vars.el' --- lisp/url/url-vars.el 2012-04-09 13:05:48 +0000 +++ lisp/url/url-vars.el 2012-05-09 08:33:48 +0000 @@ -304,8 +304,12 @@ :type '(choice (const :tag "None" :value nil) string) :group 'url) +;; From RFC3986: Scheme names consist of a sequence of characters +;; beginning with a letter and followed by any combination of letters, +;; digits, plus ("+"), period ("."), or hyphen ("-"). + (defvar url-nonrelative-link - "\\`\\([-a-zA-Z0-9+.]+:\\)" + "\\`\\([a-zA-Z][-a-zA-Z0-9+.]*:\\)" "A regular expression that will match an absolute URL.") (defcustom url-max-redirections 30 === modified file 'lisp/url/url.el' --- lisp/url/url.el 2012-04-26 12:43:28 +0000 +++ lisp/url/url.el 2012-05-09 08:33:48 +0000 @@ -125,7 +125,9 @@ ;;;###autoload (defun url-retrieve (url callback &optional cbargs silent inhibit-cookies) "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished. -URL is either a string or a parsed URL. +URL is either a string or a parsed URL. If it is a string +containing characters that are not valid in a URI, those +characters are percent-encoded; see `url-encode-url'. CALLBACK is called when the object has been completely retrieved, with the current buffer containing the object, and any MIME headers associated @@ -179,10 +181,8 @@ (url-do-setup) (url-gc-dead-buffers) (if (stringp url) - (set-text-properties 0 (length url) nil url)) - (when (multibyte-string-p url) - (let ((url-unreserved-chars (append '(?: ?/) url-unreserved-chars))) - (setq url (url-hexify-string url)))) + (set-text-properties 0 (length url) nil url)) + (setq url (url-encode-url url)) (if (not (vectorp url)) (setq url (url-generic-parse-url url))) (if (not (functionp callback)) ------------------------------------------------------------ revno: 108171 committer: Glenn Morris branch nick: trunk timestamp: Tue 2012-05-08 20:30:51 -0700 message: Yet more ChangeLog merge fixes diff: === modified file 'doc/emacs/ChangeLog' --- doc/emacs/ChangeLog 2012-05-09 03:06:08 +0000 +++ doc/emacs/ChangeLog 2012-05-09 03:30:51 +0000 @@ -3,47 +3,6 @@ * frames.texi (Mouse References, Mouse Commands): Fix index entries (Bug#11362). -2012-05-09 Glenn Morris - - * custom.texi (Customization Groups, Custom Themes, Examining): - Improve page breaks. - - * rmail.texi (Rmail Display): Use example rather than smallexample. - - * calendar.texi: Convert inforefs to refs. - - * dired.texi (Dired Enter): Improve page break. - - * abbrevs.texi (Abbrev Concepts): Copyedits. - - * maintaining.texi (Registering, Tag Syntax): - Tweak line and page breaks. - - * programs.texi (Programs, Electric C): Copyedits. - (Program Modes): Add xref to Fortran. - (Left Margin Paren): Remove what was (oddly enough) the only use - of defvar in the entire Emacs manual. - (Hungry Delete): Remove footnote about ancient Emacs version. - (Other C Commands): Use example rather than smallexample. - - * text.texi (Pages, Filling, Foldout, Org Mode, HTML Mode) - (Nroff Mode, Enriched Indentation, Table Rows and Columns): - Tweak line and page breaks. - - * modes.texi (Major Modes, Minor Modes): Reword to improve page-breaks. - (Major Modes): Use example rather than smallexample. - - * mule.texi (Output Coding): Reword to improve page-breaks. - - * frames.texi (Fonts): Tweak line and page breaks. - Use example rather than smallexample. Change cross-reference. - (Text-Only Mouse): Fix xref. - - * buffers.texi (Buffers, Kill Buffer, Several Buffers) - (Indirect Buffers): Tweak line- and page-breaks. - - * fixit.texi (Fixit, Undo): Reword to improve page-breaks. - 2012-05-05 Glenn Morris * custom.texi (Customization Groups, Custom Themes, Examining): === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2012-05-09 03:11:41 +0000 +++ doc/lispref/ChangeLog 2012-05-09 03:30:51 +0000 @@ -38,23 +38,6 @@ (Sequencing, Conditionals, Signaling Errors, Handling Errors): Tweak page breaks. - * lists.texi (List-related Predicates, List Variables): - Tweak page-breaks. - (Sets And Lists): Convert inforef to xref. - - * text.texi (Auto Filling): Don't mention Emacs 19. - - * commands.texi (Event Input Misc): Don't mention unread-command-char. - * numbers.texi (Predicates on Numbers): Don't mention Emacs 18. - - * objects.texi (Process Type, Overlay Type): Tweak page-breaks. - - * intro.texi (Caveats): Copyedit. - (Lisp History): Convert inforef to xref. - (Lisp History, Printing Notation, Version Info): Improve page-breaks. - - * elisp.texi (DATE): Forgot to change the month in 2012-04-21 change. - 2012-05-08 Glenn Morris * two.el: Remove; unused since creation of two-volume.make. === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-05-09 03:06:08 +0000 +++ lisp/ChangeLog 2012-05-09 03:30:51 +0000 @@ -27,11 +27,6 @@ shell-delimiter-argument-list (bug#11348). (shell-parse-pcomplete-arguments): Obey pcomplete-arg-quote-list. -2012-05-09 Chong Yidong - - * select.el (xselect--encode-string): Always use utf-8 for TEXT on - Nextstep. - 2012-05-09 Juanma Barranquero * textmodes/rst.el: Silence byte-compiler warnings.