commit b62c0e7bee1dcf74c97e7979fe87b81598d4a4b2 (HEAD, refs/remotes/origin/master) Author: Katsumi Yamaoka Date: Tue Sep 1 06:15:35 2015 +0000 * lisp/gnus/gnus-sum.el (gnus-summary-search-article): Ensure that the article where the search word is found is displayed and pointed to in the summary buffer. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index e4c144b..447bd5d 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9489,6 +9489,7 @@ Optional argument BACKWARD means do search for backward. ;; Return whether we found the regexp. (when (eq found 'found) (goto-char point) + (sit-for 0) ;; Ensure that the point is visible in the summary window. (gnus-summary-show-thread) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point) commit 4a703c73305211c780307e3654969ac1a20fb229 Author: Zachary Kanfer Date: Tue Sep 1 03:11:50 2015 +0100 * lisp/newcomment.el (comment-dwim): Use `use-region-p' When the region is active, but is empty (length 0), act as though the region was not active; that is, put a comment at the end of the line. (Bug#21119) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 037d294..60f35c8 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -1266,7 +1266,7 @@ Else, call `comment-indent'. You can configure `comment-style' to change the way regions are commented." (interactive "*P") (comment-normalize-vars) - (if (and mark-active transient-mark-mode) + (if (use-region-p) (comment-or-uncomment-region (region-beginning) (region-end) arg) (if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$"))) ;; FIXME: If there's no comment to kill on this line and ARG is commit 9004011ec0876d74209814417f939a348e107d61 Author: Katsumi Yamaoka Date: Mon Aug 31 18:14:15 2015 -0700 Port tls.el to older Emacs * lisp/net/tls.el (tls-format-message): Alias to format-message, or format if not available. (open-tls-stream): Use it. diff --git a/lisp/net/tls.el b/lisp/net/tls.el index 1226916..46891be 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -174,6 +174,12 @@ Used by `tls-certificate-information'." :type 'string :group 'tls) +(eval-and-compile + (if (fboundp 'format-message) + (defalias 'tls-format-message 'format-message) + ;; for Emacs < 25, and XEmacs, don't worry about quote translation. + (defalias 'tls-format-message 'format))) + (defun tls-certificate-information (der) "Parse X.509 certificate in DER format into an assoc list." (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" @@ -275,8 +281,8 @@ Fourth arg PORT is an integer specifying a port to connect to." (message "The certificate presented by `%s' is \ NOT trusted." host)) (not (yes-or-no-p - (format-message "The certificate presented by `%s' is \ -NOT trusted. Accept anyway? " host))))) + (tls-format-message "\ +The certificate presented by `%s' is NOT trusted. Accept anyway? " host))))) (and tls-hostmismatch (save-excursion (goto-char (point-min)) commit 5c0fb39c280b2557f49c12a5fc49486768b9de6f Author: Rüdiger Sonderfeld Date: Tue Sep 1 00:56:53 2015 +0100 hideif.el: Recognize .h++ as C++ header. * lisp/progmodes/hideif.el (hide-ifdef-header-regexp): Add .h++. diff --git a/etc/NEWS b/etc/NEWS index e3b5ee3..3832ffa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -702,7 +702,7 @@ non-integer inputs. interactive macro evaluation and automatic scanning of #defined symbols. *** New custom variable `hide-ifdef-header-regexp' to define C/C++ header file -name patterns. Default case-insensitive .h, .hh, .hpp and .hxx. +name patterns. Default case-insensitive .h, .hh, .hpp, .hxx, and .h++. *** New custom variable `hide-ifdef-expand-reinclusion-protection' to prevent reinclusion protected header files from being fully hidden. *** New custom variable `hide-ifdef-exclude-define-regexp' to define symbol diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index a9376ff..e0d25c4 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -164,7 +164,7 @@ This behavior is generally undesirable. If this option is non-nil, the outermos :version "25.1") (defcustom hide-ifdef-header-regexp - "\\.h\\(h\\|xx\\|pp\\)?\\'" + "\\.h\\(h\\|xx\\|pp\\|\\+\\+\\)?\\'" "C/C++ header file name patterns to determine if current buffer is a header. Effective only if `hide-ifdef-expand-reinclusion-protection' is t." :type 'string commit 28854f279c982a8f69307ffac41fcf849e994882 Author: Rüdiger Sonderfeld Date: Tue Sep 1 00:29:08 2015 +0100 ; Fix missing sentence end double space in NEWS. diff --git a/etc/NEWS b/etc/NEWS index 408286a..e3b5ee3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -108,7 +108,7 @@ frames. ** `isearch' and `query-replace' now perform character folding in matches. This is analogous to case-folding, but applies between Unicode -characters and their ASCII counterparts. This means many characters +characters and their ASCII counterparts. This means many characters will match entire groups of characters. For instance, the " will match all variants of unicode double quotes @@ -121,7 +121,7 @@ by searching commands to produce a regexp matching anything that character-folds into STRING. ** New command `checkdoc-package-keywords' checks if the -current package keywords are recognized. Set the new option +current package keywords are recognized. Set the new option `checkdoc-package-keywords-flag' to non-nil to make `checkdoc-current-buffer' call this function automatically. @@ -326,7 +326,7 @@ is suitable for most programming languages such as C or Lisp (but not ** ERC -*** Hide message types by network or channel. `erc-hide-list' will +*** Hide message types by network or channel. `erc-hide-list' will hide all messages of the specified type, where `erc-network-hide-list' and `erc-channel-hide-list' will only hide the specified message types for the respective specified targets. @@ -361,7 +361,7 @@ always respect that. *** If a package is available on multiple archives and one has higher priority (as per `package-archive-priorities') only that one is -listed. This can be configured with `package-menu-hide-low-priority'. +listed. This can be configured with `package-menu-hide-low-priority'. *** `package-menu-toggle-hiding' now toggles the hiding of packages. This includes the above-mentioned low-priority packages, as well as @@ -390,7 +390,7 @@ The FORCE argument to `package-delete' overrides this. *** New custom variable `package-selected-packages' tracks packages which were installed by the user (as opposed to installed as -dependencies). This variable can also be manually customized. +dependencies). This variable can also be manually customized. *** New command `package-install-user-selected-packages' installs all packages from `package-selected-packages' which are currently missing. @@ -543,7 +543,7 @@ appending FUN to `minibuffer-setup-hook'. ** seq *** New seq library: The seq library adds sequence manipulation functions and macros that -complement basic functions provided by subr.el. All functions are +complement basic functions provided by subr.el. All functions are prefixed with `seq-' and work on lists, strings and vectors. ** map @@ -706,7 +706,7 @@ name patterns. Default case-insensitive .h, .hh, .hpp and .hxx. *** New custom variable `hide-ifdef-expand-reinclusion-protection' to prevent reinclusion protected header files from being fully hidden. *** New custom variable `hide-ifdef-exclude-define-regexp' to define symbol -name patterns (e.x. all "FOR_DOXYGEN_ONLY_*") to be excluded. +name patterns (e.g. all "FOR_DOXYGEN_ONLY_*") to be excluded. ** TeX mode commit 8307c06e1bb5c008c92ae37fb800b134c6254e58 Author: Rüdiger Sonderfeld Date: Mon Aug 31 23:50:07 2015 +0100 isearch: Document character folding mode. * isearch.el (isearch-forward): Mention `isearch-toggle-character-fold' in docstring. diff --git a/lisp/isearch.el b/lisp/isearch.el index 8d4bf24..4fc9b38 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -710,6 +710,7 @@ Type \\[isearch-toggle-invisible] to toggle search in invisible text. Type \\[isearch-toggle-regexp] to toggle regular-expression mode. Type \\[isearch-toggle-word] to toggle word mode. Type \\[isearch-toggle-symbol] to toggle symbol mode. +Type \\[isearch-toggle-character-fold] to toggle character folding. Type \\[isearch-toggle-lax-whitespace] to toggle whitespace matching. In incremental searches, a space or spaces normally matches any whitespace commit 244c417a5669eecca2a4930628ad438029466de1 Author: Paul Eggert Date: Mon Aug 31 15:10:07 2015 -0700 Quoting fixes in ERC and Eshell * lisp/erc/erc-autoaway.el (erc-autoaway-set-away): * lisp/erc/erc-backend.el (define-erc-response-handler): * lisp/erc/erc-fill.el (erc-fill-static-center): * lisp/eshell/em-dirs.el (eshell-save-some-last-dir): * lisp/eshell/em-glob.el (eshell-glob-entries): * lisp/eshell/em-hist.el (eshell-save-some-history): * lisp/eshell/em-unix.el (eshell-remove-entries, eshell/rm) (eshell-shuffle-files): * lisp/eshell/esh-cmd.el (eshell-do-eval): * lisp/eshell/esh-proc.el (eshell-process-interact) (eshell-query-kill-processes): Respect ‘text-quoting-style’ in diagnostics and doc strings. diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el index 981a213..c01cb3a 100644 --- a/lisp/erc/erc-autoaway.el +++ b/lisp/erc/erc-autoaway.el @@ -270,7 +270,7 @@ active server buffer available." ;; existing process. (when (or notest (erc-autoaway-some-open-server-buffer)) (setq erc-autoaway-caused-away t) - (erc-cmd-GAWAY (format erc-autoaway-message idle-time)))) + (erc-cmd-GAWAY (format-message erc-autoaway-message idle-time)))) (defun erc-autoaway-reset-indicators (&rest stuff) "Reset indicators used by the erc-autoaway module." diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index ee81113..db5f6a6 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1136,7 +1136,8 @@ Would expand to: aliases)) (let* ((hook-name (intern (format "erc-server-%s-functions" name))) (fn-name (intern (format "erc-server-%s" name))) - (hook-doc (format "%sHook called upon receiving a %%s server response. + (hook-doc (format-message "\ +%sHook called upon receiving a %%s server response. Each function is called with two arguments, the process associated with the response and the parsed response. If the function returns non-nil, stop processing the hook. Otherwise, continue. @@ -1146,7 +1147,8 @@ See also `%s'." (concat extra-var-doc "\n\n") "") fn-name)) - (fn-doc (format "%sHandler for a %s server response. + (fn-doc (format-message "\ +%sHandler for a %s server response. PROC is the server process which returned the response. PARSED is the actual response as an `erc-response' struct. If you want to add responses don't modify this function, but rather diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 97c4668..84816f8 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -101,7 +101,7 @@ function is called." (defcustom erc-fill-static-center 27 "Column around which all statically filled messages will be -centered. This column denotes the point where the ' ' character +centered. This column denotes the point where the ` ' character between and the entered text will be put, thus aligning nick names right and text left." :group 'erc-fill @@ -195,4 +195,3 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'." ;; Local Variables: ;; indent-tabs-mode: nil ;; End: - diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index ac1616d..1bd7fbc 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -243,8 +243,9 @@ Thus, this does not include the current directory.") eshell-ask-to-save-last-dir (or (eq eshell-ask-to-save-last-dir 'always) (y-or-n-p - (format "Save last dir ring for Eshell buffer `%s'? " - (buffer-name buf))))) + (format-message + "Save last dir ring for Eshell buffer `%s'? " + (buffer-name buf))))) (eshell-write-last-dir-ring)))))) (defun eshell-lone-directory-p (file) diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 8abdd00..976882c 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -289,7 +289,7 @@ the form: glob (car globs) len (length glob))))) (if (and recurse-p (not glob)) - (error "'**' cannot end a globbing pattern")) + (error "‘**’ cannot end a globbing pattern")) (let ((index 1)) (setq incl glob) (while (and (eq incl glob) diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 9f070c3..499eda4 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -306,8 +306,9 @@ element, regardless of any text on the command line. In that case, eshell-save-history-on-exit (or (eq eshell-save-history-on-exit t) (y-or-n-p - (format "Save input history for Eshell buffer `%s'? " - (buffer-name buf))))) + (format-message + "Save input history for Eshell buffer `%s'? " + (buffer-name buf))))) (eshell-write-history)))))) (defun eshell/history (&rest args) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 210e74d..8ae81df 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -206,23 +206,23 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." (not (file-symlink-p (car files)))) (progn (if em-verbose - (eshell-printn (format "rm: removing directory `%s'" - (car files)))) + (eshell-printn (format-message "rm: removing directory `%s'" + (car files)))) (unless (or em-preview (and em-interactive (not (y-or-n-p - (format "rm: remove directory `%s'? " - (car files)))))) + (format-message "rm: remove directory `%s'? " + (car files)))))) (eshell-funcalln 'delete-directory (car files) t t))) (if em-verbose - (eshell-printn (format "rm: removing file `%s'" - (car files)))) + (eshell-printn (format-message "rm: removing file `%s'" + (car files)))) (unless (or em-preview (and em-interactive (not (y-or-n-p - (format "rm: remove `%s'? " - (car files)))))) + (format-message "rm: remove `%s'? " + (car files)))))) (eshell-funcalln 'delete-file (car files) t)))) (setq files (cdr files)))) @@ -260,28 +260,32 @@ Remove (unlink) the FILE(s).") (cond ((bufferp entry) (if em-verbose - (eshell-printn (format "rm: removing buffer `%s'" entry))) + (eshell-printn (format-message "rm: removing buffer `%s'" entry))) (unless (or em-preview (and em-interactive - (not (y-or-n-p (format "rm: delete buffer `%s'? " - entry))))) + (not (y-or-n-p (format-message + "rm: delete buffer `%s'? " + entry))))) (eshell-funcalln 'kill-buffer entry))) ((eshell-processp entry) (if em-verbose - (eshell-printn (format "rm: killing process `%s'" entry))) + (eshell-printn (format-message "rm: killing process `%s'" entry))) (unless (or em-preview (and em-interactive - (not (y-or-n-p (format "rm: kill process `%s'? " - entry))))) + (not (y-or-n-p (format-message + "rm: kill process `%s'? " + entry))))) (eshell-funcalln 'kill-process entry))) ((symbolp entry) (if em-verbose - (eshell-printn (format "rm: uninterning symbol `%s'" entry))) + (eshell-printn (format-message + "rm: uninterning symbol `%s'" entry))) (unless (or em-preview (and em-interactive - (not (y-or-n-p (format "rm: unintern symbol `%s'? " - entry))))) + (not (y-or-n-p (format-message + "rm: unintern symbol `%s'? " + entry))))) (eshell-funcalln 'unintern entry))) ((stringp entry) ;; -f should silently ignore missing files (bug#15373). @@ -294,8 +298,8 @@ Remove (unlink) the FILE(s).") (if (or em-preview (not em-interactive) (y-or-n-p - (format "rm: descend into directory `%s'? " - entry))) + (format-message "rm: descend into directory `%s'? " + entry))) (eshell-remove-entries (list entry) t)) (eshell-error (format "rm: %s: is a directory\n" entry))) (eshell-remove-entries (list entry) t)))))) @@ -369,8 +373,8 @@ Remove the DIRECTORY(ies), if they are empty.") (equal (nth 10 attr-target) (nth 10 attr)) (nth 11 attr-target) (nth 11 attr) (equal (nth 11 attr-target) (nth 11 attr))) - (eshell-error (format "%s: `%s' and `%s' are the same file\n" - command (car files) target))) + (eshell-error (format-message "%s: `%s' and `%s' are the same file\n" + command (car files) target))) (t (let ((source (car files)) (target (if is-dir diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index efd8582..535e169 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1016,8 +1016,8 @@ be finished later after the completion of an asynchronous subprocess." ;; we can modify any `let' forms to evaluate only once. (if (macrop (car form)) (let ((exp (eshell-copy-tree (macroexpand form)))) - (eshell-manipulate (format "expanding macro `%s'" - (symbol-name (car form))) + (eshell-manipulate (format-message "expanding macro `%s'" + (symbol-name (car form))) (setcar form (car exp)) (setcdr form (cdr exp))))) (let ((args (cdr form))) @@ -1095,8 +1095,8 @@ be finished later after the completion of an asynchronous subprocess." (t (if (and args (not (memq (car form) '(run-hooks)))) (eshell-manipulate - (format "evaluating arguments to `%s'" - (symbol-name (car form))) + (format-message "evaluating arguments to `%s'" + (symbol-name (car form))) (while args (setcar args (eshell-do-eval (car args) synchronous-p)) (setq args (cdr args))))) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 86559f0..867d3b9 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -409,7 +409,8 @@ If QUERY is non-nil, query the user with QUERY before calling FUNC." (or all (not (nth 2 entry))) (or (not query) - (y-or-n-p (format query (process-name (car entry)))))) + (y-or-n-p (format-message query + (process-name (car entry)))))) (setq result (funcall func (car entry)))) (unless (memq (process-status (car entry)) '(run stop open closed)) @@ -480,11 +481,11 @@ See the variable `eshell-kill-processes-on-exit'." (save-window-excursion (list-processes) (if (or (not (eq eshell-kill-processes-on-exit 'ask)) - (y-or-n-p (format "Kill processes owned by `%s'? " - (buffer-name)))) + (y-or-n-p (format-message "Kill processes owned by `%s'? " + (buffer-name)))) (eshell-round-robin-kill (if (eq eshell-kill-processes-on-exit 'every) - "Kill Eshell child process `%s'? "))) + (format-message "Kill Eshell child process `%s'? ")))) (let ((buf (get-buffer "*Process List*"))) (if (and buf (buffer-live-p buf)) (kill-buffer buf))) commit 86f692009b949cedea9ae1e25868c54dece68318 Author: Paul Eggert Date: Mon Aug 31 13:05:16 2015 -0700 Quoting fixes in Gnus * lisp/gnus/gnus-agent.el: (gnus-agent-possibly-synchronize-flags-server): * lisp/gnus/gnus-art.el (gnus-article-browse-delete-temp-files): * lisp/gnus/gnus-eform.el (gnus-edit-form): * lisp/gnus/gnus-group.el (gnus-group-edit-group) (gnus-group-nnimap-edit-acl): * lisp/gnus/gnus-topic.el (gnus-topic-edit-parameters): * lisp/gnus/mail-source.el (mail-source-delete-old-incoming): * lisp/gnus/message.el (message-strip-subject-encoded-words) (message-check-recipients, message-send-form-letter): * lisp/gnus/mm-decode.el (mm-display-part): * lisp/gnus/mm-uu.el (mm-uu-pgp-signed-extract-1): * lisp/gnus/mml-smime.el (mml-smime-get-dns-cert) (mml-smime-get-ldap-cert): * lisp/gnus/spam-report.el (spam-report-process-queue): Respect ‘text-quoting-style’ in diagnostics. * lisp/gnus/gnus-art.el (article-display-face) * lisp/gnus/gnus-fun.el (gnus-display-x-face-in-from): Use straight quoting in email. * lisp/gnus/rfc2231.el (rfc2231-decode-encoded-string): Escape apostrophes in doc strings. diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 7b35de0..fc75586 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -868,8 +868,9 @@ be a select method." (not (eq gnus-agent-synchronize-flags 'ask))) (and (eq gnus-agent-synchronize-flags 'ask) (gnus-y-or-n-p - (format "Synchronize flags on server `%s'? " - (cadr method)))))) + (gnus-format-message + "Synchronize flags on server `%s'? " + (cadr method)))))) (gnus-agent-synchronize-flags-server method))) ;;;###autoload diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 1a439ec..b4a2f6a 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2428,7 +2428,7 @@ long lines if and only if arg is positive." (unless (setq from (gnus-article-goto-header "from")) (insert "From:") (setq from (point)) - (insert " [no `from' set]\n")) + (insert " [no 'from' set]\n")) (while faces (when (setq png (gnus-convert-face-to-png (pop faces))) (setq image @@ -2770,7 +2770,7 @@ summary buffer." (cond ((file-directory-p file) (when (or (not (eq how 'file)) (gnus-y-or-n-p - (format + (gnus-format-message "Delete temporary HTML file(s) in directory `%s'? " (file-name-as-directory file)))) (gnus-delete-directory file))) diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index 0b41b5e..c870385 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -96,7 +96,8 @@ The optional LAYOUT overrides the `edit-form' window layout." (while (not (eobp)) (insert ";;; ") (forward-line 1)) - (insert ";; Type `C-c C-c' after you've finished editing.\n") + (insert (substitute-command-keys + ";; Type `C-c C-c' after you've finished editing.\n")) (insert "\n") (let ((p (point))) (gnus-pp form) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index ca14dd0..2a535cb 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -265,7 +265,7 @@ colors of the displayed X-Faces." (article-narrow-to-head) (gnus-article-goto-header "from") (when (bobp) - (insert "From: [no `from' set]\n") + (insert "From: [no 'from' set]\n") (forward-char -17)) (gnus-add-image 'xface diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index c6cc38f..ad49824 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2950,7 +2950,7 @@ and NEW-NAME will be prompted for." (gnus-info-params info)) (t info)) ;; The proper documentation. - (format + (gnus-format-message "Editing the %s for `%s'." (cond ((eq part 'method) "select method") @@ -3278,7 +3278,8 @@ mail messages or news articles in files that have numeric names." (error "%s is not an nnimap group" group)) (unless (setq acl (nnimap-acl-get mailbox (cadr method))) (error "Server does not support ACL's")) - (gnus-edit-form acl (format "Editing the access control list for `%s'. + (gnus-edit-form acl (gnus-format-message "\ +Editing the access control list for `%s'. An access control list is a list of (identifier . rights) elements. diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 9474ca0..7c6e109 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -1616,8 +1616,8 @@ If performed on a topic, edit the topic parameters instead." (let ((topic (gnus-group-topic-name))) (gnus-edit-form (gnus-topic-parameters topic) - (format "Editing the topic parameters for `%s'." - (or group topic)) + (gnus-format-message "Editing the topic parameters for `%s'." + (or group topic)) `(lambda (form) (gnus-topic-set-parameters ,topic form))))))) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index cb74228..ad135d4 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -612,7 +612,7 @@ If CONFIRM is non-nil, ask for confirmation before removing a file." (when (and (> (- currday fileday) diff) (if confirm (y-or-n-p - (format "\ + (gnus-format-message "\ Delete old (> %s day(s)) incoming mail file `%s'? " diff bfile)) (gnus-message 8 "\ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index d74ce43..0f6f63e 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2235,7 +2235,7 @@ contains a valid encoded word. Decode again? " (unless cs-coding (setq cs-coding (mm-read-coding-system - (format "\ + (gnus-format-message "\ Decoded Subject \"%s\" contains an encoded word. The charset `%s' is unknown or invalid. Hit RET to replace non-decodable characters with \"%s\" or enter replacement @@ -4510,7 +4510,7 @@ This function could be useful in `message-setup-hook'." (dolist (bog (message-bogus-recipient-p addr)) (and bog (not (y-or-n-p - (format + (gnus-format-message "Address `%s'%s might be bogus. Continue? " bog ;; If the encoded version of the email address @@ -8484,7 +8484,7 @@ Header and body are separated by `mail-header-separator'." (when force (sit-for message-send-form-letter-delay)) (if (or force - (y-or-n-p (format "Send message to `%s'? " to))) + (y-or-n-p (gnus-format-message "Send message to `%s'? " to))) (progn (setq sent (1+ sent)) (message-send-and-exit)) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index b0ec16e..3d5a15a 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -855,7 +855,7 @@ external if displayed external." (concat "using external program \"" (format method filename) "\"") - (format + (gnus-format-message "by calling `%s' on the contents)" method)) "? ")))))) (if external diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index fa48ee9..8304f6f 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -523,7 +523,8 @@ apply the face `mm-uu-extract'." (when (and mml2015-use (null (mml2015-clear-verify-function))) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details - (format "Clear verification not supported by `%s'.\n" mml2015-use))) + (gnus-format-message + "Clear verification not supported by `%s'.\n" mml2015-use))) (mml2015-extract-cleartext-signature)) (list (mm-make-handle buf mm-uu-text-plain-type))))) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 3f0809e..0bcc9c5 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -202,7 +202,7 @@ Whether the passphrase is cached at all is controlled by ""))))) (if (setq cert (smime-cert-by-dns who)) (setq result (list 'certfile (buffer-name cert))) - (setq bad (format "`%s' not found. " who)))) + (setq bad (gnus-format-message "`%s' not found. " who)))) (quit)) result)) @@ -221,7 +221,7 @@ Whether the passphrase is cached at all is controlled by ""))))) (if (setq cert (smime-cert-by-ldap who)) (setq result (list 'certfile (buffer-name cert))) - (setq bad (format "`%s' not found. " who)))) + (setq bad (gnus-format-message "`%s' not found. " who)))) (quit)) result)) diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el index ef7187c..2bc2333 100644 --- a/lisp/gnus/rfc2231.el +++ b/lisp/gnus/rfc2231.el @@ -209,10 +209,10 @@ must never cause a Lisp error." (defun rfc2231-decode-encoded-string (string) "Decode an RFC2231-encoded string. These look like: - \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\", - \"us-ascii''This%20is%20%2A%2A%2Afun%2A%2A%2A\", - \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\", - \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or + \"us-ascii\\='en-us\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\", + \"us-ascii\\='\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\", + \"\\='en-us\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\", + \"\\='\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\", or \"This is ***fun***\"." (string-match "\\`\\(?:\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string) (let ((coding-system (mm-charset-to-coding-system diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 96d72de..de68079 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -307,7 +307,7 @@ symbol `ask', query before flushing the queue file." (if (or (eq keep nil) (and (eq keep 'ask) (y-or-n-p - (format + (gnus-format-message "Flush requests from `%s'? " (current-buffer))))) (progn (gnus-message 7 "Flushing request file `%s'" commit 8bbff0d64d0e6ba21366c9fb24f6973e6c59b8ac Author: Paul Eggert Date: Mon Aug 31 12:42:45 2015 -0700 Quoting fixes in lisp mail, mh-e, net, url * lisp/mail/emacsbug.el (report-emacs-bug) (report-emacs-bug-hook): Use straight quotes in outgoing email, * lisp/mail/feedmail.el (feedmail-message-action-help-blat): * lisp/mail/rmail.el (rmail-unknown-mail-followup-to): * lisp/mail/rmailout.el (rmail-output-read-file-name): * lisp/net/imap.el (imap-interactive-login): * lisp/net/tls.el (open-tls-stream): * lisp/url/url-auth.el (url-register-auth-scheme): Respect ‘text-quoting-style’ in diagnostics. * lisp/mh-e/mh-e.el (mh-sortm-args): Quote docstring example using text quotes, not as a Lisp quote. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index f4ba226..f54893f 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -215,7 +215,7 @@ usually do not have translators for other languages.\n\n"))) (insert "Please describe exactly what actions triggered the bug, and\n" "the precise symptoms of the bug. If you can, give a recipe\n" - "starting from `emacs -Q':\n\n") + "starting from 'emacs -Q':\n\n") (let ((txt (delete-and-extract-region (save-excursion (rfc822-goto-eoh) (line-beginning-position 2)) (point)))) @@ -225,7 +225,7 @@ usually do not have translators for other languages.\n\n"))) (insert "If Emacs crashed, and you have the Emacs process in the gdb debugger,\n" "please include the output from the following gdb commands:\n" - " `bt full' and `xbacktrace'.\n") + " 'bt full' and 'xbacktrace'.\n") (let ((debug-file (expand-file-name "DEBUG" data-directory))) (if (file-readable-p debug-file) @@ -240,7 +240,7 @@ usually do not have translators for other languages.\n\n"))) (if (fboundp 'x-server-vendor) (condition-case nil ;; This is used not only for X11 but also W32 and others. - (insert "Windowing system distributor `" (x-server-vendor) + (insert "Windowing system distributor '" (x-server-vendor) "', version " (mapconcat 'number-to-string (x-server-version) ".") "\n") (error t))) @@ -253,7 +253,7 @@ usually do not have translators for other languages.\n\n"))) (insert "System " lsb "\n"))) (when (and system-configuration-options (not (equal system-configuration-options ""))) - (insert "Configured using:\n `configure " + (insert "Configured using:\n 'configure " system-configuration-options "'\n\n") (fill-region (line-beginning-position -1) (point))) (insert "Configured features:\n" system-configuration-features "\n\n") @@ -315,7 +315,7 @@ usually do not have translators for other languages.\n\n"))) (insert (format "\nMemory information:\n")) (pp (garbage-collect) (current-buffer)) - + ;; This is so the user has to type something in order to send easily. (use-local-map (nconc (make-sparse-keymap) (current-local-map))) (define-key (current-local-map) "\C-c\C-i" 'info-emacs-bug) @@ -417,7 +417,7 @@ and send the mail again%s." (regexp-quote (system-name))) from)) (not (yes-or-no-p - (format "Is `%s' really your email address? " from))) + (format "Is '%s' really your email address? " from))) (error "Please edit the From address and try again")))))) diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index a94a81c..ccd8926 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -1889,7 +1889,8 @@ with various lower-level mechanisms to provide features such as queueing." (defun feedmail-message-action-help-blat (d-string) (feedmail-say-debug ">in-> feedmail-message-action-help-blat") (with-output-to-temp-buffer feedmail-p-h-b-n - (princ "You're dispatching a message and feedmail queuing is enabled. + (princ (substitute-command-keys "\ +You're dispatching a message and feedmail queuing is enabled. Typing ? again will normally scroll this help buffer. Choices: @@ -1914,7 +1915,7 @@ Synonyms: y YUP do the default behavior \(same as \"C-m\"\) SPC SCROLL UP \(same as \">\"\) -The user-configurable default is currently \"") +The user-configurable default is currently \"")) (princ d-string) (princ "\". For other possibilities, see the variable feedmail-prompt-before-queue-user-alist. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 90a140b..67b04b5 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -894,7 +894,7 @@ isn't provided." (error (display-warning 'rmail - (format "Although MIME support is requested + (format-message "Although MIME support is requested through `rmail-enable-mime' being non-nil, the required feature `%s' (the value of `rmail-mime-feature') is not available in the current session. @@ -2662,8 +2662,8 @@ Ask the user whether to add that list name to `mail-mailing-lists'." "\\>\\)")) addr)) (y-or-n-p - (format "Add `%s' to `mail-mailing-lists'? " - addr))) + (format-message "Add `%s' to `mail-mailing-lists'? " + addr))) (customize-save-variable 'mail-mailing-lists (cons addr mail-mailing-lists))))))))) diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index 6b753b3..1e770e6 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -85,8 +85,11 @@ This uses `rmail-output-file-alist'." (error (display-warning :error - (format "Error evaluating \ -`rmail-output-file-alist' element:\nregexp: %s\naction: %s\nerror: %S\n" + (format-message "\ +Error evaluating `rmail-output-file-alist' element: +regexp: %s +action: %s +error: %S\n" (caar tail) (cdar tail) err)) nil)))) (setq tail (cdr tail))) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index f11511a..22e4cd7 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -1353,8 +1353,8 @@ show window is toggled off." This option is consulted when a prefix argument is used with \\[mh-sort-folder]. Normally default arguments to \"sortm\" are specified in the MH profile. This option may be used to provide -an alternate view. For example, \"'(\"-nolimit\" \"-textfield\" -\"subject\")\" is a useful setting." +an alternate view. For example, ‘(\"-nolimit\" \"-textfield\" +\"subject\")’ is a useful setting." :type '(repeat string) :group 'mh-folder :package-version '(MH-E . "8.0")) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 3e59823..cc53e04 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -850,15 +850,16 @@ t if it successfully authenticates, nil otherwise." (while (or (not user) (not passwd)) (setq user (or imap-username (read-from-minibuffer - (concat "imap: username for " imap-server - " (using stream `" (symbol-name imap-stream) - "'): ") + (format-message + "imap: username for %s (using stream ‘%s’): " + imap-server imap-stream) (or user imap-default-user)))) - (setq passwd (or imap-password - (read-passwd - (concat "imap: password for " user "@" - imap-server " (using authenticator `" - (symbol-name imap-auth) "'): ")))) + (setq passwd + (or imap-password + (read-passwd + (format-message + "imap: password for %s@%s (using authenticator ‘%s’): " + user imap-server imap-auth)))) (when (and user passwd) (if (funcall loginfunc user passwd) (progn diff --git a/lisp/net/tls.el b/lisp/net/tls.el index 9e02945..1226916 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -275,7 +275,7 @@ Fourth arg PORT is an integer specifying a port to connect to." (message "The certificate presented by `%s' is \ NOT trusted." host)) (not (yes-or-no-p - (format "The certificate presented by `%s' is \ + (format-message "The certificate presented by `%s' is \ NOT trusted. Accept anyway? " host))))) (and tls-hostmismatch (save-excursion diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index 64f56f0..87f6718 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -336,11 +336,11 @@ RATING a rating between 1 and 10 of the strength of the authentication. (t rating))) (node (assoc type url-registered-auth-schemes))) (if (not (fboundp function)) - (url-warn 'security - (format (concat - "Tried to register `%s' as an auth scheme" - ", but it is not a function!") function))) - + (url-warn + 'security + (format-message + "Tried to register `%s' as an auth scheme, but it is not a function!" + function))) (if node (setcdr node (cons function rating)) (setq url-registered-auth-schemes commit 0ff60ec82f98032375e8569a98c08b72d879bce4 Author: Stephen Leake Date: Mon Aug 31 10:32:26 2015 -0500 Fix some byte-compiler warnings in EDE This fixes a bug that caused ede-generic-new-autoloader to overwrite the existing autoloader list, rather than add to it. * lisp/cedet/ede/auto.el (ede-project-class-files): Delete obsolete name argument to eieio class constructor. (ede-show-supported-projects): New. (ede-add-project-autoload): Replace obsolete `eieio-object-name-string' with (oref ... name). (ede-auto-load-project): Use slot name, not initarg key. * lisp/cedet/ede/generic.el (ede-generic-load, ede-generic-find-matching-target): Use slot name, not initarg key. (ede-find-target): Use oref-default on class name. (ede-generic-new-autoloader): Delete obsolete name argument to eieio class constructor. (ede-enable-generic-projects): Make project type names unique. diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el index 482632f..51459fa 100644 --- a/lisp/cedet/ede/auto.el +++ b/lisp/cedet/ede/auto.el @@ -155,9 +155,9 @@ into memory.") Specifying this matcher object will allow EDE to perform a complex check without loading the project. -NOTE: If you use dirmatch, you may need to set :root-only to nil. +NOTE: If you use dirmatch, you may need to set :root-only to `nil'. While it may be a root based project, all subdirs will happen to return -true for the dirmatch, so for scanning purposes, set it to nil.") +true for the dirmatch, so for scanning purposes, set it to `nil'.") (proj-root :initarg :proj-root :type function :documentation "A function symbol to call for the project root. @@ -197,23 +197,20 @@ type is required and the load function used.") (defvar ede-project-class-files (list - (ede-project-autoload "edeproject-makefile" - :name "Make" :file 'ede/proj + (ede-project-autoload :name "Make" :file 'ede/proj :proj-file "Project.ede" :root-only nil :load-type 'ede-proj-load :class-sym 'ede-proj-project :safe-p nil) - (ede-project-autoload "edeproject-automake" - :name "Automake" :file 'ede/proj + (ede-project-autoload :name "Automake" :file 'ede/proj :proj-file "Project.ede" :root-only nil :initializers '(:makefile-type Makefile.am) :load-type 'ede-proj-load :class-sym 'ede-proj-project :safe-p nil) - (ede-project-autoload "automake" - :name "automake" :file 'ede/project-am + (ede-project-autoload :name "automake" :file 'ede/project-am :proj-file "Makefile.am" :root-only nil :load-type 'project-am-load @@ -225,6 +222,19 @@ type is required and the load function used.") (put 'ede-project-class-files 'risky-local-variable t) +(defun ede-show-supported-projects () + "Display all the project types registered with EDE." + (interactive) + (let ((b (get-buffer-create "*EDE Autodetect Projects*"))) + (set-buffer b) + (setq buffer-read-only nil) + (erase-buffer) + (dolist (prj ede-project-class-files) + (insert (oref prj name)) + (newline)) + (display-buffer b) + )) + (defun ede-add-project-autoload (projauto &optional flag) "Add PROJAUTO, an EDE autoload definition to `ede-project-class-files'. Optional argument FLAG indicates how this autoload should be @@ -234,8 +244,8 @@ added. Possible values are: front of the list so more generic projects don't get priority." ;; First, can we identify PROJAUTO as already in the list? If so, replace. (let ((projlist ede-project-class-files) - (projname (eieio-object-name-string projauto))) - (while (and projlist (not (string= (eieio-object-name-string (car projlist)) projname))) + (projname (oref projauto name))) + (while (and projlist (not (string= (oref (car projlist) name) projname))) (setq projlist (cdr projlist))) (if projlist @@ -296,7 +306,7 @@ be loaded. NOTE: Do not call this - it should only be called from `ede-load-project-file'." ;; Last line of defense: don't load unsafe projects. - (when (not (or (oref this :safe-p) + (when (not (or (oref this safe-p) (ede-directory-safe-p dir))) (error "Attempt to load an unsafe project (bug elsewhere in EDE)")) ;; Things are good - so load the project. diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el index 9e6fc97..8d01324 100644 --- a/lisp/cedet/ede/generic.el +++ b/lisp/cedet/ede/generic.el @@ -74,7 +74,7 @@ ;; The ede-generic-target-c-cpp has some example methods setting up ;; the pre-processor map and system include path. ;; -;; NOTE: It is not necessary to modify ede-generic.el to add any of +;; NOTE: It is not necessary to modify ede/generic.el to add any of ;; the above described support features. (require 'eieio-opt) @@ -102,14 +102,14 @@ ROOTPROJ is nil, since there is only one project." (let* ((alobj ede-constructing)) (when (not alobj) (error "Cannot load generic project without the autoload instance")) ;;; - ;; TODO - find the root dir. + ;; TODO - find the root dir. (let ((rootdir dir)) (funcall (oref alobj class-sym) (symbol-name (oref alobj class-sym)) :name (file-name-nondirectory (directory-file-name dir)) :version "1.0" :directory (file-name-as-directory rootdir) - :file (expand-file-name (oref alobj :proj-file) + :file (expand-file-name (oref alobj proj-file) rootdir))) )) @@ -211,7 +211,7 @@ All directories need at least one target.") (let ((match nil)) (dolist (T targets) (when (and (object-of-class-p T class) - (string= (oref T :path) dir)) + (string= (oref T path) dir)) (setq match T) )) match)) @@ -241,7 +241,7 @@ If one doesn't exist, create a new one for this directory." (when (not ans) (setq ans (make-instance cls - :name (oref cls shortname) + :name (oref-default cls shortname) :path dir :source nil)) (object-add-to-list proj :targets ans) @@ -252,18 +252,18 @@ If one doesn't exist, create a new one for this directory." ;; ;; Derived projects need an autoloader so that EDE can find the ;; different projects on disk. -(defun ede-generic-new-autoloader (internal-name external-name - projectfile class) +(defun ede-generic-new-autoloader (_internal-name external-name + projectfile class) "Add a new EDE Autoload instance for identifying a generic project. -INTERNAL-NAME is a long name that identifies this project type. -EXTERNAL-NAME is a shorter human readable name to describe the project. +INTERNAL-NAME is obsolete and ignored. +EXTERNAL-NAME is a human readable name to describe the project; it +must be unique among all autoloaded projects. PROJECTFILE is a file name that identifies a project of this type to EDE, such as a Makefile, or SConstruct file. CLASS is the EIEIO class that is used to track this project. It should subclass -the class `ede-generic-project' project." +`ede-generic-project'." (ede-add-project-autoload - (ede-project-autoload internal-name - :name external-name + (ede-project-autoload :name external-name :file 'ede/generic :proj-file projectfile :root-only nil @@ -284,29 +284,29 @@ the class `ede-generic-project' project." (defun ede-enable-generic-projects () "Enable generic project loaders." (interactive) - (ede-generic-new-autoloader "generic-makefile" "Make" + (ede-generic-new-autoloader "generic-makefile" "Generic Make" "Makefile" 'ede-generic-makefile-project) - (ede-generic-new-autoloader "generic-scons" "SCons" + (ede-generic-new-autoloader "generic-scons" "Generic SCons" "SConstruct" 'ede-generic-scons-project) - (ede-generic-new-autoloader "generic-cmake" "CMake" + (ede-generic-new-autoloader "generic-cmake" "Generic CMake" "CMakeLists" 'ede-generic-cmake-project) ;; Super Generic found via revision control tags. - (ede-generic-new-autoloader "generic-git" "Git" + (ede-generic-new-autoloader "generic-git" "Generic Git" ".git" 'ede-generic-vc-project) - (ede-generic-new-autoloader "generic-bzr" "Bazaar" + (ede-generic-new-autoloader "generic-bzr" "Generic Bazaar" ".bzr" 'ede-generic-vc-project) - (ede-generic-new-autoloader "generic-hg" "Mercurial" + (ede-generic-new-autoloader "generic-hg" "Generic Mercurial" ".hg" 'ede-generic-vc-project) - (ede-generic-new-autoloader "generic-svn" "Subversions" + (ede-generic-new-autoloader "generic-svn" "Generic Subversions" ".svn" 'ede-generic-vc-project) - (ede-generic-new-autoloader "generic-cvs" "CVS" + (ede-generic-new-autoloader "generic-cvs" "Generic CVS" "CVS" 'ede-generic-vc-project) ;; Take advantage of existing 'projectile' based projects. ;; @TODO - if projectile supports compile commands etc, can we ;; read that out? Howto if projectile is not part of core emacs. - (ede-generic-new-autoloader "generic-projectile" ".projectile" + (ede-generic-new-autoloader "generic-projectile" "Generic .projectile" ".projectile" 'ede-generic-vc-project) ) commit e634dacce7ee3bcb4d8aba9e6ad125b6b875c179 Author: Eli Zaretskii Date: Mon Aug 31 17:57:08 2015 +0300 Fix directory accessibility tests for w32 network volumes * src/w32.c (faccessat): Don't fail with network volumes without a share. (w32_accessible_directory_p): Handle network volumes without a share. diff --git a/src/w32.c b/src/w32.c index dea8431..cc55507 100644 --- a/src/w32.c +++ b/src/w32.c @@ -3826,7 +3826,7 @@ faccessat (int dirfd, const char * path, int mode, int flags) errno = EACCES; return -1; } - break; + goto check_attrs; } /* FALLTHROUGH */ case ERROR_FILE_NOT_FOUND: @@ -3839,6 +3839,8 @@ faccessat (int dirfd, const char * path, int mode, int flags) } return -1; } + + check_attrs: if ((mode & X_OK) != 0 && !(is_exec (path) || (attributes & FILE_ATTRIBUTE_DIRECTORY) != 0)) { @@ -3871,6 +3873,23 @@ w32_accessible_directory_p (const char *dirname, ptrdiff_t dirlen) bool last_slash = dirlen > 0 && IS_DIRECTORY_SEP (dirname[dirlen - 1]); HANDLE dh; + /* Network volumes need a different reading method. */ + if (is_unc_volume (dirname)) + { + void *read_result = NULL; + wchar_t fnw[MAX_PATH]; + char fna[MAX_PATH]; + + dh = open_unc_volume (dirname); + if (dh != INVALID_HANDLE_VALUE) + { + read_result = read_unc_volume (dh, fnw, fna, MAX_PATH); + close_unc_volume (dh); + } + /* Treat empty volumes as accessible. */ + return read_result != NULL || GetLastError () == ERROR_NO_MORE_ITEMS; + } + /* Note: map_w32_filename makes sure DIRNAME is not longer than MAX_UTF8_PATH. */ strcpy (pattern, map_w32_filename (dirname, NULL)); commit 5ee3ef8e1867d284be0ff9f654f8bde46e751978 Author: Eli Zaretskii Date: Mon Aug 31 17:52:47 2015 +0300 Fix handling long file names in readdir on MS-Windows * src/w32.c (sys_readdir): Append "\*" to the directory after converting it to UTF-16/ANSI, not before, to avoid overflowing the 260-character limit on file names in filename_to_utf16/ansi. diff --git a/src/w32.c b/src/w32.c index 60fbe92..dea8431 100644 --- a/src/w32.c +++ b/src/w32.c @@ -3399,30 +3399,41 @@ sys_readdir (DIR *dirp) /* If we aren't dir_finding, do a find-first, otherwise do a find-next. */ else if (dir_find_handle == INVALID_HANDLE_VALUE) { - char filename[MAX_UTF8_PATH + 2]; + char filename[MAX_UTF8_PATH]; int ln; + bool last_slash = true; + /* Note: We don't need to worry about dir_pathname being longer + than MAX_UTF8_PATH, as sys_opendir already took care of that + when it called map_w32_filename: that function will put a "?" + in its return value in that case, thus failing all the calls + below. */ strcpy (filename, dir_pathname); ln = strlen (filename); if (!IS_DIRECTORY_SEP (filename[ln - 1])) - filename[ln++] = '\\'; - strcpy (filename + ln, "*"); + last_slash = false; /* Note: No need to resolve symlinks in FILENAME, because FindFirst opens the directory that is the target of a symlink. */ if (w32_unicode_filenames) { - wchar_t fnw[MAX_PATH]; + wchar_t fnw[MAX_PATH + 2]; filename_to_utf16 (filename, fnw); + if (!last_slash) + wcscat (fnw, L"\\"); + wcscat (fnw, L"*"); dir_find_handle = FindFirstFileW (fnw, &dir_find_data_w); } else { - char fna[MAX_PATH]; + char fna[MAX_PATH + 2]; filename_to_ansi (filename, fna); + if (!last_slash) + strcat (fna, "\\"); + strcat (fna, "*"); /* If FILENAME is not representable by the current ANSI codepage, we don't want FindFirstFileA to interpret the '?' characters as a wildcard. */ @@ -3860,6 +3871,8 @@ w32_accessible_directory_p (const char *dirname, ptrdiff_t dirlen) bool last_slash = dirlen > 0 && IS_DIRECTORY_SEP (dirname[dirlen - 1]); HANDLE dh; + /* Note: map_w32_filename makes sure DIRNAME is not longer than + MAX_UTF8_PATH. */ strcpy (pattern, map_w32_filename (dirname, NULL)); /* Note: No need to resolve symlinks in FILENAME, because FindFirst commit 697be62c5f2b86e8ad93dfcaa0df07890c24d989 Author: Eli Zaretskii Date: Mon Aug 31 17:48:26 2015 +0300 Make file-accessible-directory-p reliable on MS-Windows * src/w32.c (w32_accessible_directory_p): New function. * src/w32.h (w32_accessible_directory_p): Add prototype. * src/fileio.c (file_accessible_directory_p) [WINDOWSNT]: Call w32_accessible_directory_p to test a directory for accessibility by the current user. (Bug#21346) (Ffile_accessible_directory_p): Remove the w32 specific caveat from the doc string. diff --git a/src/fileio.c b/src/fileio.c index debd1f3..a36dfbc 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2655,11 +2655,7 @@ and the directory must allow you to open files in it. In order to use a directory as a buffer's current directory, this predicate must return true. A directory name spec may be given instead; then the value is t if the directory so specified exists and really is a readable and -searchable directory. - -The result might be a false positive on MS-Windows in some rare cases, -i.e., this function could return t for a directory that is not -accessible by the current user. */) +searchable directory. */) (Lisp_Object filename) { Lisp_Object absname; @@ -2689,10 +2685,18 @@ bool file_accessible_directory_p (Lisp_Object file) { #ifdef DOS_NT - /* There's no need to test whether FILE is searchable, as the - searchable/executable bit is invented on DOS_NT platforms. */ +# ifdef WINDOWSNT + /* We need a special-purpose test because (a) NTFS security data is + not reflected in Posix-style mode bits, and (b) the trick with + accessing "DIR/.", used below on Posix hosts, doesn't work on + Windows, because "DIR/." is normalized to just "DIR" before + hitting the disk. */ + return (SBYTES (file) == 0 + || w32_accessible_directory_p (SSDATA (file), SBYTES (file))); +# else /* MSDOS */ return file_directory_p (SSDATA (file)); -#else +# endif /* MSDOS */ +#else /* !DOS_NT */ /* On POSIXish platforms, use just one system call; this avoids a race and is typically faster. */ const char *data = SSDATA (file); @@ -2725,7 +2729,7 @@ file_accessible_directory_p (Lisp_Object file) SAFE_FREE (); errno = saved_errno; return ok; -#endif +#endif /* !DOS_NT */ } DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0, diff --git a/src/w32.c b/src/w32.c index b421667..60fbe92 100644 --- a/src/w32.c +++ b/src/w32.c @@ -3847,6 +3847,57 @@ faccessat (int dirfd, const char * path, int mode, int flags) return 0; } +/* A special test for DIRNAME being a directory accessible by the + current user. This is needed because the security permissions in + directory's ACLs are not visible in the Posix-style mode bits + returned by 'stat' and in attributes returned by GetFileAttributes. + So a directory would seem like it's readable by the current user, + but will in fact error out with EACCES when they actually try. */ +int +w32_accessible_directory_p (const char *dirname, ptrdiff_t dirlen) +{ + char pattern[MAX_UTF8_PATH]; + bool last_slash = dirlen > 0 && IS_DIRECTORY_SEP (dirname[dirlen - 1]); + HANDLE dh; + + strcpy (pattern, map_w32_filename (dirname, NULL)); + + /* Note: No need to resolve symlinks in FILENAME, because FindFirst + opens the directory that is the target of a symlink. */ + if (w32_unicode_filenames) + { + wchar_t pat_w[MAX_PATH + 2]; + WIN32_FIND_DATAW dfd_w; + + filename_to_utf16 (pattern, pat_w); + if (!last_slash) + wcscat (pat_w, L"\\"); + wcscat (pat_w, L"*"); + dh = FindFirstFileW (pat_w, &dfd_w); + } + else + { + char pat_a[MAX_PATH + 2]; + WIN32_FIND_DATAA dfd_a; + + filename_to_ansi (pattern, pat_a); + if (!last_slash) + strcpy (pat_a, "\\"); + strcat (pat_a, "*"); + /* In case DIRNAME cannot be expressed in characters from the + current ANSI codepage. */ + if (_mbspbrk (pat_a, "?")) + dh = INVALID_HANDLE_VALUE; + else + dh = FindFirstFileA (pat_a, &dfd_a); + } + + if (dh == INVALID_HANDLE_VALUE) + return 0; + FindClose (dh); + return 1; +} + /* A version of 'access' to be used locally with file names in locale-specific encoding. Does not resolve symlinks and does not support file names on FAT12 and FAT16 volumes, but that's OK, since diff --git a/src/w32.h b/src/w32.h index 338cb06..2c71150 100644 --- a/src/w32.h +++ b/src/w32.h @@ -195,6 +195,7 @@ extern int filename_to_utf16 (const char *, wchar_t *); extern int codepage_for_filenames (CPINFO *); extern Lisp_Object ansi_encode_filename (Lisp_Object); extern int w32_copy_file (const char *, const char *, int, int, int); +extern int w32_accessible_directory_p (const char *, ptrdiff_t); extern BOOL init_winsock (int load_now); extern void srandom (int); commit 8af8355c3f72500986f6f10b62714b228d6f35ee Author: Martin Rudalics Date: Mon Aug 31 11:09:22 2015 +0200 Don't call do_pending_window_change in signal handlers (Bug#21380) * src/gtkutil.c (xg_frame_resized): * src/xterm.c (x_set_window_size): * src/w32term.c (x_set_window_size): Don't call do_pending_window_change. diff --git a/src/ChangeLog.13 b/src/ChangeLog.13 index 196bd8e..ac21628 100644 --- a/src/ChangeLog.13 +++ b/src/ChangeLog.13 @@ -5245,8 +5245,7 @@ (xg_set_toolkit_horizontal_scroll_bar_thumb) (xg_get_default_scrollbar_height) (xg_clear_under_internal_border): Extern. - * gtkutil.c (xg_frame_resized): Don't call - do_pending_window_change. + * gtkutil.c (xg_frame_resized): Call do_pending_window_change. (xg_frame_set_char_size): Use adjust_frame_size. (style_changed_cb): Call update_theme_scrollbar_height and x_set_scroll_bar_default_height. @@ -5367,7 +5366,7 @@ build without toolkit. Always clear under internal border. (x_set_window_size): Don't check frame size or recompute fringes. Reset fullscreen status before applying sizes. - Always resize as requested by pixelwise argument. Don't call + Always resize as requested by pixelwise argument. Call do_pending_window_change. (x_wm_set_size_hint): Add call for FRAME_SCROLL_BAR_AREA_HEIGHT. (w32_initialize_display_info): Initialize dpyinfo's @@ -5519,7 +5518,7 @@ Call x_net_wm_state. (x_set_window_size_1, x_wm_set_size_hint): Don't call check_frame_size. - (x_set_window_size): Don't call check_frame_size and + (x_set_window_size): Don't call check_frame_size. Call do_pending_window_change. (x_term_init): Init horizontal_scroll_bar_cursor display info. (x_create_terminal): Add set_horizontal_scroll_bar_hook. diff --git a/src/gtkutil.c b/src/gtkutil.c index 89647ee..725e330 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -920,8 +920,6 @@ xg_frame_resized (struct frame *f, int pixelwidth, int pixelheight) change_frame_size (f, width, height, 0, 1, 0, 1); SET_FRAME_GARBAGED (f); cancel_mouse_face (f); - - do_pending_window_change (0); } } diff --git a/src/w32term.c b/src/w32term.c index fbd31b1..82b05bf 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -6202,8 +6202,6 @@ x_set_window_size (struct frame *f, bool change_gravity, } unblock_input (); - - do_pending_window_change (0); } /* Mouse warping. */ diff --git a/src/xterm.c b/src/xterm.c index 4eb777f..9ee76e9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10515,8 +10515,6 @@ x_set_window_size (struct frame *f, bool change_gravity, cancel_mouse_face (f); unblock_input (); - - do_pending_window_change (false); } /* Move the mouse to position pixel PIX_X, PIX_Y relative to frame F. */