diff options
| author | Stefan Monnier | 2011-03-21 12:42:16 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2011-03-21 12:42:16 -0400 |
| commit | cafdcef32d55cbb44389d7e322e7f973cbb72dfd (patch) | |
| tree | 7ee0c41ea8a589650ce6f4311fb10e61a63807b9 /lisp | |
| parent | a08a25d7aaf251aa18f2ef747be53734bc55cae9 (diff) | |
| parent | 4e05e67e4cd0bc1b0a4ef3176a4d0d91c6b3738e (diff) | |
| download | emacs-cafdcef32d55cbb44389d7e322e7f973cbb72dfd.tar.gz emacs-cafdcef32d55cbb44389d7e322e7f973cbb72dfd.zip | |
Merge from trunk
Diffstat (limited to 'lisp')
90 files changed, 2343 insertions, 997 deletions
diff --git a/lisp/ChangeLog.trunk b/lisp/ChangeLog.trunk index e4d402afa76..d087982edee 100644 --- a/lisp/ChangeLog.trunk +++ b/lisp/ChangeLog.trunk | |||
| @@ -1,3 +1,410 @@ | |||
| 1 | 2011-03-21 Glenn Morris <rgm@gnu.org> | ||
| 2 | |||
| 3 | * eshell/esh-opt.el (eshell-eval-using-options, eshell-process-args): | ||
| 4 | Doc fixes. | ||
| 5 | |||
| 6 | 2011-03-21 Chong Yidong <cyd@stupidchicken.com> | ||
| 7 | |||
| 8 | * cus-theme.el: Add missing provide statement. | ||
| 9 | (customize-create-theme): Extract theme value correctly. | ||
| 10 | (custom-theme-visit-theme): Autoload. | ||
| 11 | (customize-create-theme): Prompt before inserting default faces. | ||
| 12 | |||
| 13 | 2011-03-20 Jay Belanger <jay.p.belanger@gmail.com> | ||
| 14 | |||
| 15 | * calc/calc-menu.el (calc-units-menu): Add entries for logarithmic | ||
| 16 | units and musical notes. | ||
| 17 | |||
| 18 | 2011-03-20 Leo <sdl.web@gmail.com> | ||
| 19 | |||
| 20 | * ido.el (ido-read-internal): Use completing-read-default. | ||
| 21 | (ido-completing-read): Fix compatibility with completing-read. | ||
| 22 | |||
| 23 | 2011-03-20 Christian Ohler <ohler@gnu.org> | ||
| 24 | |||
| 25 | * emacs-lisp/ert.el (ert-run-tests-batch): Remove unused variable. | ||
| 26 | (ert-delete-all-tests): Use `called-interactively-p' rather than | ||
| 27 | `interactive-p'. | ||
| 28 | (ert--make-xrefs-region): Respect END. | ||
| 29 | |||
| 30 | 2011-03-19 Chong Yidong <cyd@stupidchicken.com> | ||
| 31 | |||
| 32 | * dired-aux.el (dired-create-directory): Signal an error if the | ||
| 33 | directory already exists (Bug#8246). | ||
| 34 | |||
| 35 | * facemenu.el (list-colors-display): Call list-faces-display | ||
| 36 | inside with-help-window. | ||
| 37 | (list-colors-print): Use display property to align the final | ||
| 38 | column, instead of checking window-width. | ||
| 39 | |||
| 40 | 2011-03-19 Eli Zaretskii <eliz@gnu.org> | ||
| 41 | |||
| 42 | * emerge.el (emerge-metachars): Separate value for ms-dos and | ||
| 43 | windows-nt systems. | ||
| 44 | (emerge-protect-metachars): Quote correctly for ms-dos and | ||
| 45 | windows-nt systems. | ||
| 46 | |||
| 47 | 2011-03-19 Ralph Schleicher <rs@ralph-schleicher.de> | ||
| 48 | |||
| 49 | * info.el (info-initialize): Replace all uses of `:' with | ||
| 50 | path-separator for compatibility with non-Unix systems. | ||
| 51 | Cache quoting of path-separator. (Bug#8258) | ||
| 52 | |||
| 53 | 2011-03-19 Juanma Barranquero <lekktu@gmail.com> | ||
| 54 | |||
| 55 | * avoid.el (mouse-avoidance-mode, mouse-avoidance-nudge-dist) | ||
| 56 | (mouse-avoidance-threshold, mouse-avoidance-banish-destination) | ||
| 57 | (mouse-avoidance-mode): Fix typos in docstrings. | ||
| 58 | |||
| 59 | 2011-03-19 Chong Yidong <cyd@stupidchicken.com> | ||
| 60 | |||
| 61 | * startup.el (package-subdirectory-regexp): Move from package.el. | ||
| 62 | Omit \\` and \\', and let callers add them. | ||
| 63 | |||
| 64 | * emacs-lisp/package.el (package-strip-version) | ||
| 65 | (package-load-all-descriptors): Add \\` and \\' to | ||
| 66 | package-subdirectory-regexp before using it. | ||
| 67 | (package-untar-buffer): New arg DIR; ensure that file untars only | ||
| 68 | into this expected directory. Remove superfluous delete-region. | ||
| 69 | (package-unpack): Caller changed. | ||
| 70 | (package-tar-file-info): Use package-subdirectory-regexp. | ||
| 71 | |||
| 72 | 2011-03-18 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 73 | |||
| 74 | * vc/diff-mode.el (diff-mode-map): Shadow problematic bindings from | ||
| 75 | diff-mode-shared-map (bug#8284). | ||
| 76 | (diff-mode-shared-map): Re-introduce some bindings that were problematic. | ||
| 77 | |||
| 78 | 2011-03-17 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 79 | |||
| 80 | * calendar/time-date.el (format-seconds): Use assoc instead of | ||
| 81 | assoc-string, since assoc-string doesn't exist in XEmacs. | ||
| 82 | |||
| 83 | 2011-03-17 Juanma Barranquero <lekktu@gmail.com> | ||
| 84 | |||
| 85 | * custom.el (custom-known-themes): Reflow docstring. | ||
| 86 | (custom-theme-load-path): Fix typo in docstring. | ||
| 87 | (load-theme): Fix typo in error message. | ||
| 88 | (custom-available-themes, custom-variable-theme-value): | ||
| 89 | Use `let', not `let*'. | ||
| 90 | |||
| 91 | 2011-03-17 Jay Belanger <jay.p.belanger@gmail.com> | ||
| 92 | |||
| 93 | * calc/README: Mention inclusion of musical notes. | ||
| 94 | |||
| 95 | * calc/calc-units.el (calc-lu-quant): Rename from | ||
| 96 | `calc-logunits-quantity'. | ||
| 97 | (calcFunc-lupquant): Rename from `calcFunc-powerquant'. | ||
| 98 | (calcFunc-lufquant): Rename from `calcFunc-fieldquant'. | ||
| 99 | (calc-db): Rename from `calc-dblevel'. | ||
| 100 | (calcFunc-dbpower): Rename from `calcFunc-dbpowerlevel'. | ||
| 101 | (calcFunc-dbfield): Rename from `calcFunc-dbfieldlevel'. | ||
| 102 | (calc-np): Rename from `calc-nplevel'. | ||
| 103 | (calcFunc-nppower): Rename from `calcFunc-nppowerlevel'. | ||
| 104 | (calcFunc-npfield): Rename from `calcFunc-npfieldlevel'. | ||
| 105 | (calc-lu-plus): Rename from `calc-logunits-add'. | ||
| 106 | (calcFunc-lupadd): Rename from `calcFunc-lupoweradd'. | ||
| 107 | (calcFunc-lufadd): Rename from `calcFunc-lufieldadd'. | ||
| 108 | (calc-lu-minus): Rename from `calc-logunits-sub'. | ||
| 109 | (calcFunc-lupsub): Rename from `calcFunc-lupowersub'. | ||
| 110 | (calcFunc-lufsub): Rename from `calcFunc-lufieldsub'. | ||
| 111 | (calc-lu-times): Rename from `calc-logunits-mul'. | ||
| 112 | (calcFunc-lupmul): Rename from `calcFunc-lupowermul'. | ||
| 113 | (calcFunc-lufmul): Rename from `calcFunc-lufieldmul'. | ||
| 114 | (calc-lu-divide): Rename from `calc-logunits-div'. | ||
| 115 | (calcFunc-lupdiv): Rename from `calcFunc-lupowerdiv'. | ||
| 116 | (calcFunc-lufdiv): Rename from `calcFunc-lufielddiv'. | ||
| 117 | |||
| 118 | * calc/calc-ext.el (calc-init-extensions): Update the names of the | ||
| 119 | functions being autoloaded. | ||
| 120 | |||
| 121 | * calc/calc.el (calc-lu-power-reference): Rename from | ||
| 122 | `calc-logunits-power-reference'. | ||
| 123 | (calc-lu-field-reference): Rename from | ||
| 124 | `calc-logunits-field-reference'. | ||
| 125 | |||
| 126 | * calc/calc-help (calc-l-prefix-help): Mention musical note functions. | ||
| 127 | |||
| 128 | 2011-03-17 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 129 | |||
| 130 | * minibuffer.el (completion-all-sorted-completions): | ||
| 131 | Use :completion-cycle-penalty text property if present. | ||
| 132 | |||
| 133 | 2011-03-16 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 134 | |||
| 135 | * allout.el (allout-yank-processing): Adjust for new rebulleting | ||
| 136 | regime so bullet being yanked is used without prompting the user | ||
| 137 | for a choice. | ||
| 138 | |||
| 139 | 2011-03-16 Juanma Barranquero <lekktu@gmail.com> | ||
| 140 | |||
| 141 | * startup.el (command-line): Warn the user that _emacs is deprecated. | ||
| 142 | |||
| 143 | 2011-03-16 Juanma Barranquero <lekktu@gmail.com> | ||
| 144 | |||
| 145 | * progmodes/delphi.el (delphi-search-path, delphi-indent-level) | ||
| 146 | (delphi-verbose, delphi-comment-face, delphi-string-face) | ||
| 147 | (delphi-keyword-face, delphi-ignore-changes, delphi-indent-line) | ||
| 148 | (delphi-mode-abbrev-table, delphi-debug-buffer, delphi-tab) | ||
| 149 | (delphi-find-unit, delphi-find-current-xdef, delphi-fill-comment) | ||
| 150 | (delphi-new-comment-line, delphi-font-lock-defaults) | ||
| 151 | (delphi-debug-mode-map, delphi-mode-syntax-table, delphi-mode): | ||
| 152 | Fix typos in docstrings. | ||
| 153 | |||
| 154 | 2011-03-15 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 155 | |||
| 156 | * allout.el (allout-make-topic-prefix, allout-rebullet-heading): | ||
| 157 | Invert the roles of character and string values for INSTEAD, so a | ||
| 158 | string is used for the more common case of a defaulting prompt. | ||
| 159 | |||
| 160 | 2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 161 | |||
| 162 | * progmodes/ruby-mode.el (ruby-backward-sexp): | ||
| 163 | * progmodes/ebrowse.el (ebrowse-draw-file-member-info): | ||
| 164 | * play/gamegrid.el (gamegrid-make-face): | ||
| 165 | * play/bubbles.el (bubbles--grid-width, bubbles--grid-height) | ||
| 166 | (bubbles--colors, bubbles--shift-mode, bubbles--initialize-images): | ||
| 167 | * notifications.el (notifications-notify): | ||
| 168 | * net/xesam.el (xesam-search-engines): | ||
| 169 | * net/quickurl.el (quickurl-list-insert): | ||
| 170 | * vc/vc-hg.el (vc-hg-dir-printer): Fix use of case. | ||
| 171 | |||
| 172 | 2011-03-15 Chong Yidong <cyd@stupidchicken.com> | ||
| 173 | |||
| 174 | * startup.el (command-line): Update package subdirectory regexp. | ||
| 175 | |||
| 176 | 2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 177 | |||
| 178 | * allout.el (allout-abbreviate-flattened-numbering) | ||
| 179 | (allout-mode-deactivate-hook): Fix up obsolescence "date". | ||
| 180 | |||
| 181 | * subr.el (read-char-choice): Only show the cursor after the prompt, | ||
| 182 | not after the answer. | ||
| 183 | |||
| 184 | 2011-03-15 Kevin Ryde <user42@zip.com.au> | ||
| 185 | |||
| 186 | * help-fns.el (variable-at-point): Skip leading quotes, if any | ||
| 187 | (bug#8253). | ||
| 188 | |||
| 189 | 2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 190 | |||
| 191 | * emacs-lisp/bytecomp.el (byte-compile-save-excursion): Change the | ||
| 192 | warning message. | ||
| 193 | |||
| 194 | 2011-03-14 Michael Albinus <michael.albinus@gmx.de> | ||
| 195 | |||
| 196 | * shell.el (shell): When called interactively, offer to change the | ||
| 197 | shell file name on remote hosts. | ||
| 198 | |||
| 199 | 2011-03-13 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 200 | |||
| 201 | * net/ldap.el (ldap-search-internal): Add `auth-source-search' | ||
| 202 | integration for LDAP parameters. The host, base, user or binddn, | ||
| 203 | and secret tokens can be specified in a netrc file, for instance. | ||
| 204 | This is optional because an `auth-source' parameter must be | ||
| 205 | specified in the search attributes. | ||
| 206 | |||
| 207 | 2011-03-13 Juanma Barranquero <lekktu@gmail.com> | ||
| 208 | |||
| 209 | * help.el (describe-mode): Link to the mode's definition (bug#8185). | ||
| 210 | |||
| 211 | 2011-03-12 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 212 | |||
| 213 | * ebuff-menu.el (electric-buffer-menu-mode-map): Move initialization | ||
| 214 | into declaration. Remove redundant and harmful binding. | ||
| 215 | |||
| 216 | 2011-03-12 Eli Zaretskii <eliz@gnu.org> | ||
| 217 | |||
| 218 | * files.el (file-ownership-preserved-p): Pass `integer' as an | ||
| 219 | explicit 2nd argument to `file-attributes'. If the file's owner | ||
| 220 | is the Administrators group on Windows, and the current user is | ||
| 221 | Administrator, consider that a match. | ||
| 222 | |||
| 223 | * server.el (server-ensure-safe-dir): Consider server directory | ||
| 224 | safe on MS-Windows if its owner is the Administrators group while | ||
| 225 | the current Emacs user is Administrator. Use `=' to compare | ||
| 226 | numerical UIDs, since they could be integers or floats. | ||
| 227 | |||
| 228 | 2011-03-12 Juanma Barranquero <lekktu@gmail.com> | ||
| 229 | |||
| 230 | * vc/vc-bzr.el (vc-bzr-state): Handle bzr 2.3.0 (follow-up to bug#8170). | ||
| 231 | |||
| 232 | 2011-03-12 Michael Albinus <michael.albinus@gmx.de> | ||
| 233 | |||
| 234 | Sync with Tramp 2.2.1. | ||
| 235 | |||
| 236 | * net/tramp-sh.el (tramp-methods): Exchange "%k" marker with options. | ||
| 237 | |||
| 238 | * net/trampver.el: Update release number. | ||
| 239 | |||
| 240 | 2011-03-12 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 241 | |||
| 242 | * progmodes/compile.el (compilation--previous-directory): Fix up | ||
| 243 | various nil/dead-marker mismatches (bug#8014). | ||
| 244 | (compilation-directory-properties, compilation-error-properties): | ||
| 245 | Don't call it at a position past the one we're about to change. | ||
| 246 | |||
| 247 | * emacs-lisp/bytecomp.el (byte-compile-make-obsolete-variable): | ||
| 248 | Disable obsolescence warnings in the file that declares it. | ||
| 249 | |||
| 250 | 2011-03-11 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 251 | |||
| 252 | * allout-widgets.el (allout-widgets-tally): Initialize | ||
| 253 | allout-widgets-tally as a hash table rather than nil to prevent | ||
| 254 | mode-line redisplay warnings. | ||
| 255 | Also, clarify the module description and fix a comment typo. | ||
| 256 | |||
| 257 | 2011-03-11 Juanma Barranquero <lekktu@gmail.com> | ||
| 258 | |||
| 259 | * help-fns.el (describe-variable): Don't complete keywords. | ||
| 260 | Suggested by Teodor Zlatanov <tzz@lifelogs.com>. | ||
| 261 | |||
| 262 | 2011-03-10 Chong Yidong <cyd@stupidchicken.com> | ||
| 263 | |||
| 264 | * emacs-lisp/package.el (package-version-join): Impose a standard | ||
| 265 | string representation for pre/alpha/beta version lists. | ||
| 266 | (package-unpack-single): Standardize the directory name by passing | ||
| 267 | it through package-version-join. | ||
| 268 | (package-strip-rcs-id): Accept any version string that does not | ||
| 269 | signal an error in version-to-list. | ||
| 270 | |||
| 271 | 2011-03-10 Michael Albinus <michael.albinus@gmx.de> | ||
| 272 | |||
| 273 | * simple.el (delete-trailing-whitespace): Return nil for the | ||
| 274 | benefit of `write-file-functions'. | ||
| 275 | |||
| 276 | 2011-03-10 Glenn Morris <rgm@gnu.org> | ||
| 277 | |||
| 278 | * vc/vc-hg.el (vc-hg-pull, vc-hg-merge-branch): Use vc-hg-program. | ||
| 279 | |||
| 280 | * vc/vc-git.el (vc-git-program): New option. | ||
| 281 | (vc-git-branches, vc-git-pull, vc-git-merge-branch, vc-git-command) | ||
| 282 | (vc-git--call): Use it. | ||
| 283 | |||
| 284 | * eshell/esh-util.el (eshell-condition-case): Doc fix. | ||
| 285 | |||
| 286 | * cus-edit.el (Custom-newline): If no button at point, look | ||
| 287 | for a subgroup button at start-of-line. (Bug#2298) | ||
| 288 | |||
| 289 | * mail/rmail.el (rmail-msgend, rmail-msgbeg): Doc fixes. | ||
| 290 | |||
| 291 | 2011-03-10 Julien Danjou <julien@danjou.info> | ||
| 292 | |||
| 293 | * avoid.el (mouse-avoidance-ignore-p): Do not move the cursor if | ||
| 294 | `cursor-type' is nil. | ||
| 295 | |||
| 296 | 2011-03-09 Jay Belanger <jay.p.belanger@gmail.com> | ||
| 297 | |||
| 298 | * calc/calc.el (calc-mode-map): Don't bind "C-_" to `calc-missing-key'. | ||
| 299 | |||
| 300 | 2011-03-09 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 301 | |||
| 302 | * allout.el Summary: Change so yank of distinctive-bullet items | ||
| 303 | preserves the existing header prefix, rebulleting it if necessary, | ||
| 304 | rather than replacing it. This is necessary for proper operation | ||
| 305 | of cooperative addons like allout-widgets. | ||
| 306 | (allout-make-topic-prefix, allout-rebullet-heading): Change | ||
| 307 | SOLICIT arg to INSTEAD, and interpret additionally a string value | ||
| 308 | as alternate bullet to be used, instead of prompting the user for | ||
| 309 | a bullet character. | ||
| 310 | |||
| 311 | 2011-03-09 Michael Albinus <michael.albinus@gmx.de> | ||
| 312 | |||
| 313 | * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Do | ||
| 314 | not use `tramp-file-name-port', because this returns also | ||
| 315 | `tramp-default-port'. | ||
| 316 | |||
| 317 | 2011-03-09 Deniz Dogan <deniz.a.m.dogan@gmail.com> | ||
| 318 | |||
| 319 | * net/rcirc.el (rcirc-handler-001): Remove useless | ||
| 320 | with-rcirc-process-buffer. | ||
| 321 | (rcirc-check-auth-status): Swap arguments to string-match. | ||
| 322 | |||
| 323 | 2011-03-09 Glenn Morris <rgm@gnu.org> | ||
| 324 | |||
| 325 | * shell.el (shell-mode): | ||
| 326 | Set comint-input-ring-size from HISTSIZE. (Bug#7889) | ||
| 327 | |||
| 328 | * progmodes/gdb-mi.el (gdb): Improve 2010-12-08 change. | ||
| 329 | Check for GDBHISTFILE, HISTSIZE, etc. (Bug#7889) | ||
| 330 | |||
| 331 | 2011-03-08 Chong Yidong <cyd@stupidchicken.com> | ||
| 332 | |||
| 333 | * emacs-lisp/package.el (package-refresh-contents) | ||
| 334 | (package-menu-execute): Use condition-case-no-debug. | ||
| 335 | |||
| 336 | 2011-03-08 Michael Albinus <michael.albinus@gmx.de> | ||
| 337 | |||
| 338 | * simple.el (shell-command-to-string): Use `process-file'. | ||
| 339 | |||
| 340 | * emacs-lisp/package.el (package-tar-file-info): Handle also | ||
| 341 | remote files. | ||
| 342 | |||
| 343 | * emacs-lisp/package-x.el (package-upload-buffer-internal): Use | ||
| 344 | `equal' for upload base check. | ||
| 345 | |||
| 346 | 2011-03-08 Arni Magnusson <arnima@hafro.is> (tiny change) | ||
| 347 | |||
| 348 | * textmodes/texinfo.el (texinfo-environments): | ||
| 349 | Add deftypecv, deftypeivar, deftypemethod, deftypeop, html. (Bug#2783) | ||
| 350 | |||
| 351 | 2011-03-08 Glenn Morris <rgm@gnu.org> | ||
| 352 | |||
| 353 | * cus-start.el (cursor-in-non-selected-windows): | ||
| 354 | Fix :set quoting oddness. (Bug#8192) | ||
| 355 | |||
| 356 | * font-lock.el (lisp-font-lock-keywords-1): Don't highlight `)' | ||
| 357 | in some setf expressions. (Bug#2159) | ||
| 358 | |||
| 359 | 2011-03-08 Chong Yidong <cyd@stupidchicken.com> | ||
| 360 | |||
| 361 | * custom.el (custom-available-themes): Return themes in | ||
| 362 | alphabetical order. | ||
| 363 | |||
| 364 | 2011-03-07 Chong Yidong <cyd@stupidchicken.com> | ||
| 365 | |||
| 366 | * progmodes/cc-cmds.el (c-beginning-of-statement): Fix incorrect | ||
| 367 | application of patch from Alan Mackenzie (Bug#7595). | ||
| 368 | |||
| 369 | 2011-03-07 Deniz Dogan <deniz.a.m.dogan@gmail.com> | ||
| 370 | |||
| 371 | * net/rcirc.el (rcirc-connect): Fix PASS bug. | ||
| 372 | |||
| 373 | 2011-03-07 Glenn Morris <rgm@gnu.org> | ||
| 374 | |||
| 375 | * vc/vc.el (vc-next-action): Add missing space to y-or-n-p prompt. | ||
| 376 | Give an explicit error if failed to make writable. (Bug#6146) | ||
| 377 | |||
| 378 | 2011-03-07 Ed Reingold <reingold@emr.cs.iit.edu> | ||
| 379 | |||
| 380 | * calendar/cal-hebrew.el (diary-hebrew-yahrzeit): | ||
| 381 | Add optional `after-sunset' argument. (Bug#8190) | ||
| 382 | |||
| 383 | 2011-03-07 Aaron S. Hawley <aaron.s.hawley@gmail.com> | ||
| 384 | |||
| 385 | * play/morse.el (nato-alphabet, nato-region, denato-region): | ||
| 386 | New variable and functions. (Bug#2288) | ||
| 387 | (morse-region, unmorse-region): Barf if read-only. | ||
| 388 | |||
| 389 | 2011-03-06 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 390 | |||
| 391 | * progmodes/gud.el (gdb-script-syntax-propertize-function): | ||
| 392 | Don't change the syntax of a \n that closes a comment (bug#8169). | ||
| 393 | |||
| 394 | 2011-03-06 Chong Yidong <cyd@stupidchicken.com> | ||
| 395 | |||
| 396 | * emacs-lisp/package-x.el (package-archive-upload-base): Make it a | ||
| 397 | defcustom. | ||
| 398 | (package--update-file): Doc fix. Accept relative file names. | ||
| 399 | (package--archive-contents-from-file): Remove the argument, since | ||
| 400 | it's necessarily always "archive-contents". | ||
| 401 | (package-maint-add-news-item): Pass relative file name args to | ||
| 402 | package--update-file. | ||
| 403 | (package-upload-buffer-internal): Prompt for a destination if | ||
| 404 | package-archive-upload-base is invalid. Create the directory if | ||
| 405 | it does not exist. | ||
| 406 | (package-upload-buffer, package-upload-file): Doc fix. | ||
| 407 | |||
| 1 | 2011-03-06 Chong Yidong <cyd@stupidchicken.com> | 408 | 2011-03-06 Chong Yidong <cyd@stupidchicken.com> |
| 2 | 409 | ||
| 3 | * isearch.el (isearch-mode-map): Bind C-y to isearch-yank-kill, | 410 | * isearch.el (isearch-mode-map): Bind C-y to isearch-yank-kill, |
| @@ -11,8 +418,8 @@ | |||
| 11 | 418 | ||
| 12 | 2011-03-06 Jay Belanger <jay.p.belanger@gmail.com> | 419 | 2011-03-06 Jay Belanger <jay.p.belanger@gmail.com> |
| 13 | 420 | ||
| 14 | * calc/calc-ext.el (calc-init-extensions): Rename | 421 | * calc/calc-ext.el (calc-init-extensions): |
| 15 | calc-logunits-dblevel and calc-logunits-nplevel to calc-dblevel | 422 | Rename calc-logunits-dblevel and calc-logunits-nplevel to calc-dblevel |
| 16 | and calc-nplevel, respectively. Add keybindings for calc-spn, | 423 | and calc-nplevel, respectively. Add keybindings for calc-spn, |
| 17 | calc-midi and calc-freq. Add autoloads for calcFunc-spn, | 424 | calc-midi and calc-freq. Add autoloads for calcFunc-spn, |
| 18 | calcFunc-midi, calcFunc-freq, calc-spn, calc-midi and calc-freq. | 425 | calcFunc-midi, calcFunc-freq, calc-spn, calc-midi and calc-freq. |
| @@ -732,7 +1139,7 @@ | |||
| 732 | 2011-02-17 Ken Manheimer <ken.manheimer@gmail.com> | 1139 | 2011-02-17 Ken Manheimer <ken.manheimer@gmail.com> |
| 733 | 1140 | ||
| 734 | * lisp/allout-widgets.el (allout-widgets-icons-light-subdir) | 1141 | * lisp/allout-widgets.el (allout-widgets-icons-light-subdir) |
| 735 | (allout-widgets-icons-dark-subdir): Track relocations of icons | 1142 | (allout-widgets-icons-dark-subdir): Track relocations of icons. |
| 736 | * lisp/allout.el: Remove commentary about remove encryption | 1143 | * lisp/allout.el: Remove commentary about remove encryption |
| 737 | passphrase mnemonic support and verification. | 1144 | passphrase mnemonic support and verification. |
| 738 | (allout-encrypt-string): Recognize epg failure to decrypt gpg2 | 1145 | (allout-encrypt-string): Recognize epg failure to decrypt gpg2 |
| @@ -1109,10 +1516,9 @@ | |||
| 1109 | 1516 | ||
| 1110 | (allout-auto-activation-helper, allout-setup): New autoloads | 1517 | (allout-auto-activation-helper, allout-setup): New autoloads |
| 1111 | implement new custom set procedure for allout-auto-activation. | 1518 | implement new custom set procedure for allout-auto-activation. |
| 1112 | Also, explicitly invoke | 1519 | Also, explicitly invoke (allout-setup) after allout-auto-activation |
| 1113 | (allout-setup) after allout-auto-activation is custom-defined, to | 1520 | is custom-defined, to affect the settings in emacs sessions besides |
| 1114 | effect the settings in emacs sessions besides the few where | 1521 | the few where allout-auto-activation customization is done. |
| 1115 | allout-auto-activation customization is donea. | ||
| 1116 | (allout-auto-activation): Use allout-auto-activation-helper to | 1522 | (allout-auto-activation): Use allout-auto-activation-helper to |
| 1117 | :set. Revise the docstring. | 1523 | :set. Revise the docstring. |
| 1118 | (allout-init): Reduce functionality to just customizing | 1524 | (allout-init): Reduce functionality to just customizing |
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index cc5fd6d96fa..47f181ab76b 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;; allout-widgets.el --- Show allout outline structure with graphical widgets. | 1 | ;; allout-widgets.el --- Visually highlight allout outline structure. |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 Ken Manheimer | 3 | ;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 Ken Manheimer |
| 4 | 4 | ||
| @@ -238,7 +238,7 @@ buffer, and tracking increases as new widgets are added and | |||
| 238 | decreases as obsolete widgets are garbage collected." | 238 | decreases as obsolete widgets are garbage collected." |
| 239 | :type 'boolean | 239 | :type 'boolean |
| 240 | :group 'allout-widgets-developer) | 240 | :group 'allout-widgets-developer) |
| 241 | (defvar allout-widgets-tally nil | 241 | (defvar allout-widgets-tally (make-hash-table :test 'eq :weakness 'key) |
| 242 | "Hash-table of existing allout widgets, for debugging. | 242 | "Hash-table of existing allout widgets, for debugging. |
| 243 | 243 | ||
| 244 | Table is maintained iff `allout-widgets-maintain-tally' is non-nil. | 244 | Table is maintained iff `allout-widgets-maintain-tally' is non-nil. |
diff --git a/lisp/allout.el b/lisp/allout.el index c75b7a22f9a..3fb8ed7ccd5 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -310,6 +310,7 @@ Auto-layout is not. | |||
| 310 | 310 | ||
| 311 | With value nil, inhibit any automatic allout-mode activation." | 311 | With value nil, inhibit any automatic allout-mode activation." |
| 312 | :set 'allout-auto-activation-helper | 312 | :set 'allout-auto-activation-helper |
| 313 | ;; FIXME: Using strings here is unusual and less efficient than symbols. | ||
| 313 | :type '(choice (const :tag "On" t) | 314 | :type '(choice (const :tag "On" t) |
| 314 | (const :tag "Ask about layout" "ask") | 315 | (const :tag "Ask about layout" "ask") |
| 315 | (const :tag "Mode only" "activate") | 316 | (const :tag "Mode only" "activate") |
| @@ -752,7 +753,7 @@ Set this var to the bullet you want to use for file cross-references." | |||
| 752 | 753 | ||
| 753 | ;;;_ = allout-flattened-numbering-abbreviation | 754 | ;;;_ = allout-flattened-numbering-abbreviation |
| 754 | (define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering | 755 | (define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering |
| 755 | 'allout-flattened-numbering-abbreviation "24.0") | 756 | 'allout-flattened-numbering-abbreviation "24.1") |
| 756 | (defcustom allout-flattened-numbering-abbreviation nil | 757 | (defcustom allout-flattened-numbering-abbreviation nil |
| 757 | "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic | 758 | "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic |
| 758 | numbers to minimal amount with some context. Otherwise, entire | 759 | numbers to minimal amount with some context. Otherwise, entire |
| @@ -1402,7 +1403,7 @@ their settings before allout-mode was started." | |||
| 1402 | (defvar allout-mode-deactivate-hook nil | 1403 | (defvar allout-mode-deactivate-hook nil |
| 1403 | "*Hook that's run when allout mode ends.") | 1404 | "*Hook that's run when allout mode ends.") |
| 1404 | (define-obsolete-variable-alias 'allout-mode-deactivate-hook | 1405 | (define-obsolete-variable-alias 'allout-mode-deactivate-hook |
| 1405 | 'allout-mode-off-hook "future") | 1406 | 'allout-mode-off-hook "24.1") |
| 1406 | ;;;_ = allout-exposure-category | 1407 | ;;;_ = allout-exposure-category |
| 1407 | (defvar allout-exposure-category nil | 1408 | (defvar allout-exposure-category nil |
| 1408 | "Symbol for use as allout invisible-text overlay category.") | 1409 | "Symbol for use as allout invisible-text overlay category.") |
| @@ -3465,13 +3466,13 @@ Offer one suitable for current depth DEPTH as default." | |||
| 3465 | (defun allout-make-topic-prefix (&optional prior-bullet | 3466 | (defun allout-make-topic-prefix (&optional prior-bullet |
| 3466 | new | 3467 | new |
| 3467 | depth | 3468 | depth |
| 3468 | solicit | 3469 | instead |
| 3469 | number-control | 3470 | number-control |
| 3470 | index) | 3471 | index) |
| 3471 | ;; Depth null means use current depth, non-null means we're either | 3472 | ;; Depth null means use current depth, non-null means we're either |
| 3472 | ;; opening a new topic after current topic, lower or higher, or we're | 3473 | ;; opening a new topic after current topic, lower or higher, or we're |
| 3473 | ;; changing level of current topic. | 3474 | ;; changing level of current topic. |
| 3474 | ;; Solicit dominates specified bullet-char. | 3475 | ;; Instead dominates specified bullet-char. |
| 3475 | ;;;_ . Doc string: | 3476 | ;;;_ . Doc string: |
| 3476 | "Generate a topic prefix suitable for optional arg DEPTH, or current depth. | 3477 | "Generate a topic prefix suitable for optional arg DEPTH, or current depth. |
| 3477 | 3478 | ||
| @@ -3492,15 +3493,18 @@ bullet or previous sibling. | |||
| 3492 | Third arg DEPTH forces the topic prefix to that depth, regardless of | 3493 | Third arg DEPTH forces the topic prefix to that depth, regardless of |
| 3493 | the current topics' depth. | 3494 | the current topics' depth. |
| 3494 | 3495 | ||
| 3495 | If SOLICIT is non-nil, then the choice of bullet is solicited from | 3496 | If INSTEAD is: |
| 3496 | user. If it's a character, then that character is offered as the | 3497 | |
| 3497 | default, otherwise the one suited to the context (according to | 3498 | - nil, then the bullet char for the context is used, per distinction or depth |
| 3498 | distinction or depth) is offered. (This overrides other options, | 3499 | - a \(numeric) character, then character's string representation is used |
| 3499 | including, eg, a distinctive PRIOR-BULLET.) If non-nil, then the | 3500 | - a string, then the user is asked for bullet with the first char as default |
| 3500 | context-specific bullet is used. | 3501 | - anything else, the user is solicited with bullet char per context as default |
| 3502 | |||
| 3503 | \(INSTEAD overrides other options, including, eg, a distinctive | ||
| 3504 | PRIOR-BULLET.) | ||
| 3501 | 3505 | ||
| 3502 | Fifth arg, NUMBER-CONTROL, matters only if `allout-numbered-bullet' | 3506 | Fifth arg, NUMBER-CONTROL, matters only if `allout-numbered-bullet' |
| 3503 | is non-nil *and* soliciting was not explicitly invoked. Then | 3507 | is non-nil *and* no specific INSTEAD was specified. Then |
| 3504 | NUMBER-CONTROL non-nil forces prefix to either numbered or | 3508 | NUMBER-CONTROL non-nil forces prefix to either numbered or |
| 3505 | denumbered format, depending on the value of the sixth arg, INDEX. | 3509 | denumbered format, depending on the value of the sixth arg, INDEX. |
| 3506 | 3510 | ||
| @@ -3549,8 +3553,13 @@ index for each successive sibling)." | |||
| 3549 | ;; Solicitation overrides numbering and other cases: | 3553 | ;; Solicitation overrides numbering and other cases: |
| 3550 | ((progn (setq body (make-string (- depth 2) ?\ )) | 3554 | ((progn (setq body (make-string (- depth 2) ?\ )) |
| 3551 | ;; The actual condition: | 3555 | ;; The actual condition: |
| 3552 | solicit) | 3556 | instead) |
| 3553 | (let* ((got (allout-solicit-alternate-bullet depth solicit))) | 3557 | (let ((got (cond ((stringp instead) |
| 3558 | (if (> (length instead) 0) | ||
| 3559 | (allout-solicit-alternate-bullet | ||
| 3560 | depth (substring instead 0 1)))) | ||
| 3561 | ((characterp instead) (char-to-string instead)) | ||
| 3562 | (t (allout-solicit-alternate-bullet depth))))) | ||
| 3554 | ;; Gotta check whether we're numbering and got a numbered bullet: | 3563 | ;; Gotta check whether we're numbering and got a numbered bullet: |
| 3555 | (setq numbering (and allout-numbered-bullet | 3564 | (setq numbering (and allout-numbered-bullet |
| 3556 | (not (and number-control (not index))) | 3565 | (not (and number-control (not index))) |
| @@ -3913,7 +3922,7 @@ Note that refill of indented paragraphs is not done." | |||
| 3913 | (allout-end-of-prefix) | 3922 | (allout-end-of-prefix) |
| 3914 | (setq from allout-recent-prefix-beginning | 3923 | (setq from allout-recent-prefix-beginning |
| 3915 | to allout-recent-prefix-end) | 3924 | to allout-recent-prefix-end) |
| 3916 | (allout-rebullet-heading t ;;; solicit | 3925 | (allout-rebullet-heading t ;;; instead |
| 3917 | nil ;;; depth | 3926 | nil ;;; depth |
| 3918 | nil ;;; number-control | 3927 | nil ;;; number-control |
| 3919 | nil ;;; index | 3928 | nil ;;; index |
| @@ -3931,8 +3940,8 @@ Note that refill of indented paragraphs is not done." | |||
| 3931 | (message "Done.") | 3940 | (message "Done.") |
| 3932 | (cond (on-bullet (goto-char (allout-current-bullet-pos))) | 3941 | (cond (on-bullet (goto-char (allout-current-bullet-pos))) |
| 3933 | (initial-col (move-to-column initial-col))))) | 3942 | (initial-col (move-to-column initial-col))))) |
| 3934 | ;;;_ > allout-rebullet-heading (&optional solicit ...) | 3943 | ;;;_ > allout-rebullet-heading (&optional instead ...) |
| 3935 | (defun allout-rebullet-heading (&optional solicit | 3944 | (defun allout-rebullet-heading (&optional instead |
| 3936 | new-depth | 3945 | new-depth |
| 3937 | number-control | 3946 | number-control |
| 3938 | index | 3947 | index |
| @@ -3942,11 +3951,11 @@ Note that refill of indented paragraphs is not done." | |||
| 3942 | 3951 | ||
| 3943 | All args are optional. | 3952 | All args are optional. |
| 3944 | 3953 | ||
| 3945 | If SOLICIT is non-nil, then the choice of bullet is solicited from | 3954 | If INSTEAD is: |
| 3946 | user. If it's a character, then that character is offered as the | 3955 | - nil, then the bullet char for the context is used, per distinction or depth |
| 3947 | default, otherwise the one suited to the context (according to | 3956 | - a \(numeric) character, then character's string representation is used |
| 3948 | distinction or depth) is offered. If non-nil, then the | 3957 | - a string, then the user is asked for bullet with the first char as default |
| 3949 | context-specific bullet is just used. | 3958 | - anything else, the user is solicited with bullet char per context as default |
| 3950 | 3959 | ||
| 3951 | Second arg DEPTH forces the topic prefix to that depth, regardless | 3960 | Second arg DEPTH forces the topic prefix to that depth, regardless |
| 3952 | of the topic's current depth. | 3961 | of the topic's current depth. |
| @@ -3981,7 +3990,7 @@ this function." | |||
| 3981 | (new-prefix (allout-make-topic-prefix current-bullet | 3990 | (new-prefix (allout-make-topic-prefix current-bullet |
| 3982 | nil | 3991 | nil |
| 3983 | new-depth | 3992 | new-depth |
| 3984 | solicit | 3993 | instead |
| 3985 | number-control | 3994 | number-control |
| 3986 | index))) | 3995 | index))) |
| 3987 | 3996 | ||
| @@ -4028,7 +4037,7 @@ this function." | |||
| 4028 | (cond ((numberp index) (1+ index)) | 4037 | (cond ((numberp index) (1+ index)) |
| 4029 | ((not number-control) (allout-sibling-index)))) | 4038 | ((not number-control) (allout-sibling-index)))) |
| 4030 | (if (allout-numbered-type-prefix) | 4039 | (if (allout-numbered-type-prefix) |
| 4031 | (allout-rebullet-heading nil ;;; solicit | 4040 | (allout-rebullet-heading nil ;;; instead |
| 4032 | new-depth ;;; new-depth | 4041 | new-depth ;;; new-depth |
| 4033 | number-control;;; number-control | 4042 | number-control;;; number-control |
| 4034 | index ;;; index | 4043 | index ;;; index |
| @@ -4145,7 +4154,7 @@ a topic and its immediate offspring is greater than one.)" | |||
| 4145 | (when (< relative-depth 0) | 4154 | (when (< relative-depth 0) |
| 4146 | (save-excursion | 4155 | (save-excursion |
| 4147 | (goto-char local-point) | 4156 | (goto-char local-point) |
| 4148 | (allout-rebullet-heading nil ;;; solicit | 4157 | (allout-rebullet-heading nil ;;; instead |
| 4149 | (+ starting-depth relative-depth) | 4158 | (+ starting-depth relative-depth) |
| 4150 | nil ;;; number | 4159 | nil ;;; number |
| 4151 | starting-index | 4160 | starting-index |
| @@ -4203,7 +4212,7 @@ Returns final depth." | |||
| 4203 | ; Prime ascender for ascension: | 4212 | ; Prime ascender for ascension: |
| 4204 | (setq ascender (1- allout-recent-depth)) | 4213 | (setq ascender (1- allout-recent-depth)) |
| 4205 | (if (>= allout-recent-depth depth) | 4214 | (if (>= allout-recent-depth depth) |
| 4206 | (allout-rebullet-heading nil ;;; solicit | 4215 | (allout-rebullet-heading nil ;;; instead |
| 4207 | nil ;;; depth | 4216 | nil ;;; depth |
| 4208 | nil ;;; number-control | 4217 | nil ;;; number-control |
| 4209 | nil ;;; index | 4218 | nil ;;; index |
| @@ -4230,7 +4239,7 @@ rebulleting each topic at this level." | |||
| 4230 | (use-bullet (equal '(16) denumber)) | 4239 | (use-bullet (equal '(16) denumber)) |
| 4231 | (more t)) | 4240 | (more t)) |
| 4232 | (while more | 4241 | (while more |
| 4233 | (allout-rebullet-heading use-bullet ;;; solicit | 4242 | (allout-rebullet-heading use-bullet ;;; instead |
| 4234 | depth ;;; depth | 4243 | depth ;;; depth |
| 4235 | t ;;; number-control | 4244 | t ;;; number-control |
| 4236 | index ;;; index | 4245 | index ;;; index |
| @@ -4577,32 +4586,20 @@ however, are left exactly like normal, non-allout-specific yanks." | |||
| 4577 | (progn (widen) | 4586 | (progn (widen) |
| 4578 | (forward-char -1) | 4587 | (forward-char -1) |
| 4579 | (narrow-to-region subj-beg (point)))))) | 4588 | (narrow-to-region subj-beg (point)))))) |
| 4580 | ;; Preserve new bullet if it's a distinctive one, otherwise | 4589 | ;; Remove new heading prefix: |
| 4581 | ;; use old one: | 4590 | (allout-unprotected |
| 4582 | (if (string-match (regexp-quote prefix-bullet) | 4591 | (progn |
| 4583 | allout-distinctive-bullets-string) | 4592 | (delete-region (point) (+ (point) |
| 4584 | ; Delete from bullet of old to | 4593 | prefix-len |
| 4585 | ; before bullet of new: | 4594 | (- adjust-to-depth |
| 4586 | (progn | 4595 | subj-depth))) |
| 4587 | (beginning-of-line) | ||
| 4588 | (allout-unprotected | ||
| 4589 | (delete-region (point) subj-beg)) | ||
| 4590 | (set-marker (allout-mark-marker t) subj-end) | ||
| 4591 | (goto-char subj-beg) | ||
| 4592 | (allout-end-of-prefix)) | ||
| 4593 | ; Delete base subj prefix, | ||
| 4594 | ; leaving old one: | ||
| 4595 | (allout-unprotected | ||
| 4596 | (progn | ||
| 4597 | (delete-region (point) (+ (point) | ||
| 4598 | prefix-len | ||
| 4599 | (- adjust-to-depth | ||
| 4600 | subj-depth))) | ||
| 4601 | ; and delete residual subj | 4596 | ; and delete residual subj |
| 4602 | ; prefix digits and space: | 4597 | ; prefix digits and space: |
| 4603 | (while (looking-at "[0-9]") (delete-char 1)) | 4598 | (while (looking-at "[0-9]") (delete-char 1)) |
| 4604 | (if (looking-at " ") | 4599 | (if (looking-at " ") |
| 4605 | (delete-char 1)))))) | 4600 | (delete-char 1)))) |
| 4601 | ;; Assert new topic's bullet - minimal effort if unchanged: | ||
| 4602 | (allout-rebullet-heading (string-to-char prefix-bullet))) | ||
| 4606 | (exchange-point-and-mark)))) | 4603 | (exchange-point-and-mark)))) |
| 4607 | (if rectify-numbering | 4604 | (if rectify-numbering |
| 4608 | (progn | 4605 | (progn |
| @@ -4613,7 +4610,7 @@ however, are left exactly like normal, non-allout-specific yanks." | |||
| 4613 | (goto-char subj-beg) | 4610 | (goto-char subj-beg) |
| 4614 | (if (allout-goto-prefix-doublechecked) | 4611 | (if (allout-goto-prefix-doublechecked) |
| 4615 | (allout-unprotected | 4612 | (allout-unprotected |
| 4616 | (allout-rebullet-heading nil ;;; solicit | 4613 | (allout-rebullet-heading nil ;;; instead |
| 4617 | (allout-depth) ;;; depth | 4614 | (allout-depth) ;;; depth |
| 4618 | nil ;;; number-control | 4615 | nil ;;; number-control |
| 4619 | nil ;;; index | 4616 | nil ;;; index |
diff --git a/lisp/avoid.el b/lisp/avoid.el index fe47a0c4a33..038927105ec 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el | |||
| @@ -76,7 +76,7 @@ | |||
| 76 | 76 | ||
| 77 | ;;;###autoload | 77 | ;;;###autoload |
| 78 | (defcustom mouse-avoidance-mode nil | 78 | (defcustom mouse-avoidance-mode nil |
| 79 | "Activate mouse avoidance mode. | 79 | "Activate Mouse Avoidance mode. |
| 80 | See function `mouse-avoidance-mode' for possible values. | 80 | See function `mouse-avoidance-mode' for possible values. |
| 81 | Setting this variable directly does not take effect; | 81 | Setting this variable directly does not take effect; |
| 82 | use either \\[customize] or the function `mouse-avoidance-mode'." | 82 | use either \\[customize] or the function `mouse-avoidance-mode'." |
| @@ -85,8 +85,7 @@ use either \\[customize] or the function `mouse-avoidance-mode'." | |||
| 85 | (mouse-avoidance-mode (or value 'none))) | 85 | (mouse-avoidance-mode (or value 'none))) |
| 86 | :initialize 'custom-initialize-default | 86 | :initialize 'custom-initialize-default |
| 87 | :type '(choice (const :tag "none" nil) (const banish) (const jump) | 87 | :type '(choice (const :tag "none" nil) (const banish) (const jump) |
| 88 | (const animate) (const exile) (const proteus) | 88 | (const animate) (const exile) (const proteus)) |
| 89 | ) | ||
| 90 | :group 'avoid | 89 | :group 'avoid |
| 91 | :require 'avoid | 90 | :require 'avoid |
| 92 | :version "20.3") | 91 | :version "20.3") |
| @@ -94,7 +93,7 @@ use either \\[customize] or the function `mouse-avoidance-mode'." | |||
| 94 | 93 | ||
| 95 | (defcustom mouse-avoidance-nudge-dist 15 | 94 | (defcustom mouse-avoidance-nudge-dist 15 |
| 96 | "Average distance that mouse will be moved when approached by cursor. | 95 | "Average distance that mouse will be moved when approached by cursor. |
| 97 | Only applies in Mouse-Avoidance mode `jump' and its derivatives. | 96 | Only applies in Mouse Avoidance mode `jump' and its derivatives. |
| 98 | For best results make this larger than `mouse-avoidance-threshold'." | 97 | For best results make this larger than `mouse-avoidance-threshold'." |
| 99 | :type 'integer | 98 | :type 'integer |
| 100 | :group 'avoid) | 99 | :group 'avoid) |
| @@ -112,7 +111,7 @@ For best results make this larger than `mouse-avoidance-threshold'." | |||
| 112 | (defcustom mouse-avoidance-threshold 5 | 111 | (defcustom mouse-avoidance-threshold 5 |
| 113 | "Mouse-pointer's flight distance. | 112 | "Mouse-pointer's flight distance. |
| 114 | If the cursor gets closer than this, the mouse pointer will move away. | 113 | If the cursor gets closer than this, the mouse pointer will move away. |
| 115 | Only applies in mouse-avoidance-modes `animate' and `jump'." | 114 | Only applies in Mouse Avoidance modes `animate' and `jump'." |
| 116 | :type 'integer | 115 | :type 'integer |
| 117 | :group 'avoid) | 116 | :group 'avoid) |
| 118 | 117 | ||
| @@ -183,7 +182,7 @@ Acceptable distance is defined by `mouse-avoidance-threshold'." | |||
| 183 | mouse-avoidance-threshold)))))) | 182 | mouse-avoidance-threshold)))))) |
| 184 | 183 | ||
| 185 | (defun mouse-avoidance-banish-destination () | 184 | (defun mouse-avoidance-banish-destination () |
| 186 | "The position to which Mouse-Avoidance mode `banish' moves the mouse. | 185 | "The position to which Mouse Avoidance mode `banish' moves the mouse. |
| 187 | You can redefine this if you want the mouse banished to a different corner." | 186 | You can redefine this if you want the mouse banished to a different corner." |
| 188 | (let* ((pos (window-edges))) | 187 | (let* ((pos (window-edges))) |
| 189 | (cons (- (nth 2 pos) 2) | 188 | (cons (- (nth 2 pos) 2) |
| @@ -278,6 +277,7 @@ redefine this function to suit your own tastes." | |||
| 278 | (defun mouse-avoidance-ignore-p () | 277 | (defun mouse-avoidance-ignore-p () |
| 279 | (let ((mp (mouse-position))) | 278 | (let ((mp (mouse-position))) |
| 280 | (or (not (frame-pointer-visible-p)) ; The pointer is hidden | 279 | (or (not (frame-pointer-visible-p)) ; The pointer is hidden |
| 280 | (not cursor-type) ; There's no cursor | ||
| 281 | executing-kbd-macro ; don't check inside macro | 281 | executing-kbd-macro ; don't check inside macro |
| 282 | (null (cadr mp)) ; don't move unless in an Emacs frame | 282 | (null (cadr mp)) ; don't move unless in an Emacs frame |
| 283 | (not (eq (car mp) (selected-frame))) | 283 | (not (eq (car mp) (selected-frame))) |
| @@ -332,7 +332,7 @@ redefine this function to suit your own tastes." | |||
| 332 | 332 | ||
| 333 | ;;;###autoload | 333 | ;;;###autoload |
| 334 | (defun mouse-avoidance-mode (&optional mode) | 334 | (defun mouse-avoidance-mode (&optional mode) |
| 335 | "Set cursor avoidance mode to MODE. | 335 | "Set Mouse Avoidance mode to MODE. |
| 336 | MODE should be one of the symbols `banish', `exile', `jump', `animate', | 336 | MODE should be one of the symbols `banish', `exile', `jump', `animate', |
| 337 | `cat-and-mouse', `proteus', or `none'. | 337 | `cat-and-mouse', `proteus', or `none'. |
| 338 | 338 | ||
| @@ -352,7 +352,7 @@ Effects of the different modes: | |||
| 352 | 352 | ||
| 353 | Whenever the mouse is moved, the frame is also raised. | 353 | Whenever the mouse is moved, the frame is also raised. |
| 354 | 354 | ||
| 355 | \(see `mouse-avoidance-threshold' for definition of \"too close\", | 355 | \(See `mouse-avoidance-threshold' for definition of \"too close\", |
| 356 | and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for | 356 | and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for |
| 357 | definition of \"random distance\".)" | 357 | definition of \"random distance\".)" |
| 358 | (interactive | 358 | (interactive |
diff --git a/lisp/calc/README b/lisp/calc/README index 533b80baeb0..308b5115aa2 100644 --- a/lisp/calc/README +++ b/lisp/calc/README | |||
| @@ -72,6 +72,8 @@ Summary of changes to "Calc" | |||
| 72 | 72 | ||
| 73 | Emacs 24.1 | 73 | Emacs 24.1 |
| 74 | 74 | ||
| 75 | * Support for musical notes added. | ||
| 76 | |||
| 75 | * Support for logarithmic units added. | 77 | * Support for logarithmic units added. |
| 76 | 78 | ||
| 77 | * Calc no longer uses the tex prefix for TeX specific unit | 79 | * Calc no longer uses the tex prefix for TeX specific unit |
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 11a26d6d125..9ea773fbb98 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el | |||
| @@ -422,13 +422,13 @@ | |||
| 422 | (define-key calc-mode-map "kT" 'calc-utpt) | 422 | (define-key calc-mode-map "kT" 'calc-utpt) |
| 423 | 423 | ||
| 424 | (define-key calc-mode-map "l" nil) | 424 | (define-key calc-mode-map "l" nil) |
| 425 | (define-key calc-mode-map "lq" 'calc-logunits-quantity) | 425 | (define-key calc-mode-map "lq" 'calc-lu-quant) |
| 426 | (define-key calc-mode-map "ld" 'calc-dblevel) | 426 | (define-key calc-mode-map "ld" 'calc-db) |
| 427 | (define-key calc-mode-map "ln" 'calc-nplevel) | 427 | (define-key calc-mode-map "ln" 'calc-np) |
| 428 | (define-key calc-mode-map "l+" 'calc-logunits-add) | 428 | (define-key calc-mode-map "l+" 'calc-lu-plus) |
| 429 | (define-key calc-mode-map "l-" 'calc-logunits-sub) | 429 | (define-key calc-mode-map "l-" 'calc-lu-minus) |
| 430 | (define-key calc-mode-map "l*" 'calc-logunits-mul) | 430 | (define-key calc-mode-map "l*" 'calc-lu-times) |
| 431 | (define-key calc-mode-map "l/" 'calc-logunits-divide) | 431 | (define-key calc-mode-map "l/" 'calc-lu-divide) |
| 432 | (define-key calc-mode-map "ls" 'calc-spn) | 432 | (define-key calc-mode-map "ls" 'calc-spn) |
| 433 | (define-key calc-mode-map "lm" 'calc-midi) | 433 | (define-key calc-mode-map "lm" 'calc-midi) |
| 434 | (define-key calc-mode-map "lf" 'calc-freq) | 434 | (define-key calc-mode-map "lf" 'calc-freq) |
| @@ -943,12 +943,11 @@ calc-store-value calc-var-name) | |||
| 943 | ("calc-stuff" calc-explain-why calcFunc-clean | 943 | ("calc-stuff" calc-explain-why calcFunc-clean |
| 944 | calcFunc-pclean calcFunc-pfloat calcFunc-pfrac) | 944 | calcFunc-pclean calcFunc-pfloat calcFunc-pfrac) |
| 945 | 945 | ||
| 946 | ("calc-units" calcFunc-usimplify calcFunc-lufieldadd | 946 | ("calc-units" calcFunc-usimplify calcFunc-lufadd calcFunc-lupadd |
| 947 | calcFunc-lupoweradd calcFunc-lufieldsub calcFunc-lupowersub | 947 | calcFunc-lufsub calcFunc-lupsub calcFunc-lufmul calcFunc-lupmul |
| 948 | calcFunc-lufieldmul calcFunc-lupowermul calcFunc-lufielddiv | 948 | calcFunc-lufdiv calcFunc-lupdiv calcFunc-lufquant calcFunc-lupquant |
| 949 | calcFunc-lupowerdiv calcFunc-fieldquant calcFunc-powerquant | 949 | calcFunc-dbfield calcFunc-dbpower calcFunc-npfield |
| 950 | calcFunc-dbfieldlevel calcFunc-dbpowerlevel calcFunc-npfieldlevel | 950 | calcFunc-nppower calcFunc-spn calcFunc-midi calcFunc-freq |
| 951 | calcFunc-nppowerlevel calcFunc-spn calcFunc-midi calcFunc-freq | ||
| 952 | math-build-units-table math-build-units-table-buffer | 951 | math-build-units-table math-build-units-table-buffer |
| 953 | math-check-unit-name math-convert-temperature math-convert-units | 952 | math-check-unit-name math-convert-temperature math-convert-units |
| 954 | math-extract-units math-remove-units math-simplify-units | 953 | math-extract-units math-remove-units math-simplify-units |
| @@ -1180,9 +1179,9 @@ calc-convert-temperature calc-convert-units calc-define-unit | |||
| 1180 | calc-enter-units-table calc-explain-units calc-extract-units | 1179 | calc-enter-units-table calc-explain-units calc-extract-units |
| 1181 | calc-get-unit-definition calc-permanent-units calc-quick-units | 1180 | calc-get-unit-definition calc-permanent-units calc-quick-units |
| 1182 | calc-remove-units calc-simplify-units calc-undefine-unit | 1181 | calc-remove-units calc-simplify-units calc-undefine-unit |
| 1183 | calc-view-units-table calc-logunits-quantity calc-dblevel | 1182 | calc-view-units-table calc-lu-quant calc-db |
| 1184 | calc-nplevel calc-logunits-add calc-logunits-sub | 1183 | calc-np calc-lu-plus calc-lu-minus |
| 1185 | calc-logunits-mul calc-logunits-divide calc-spn calc-midi | 1184 | calc-lu-times calc-lu-divide calc-spn calc-midi |
| 1186 | calc-freq) | 1185 | calc-freq) |
| 1187 | 1186 | ||
| 1188 | ("calc-vec" calc-arrange-vector calc-build-vector calc-cnorm | 1187 | ("calc-vec" calc-arrange-vector calc-build-vector calc-cnorm |
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index d688b31b3cb..427cf6ba233 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el | |||
| @@ -673,7 +673,9 @@ C-w Describe how there is no warranty for Calc." | |||
| 673 | (interactive) | 673 | (interactive) |
| 674 | (calc-do-prefix-help | 674 | (calc-do-prefix-help |
| 675 | '("Quantity, DB level, Np level" | 675 | '("Quantity, DB level, Np level" |
| 676 | "+, -, *, /") | 676 | "+, -, *, /" |
| 677 | "Scientific pitch notation, Midi number, Frequency" | ||
| 678 | ) | ||
| 677 | "log units" ?l)) | 679 | "log units" ?l)) |
| 678 | 680 | ||
| 679 | (defun calc-v-prefix-help () | 681 | (defun calc-v-prefix-help () |
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index aaddf3e486e..d8099b0aadc 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el | |||
| @@ -960,6 +960,111 @@ | |||
| 960 | (require 'calc-units) | 960 | (require 'calc-units) |
| 961 | (call-interactively 'calc-view-units-table)) | 961 | (call-interactively 'calc-view-units-table)) |
| 962 | :keys "u V"] | 962 | :keys "u V"] |
| 963 | (list "Logarithmic Units" | ||
| 964 | ["Convert (1:) to dB (power)" | ||
| 965 | (progn | ||
| 966 | (require 'calc-units) | ||
| 967 | (call-interactively 'calc-db)) | ||
| 968 | :keys "l d" | ||
| 969 | :active (>= (calc-stack-size) 1)] | ||
| 970 | ["Convert (2:) to dB (power) with reference level (1:)" | ||
| 971 | (progn | ||
| 972 | (require 'calc-units) | ||
| 973 | (let ((calc-option-flag t)) | ||
| 974 | (call-interactively 'calc-db))) | ||
| 975 | :keys "O l d" | ||
| 976 | :active (>= (calc-stack-size) 2)] | ||
| 977 | ["Convert (1:) to Np (power)" | ||
| 978 | (progn | ||
| 979 | (require 'calc-units) | ||
| 980 | (call-interactively 'calc-np)) | ||
| 981 | :keys "l n" | ||
| 982 | :active (>= (calc-stack-size) 1)] | ||
| 983 | ["Convert (2:) to Np (power) with reference level (1:)" | ||
| 984 | (progn | ||
| 985 | (require 'calc-units) | ||
| 986 | (let ((calc-option-flag t)) | ||
| 987 | (call-interactively 'calc-np))) | ||
| 988 | :keys "O l n" | ||
| 989 | :active (>= (calc-stack-size) 2)] | ||
| 990 | ["Convert (1:) to power quantity" | ||
| 991 | (progn | ||
| 992 | (require 'calc-units) | ||
| 993 | (call-interactively 'calc-lu-quant)) | ||
| 994 | :keys "l q" | ||
| 995 | :active (>= (calc-stack-size) 1)] | ||
| 996 | ["Convert (2:) to power quantity with reference level (1:)" | ||
| 997 | (progn | ||
| 998 | (require 'calc-units) | ||
| 999 | (let ((calc-option-flag t)) | ||
| 1000 | (call-interactively 'calc-lu-quant))) | ||
| 1001 | :keys "O l q" | ||
| 1002 | :active (>= (calc-stack-size) 2)] | ||
| 1003 | "----" | ||
| 1004 | ["Convert (1:) to dB (field)" | ||
| 1005 | (progn | ||
| 1006 | (require 'calc-units) | ||
| 1007 | (let ((calc-hyperbolic-flag t)) | ||
| 1008 | (call-interactively 'calc-db))) | ||
| 1009 | :keys "H l d" | ||
| 1010 | :active (>= (calc-stack-size) 1)] | ||
| 1011 | ["Convert (2:) to dB (field) with reference level (1:)" | ||
| 1012 | (progn | ||
| 1013 | (require 'calc-units) | ||
| 1014 | (let ((calc-option-flag t) | ||
| 1015 | (calc-hyperbolic-flag t)) | ||
| 1016 | (call-interactively 'calc-db))) | ||
| 1017 | :keys "O H l d" | ||
| 1018 | :active (>= (calc-stack-size) 2)] | ||
| 1019 | ["Convert (1:) to Np (field)" | ||
| 1020 | (progn | ||
| 1021 | (require 'calc-units) | ||
| 1022 | (let ((calc-hyperbolic-flag t)) | ||
| 1023 | (call-interactively 'calc-np))) | ||
| 1024 | :keys "H l n" | ||
| 1025 | :active (>= (calc-stack-size) 1)] | ||
| 1026 | ["Convert (2:) to Np (field) with reference level (1:)" | ||
| 1027 | (progn | ||
| 1028 | (require 'calc-units) | ||
| 1029 | (let ((calc-option-flag t) | ||
| 1030 | (calc-hyperbolic-flag t)) | ||
| 1031 | (call-interactively 'calc-np))) | ||
| 1032 | :keys "O H l d" | ||
| 1033 | :active (>= (calc-stack-size) 2)] | ||
| 1034 | ["Convert (1:) to field quantity" | ||
| 1035 | (progn | ||
| 1036 | (require 'calc-units) | ||
| 1037 | (let ((calc-hyperbolic-flag t)) | ||
| 1038 | (call-interactively 'calc-lu-quant))) | ||
| 1039 | :keys "H l q" | ||
| 1040 | :active (>= (calc-stack-size) 1)] | ||
| 1041 | ["Convert (2:) to field quantity with reference level (1:)" | ||
| 1042 | (progn | ||
| 1043 | (require 'calc-units) | ||
| 1044 | (let ((calc-option-flag t) | ||
| 1045 | (calc-hyperbolic-flag)) | ||
| 1046 | (call-interactively 'calc-lu-quant))) | ||
| 1047 | :keys "O H l q" | ||
| 1048 | :active (>= (calc-stack-size) 2)]) | ||
| 1049 | (list "Musical Notes" | ||
| 1050 | ["Convert (1:) to scientific pitch notation" | ||
| 1051 | (progn | ||
| 1052 | (require 'calc-units) | ||
| 1053 | (call-interactively 'calc-spn)) | ||
| 1054 | :keys "l s" | ||
| 1055 | :active (>= (calc-stack-size) 1)] | ||
| 1056 | ["Convert (1:) to midi number" | ||
| 1057 | (progn | ||
| 1058 | (require 'calc-units) | ||
| 1059 | (call-interactively 'calc-midi)) | ||
| 1060 | :keys "l m" | ||
| 1061 | :active (>= (calc-stack-size) 1)] | ||
| 1062 | ["Convert (1:) to frequency" | ||
| 1063 | (progn | ||
| 1064 | (require 'calc-units) | ||
| 1065 | (call-interactively 'calc-freq)) | ||
| 1066 | :keys "l f" | ||
| 1067 | :active (>= (calc-stack-size) 1)]) | ||
| 963 | "----" | 1068 | "----" |
| 964 | ["Help on Units" | 1069 | ["Help on Units" |
| 965 | (calc-info-goto-node "Units")]) | 1070 | (calc-info-goto-node "Units")]) |
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 7f0adc9fe7e..43cb5828e85 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el | |||
| @@ -1623,39 +1623,39 @@ In symbolic mode, return the list (^ a b)." | |||
| 1623 | coef))) | 1623 | coef))) |
| 1624 | units))))))) | 1624 | units))))))) |
| 1625 | 1625 | ||
| 1626 | (defun calcFunc-lufieldplus (a b) | 1626 | (defun calcFunc-lufadd (a b) |
| 1627 | (math-logunits-add a b nil nil)) | 1627 | (math-logunits-add a b nil nil)) |
| 1628 | 1628 | ||
| 1629 | (defun calcFunc-lupowerplus (a b) | 1629 | (defun calcFunc-lupadd (a b) |
| 1630 | (math-logunits-add a b nil t)) | 1630 | (math-logunits-add a b nil t)) |
| 1631 | 1631 | ||
| 1632 | (defun calcFunc-lufieldminus (a b) | 1632 | (defun calcFunc-lufsub (a b) |
| 1633 | (math-logunits-add a b t nil)) | 1633 | (math-logunits-add a b t nil)) |
| 1634 | 1634 | ||
| 1635 | (defun calcFunc-lupowerminus (a b) | 1635 | (defun calcFunc-lupsub (a b) |
| 1636 | (math-logunits-add a b t t)) | 1636 | (math-logunits-add a b t t)) |
| 1637 | 1637 | ||
| 1638 | (defun calc-logunits-add (arg) | 1638 | (defun calc-lu-plus (arg) |
| 1639 | (interactive "P") | 1639 | (interactive "P") |
| 1640 | (calc-slow-wrapper | 1640 | (calc-slow-wrapper |
| 1641 | (if (calc-is-inverse) | 1641 | (if (calc-is-inverse) |
| 1642 | (if (calc-is-hyperbolic) | 1642 | (if (calc-is-hyperbolic) |
| 1643 | (calc-binary-op "lu-" 'calcFunc-lufieldminus arg) | 1643 | (calc-binary-op "lu-" 'calcFunc-lufsub arg) |
| 1644 | (calc-binary-op "lu-" 'calcFunc-lupowerminus arg)) | 1644 | (calc-binary-op "lu-" 'calcFunc-lupsub arg)) |
| 1645 | (if (calc-is-hyperbolic) | 1645 | (if (calc-is-hyperbolic) |
| 1646 | (calc-binary-op "lu+" 'calcFunc-lufieldplus arg) | 1646 | (calc-binary-op "lu+" 'calcFunc-lufadd arg) |
| 1647 | (calc-binary-op "lu+" 'calcFunc-lupowerplus arg))))) | 1647 | (calc-binary-op "lu+" 'calcFunc-lupadd arg))))) |
| 1648 | 1648 | ||
| 1649 | (defun calc-logunits-sub (arg) | 1649 | (defun calc-lu-minus (arg) |
| 1650 | (interactive "P") | 1650 | (interactive "P") |
| 1651 | (calc-slow-wrapper | 1651 | (calc-slow-wrapper |
| 1652 | (if (calc-is-inverse) | 1652 | (if (calc-is-inverse) |
| 1653 | (if (calc-is-hyperbolic) | 1653 | (if (calc-is-hyperbolic) |
| 1654 | (calc-binary-op "lu+" 'calcFunc-lufieldplus arg) | 1654 | (calc-binary-op "lu+" 'calcFunc-lufadd arg) |
| 1655 | (calc-binary-op "lu+" 'calcFunc-lupowerplus arg)) | 1655 | (calc-binary-op "lu+" 'calcFunc-lupadd arg)) |
| 1656 | (if (calc-is-hyperbolic) | 1656 | (if (calc-is-hyperbolic) |
| 1657 | (calc-binary-op "lu-" 'calcFunc-lufieldminus arg) | 1657 | (calc-binary-op "lu-" 'calcFunc-lufsub arg) |
| 1658 | (calc-binary-op "lu-" 'calcFunc-lupowerminus arg))))) | 1658 | (calc-binary-op "lu-" 'calcFunc-lupsub arg))))) |
| 1659 | 1659 | ||
| 1660 | (defun math-logunits-mul (a b power) | 1660 | (defun math-logunits-mul (a b power) |
| 1661 | (let (logunit coef units number) | 1661 | (let (logunit coef units number) |
| @@ -1719,39 +1719,39 @@ In symbolic mode, return the list (^ a b)." | |||
| 1719 | (math-div (math-conditional-apply 'calcFunc-ln b) (if power 2 1))) | 1719 | (math-div (math-conditional-apply 'calcFunc-ln b) (if power 2 1))) |
| 1720 | units))))))))) | 1720 | units))))))))) |
| 1721 | 1721 | ||
| 1722 | (defun calcFunc-lufieldtimes (a b) | 1722 | (defun calcFunc-lufmul (a b) |
| 1723 | (math-logunits-mul a b nil)) | 1723 | (math-logunits-mul a b nil)) |
| 1724 | 1724 | ||
| 1725 | (defun calcFunc-lupowertimes (a b) | 1725 | (defun calcFunc-lupmul (a b) |
| 1726 | (math-logunits-mul a b t)) | 1726 | (math-logunits-mul a b t)) |
| 1727 | 1727 | ||
| 1728 | (defun calc-logunits-mul (arg) | 1728 | (defun calc-lu-times (arg) |
| 1729 | (interactive "P") | 1729 | (interactive "P") |
| 1730 | (calc-slow-wrapper | 1730 | (calc-slow-wrapper |
| 1731 | (if (calc-is-inverse) | 1731 | (if (calc-is-inverse) |
| 1732 | (if (calc-is-hyperbolic) | 1732 | (if (calc-is-hyperbolic) |
| 1733 | (calc-binary-op "lu/" 'calcFunc-lufielddiv arg) | 1733 | (calc-binary-op "lu/" 'calcFunc-lufdiv arg) |
| 1734 | (calc-binary-op "lu/" 'calcFunc-lupowerdiv arg)) | 1734 | (calc-binary-op "lu/" 'calcFunc-lupdiv arg)) |
| 1735 | (if (calc-is-hyperbolic) | 1735 | (if (calc-is-hyperbolic) |
| 1736 | (calc-binary-op "lu*" 'calcFunc-lufieldtimes arg) | 1736 | (calc-binary-op "lu*" 'calcFunc-lufmul arg) |
| 1737 | (calc-binary-op "lu*" 'calcFunc-lupowertimes arg))))) | 1737 | (calc-binary-op "lu*" 'calcFunc-lupmul arg))))) |
| 1738 | 1738 | ||
| 1739 | (defun calcFunc-lufielddiv (a b) | 1739 | (defun calcFunc-lufdiv (a b) |
| 1740 | (math-logunits-divide a b nil)) | 1740 | (math-logunits-divide a b nil)) |
| 1741 | 1741 | ||
| 1742 | (defun calcFunc-lupowerdiv (a b) | 1742 | (defun calcFunc-lupdiv (a b) |
| 1743 | (math-logunits-divide a b t)) | 1743 | (math-logunits-divide a b t)) |
| 1744 | 1744 | ||
| 1745 | (defun calc-logunits-divide (arg) | 1745 | (defun calc-lu-divide (arg) |
| 1746 | (interactive "P") | 1746 | (interactive "P") |
| 1747 | (calc-slow-wrapper | 1747 | (calc-slow-wrapper |
| 1748 | (if (calc-is-inverse) | 1748 | (if (calc-is-inverse) |
| 1749 | (if (calc-is-hyperbolic) | 1749 | (if (calc-is-hyperbolic) |
| 1750 | (calc-binary-op "lu*" 'calcFunc-lufieldtimes arg) | 1750 | (calc-binary-op "lu*" 'calcFunc-lufmul arg) |
| 1751 | (calc-binary-op "lu*" 'calcFunc-lupowertimes arg)) | 1751 | (calc-binary-op "lu*" 'calcFunc-lupmul arg)) |
| 1752 | (if (calc-is-hyperbolic) | 1752 | (if (calc-is-hyperbolic) |
| 1753 | (calc-binary-op "lu/" 'calcFunc-lufielddiv arg) | 1753 | (calc-binary-op "lu/" 'calcFunc-lufdiv arg) |
| 1754 | (calc-binary-op "lu/" 'calcFunc-lupowerdiv arg))))) | 1754 | (calc-binary-op "lu/" 'calcFunc-lupdiv arg))))) |
| 1755 | 1755 | ||
| 1756 | (defun math-logunits-quant (val ref power) | 1756 | (defun math-logunits-quant (val ref power) |
| 1757 | (let* ((units (math-simplify (math-extract-units val))) | 1757 | (let* ((units (math-simplify (math-extract-units val))) |
| @@ -1777,29 +1777,29 @@ In symbolic mode, return the list (^ a b)." | |||
| 1777 | coeff)))) | 1777 | coeff)))) |
| 1778 | runits))))) | 1778 | runits))))) |
| 1779 | 1779 | ||
| 1780 | (defvar calc-logunits-field-reference) | 1780 | (defvar calc-lu-field-reference) |
| 1781 | (defvar calc-logunits-power-reference) | 1781 | (defvar calc-lu-power-reference) |
| 1782 | 1782 | ||
| 1783 | (defun calcFunc-fieldquant (val &optional ref) | 1783 | (defun calcFunc-lufquant (val &optional ref) |
| 1784 | (unless ref | 1784 | (unless ref |
| 1785 | (setq ref (math-read-expr calc-logunits-field-reference))) | 1785 | (setq ref (math-read-expr calc-lu-field-reference))) |
| 1786 | (math-logunits-quant val ref nil)) | 1786 | (math-logunits-quant val ref nil)) |
| 1787 | 1787 | ||
| 1788 | (defun calcFunc-powerquant (val &optional ref) | 1788 | (defun calcFunc-lupquant (val &optional ref) |
| 1789 | (unless ref | 1789 | (unless ref |
| 1790 | (setq ref (math-read-expr calc-logunits-power-reference))) | 1790 | (setq ref (math-read-expr calc-lu-power-reference))) |
| 1791 | (math-logunits-quant val ref t)) | 1791 | (math-logunits-quant val ref t)) |
| 1792 | 1792 | ||
| 1793 | (defun calc-logunits-quantity (arg) | 1793 | (defun calc-lu-quant (arg) |
| 1794 | (interactive "P") | 1794 | (interactive "P") |
| 1795 | (calc-slow-wrapper | 1795 | (calc-slow-wrapper |
| 1796 | (if (calc-is-hyperbolic) | 1796 | (if (calc-is-hyperbolic) |
| 1797 | (if (calc-is-option) | 1797 | (if (calc-is-option) |
| 1798 | (calc-binary-op "lupq" 'calcFunc-fieldquant arg) | 1798 | (calc-binary-op "lupq" 'calcFunc-lufquant arg) |
| 1799 | (calc-unary-op "lupq" 'calcFunc-fieldquant arg)) | 1799 | (calc-unary-op "lupq" 'calcFunc-lufquant arg)) |
| 1800 | (if (calc-is-option) | 1800 | (if (calc-is-option) |
| 1801 | (calc-binary-op "lufq" 'calcFunc-powerquant arg) | 1801 | (calc-binary-op "lufq" 'calcFunc-lupquant arg) |
| 1802 | (calc-unary-op "lufq" 'calcFunc-powerquant arg))))) | 1802 | (calc-unary-op "lufq" 'calcFunc-lupquant arg))))) |
| 1803 | 1803 | ||
| 1804 | (defun math-logunits-level (val ref db power) | 1804 | (defun math-logunits-level (val ref db power) |
| 1805 | "Compute the value of VAL in decibels or nepers." | 1805 | "Compute the value of VAL in decibels or nepers." |
| @@ -1817,47 +1817,47 @@ In symbolic mode, return the list (^ a b)." | |||
| 1817 | '(var Np var-Np))) | 1817 | '(var Np var-Np))) |
| 1818 | units))) | 1818 | units))) |
| 1819 | 1819 | ||
| 1820 | (defun calcFunc-dbfieldlevel (val &optional ref) | 1820 | (defun calcFunc-dbfield (val &optional ref) |
| 1821 | (unless ref | 1821 | (unless ref |
| 1822 | (setq ref (math-read-expr calc-logunits-field-reference))) | 1822 | (setq ref (math-read-expr calc-lu-field-reference))) |
| 1823 | (math-logunits-level val ref t nil)) | 1823 | (math-logunits-level val ref t nil)) |
| 1824 | 1824 | ||
| 1825 | (defun calcFunc-dbpowerlevel (val &optional ref) | 1825 | (defun calcFunc-dbpower (val &optional ref) |
| 1826 | (unless ref | 1826 | (unless ref |
| 1827 | (setq ref (math-read-expr calc-logunits-power-reference))) | 1827 | (setq ref (math-read-expr calc-lu-power-reference))) |
| 1828 | (math-logunits-level val ref t t)) | 1828 | (math-logunits-level val ref t t)) |
| 1829 | 1829 | ||
| 1830 | (defun calcFunc-npfieldlevel (val &optional ref) | 1830 | (defun calcFunc-npfield (val &optional ref) |
| 1831 | (unless ref | 1831 | (unless ref |
| 1832 | (setq ref (math-read-expr calc-logunits-field-reference))) | 1832 | (setq ref (math-read-expr calc-lu-field-reference))) |
| 1833 | (math-logunits-level val ref nil nil)) | 1833 | (math-logunits-level val ref nil nil)) |
| 1834 | 1834 | ||
| 1835 | (defun calcFunc-nppowerlevel (val &optional ref) | 1835 | (defun calcFunc-nppower (val &optional ref) |
| 1836 | (unless ref | 1836 | (unless ref |
| 1837 | (setq ref (math-read-expr calc-logunits-power-reference))) | 1837 | (setq ref (math-read-expr calc-lu-power-reference))) |
| 1838 | (math-logunits-level val ref nil t)) | 1838 | (math-logunits-level val ref nil t)) |
| 1839 | 1839 | ||
| 1840 | (defun calc-dblevel (arg) | 1840 | (defun calc-db (arg) |
| 1841 | (interactive "P") | 1841 | (interactive "P") |
| 1842 | (calc-slow-wrapper | 1842 | (calc-slow-wrapper |
| 1843 | (if (calc-is-hyperbolic) | 1843 | (if (calc-is-hyperbolic) |
| 1844 | (if (calc-is-option) | 1844 | (if (calc-is-option) |
| 1845 | (calc-binary-op "ludb" 'calcFunc-dbfieldlevel arg) | 1845 | (calc-binary-op "ludb" 'calcFunc-dbfield arg) |
| 1846 | (calc-unary-op "ludb" 'calcFunc-dbfieldlevel arg)) | 1846 | (calc-unary-op "ludb" 'calcFunc-dbfield arg)) |
| 1847 | (if (calc-is-option) | 1847 | (if (calc-is-option) |
| 1848 | (calc-binary-op "ludb" 'calcFunc-dbpowerlevel arg) | 1848 | (calc-binary-op "ludb" 'calcFunc-dbpower arg) |
| 1849 | (calc-unary-op "ludb" 'calcFunc-dbpowerlevel arg))))) | 1849 | (calc-unary-op "ludb" 'calcFunc-dbpower arg))))) |
| 1850 | 1850 | ||
| 1851 | (defun calc-nplevel (arg) | 1851 | (defun calc-np (arg) |
| 1852 | (interactive "P") | 1852 | (interactive "P") |
| 1853 | (calc-slow-wrapper | 1853 | (calc-slow-wrapper |
| 1854 | (if (calc-is-hyperbolic) | 1854 | (if (calc-is-hyperbolic) |
| 1855 | (if (calc-is-option) | 1855 | (if (calc-is-option) |
| 1856 | (calc-binary-op "lunp" 'calcFunc-npfieldlevel arg) | 1856 | (calc-binary-op "lunp" 'calcFunc-npfield arg) |
| 1857 | (calc-unary-op "lunp" 'calcFunc-npfieldlevel arg)) | 1857 | (calc-unary-op "lunp" 'calcFunc-npfield arg)) |
| 1858 | (if (calc-is-option) | 1858 | (if (calc-is-option) |
| 1859 | (calc-binary-op "lunp" 'calcFunc-nppowerlevel arg) | 1859 | (calc-binary-op "lunp" 'calcFunc-nppower arg) |
| 1860 | (calc-unary-op "lunp" 'calcFunc-nppowerlevel arg))))) | 1860 | (calc-unary-op "lunp" 'calcFunc-nppower arg))))) |
| 1861 | 1861 | ||
| 1862 | ;;; Musical notes | 1862 | ;;; Musical notes |
| 1863 | 1863 | ||
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index f4d8983eb88..41f549cbe2c 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el | |||
| @@ -434,13 +434,13 @@ by displaying the sub-formula in `calc-selected-face'." | |||
| 434 | :group 'calc | 434 | :group 'calc |
| 435 | :type 'boolean) | 435 | :type 'boolean) |
| 436 | 436 | ||
| 437 | (defcustom calc-logunits-field-reference | 437 | (defcustom calc-lu-field-reference |
| 438 | "20 uPa" | 438 | "20 uPa" |
| 439 | "The default reference level for logarithmic units (field)." | 439 | "The default reference level for logarithmic units (field)." |
| 440 | :group 'calc | 440 | :group 'calc |
| 441 | :type '(string)) | 441 | :type '(string)) |
| 442 | 442 | ||
| 443 | (defcustom calc-logunits-power-reference | 443 | (defcustom calc-lu-power-reference |
| 444 | "mW" | 444 | "mW" |
| 445 | "The default reference level for logarithmic units (power)." | 445 | "The default reference level for logarithmic units (power)." |
| 446 | :group 'calc | 446 | :group 'calc |
| @@ -1084,7 +1084,7 @@ Used by `calc-user-invocation'.") | |||
| 1084 | "lOW") | 1084 | "lOW") |
| 1085 | (mapc (lambda (x) (define-key map (char-to-string x) 'calc-missing-key)) | 1085 | (mapc (lambda (x) (define-key map (char-to-string x) 'calc-missing-key)) |
| 1086 | (concat "ABCDEFGHIJKLMNOPQRSTUVXZabcdfghjkmoprstuvwxyz" | 1086 | (concat "ABCDEFGHIJKLMNOPQRSTUVXZabcdfghjkmoprstuvwxyz" |
| 1087 | ":\\|!()[]<>{},;=~`\C-k\C-w\C-_")) | 1087 | ":\\|!()[]<>{},;=~`\C-k\C-w")) |
| 1088 | (define-key map "\M-w" 'calc-missing-key) | 1088 | (define-key map "\M-w" 'calc-missing-key) |
| 1089 | (define-key map "\M-k" 'calc-missing-key) | 1089 | (define-key map "\M-k" 'calc-missing-key) |
| 1090 | (define-key map "\M-\C-w" 'calc-missing-key) | 1090 | (define-key map "\M-\C-w" 'calc-missing-key) |
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 63e7484e127..e5373a28756 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el | |||
| @@ -879,21 +879,27 @@ use when highlighting the day in the calendar." | |||
| 879 | (declare-function diary-ordinal-suffix "diary-lib" (n)) | 879 | (declare-function diary-ordinal-suffix "diary-lib" (n)) |
| 880 | 880 | ||
| 881 | ;;;###diary-autoload | 881 | ;;;###diary-autoload |
| 882 | (defun diary-hebrew-yahrzeit (death-month death-day death-year &optional mark) | 882 | (defun diary-hebrew-yahrzeit (death-month death-day death-year |
| 883 | &optional mark after-sunset) | ||
| 883 | "Yahrzeit diary entry--entry applies if date is Yahrzeit or the day before. | 884 | "Yahrzeit diary entry--entry applies if date is Yahrzeit or the day before. |
| 884 | Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary | 885 | Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary |
| 885 | entry is assumed to be the name of the person. Although the date | 886 | entry is assumed to be the name of the person. Although the date |
| 886 | of death is specified by the civil calendar, the proper Hebrew | 887 | of death is specified by the civil calendar, the proper Hebrew |
| 887 | calendar Yahrzeit is determined. | 888 | calendar Yahrzeit is determined. |
| 888 | 889 | ||
| 890 | If the death occurred after local sunset on the given civil date, | ||
| 891 | the following civil date corresponds to the Hebrew date of | ||
| 892 | death--set the optional parameter AFTER-SUNSET non-nil in this case. | ||
| 893 | |||
| 889 | The order of the input parameters changes according to `calendar-date-style' | 894 | The order of the input parameters changes according to `calendar-date-style' |
| 890 | \(e.g. to DEATH-DAY, DEATH-MONTH, DEATH-YEAR in the European style). | 895 | \(e.g. to DEATH-DAY, DEATH-MONTH, DEATH-YEAR in the European style). |
| 891 | 896 | ||
| 892 | An optional parameter MARK specifies a face or single-character string to | 897 | An optional parameter MARK specifies a face or single-character string to |
| 893 | use when highlighting the day in the calendar." | 898 | use when highlighting the day in the calendar." |
| 894 | (let* ((h-date (calendar-hebrew-from-absolute | 899 | (let* ((h-date (calendar-hebrew-from-absolute |
| 895 | (calendar-absolute-from-gregorian | 900 | (+ (calendar-absolute-from-gregorian |
| 896 | (diary-make-date death-month death-day death-year)))) | 901 | (diary-make-date death-month death-day death-year)) |
| 902 | (if after-sunset 1 0)))) | ||
| 897 | (h-month (calendar-extract-month h-date)) | 903 | (h-month (calendar-extract-month h-date)) |
| 898 | (h-day (calendar-extract-day h-date)) | 904 | (h-day (calendar-extract-day h-date)) |
| 899 | (h-year (calendar-extract-year h-date)) | 905 | (h-year (calendar-extract-year h-date)) |
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index a1bfad3a5f5..62203600612 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el | |||
| @@ -308,13 +308,9 @@ This function does not work for SECONDS greater than `most-positive-fixnum'." | |||
| 308 | (setq start (match-end 0) | 308 | (setq start (match-end 0) |
| 309 | spec (match-string 1 string)) | 309 | spec (match-string 1 string)) |
| 310 | (unless (string-equal spec "%") | 310 | (unless (string-equal spec "%") |
| 311 | ;; `assoc-string' is not available in XEmacs. So when compiling | 311 | (or (setq match (assoc (downcase spec) units)) |
| 312 | ;; Gnus (`time-date.el' is part of Gnus) with XEmacs, we get | ||
| 313 | ;; a warning here. But `format-seconds' is not used anywhere in | ||
| 314 | ;; Gnus so it's not a real problem. --rsteib | ||
| 315 | (or (setq match (assoc-string spec units t)) | ||
| 316 | (error "Bad format specifier: `%s'" spec)) | 312 | (error "Bad format specifier: `%s'" spec)) |
| 317 | (if (assoc-string spec usedunits t) | 313 | (if (assoc (downcase spec) usedunits) |
| 318 | (error "Multiple instances of specifier: `%s'" spec)) | 314 | (error "Multiple instances of specifier: `%s'" spec)) |
| 319 | (if (string-equal (car match) "z") | 315 | (if (string-equal (car match) "z") |
| 320 | (setq zeroflag t) | 316 | (setq zeroflag t) |
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 88821652784..203043ebd97 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -4756,6 +4756,12 @@ The format is suitable for use with `easy-menu-define'." | |||
| 4756 | "Invoke button at POS, or refuse to allow editing of Custom buffer." | 4756 | "Invoke button at POS, or refuse to allow editing of Custom buffer." |
| 4757 | (interactive "@d") | 4757 | (interactive "@d") |
| 4758 | (let ((button (get-char-property pos 'button))) | 4758 | (let ((button (get-char-property pos 'button))) |
| 4759 | ;; If there is no button at point, then use the one at the start | ||
| 4760 | ;; of the line, if it is a custom-group-link (bug#2298). | ||
| 4761 | (or button | ||
| 4762 | (if (setq button (get-char-property (line-beginning-position) 'button)) | ||
| 4763 | (or (eq (widget-type button) 'custom-group-link) | ||
| 4764 | (setq button nil)))) | ||
| 4759 | (if button | 4765 | (if button |
| 4760 | (widget-apply-action button event) | 4766 | (widget-apply-action button event) |
| 4761 | (error "You can't edit this part of the Custom buffer")))) | 4767 | (error "You can't edit this part of the Custom buffer")))) |
diff --git a/lisp/cus-start.el b/lisp/cus-start.el index d2d99ee64fb..788731e4dbc 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el | |||
| @@ -111,9 +111,9 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of | |||
| 111 | (cursor-in-non-selected-windows | 111 | (cursor-in-non-selected-windows |
| 112 | cursor boolean nil | 112 | cursor boolean nil |
| 113 | :tag "Cursor In Non-selected Windows" | 113 | :tag "Cursor In Non-selected Windows" |
| 114 | :set #'(lambda (symbol value) | 114 | :set (lambda (symbol value) |
| 115 | (set-default symbol value) | 115 | (set-default symbol value) |
| 116 | (force-mode-line-update t))) | 116 | (force-mode-line-update t))) |
| 117 | (transient-mark-mode editing-basics boolean nil | 117 | (transient-mark-mode editing-basics boolean nil |
| 118 | :standard (not noninteractive) | 118 | :standard (not noninteractive) |
| 119 | :initialize custom-initialize-delay | 119 | :initialize custom-initialize-delay |
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index cdc066aa91a..4f9428d497b 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el | |||
| @@ -100,6 +100,9 @@ named *Custom Theme*." | |||
| 100 | (make-local-variable 'custom-theme-insert-face-marker) | 100 | (make-local-variable 'custom-theme-insert-face-marker) |
| 101 | (make-local-variable 'custom-theme-insert-variable-marker) | 101 | (make-local-variable 'custom-theme-insert-variable-marker) |
| 102 | (make-local-variable 'custom-theme--listed-faces) | 102 | (make-local-variable 'custom-theme--listed-faces) |
| 103 | (when (called-interactively-p 'interactive) | ||
| 104 | (unless (y-or-n-p "Include basic face customizations in this theme? ") | ||
| 105 | (setq custom-theme--listed-faces nil))) | ||
| 103 | 106 | ||
| 104 | (if (eq theme 'user) | 107 | (if (eq theme 'user) |
| 105 | (widget-insert "This buffer contains all the Custom settings you have made. | 108 | (widget-insert "This buffer contains all the Custom settings you have made. |
| @@ -188,7 +191,7 @@ remove them from your saved Custom file.\n\n")) | |||
| 188 | (while vars | 191 | (while vars |
| 189 | (if (eq (car vars) 'custom-enabled-themes) | 192 | (if (eq (car vars) 'custom-enabled-themes) |
| 190 | (progn (pop vars) (pop values)) | 193 | (progn (pop vars) (pop values)) |
| 191 | (custom-theme-add-var-1 (pop vars) (pop values))))) | 194 | (custom-theme-add-var-1 (pop vars) (eval (pop values)))))) |
| 192 | (setq custom-theme-insert-variable-marker (point-marker)) | 195 | (setq custom-theme-insert-variable-marker (point-marker)) |
| 193 | (widget-insert " ") | 196 | (widget-insert " ") |
| 194 | (widget-create 'push-button | 197 | (widget-create 'push-button |
| @@ -297,8 +300,9 @@ SPEC, if non-nil, should be a face spec to which to set the widget." | |||
| 297 | 300 | ||
| 298 | ;;; Reading and writing | 301 | ;;; Reading and writing |
| 299 | 302 | ||
| 303 | ;;;###autoload | ||
| 300 | (defun custom-theme-visit-theme (theme) | 304 | (defun custom-theme-visit-theme (theme) |
| 301 | "Load the custom theme THEME's settings into the current buffer." | 305 | "Set up a Custom buffer to edit custom theme THEME." |
| 302 | (interactive | 306 | (interactive |
| 303 | (list | 307 | (list |
| 304 | (intern (completing-read "Find custom theme: " | 308 | (intern (completing-read "Find custom theme: " |
| @@ -663,4 +667,6 @@ Theme files are named *-theme.el in `")) | |||
| 663 | (widget-toggle-action widget event) | 667 | (widget-toggle-action widget event) |
| 664 | (setq custom-theme-allow-multiple-selections (widget-value widget))) | 668 | (setq custom-theme-allow-multiple-selections (widget-value widget))) |
| 665 | 669 | ||
| 670 | (provide 'cus-theme) | ||
| 671 | |||
| 666 | ;;; cus-theme.el ends here | 672 | ;;; cus-theme.el ends here |
diff --git a/lisp/custom.el b/lisp/custom.el index d0d11610b91..d9bb4f954bc 100644 --- a/lisp/custom.el +++ b/lisp/custom.el | |||
| @@ -792,10 +792,10 @@ E.g. dumped variables whose default depends on run-time information." | |||
| 792 | (defvar custom-known-themes '(user changed) | 792 | (defvar custom-known-themes '(user changed) |
| 793 | "Themes that have been defined with `deftheme'. | 793 | "Themes that have been defined with `deftheme'. |
| 794 | The default value is the list (user changed). The theme `changed' | 794 | The default value is the list (user changed). The theme `changed' |
| 795 | contains the settings before custom themes are applied. The | 795 | contains the settings before custom themes are applied. The theme |
| 796 | theme `user' contains all the settings the user customized and saved. | 796 | `user' contains all the settings the user customized and saved. |
| 797 | Additional themes declared with the `deftheme' macro will be added to | 797 | Additional themes declared with the `deftheme' macro will be added |
| 798 | the front of this list.") | 798 | to the front of this list.") |
| 799 | 799 | ||
| 800 | (defsubst custom-theme-p (theme) | 800 | (defsubst custom-theme-p (theme) |
| 801 | "Non-nil when THEME has been defined." | 801 | "Non-nil when THEME has been defined." |
| @@ -1074,7 +1074,7 @@ order. Each element in the list should be one of the following: | |||
| 1074 | named \"themes\" in `data-directory'). | 1074 | named \"themes\" in `data-directory'). |
| 1075 | - a directory name (a string). | 1075 | - a directory name (a string). |
| 1076 | 1076 | ||
| 1077 | Each theme file is named NAME-theme.el, where THEME is the theme | 1077 | Each theme file is named THEME-theme.el, where THEME is the theme |
| 1078 | name." | 1078 | name." |
| 1079 | :type '(repeat (choice (const :tag "custom-theme-directory" | 1079 | :type '(repeat (choice (const :tag "custom-theme-directory" |
| 1080 | custom-theme-directory) | 1080 | custom-theme-directory) |
| @@ -1146,7 +1146,7 @@ Return t if THEME was successfully loaded, nil otherwise." | |||
| 1146 | '("" "c"))) | 1146 | '("" "c"))) |
| 1147 | hash) | 1147 | hash) |
| 1148 | (unless fn | 1148 | (unless fn |
| 1149 | (error "Unable to find theme file for `%s'." theme)) | 1149 | (error "Unable to find theme file for `%s'" theme)) |
| 1150 | (with-temp-buffer | 1150 | (with-temp-buffer |
| 1151 | (insert-file-contents fn) | 1151 | (insert-file-contents fn) |
| 1152 | (setq hash (sha1 (current-buffer))) | 1152 | (setq hash (sha1 (current-buffer))) |
| @@ -1212,7 +1212,7 @@ NAME should be a symbol." | |||
| 1212 | 1212 | ||
| 1213 | (defun custom-available-themes () | 1213 | (defun custom-available-themes () |
| 1214 | "Return a list of available Custom themes (symbols)." | 1214 | "Return a list of available Custom themes (symbols)." |
| 1215 | (let* (sym themes) | 1215 | (let (sym themes) |
| 1216 | (dolist (dir (custom-theme--load-path)) | 1216 | (dolist (dir (custom-theme--load-path)) |
| 1217 | (when (file-directory-p dir) | 1217 | (when (file-directory-p dir) |
| 1218 | (dolist (file (file-expand-wildcards | 1218 | (dolist (file (file-expand-wildcards |
| @@ -1222,7 +1222,7 @@ NAME should be a symbol." | |||
| 1222 | (setq sym (intern (match-string 1 file))) | 1222 | (setq sym (intern (match-string 1 file))) |
| 1223 | (custom-theme-name-valid-p sym) | 1223 | (custom-theme-name-valid-p sym) |
| 1224 | (push sym themes))))) | 1224 | (push sym themes))))) |
| 1225 | (delete-dups themes))) | 1225 | (nreverse (delete-dups themes)))) |
| 1226 | 1226 | ||
| 1227 | (defun custom-theme--load-path () | 1227 | (defun custom-theme--load-path () |
| 1228 | (let (lpath) | 1228 | (let (lpath) |
| @@ -1338,7 +1338,7 @@ That is to say, it specifies what the value should be according to | |||
| 1338 | currently enabled custom themes. | 1338 | currently enabled custom themes. |
| 1339 | 1339 | ||
| 1340 | This function returns nil if no custom theme specifies a value for VARIABLE." | 1340 | This function returns nil if no custom theme specifies a value for VARIABLE." |
| 1341 | (let* ((theme-value (get variable 'theme-value))) | 1341 | (let ((theme-value (get variable 'theme-value))) |
| 1342 | (if theme-value | 1342 | (if theme-value |
| 1343 | (cdr (car theme-value))))) | 1343 | (cdr (car theme-value))))) |
| 1344 | 1344 | ||
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index c533c81be0e..9ab1fcb0e2b 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el | |||
| @@ -1638,11 +1638,14 @@ Optional arg HOW-TO determiness how to treat the target. | |||
| 1638 | 1638 | ||
| 1639 | ;;;###autoload | 1639 | ;;;###autoload |
| 1640 | (defun dired-create-directory (directory) | 1640 | (defun dired-create-directory (directory) |
| 1641 | "Create a directory called DIRECTORY." | 1641 | "Create a directory called DIRECTORY. |
| 1642 | If DIRECTORY already exists, signal an error." | ||
| 1642 | (interactive | 1643 | (interactive |
| 1643 | (list (read-file-name "Create directory: " (dired-current-directory)))) | 1644 | (list (read-file-name "Create directory: " (dired-current-directory)))) |
| 1644 | (let* ((expanded (directory-file-name (expand-file-name directory))) | 1645 | (let* ((expanded (directory-file-name (expand-file-name directory))) |
| 1645 | (try expanded) new) | 1646 | (try expanded) new) |
| 1647 | (if (file-exists-p expanded) | ||
| 1648 | (error "Cannot create directory %s: file exists" expanded)) | ||
| 1646 | ;; Find the topmost nonexistent parent dir (variable `new') | 1649 | ;; Find the topmost nonexistent parent dir (variable `new') |
| 1647 | (while (and try (not (file-exists-p try)) (not (equal new try))) | 1650 | (while (and try (not (file-exists-p try)) (not (equal new try))) |
| 1648 | (setq new try | 1651 | (setq new try |
diff --git a/lisp/dired.el b/lisp/dired.el index c8343ba7561..d72e0aad55f 100644 --- a/lisp/dired.el +++ b/lisp/dired.el | |||
| @@ -3629,7 +3629,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." | |||
| 3629 | ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command | 3629 | ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command |
| 3630 | ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown | 3630 | ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown |
| 3631 | ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff | 3631 | ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff |
| 3632 | ;;;;;; dired-diff) "dired-aux" "dired-aux.el" "154cdfbf451aedec60c5012b625ff329") | 3632 | ;;;;;; dired-diff) "dired-aux" "dired-aux.el" "2d805d6766bd7970cd446413b4ed4ce0") |
| 3633 | ;;; Generated autoloads from dired-aux.el | 3633 | ;;; Generated autoloads from dired-aux.el |
| 3634 | 3634 | ||
| 3635 | (autoload 'dired-diff "dired-aux" "\ | 3635 | (autoload 'dired-diff "dired-aux" "\ |
| @@ -3860,6 +3860,7 @@ Not documented | |||
| 3860 | 3860 | ||
| 3861 | (autoload 'dired-create-directory "dired-aux" "\ | 3861 | (autoload 'dired-create-directory "dired-aux" "\ |
| 3862 | Create a directory called DIRECTORY. | 3862 | Create a directory called DIRECTORY. |
| 3863 | If DIRECTORY already exists, signal an error. | ||
| 3863 | 3864 | ||
| 3864 | \(fn DIRECTORY)" t nil) | 3865 | \(fn DIRECTORY)" t nil) |
| 3865 | 3866 | ||
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index dd589cb58f7..a906cf8516a 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el | |||
| @@ -34,7 +34,56 @@ | |||
| 34 | ;; this depends on the format of list-buffers (from src/buffer.c) and | 34 | ;; this depends on the format of list-buffers (from src/buffer.c) and |
| 35 | ;; on stuff in lisp/buff-menu.el | 35 | ;; on stuff in lisp/buff-menu.el |
| 36 | 36 | ||
| 37 | (defvar electric-buffer-menu-mode-map nil) | 37 | (defvar electric-buffer-menu-mode-map |
| 38 | (let ((map (make-keymap))) | ||
| 39 | (fillarray (car (cdr map)) 'Electric-buffer-menu-undefined) | ||
| 40 | (define-key map "\e" nil) | ||
| 41 | (define-key map "\C-z" 'suspend-frame) | ||
| 42 | (define-key map "v" 'Electric-buffer-menu-mode-view-buffer) | ||
| 43 | (define-key map (char-to-string help-char) 'Helper-help) | ||
| 44 | (define-key map "?" 'Helper-describe-bindings) | ||
| 45 | (define-key map "\C-c" nil) | ||
| 46 | (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit) | ||
| 47 | (define-key map "\C-]" 'Electric-buffer-menu-quit) | ||
| 48 | (define-key map "q" 'Electric-buffer-menu-quit) | ||
| 49 | (define-key map " " 'Electric-buffer-menu-select) | ||
| 50 | (define-key map "\C-m" 'Electric-buffer-menu-select) | ||
| 51 | (define-key map "\C-l" 'recenter) | ||
| 52 | (define-key map "s" 'Buffer-menu-save) | ||
| 53 | (define-key map "d" 'Buffer-menu-delete) | ||
| 54 | (define-key map "k" 'Buffer-menu-delete) | ||
| 55 | (define-key map "\C-d" 'Buffer-menu-delete-backwards) | ||
| 56 | ;; (define-key map "\C-k" 'Buffer-menu-delete) | ||
| 57 | (define-key map "\177" 'Buffer-menu-backup-unmark) | ||
| 58 | (define-key map "~" 'Buffer-menu-not-modified) | ||
| 59 | (define-key map "u" 'Buffer-menu-unmark) | ||
| 60 | (let ((i ?0)) | ||
| 61 | (while (<= i ?9) | ||
| 62 | (define-key map (char-to-string i) 'digit-argument) | ||
| 63 | (define-key map (concat "\e" (char-to-string i)) 'digit-argument) | ||
| 64 | (setq i (1+ i)))) | ||
| 65 | (define-key map "-" 'negative-argument) | ||
| 66 | (define-key map "\e-" 'negative-argument) | ||
| 67 | (define-key map "m" 'Buffer-menu-mark) | ||
| 68 | (define-key map "\C-u" 'universal-argument) | ||
| 69 | (define-key map "\C-p" 'previous-line) | ||
| 70 | (define-key map "\C-n" 'next-line) | ||
| 71 | (define-key map "p" 'previous-line) | ||
| 72 | (define-key map "n" 'next-line) | ||
| 73 | (define-key map "\C-v" 'scroll-up) | ||
| 74 | (define-key map "\ev" 'scroll-down) | ||
| 75 | (define-key map ">" 'scroll-right) | ||
| 76 | (define-key map "<" 'scroll-left) | ||
| 77 | (define-key map "\e\C-v" 'scroll-other-window) | ||
| 78 | (define-key map "\e>" 'end-of-buffer) | ||
| 79 | (define-key map "\e<" 'beginning-of-buffer) | ||
| 80 | (define-key map "\e\e" nil) | ||
| 81 | (define-key map "\e\e\e" 'Electric-buffer-menu-quit) | ||
| 82 | ;; This binding prevents the "escape => ESC" function-key-map mapping from | ||
| 83 | ;; kicking in! | ||
| 84 | ;; (define-key map [escape escape escape] 'Electric-buffer-menu-quit) | ||
| 85 | (define-key map [mouse-2] 'Electric-buffer-menu-mouse-select) | ||
| 86 | map)) | ||
| 38 | 87 | ||
| 39 | (defvar electric-buffer-menu-mode-hook nil | 88 | (defvar electric-buffer-menu-mode-hook nil |
| 40 | "Normal hook run by `electric-buffer-list'.") | 89 | "Normal hook run by `electric-buffer-list'.") |
| @@ -167,55 +216,7 @@ Entry to this mode via command `electric-buffer-list' calls the value of | |||
| 167 | ;; generally the same as Buffer-menu-mode-map | 216 | ;; generally the same as Buffer-menu-mode-map |
| 168 | ;; (except we don't indirect to global-map) | 217 | ;; (except we don't indirect to global-map) |
| 169 | (put 'Electric-buffer-menu-undefined 'suppress-keymap t) | 218 | (put 'Electric-buffer-menu-undefined 'suppress-keymap t) |
| 170 | (if electric-buffer-menu-mode-map | 219 | |
| 171 | nil | ||
| 172 | (let ((map (make-keymap))) | ||
| 173 | (fillarray (car (cdr map)) 'Electric-buffer-menu-undefined) | ||
| 174 | (define-key map "\e" nil) | ||
| 175 | (define-key map "\C-z" 'suspend-frame) | ||
| 176 | (define-key map "v" 'Electric-buffer-menu-mode-view-buffer) | ||
| 177 | (define-key map (char-to-string help-char) 'Helper-help) | ||
| 178 | (define-key map "?" 'Helper-describe-bindings) | ||
| 179 | (define-key map "\C-c" nil) | ||
| 180 | (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit) | ||
| 181 | (define-key map "\C-]" 'Electric-buffer-menu-quit) | ||
| 182 | (define-key map "q" 'Electric-buffer-menu-quit) | ||
| 183 | (define-key map " " 'Electric-buffer-menu-select) | ||
| 184 | (define-key map "\C-m" 'Electric-buffer-menu-select) | ||
| 185 | (define-key map "\C-l" 'recenter) | ||
| 186 | (define-key map "s" 'Buffer-menu-save) | ||
| 187 | (define-key map "d" 'Buffer-menu-delete) | ||
| 188 | (define-key map "k" 'Buffer-menu-delete) | ||
| 189 | (define-key map "\C-d" 'Buffer-menu-delete-backwards) | ||
| 190 | ;(define-key map "\C-k" 'Buffer-menu-delete) | ||
| 191 | (define-key map "\177" 'Buffer-menu-backup-unmark) | ||
| 192 | (define-key map "~" 'Buffer-menu-not-modified) | ||
| 193 | (define-key map "u" 'Buffer-menu-unmark) | ||
| 194 | (let ((i ?0)) | ||
| 195 | (while (<= i ?9) | ||
| 196 | (define-key map (char-to-string i) 'digit-argument) | ||
| 197 | (define-key map (concat "\e" (char-to-string i)) 'digit-argument) | ||
| 198 | (setq i (1+ i)))) | ||
| 199 | (define-key map "-" 'negative-argument) | ||
| 200 | (define-key map "\e-" 'negative-argument) | ||
| 201 | (define-key map "m" 'Buffer-menu-mark) | ||
| 202 | (define-key map "\C-u" 'universal-argument) | ||
| 203 | (define-key map "\C-p" 'previous-line) | ||
| 204 | (define-key map "\C-n" 'next-line) | ||
| 205 | (define-key map "p" 'previous-line) | ||
| 206 | (define-key map "n" 'next-line) | ||
| 207 | (define-key map "\C-v" 'scroll-up) | ||
| 208 | (define-key map "\ev" 'scroll-down) | ||
| 209 | (define-key map ">" 'scroll-right) | ||
| 210 | (define-key map "<" 'scroll-left) | ||
| 211 | (define-key map "\e\C-v" 'scroll-other-window) | ||
| 212 | (define-key map "\e>" 'end-of-buffer) | ||
| 213 | (define-key map "\e<" 'beginning-of-buffer) | ||
| 214 | (define-key map "\e\e" nil) | ||
| 215 | (define-key map "\e\e\e" 'Electric-buffer-menu-quit) | ||
| 216 | (define-key map [escape escape escape] 'Electric-buffer-menu-quit) | ||
| 217 | (define-key map [mouse-2] 'Electric-buffer-menu-mouse-select) | ||
| 218 | (setq electric-buffer-menu-mode-map map))) | ||
| 219 | 220 | ||
| 220 | (defun Electric-buffer-menu-exit () | 221 | (defun Electric-buffer-menu-exit () |
| 221 | (interactive) | 222 | (interactive) |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c9a85edfca4..5a87f590020 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -4071,7 +4071,8 @@ binding slots have been popped." | |||
| 4071 | (defun byte-compile-save-excursion (form) | 4071 | (defun byte-compile-save-excursion (form) |
| 4072 | (if (and (eq 'set-buffer (car-safe (car-safe (cdr form)))) | 4072 | (if (and (eq 'set-buffer (car-safe (car-safe (cdr form)))) |
| 4073 | (byte-compile-warning-enabled-p 'suspicious)) | 4073 | (byte-compile-warning-enabled-p 'suspicious)) |
| 4074 | (byte-compile-warn "`save-excursion' defeated by `set-buffer'")) | 4074 | (byte-compile-warn |
| 4075 | "Use `with-current-buffer' rather than save-excursion+set-buffer")) | ||
| 4075 | (byte-compile-out 'byte-save-excursion 0) | 4076 | (byte-compile-out 'byte-save-excursion 0) |
| 4076 | (byte-compile-body-do-effect (cdr form)) | 4077 | (byte-compile-body-do-effect (cdr form)) |
| 4077 | (byte-compile-out 'byte-unbind 1)) | 4078 | (byte-compile-out 'byte-unbind 1)) |
| @@ -4120,6 +4121,17 @@ binding slots have been popped." | |||
| 4120 | ,@decls | 4121 | ,@decls |
| 4121 | ',(nth 1 form))))) | 4122 | ',(nth 1 form))))) |
| 4122 | 4123 | ||
| 4124 | ;; If foo.el declares `toto' as obsolete, it is likely that foo.el will | ||
| 4125 | ;; actually use `toto' in order for this obsolete variable to still work | ||
| 4126 | ;; correctly, so paradoxically, while byte-compiling foo.el, the presence | ||
| 4127 | ;; of a make-obsolete-variable call for `toto' is an indication that `toto' | ||
| 4128 | ;; should not trigger obsolete-warnings in foo.el. | ||
| 4129 | (byte-defop-compiler-1 make-obsolete-variable) | ||
| 4130 | (defun byte-compile-make-obsolete-variable (form) | ||
| 4131 | (when (eq 'quote (car-safe (nth 1 form))) | ||
| 4132 | (push (nth 1 (nth 1 form)) byte-compile-not-obsolete-vars)) | ||
| 4133 | (byte-compile-normal-call form)) | ||
| 4134 | |||
| 4123 | (defun byte-compile-defvar (form) | 4135 | (defun byte-compile-defvar (form) |
| 4124 | ;; This is not used for file-level defvar/consts with doc strings. | 4136 | ;; This is not used for file-level defvar/consts with doc strings. |
| 4125 | (when (and (symbolp (nth 1 form)) | 4137 | (when (and (symbolp (nth 1 form)) |
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 3a6878ed16b..8bcbd67f46b 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el | |||
| @@ -282,7 +282,7 @@ Not documented | |||
| 282 | ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist | 282 | ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist |
| 283 | ;;;;;; do* do loop return-from return block etypecase typecase ecase | 283 | ;;;;;; do* do loop return-from return block etypecase typecase ecase |
| 284 | ;;;;;; case load-time-value eval-when destructuring-bind function* | 284 | ;;;;;; case load-time-value eval-when destructuring-bind function* |
| 285 | ;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "80cb83265399ce021c8c0c7d1a8562f2") | 285 | ;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "c4734fbda33043d967624d39d80c3304") |
| 286 | ;;; Generated autoloads from cl-macs.el | 286 | ;;; Generated autoloads from cl-macs.el |
| 287 | 287 | ||
| 288 | (autoload 'gensym "cl-macs" "\ | 288 | (autoload 'gensym "cl-macs" "\ |
| @@ -500,16 +500,16 @@ Like `let', but lexically scoped. | |||
| 500 | The main visible difference is that lambdas inside BODY will create | 500 | The main visible difference is that lambdas inside BODY will create |
| 501 | lexical closures as in Common Lisp. | 501 | lexical closures as in Common Lisp. |
| 502 | 502 | ||
| 503 | \(fn VARLIST BODY)" nil (quote macro)) | 503 | \(fn BINDINGS BODY)" nil (quote macro)) |
| 504 | 504 | ||
| 505 | (autoload 'lexical-let* "cl-macs" "\ | 505 | (autoload 'lexical-let* "cl-macs" "\ |
| 506 | Like `let*', but lexically scoped. | 506 | Like `let*', but lexically scoped. |
| 507 | The main visible difference is that lambdas inside BODY, and in | 507 | The main visible difference is that lambdas inside BODY, and in |
| 508 | successive bindings within VARLIST, will create lexical closures | 508 | successive bindings within BINDINGS, will create lexical closures |
| 509 | as in Common Lisp. This is similar to the behavior of `let*' in | 509 | as in Common Lisp. This is similar to the behavior of `let*' in |
| 510 | Common Lisp. | 510 | Common Lisp. |
| 511 | 511 | ||
| 512 | \(fn VARLIST BODY)" nil (quote macro)) | 512 | \(fn BINDINGS BODY)" nil (quote macro)) |
| 513 | 513 | ||
| 514 | (autoload 'multiple-value-bind "cl-macs" "\ | 514 | (autoload 'multiple-value-bind "cl-macs" "\ |
| 515 | Collect multiple return values. | 515 | Collect multiple return values. |
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 5bd8fd01b1e..b2e20843856 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el | |||
| @@ -1482,9 +1482,8 @@ Returns the stats object." | |||
| 1482 | (let ((print-escape-newlines t) | 1482 | (let ((print-escape-newlines t) |
| 1483 | (print-level 5) | 1483 | (print-level 5) |
| 1484 | (print-length 10)) | 1484 | (print-length 10)) |
| 1485 | (let ((begin (point))) | 1485 | (ert--pp-with-indentation-and-newline |
| 1486 | (ert--pp-with-indentation-and-newline | 1486 | (ert-test-result-with-condition-condition result))) |
| 1487 | (ert-test-result-with-condition-condition result)))) | ||
| 1488 | (goto-char (1- (point-max))) | 1487 | (goto-char (1- (point-max))) |
| 1489 | (assert (looking-at "\n")) | 1488 | (assert (looking-at "\n")) |
| 1490 | (delete-char 1) | 1489 | (delete-char 1) |
| @@ -1603,7 +1602,7 @@ Nothing more than an interactive interface to `ert-make-test-unbound'." | |||
| 1603 | (defun ert-delete-all-tests () | 1602 | (defun ert-delete-all-tests () |
| 1604 | "Make all symbols in `obarray' name no test." | 1603 | "Make all symbols in `obarray' name no test." |
| 1605 | (interactive) | 1604 | (interactive) |
| 1606 | (when (interactive-p) | 1605 | (when (called-interactively-p 'any) |
| 1607 | (unless (y-or-n-p "Delete all tests? ") | 1606 | (unless (y-or-n-p "Delete all tests? ") |
| 1608 | (error "Aborted"))) | 1607 | (error "Aborted"))) |
| 1609 | ;; We can't use `ert-select-tests' here since that gives us only | 1608 | ;; We can't use `ert-select-tests' here since that gives us only |
| @@ -1793,7 +1792,7 @@ EWOC and STATS are arguments for `ert--results-update-stats-display'." | |||
| 1793 | BEGIN and END specify a region in the current buffer." | 1792 | BEGIN and END specify a region in the current buffer." |
| 1794 | (save-excursion | 1793 | (save-excursion |
| 1795 | (save-restriction | 1794 | (save-restriction |
| 1796 | (narrow-to-region begin (point)) | 1795 | (narrow-to-region begin end) |
| 1797 | ;; Inhibit optimization in `debugger-make-xrefs' that would | 1796 | ;; Inhibit optimization in `debugger-make-xrefs' that would |
| 1798 | ;; sometimes insert unrelated backtrace info into our buffer. | 1797 | ;; sometimes insert unrelated backtrace info into our buffer. |
| 1799 | (let ((debugger-previous-backtrace nil)) | 1798 | (let ((debugger-previous-backtrace nil)) |
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index 61f23abf0a7..cd4b5ee231c 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el | |||
| @@ -27,21 +27,41 @@ | |||
| 27 | 27 | ||
| 28 | ;;; Commentary: | 28 | ;;; Commentary: |
| 29 | 29 | ||
| 30 | ;; This file currently contains parts of the package system most | 30 | ;; This file currently contains parts of the package system that many |
| 31 | ;; people won't need, such as package uploading. | 31 | ;; won't need, such as package uploading. |
| 32 | |||
| 33 | ;; To upload to an archive, first set `package-archive-upload-base' to | ||
| 34 | ;; some desired directory. For testing purposes, you can specify any | ||
| 35 | ;; directory you want, but if you want the archive to be accessible to | ||
| 36 | ;; others via http, this is typically a directory in the /var/www tree | ||
| 37 | ;; (possibly one on a remote machine, accessed via Tramp). | ||
| 38 | |||
| 39 | ;; Then call M-x package-upload-file, which prompts for a file to | ||
| 40 | ;; upload. Alternatively, M-x package-upload-buffer uploads the | ||
| 41 | ;; current buffer, if it's visiting a package file. | ||
| 42 | |||
| 43 | ;; Once a package is uploaded, users can access it via the Package | ||
| 44 | ;; Menu, by adding the archive to `package-archives'. | ||
| 32 | 45 | ||
| 33 | ;;; Code: | 46 | ;;; Code: |
| 34 | 47 | ||
| 35 | (require 'package) | 48 | (require 'package) |
| 36 | (defvar gnus-article-buffer) | 49 | (defvar gnus-article-buffer) |
| 37 | 50 | ||
| 38 | ;; Note that this only works if you have the password, which you | 51 | (defcustom package-archive-upload-base "/path/to/archive" |
| 39 | ;; probably don't :-). | 52 | "The base location of the archive to which packages are uploaded. |
| 40 | (defvar package-archive-upload-base nil | 53 | This should be an absolute directory name. If the archive is on |
| 41 | "Base location for uploading to package archive.") | 54 | another machine, you may specify a remote name in the usual way, |
| 55 | e.g. \"/ssh:foo@example.com:/var/www/packages/\". | ||
| 56 | See Info node `(emacs)Remote Files'. | ||
| 57 | |||
| 58 | Unlike `package-archives', you can't specify a HTTP URL." | ||
| 59 | :type 'directory | ||
| 60 | :group 'package | ||
| 61 | :version "24.1") | ||
| 42 | 62 | ||
| 43 | (defvar package-update-news-on-upload nil | 63 | (defvar package-update-news-on-upload nil |
| 44 | "Whether package upload should also update NEWS and RSS feeds.") | 64 | "Whether uploading a package should also update NEWS and RSS feeds.") |
| 45 | 65 | ||
| 46 | (defun package--encode (string) | 66 | (defun package--encode (string) |
| 47 | "Encode a string by replacing some characters with XML entities." | 67 | "Encode a string by replacing some characters with XML entities." |
| @@ -75,13 +95,18 @@ | |||
| 75 | title " - " (package--encode text) | 95 | title " - " (package--encode text) |
| 76 | " </li>\n")) | 96 | " </li>\n")) |
| 77 | 97 | ||
| 78 | (defun package--update-file (file location text) | 98 | (defun package--update-file (file tag text) |
| 99 | "Update the package archive file named FILE. | ||
| 100 | FILE should be relative to `package-archive-upload-base'. | ||
| 101 | TAG is a string that can be found within the file; TEXT is | ||
| 102 | inserted after its first occurrence in the file." | ||
| 103 | (setq file (expand-file-name file package-archive-upload-base)) | ||
| 79 | (save-excursion | 104 | (save-excursion |
| 80 | (let ((old-buffer (find-buffer-visiting file))) | 105 | (let ((old-buffer (find-buffer-visiting file))) |
| 81 | (with-current-buffer (let ((find-file-visit-truename t)) | 106 | (with-current-buffer (let ((find-file-visit-truename t)) |
| 82 | (or old-buffer (find-file-noselect file))) | 107 | (or old-buffer (find-file-noselect file))) |
| 83 | (goto-char (point-min)) | 108 | (goto-char (point-min)) |
| 84 | (search-forward location) | 109 | (search-forward tag) |
| 85 | (forward-line) | 110 | (forward-line) |
| 86 | (insert text) | 111 | (insert text) |
| 87 | (let ((file-precious-flag t)) | 112 | (let ((file-precious-flag t)) |
| @@ -105,30 +130,31 @@ Return the file contents, as a string, or nil if unsuccessful." | |||
| 105 | (buffer-substring-no-properties (point-min) (point-max))) | 130 | (buffer-substring-no-properties (point-min) (point-max))) |
| 106 | (kill-buffer buffer)))))) | 131 | (kill-buffer buffer)))))) |
| 107 | 132 | ||
| 108 | (defun package--archive-contents-from-file (file) | 133 | (defun package--archive-contents-from-file () |
| 109 | "Parse the given archive-contents file." | 134 | "Parse the archive-contents at `package-archive-upload-base'" |
| 110 | (if (not (file-exists-p file)) | 135 | (let ((file (expand-file-name "archive-contents" |
| 111 | ;; no existing archive-contents, possibly a new ELPA repo. | 136 | package-archive-upload-base))) |
| 112 | (list package-archive-version) | 137 | (if (not (file-exists-p file)) |
| 113 | (let ((dont-kill (find-buffer-visiting file))) | 138 | ;; No existing archive-contents means a new archive. |
| 114 | (with-current-buffer (let ((find-file-visit-truename t)) | 139 | (list package-archive-version) |
| 115 | (find-file-noselect file)) | 140 | (let ((dont-kill (find-buffer-visiting file))) |
| 116 | (prog1 | 141 | (with-current-buffer (let ((find-file-visit-truename t)) |
| 117 | (package-read-from-string | 142 | (find-file-noselect file)) |
| 118 | (buffer-substring-no-properties (point-min) (point-max))) | 143 | (prog1 |
| 119 | (unless dont-kill | 144 | (package-read-from-string |
| 120 | (kill-buffer (current-buffer)))))))) | 145 | (buffer-substring-no-properties (point-min) (point-max))) |
| 146 | (unless dont-kill | ||
| 147 | (kill-buffer (current-buffer))))))))) | ||
| 121 | 148 | ||
| 122 | (defun package-maint-add-news-item (title description archive-url) | 149 | (defun package-maint-add-news-item (title description archive-url) |
| 123 | "Add a news item to the ELPA web pages. | 150 | "Add a news item to the webpages associated with the package archive. |
| 124 | TITLE is the title of the news item. | 151 | TITLE is the title of the news item. |
| 125 | DESCRIPTION is the text of the news item. | 152 | DESCRIPTION is the text of the news item." |
| 126 | You need administrative access to ELPA to use this." | ||
| 127 | (interactive "sTitle: \nsText: ") | 153 | (interactive "sTitle: \nsText: ") |
| 128 | (package--update-file (concat package-archive-upload-base "elpa.rss") | 154 | (package--update-file "elpa.rss" |
| 129 | "<description>" | 155 | "<description>" |
| 130 | (package--make-rss-entry title description archive-url)) | 156 | (package--make-rss-entry title description archive-url)) |
| 131 | (package--update-file (concat package-archive-upload-base "news.html") | 157 | (package--update-file "news.html" |
| 132 | "New entries go here" | 158 | "New entries go here" |
| 133 | (package--make-html-entry title description))) | 159 | (package--make-html-entry title description))) |
| 134 | 160 | ||
| @@ -144,8 +170,8 @@ PKG-INFO is the package info, see `package-buffer-info'. | |||
| 144 | EXTENSION is the file extension, a string. It can be either | 170 | EXTENSION is the file extension, a string. It can be either |
| 145 | \"el\" or \"tar\". | 171 | \"el\" or \"tar\". |
| 146 | 172 | ||
| 147 | The variable `package-archive-upload-base' specifies the upload | 173 | The upload destination is given by `package-archive-upload-base'. |
| 148 | destination. If this is nil, signal an error. | 174 | If its value is invalid, prompt for a directory. |
| 149 | 175 | ||
| 150 | Optional arg ARCHIVE-URL is the URL of the destination archive. | 176 | Optional arg ARCHIVE-URL is the URL of the destination archive. |
| 151 | If it is non-nil, compute the new \"archive-contents\" file | 177 | If it is non-nil, compute the new \"archive-contents\" file |
| @@ -156,85 +182,97 @@ addition, if `package-update-news-on-upload' is non-nil, call | |||
| 156 | If ARCHIVE-URL is nil, compute the new \"archive-contents\" file | 182 | If ARCHIVE-URL is nil, compute the new \"archive-contents\" file |
| 157 | from the \"archive-contents\" at `package-archive-upload-base', | 183 | from the \"archive-contents\" at `package-archive-upload-base', |
| 158 | if it exists." | 184 | if it exists." |
| 159 | (unless package-archive-upload-base | 185 | (let ((package-archive-upload-base package-archive-upload-base)) |
| 160 | (error "No destination specified in `package-archive-upload-base'")) | 186 | ;; Check if `package-archive-upload-base' is valid. |
| 161 | (save-excursion | 187 | (when (or (not (stringp package-archive-upload-base)) |
| 162 | (save-restriction | 188 | (equal package-archive-upload-base |
| 163 | (let* ((file-type (cond | 189 | (car-safe |
| 164 | ((equal extension "el") 'single) | 190 | (get 'package-archive-upload-base 'standard-value)))) |
| 165 | ((equal extension "tar") 'tar) | 191 | (setq package-archive-upload-base |
| 166 | (t (error "Unknown extension `%s'" extension)))) | 192 | (read-directory-name |
| 167 | (file-name (aref pkg-info 0)) | 193 | "Base directory for package archive: "))) |
| 168 | (pkg-name (intern file-name)) | 194 | (unless (file-directory-p package-archive-upload-base) |
| 169 | (requires (aref pkg-info 1)) | 195 | (if (y-or-n-p (format "%s does not exist; create it? " |
| 170 | (desc (if (string= (aref pkg-info 2) "") | 196 | package-archive-upload-base)) |
| 171 | (read-string "Description of package: ") | 197 | (make-directory package-archive-upload-base t) |
| 172 | (aref pkg-info 2))) | 198 | (error "Aborted"))) |
| 173 | (pkg-version (aref pkg-info 3)) | 199 | (save-excursion |
| 174 | (commentary (aref pkg-info 4)) | 200 | (save-restriction |
| 175 | (split-version (version-to-list pkg-version)) | 201 | (let* ((file-type (cond |
| 176 | (pkg-buffer (current-buffer))) | 202 | ((equal extension "el") 'single) |
| 177 | 203 | ((equal extension "tar") 'tar) | |
| 178 | ;; Get archive-contents from ARCHIVE-URL if it's non-nil, or | 204 | (t (error "Unknown extension `%s'" extension)))) |
| 179 | ;; from `package-archive-upload-base' otherwise. | 205 | (file-name (aref pkg-info 0)) |
| 180 | (let ((contents (or (package--archive-contents-from-url archive-url) | 206 | (pkg-name (intern file-name)) |
| 181 | (package--archive-contents-from-file | 207 | (requires (aref pkg-info 1)) |
| 182 | (concat package-archive-upload-base | 208 | (desc (if (string= (aref pkg-info 2) "") |
| 183 | "archive-contents")))) | 209 | (read-string "Description of package: ") |
| 184 | (new-desc (vector split-version requires desc file-type))) | 210 | (aref pkg-info 2))) |
| 185 | (if (> (car contents) package-archive-version) | 211 | (pkg-version (aref pkg-info 3)) |
| 186 | (error "Unrecognized archive version %d" (car contents))) | 212 | (commentary (aref pkg-info 4)) |
| 187 | (let ((elt (assq pkg-name (cdr contents)))) | 213 | (split-version (version-to-list pkg-version)) |
| 188 | (if elt | 214 | (pkg-buffer (current-buffer))) |
| 189 | (if (version-list-<= split-version | 215 | |
| 190 | (package-desc-vers (cdr elt))) | 216 | ;; Get archive-contents from ARCHIVE-URL if it's non-nil, or |
| 191 | (error "New package has smaller version: %s" pkg-version) | 217 | ;; from `package-archive-upload-base' otherwise. |
| 192 | (setcdr elt new-desc)) | 218 | (let ((contents (or (package--archive-contents-from-url archive-url) |
| 193 | (setq contents (cons (car contents) | 219 | (package--archive-contents-from-file))) |
| 194 | (cons (cons pkg-name new-desc) | 220 | (new-desc (vector split-version requires desc file-type))) |
| 195 | (cdr contents)))))) | 221 | (if (> (car contents) package-archive-version) |
| 196 | 222 | (error "Unrecognized archive version %d" (car contents))) | |
| 197 | ;; Now CONTENTS is the updated archive contents. Upload | 223 | (let ((elt (assq pkg-name (cdr contents)))) |
| 198 | ;; this and the package itself. For now we assume ELPA is | 224 | (if elt |
| 199 | ;; writable via file primitives. | 225 | (if (version-list-<= split-version |
| 200 | (let ((print-level nil) | 226 | (package-desc-vers (cdr elt))) |
| 201 | (print-length nil)) | 227 | (error "New package has smaller version: %s" pkg-version) |
| 202 | (write-region (concat (pp-to-string contents) "\n") | 228 | (setcdr elt new-desc)) |
| 203 | nil | 229 | (setq contents (cons (car contents) |
| 204 | (concat package-archive-upload-base | 230 | (cons (cons pkg-name new-desc) |
| 205 | "archive-contents"))) | 231 | (cdr contents)))))) |
| 206 | 232 | ||
| 207 | ;; If there is a commentary section, write it. | 233 | ;; Now CONTENTS is the updated archive contents. Upload |
| 208 | (when commentary | 234 | ;; this and the package itself. For now we assume ELPA is |
| 209 | (write-region commentary nil | 235 | ;; writable via file primitives. |
| 210 | (concat package-archive-upload-base | 236 | (let ((print-level nil) |
| 211 | (symbol-name pkg-name) "-readme.txt"))) | 237 | (print-length nil)) |
| 212 | 238 | (write-region (concat (pp-to-string contents) "\n") | |
| 213 | (set-buffer pkg-buffer) | 239 | nil |
| 214 | (write-region (point-min) (point-max) | 240 | (expand-file-name "archive-contents" |
| 215 | (concat package-archive-upload-base | 241 | package-archive-upload-base))) |
| 216 | file-name "-" pkg-version | 242 | |
| 217 | "." extension) | 243 | ;; If there is a commentary section, write it. |
| 218 | nil nil nil 'excl) | 244 | (when commentary |
| 219 | 245 | (write-region commentary nil | |
| 220 | ;; Write a news entry. | 246 | (expand-file-name |
| 221 | (and package-update-news-on-upload | 247 | (concat (symbol-name pkg-name) "-readme.txt") |
| 222 | archive-url | 248 | package-archive-upload-base))) |
| 223 | (package--update-news (concat file-name "." extension) | 249 | |
| 224 | pkg-version desc archive-url)) | 250 | (set-buffer pkg-buffer) |
| 225 | 251 | (write-region (point-min) (point-max) | |
| 226 | ;; special-case "package": write a second copy so that the | 252 | (expand-file-name |
| 227 | ;; installer can easily find the latest version. | 253 | (concat file-name "-" pkg-version "." extension) |
| 228 | (if (string= file-name "package") | 254 | package-archive-upload-base) |
| 229 | (write-region (point-min) (point-max) | 255 | nil nil nil 'excl) |
| 230 | (concat package-archive-upload-base | 256 | |
| 231 | file-name "." extension) | 257 | ;; Write a news entry. |
| 232 | nil nil nil 'ask))))))) | 258 | (and package-update-news-on-upload |
| 259 | archive-url | ||
| 260 | (package--update-news (concat file-name "." extension) | ||
| 261 | pkg-version desc archive-url)) | ||
| 262 | |||
| 263 | ;; special-case "package": write a second copy so that the | ||
| 264 | ;; installer can easily find the latest version. | ||
| 265 | (if (string= file-name "package") | ||
| 266 | (write-region (point-min) (point-max) | ||
| 267 | (expand-file-name | ||
| 268 | (concat file-name "." extension) | ||
| 269 | package-archive-upload-base) | ||
| 270 | nil nil nil 'ask)))))))) | ||
| 233 | 271 | ||
| 234 | (defun package-upload-buffer () | 272 | (defun package-upload-buffer () |
| 235 | "Upload the current buffer as a single-file Emacs Lisp package. | 273 | "Upload the current buffer as a single-file Emacs Lisp package. |
| 236 | The variable `package-archive-upload-base' specifies the upload | 274 | If `package-archive-upload-base' does not specify a valid upload |
| 237 | destination." | 275 | destination, prompt for one." |
| 238 | (interactive) | 276 | (interactive) |
| 239 | (save-excursion | 277 | (save-excursion |
| 240 | (save-restriction | 278 | (save-restriction |
| @@ -247,9 +285,8 @@ destination." | |||
| 247 | Interactively, prompt for FILE. The package is considered a | 285 | Interactively, prompt for FILE. The package is considered a |
| 248 | single-file package if FILE ends in \".el\", and a multi-file | 286 | single-file package if FILE ends in \".el\", and a multi-file |
| 249 | package if FILE ends in \".tar\". | 287 | package if FILE ends in \".tar\". |
| 250 | 288 | If `package-archive-upload-base' does not specify a valid upload | |
| 251 | The variable `package-archive-upload-base' specifies the upload | 289 | destination, prompt for one." |
| 252 | destination." | ||
| 253 | (interactive "fPackage file name: ") | 290 | (interactive "fPackage file name: ") |
| 254 | (with-temp-buffer | 291 | (with-temp-buffer |
| 255 | (insert-file-contents-literally file) | 292 | (insert-file-contents-literally file) |
| @@ -269,4 +306,4 @@ This should be invoked from the gnus *Summary* buffer." | |||
| 269 | 306 | ||
| 270 | (provide 'package-x) | 307 | (provide 'package-x) |
| 271 | 308 | ||
| 272 | ;;; package.el ends here | 309 | ;;; package-x.el ends here |
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2552ad4eb68..5dc2938fe08 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -319,20 +319,39 @@ Like `package-alist', but maps package name to a second alist. | |||
| 319 | The inner alist is keyed by version.") | 319 | The inner alist is keyed by version.") |
| 320 | (put 'package-obsolete-alist 'risky-local-variable t) | 320 | (put 'package-obsolete-alist 'risky-local-variable t) |
| 321 | 321 | ||
| 322 | (defconst package-subdirectory-regexp | 322 | (defun package-version-join (vlist) |
| 323 | "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" | 323 | "Return the version string corresponding to the list VLIST. |
| 324 | "Regular expression matching the name of a package subdirectory. | 324 | This is, approximately, the inverse of `version-to-list'. |
| 325 | The first subexpression is the package name. | 325 | \(Actually, it returns only one of the possible inverses, since |
| 326 | The second subexpression is the version string.") | 326 | `version-to-list' is a many-to-one operation.)" |
| 327 | 327 | (if (null vlist) | |
| 328 | (defun package-version-join (l) | 328 | "" |
| 329 | "Turn a list of version numbers into a version string." | 329 | (let ((str-list (list "." (int-to-string (car vlist))))) |
| 330 | (mapconcat 'int-to-string l ".")) | 330 | (dolist (num (cdr vlist)) |
| 331 | (cond | ||
| 332 | ((>= num 0) | ||
| 333 | (push (int-to-string num) str-list) | ||
| 334 | (push "." str-list)) | ||
| 335 | ((< num -3) | ||
| 336 | (error "Invalid version list `%s'" vlist)) | ||
| 337 | (t | ||
| 338 | ;; pre, or beta, or alpha | ||
| 339 | (cond ((equal "." (car str-list)) | ||
| 340 | (pop str-list)) | ||
| 341 | ((not (string-match "[0-9]+" (car str-list))) | ||
| 342 | (error "Invalid version list `%s'" vlist))) | ||
| 343 | (push (cond ((= num -1) "pre") | ||
| 344 | ((= num -2) "beta") | ||
| 345 | ((= num -3) "alpha")) | ||
| 346 | str-list)))) | ||
| 347 | (if (equal "." (car str-list)) | ||
| 348 | (pop str-list)) | ||
| 349 | (apply 'concat (nreverse str-list))))) | ||
| 331 | 350 | ||
| 332 | (defun package-strip-version (dirname) | 351 | (defun package-strip-version (dirname) |
| 333 | "Strip the version from a combined package name and version. | 352 | "Strip the version from a combined package name and version. |
| 334 | E.g., if given \"quux-23.0\", will return \"quux\"" | 353 | E.g., if given \"quux-23.0\", will return \"quux\"" |
| 335 | (if (string-match package-subdirectory-regexp dirname) | 354 | (if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirname) |
| 336 | (match-string 1 dirname))) | 355 | (match-string 1 dirname))) |
| 337 | 356 | ||
| 338 | (defun package-load-descriptor (dir package) | 357 | (defun package-load-descriptor (dir package) |
| @@ -357,12 +376,13 @@ In each valid package subdirectory, this function loads the | |||
| 357 | description file containing a call to `define-package', which | 376 | description file containing a call to `define-package', which |
| 358 | updates `package-alist' and `package-obsolete-alist'." | 377 | updates `package-alist' and `package-obsolete-alist'." |
| 359 | (let ((all (memq 'all package-load-list)) | 378 | (let ((all (memq 'all package-load-list)) |
| 379 | (regexp (concat "\\`" package-subdirectory-regexp "\\'")) | ||
| 360 | name version force) | 380 | name version force) |
| 361 | (dolist (dir (cons package-user-dir package-directory-list)) | 381 | (dolist (dir (cons package-user-dir package-directory-list)) |
| 362 | (when (file-directory-p dir) | 382 | (when (file-directory-p dir) |
| 363 | (dolist (subdir (directory-files dir)) | 383 | (dolist (subdir (directory-files dir)) |
| 364 | (when (and (file-directory-p (expand-file-name subdir dir)) | 384 | (when (and (file-directory-p (expand-file-name subdir dir)) |
| 365 | (string-match package-subdirectory-regexp subdir)) | 385 | (string-match regexp subdir)) |
| 366 | (setq name (intern (match-string 1 subdir)) | 386 | (setq name (intern (match-string 1 subdir)) |
| 367 | version (match-string 2 subdir) | 387 | version (match-string 2 subdir) |
| 368 | force (assq name package-load-list)) | 388 | force (assq name package-load-list)) |
| @@ -554,30 +574,29 @@ EXTRA-PROPERTIES is currently unused." | |||
| 554 | (package-autoload-ensure-default-file generated-autoload-file)) | 574 | (package-autoload-ensure-default-file generated-autoload-file)) |
| 555 | (update-directory-autoloads pkg-dir))) | 575 | (update-directory-autoloads pkg-dir))) |
| 556 | 576 | ||
| 557 | (defun package-untar-buffer () | 577 | (defvar tar-parse-info) |
| 578 | (declare-function tar-untar-buffer "tar-mode" ()) | ||
| 579 | |||
| 580 | (defun package-untar-buffer (dir) | ||
| 558 | "Untar the current buffer. | 581 | "Untar the current buffer. |
| 559 | This uses `tar-untar-buffer' if it is available. | 582 | This uses `tar-untar-buffer' from Tar mode. All files should |
| 560 | Otherwise it uses an external `tar' program. | 583 | untar into a directory named DIR; otherwise, signal an error." |
| 561 | `default-directory' should be set by the caller." | ||
| 562 | (require 'tar-mode) | 584 | (require 'tar-mode) |
| 563 | (if (fboundp 'tar-untar-buffer) | 585 | (tar-mode) |
| 564 | (progn | 586 | ;; Make sure everything extracts into DIR. |
| 565 | ;; tar-mode messes with narrowing, so we just let it have the | 587 | (let ((regexp (concat "\\`" (regexp-quote dir) "/"))) |
| 566 | ;; whole buffer to play with. | 588 | (dolist (tar-data tar-parse-info) |
| 567 | (delete-region (point-min) (point)) | 589 | (unless (string-match regexp (aref tar-data 2)) |
| 568 | (tar-mode) | 590 | (error "Package does not untar cleanly into directory %s/" dir)))) |
| 569 | (tar-untar-buffer)) | 591 | (tar-untar-buffer)) |
| 570 | ;; FIXME: check the result. | ||
| 571 | (call-process-region (point) (point-max) "tar" nil '(nil nil) nil | ||
| 572 | "xf" "-"))) | ||
| 573 | 592 | ||
| 574 | (defun package-unpack (name version) | 593 | (defun package-unpack (name version) |
| 575 | (let ((pkg-dir (expand-file-name (concat (symbol-name name) "-" version) | 594 | (let* ((dirname (concat (symbol-name name) "-" version)) |
| 576 | package-user-dir))) | 595 | (pkg-dir (expand-file-name dirname package-user-dir))) |
| 577 | (make-directory package-user-dir t) | 596 | (make-directory package-user-dir t) |
| 578 | ;; FIXME: should we delete PKG-DIR if it exists? | 597 | ;; FIXME: should we delete PKG-DIR if it exists? |
| 579 | (let* ((default-directory (file-name-as-directory package-user-dir))) | 598 | (let* ((default-directory (file-name-as-directory package-user-dir))) |
| 580 | (package-untar-buffer) | 599 | (package-untar-buffer dirname) |
| 581 | (package-generate-autoloads (symbol-name name) pkg-dir) | 600 | (package-generate-autoloads (symbol-name name) pkg-dir) |
| 582 | (let ((load-path (cons pkg-dir load-path))) | 601 | (let ((load-path (cons pkg-dir load-path))) |
| 583 | (byte-recompile-directory pkg-dir 0 t))))) | 602 | (byte-recompile-directory pkg-dir 0 t))))) |
| @@ -592,7 +611,9 @@ Otherwise it uses an external `tar' program. | |||
| 592 | (if (string= file-name "package") | 611 | (if (string= file-name "package") |
| 593 | (package--write-file-no-coding | 612 | (package--write-file-no-coding |
| 594 | (expand-file-name (concat file-name ".el") package-user-dir)) | 613 | (expand-file-name (concat file-name ".el") package-user-dir)) |
| 595 | (let* ((pkg-dir (expand-file-name (concat file-name "-" version) | 614 | (let* ((pkg-dir (expand-file-name (concat file-name "-" |
| 615 | (package-version-join | ||
| 616 | (version-to-list version))) | ||
| 596 | package-user-dir)) | 617 | package-user-dir)) |
| 597 | (el-file (expand-file-name (concat file-name ".el") pkg-dir)) | 618 | (el-file (expand-file-name (concat file-name ".el") pkg-dir)) |
| 598 | (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) | 619 | (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) |
| @@ -848,15 +869,17 @@ The package is found on one of the archives in `package-archives'." | |||
| 848 | ;; Try to activate it. | 869 | ;; Try to activate it. |
| 849 | (package-initialize)) | 870 | (package-initialize)) |
| 850 | 871 | ||
| 851 | (defun package-strip-rcs-id (v-str) | 872 | (defun package-strip-rcs-id (str) |
| 852 | "Strip RCS version ID from the version string. | 873 | "Strip RCS version ID from the version string STR. |
| 853 | If the result looks like a dotted numeric version, return it. | 874 | If the result looks like a dotted numeric version, return it. |
| 854 | Otherwise return nil." | 875 | Otherwise return nil." |
| 855 | (if v-str | 876 | (when str |
| 856 | (if (string-match "^[ \t]*[$]Revision:[ \t]\([0-9.]+\)[ \t]*[$]$" v-str) | 877 | (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str) |
| 857 | (match-string 1 v-str) | 878 | (setq str (substring str (match-end 0)))) |
| 858 | (if (string-match "^[0-9.]*$" v-str) | 879 | (condition-case nil |
| 859 | v-str)))) | 880 | (if (version-to-list str) |
| 881 | str) | ||
| 882 | (error nil)))) | ||
| 860 | 883 | ||
| 861 | (defun package-buffer-info () | 884 | (defun package-buffer-info () |
| 862 | "Return a vector describing the package in the current buffer. | 885 | "Return a vector describing the package in the current buffer. |
| @@ -911,43 +934,47 @@ boundaries." | |||
| 911 | "Find package information for a tar file. | 934 | "Find package information for a tar file. |
| 912 | FILE is the name of the tar file to examine. | 935 | FILE is the name of the tar file to examine. |
| 913 | The return result is a vector like `package-buffer-info'." | 936 | The return result is a vector like `package-buffer-info'." |
| 914 | (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file) | 937 | (let ((default-directory (file-name-directory file)) |
| 915 | (error "Invalid package name `%s'" file)) | 938 | (file (file-name-nondirectory file))) |
| 916 | (let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 file))) | 939 | (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'") |
| 917 | (pkg-version (match-string-no-properties 2 file)) | 940 | file) |
| 918 | ;; Extract the package descriptor. | 941 | (error "Invalid package name `%s'" file)) |
| 919 | (pkg-def-contents (shell-command-to-string | 942 | (let* ((pkg-name (match-string-no-properties 1 file)) |
| 920 | ;; Requires GNU tar. | 943 | (pkg-version (match-string-no-properties 2 file)) |
| 921 | (concat "tar -xOf " file " " | 944 | ;; Extract the package descriptor. |
| 922 | pkg-name "-" pkg-version "/" | 945 | (pkg-def-contents (shell-command-to-string |
| 923 | pkg-name "-pkg.el"))) | 946 | ;; Requires GNU tar. |
| 924 | (pkg-def-parsed (package-read-from-string pkg-def-contents))) | 947 | (concat "tar -xOf " file " " |
| 925 | (unless (eq (car pkg-def-parsed) 'define-package) | 948 | |
| 926 | (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) | 949 | pkg-name "-" pkg-version "/" |
| 927 | (let ((name-str (nth 1 pkg-def-parsed)) | 950 | pkg-name "-pkg.el"))) |
| 928 | (version-string (nth 2 pkg-def-parsed)) | 951 | (pkg-def-parsed (package-read-from-string pkg-def-contents))) |
| 929 | (docstring (nth 3 pkg-def-parsed)) | 952 | (unless (eq (car pkg-def-parsed) 'define-package) |
| 930 | (requires (nth 4 pkg-def-parsed)) | 953 | (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) |
| 931 | (readme (shell-command-to-string | 954 | (let ((name-str (nth 1 pkg-def-parsed)) |
| 932 | ;; Requires GNU tar. | 955 | (version-string (nth 2 pkg-def-parsed)) |
| 933 | (concat "tar -xOf " file " " | 956 | (docstring (nth 3 pkg-def-parsed)) |
| 934 | pkg-name "-" pkg-version "/README")))) | 957 | (requires (nth 4 pkg-def-parsed)) |
| 935 | (unless (equal pkg-version version-string) | 958 | (readme (shell-command-to-string |
| 936 | (error "Package has inconsistent versions")) | 959 | ;; Requires GNU tar. |
| 937 | (unless (equal pkg-name name-str) | 960 | (concat "tar -xOf " file " " |
| 938 | (error "Package has inconsistent names")) | 961 | pkg-name "-" pkg-version "/README")))) |
| 939 | ;; Kind of a hack. | 962 | (unless (equal pkg-version version-string) |
| 940 | (if (string-match ": Not found in archive" readme) | 963 | (error "Package has inconsistent versions")) |
| 941 | (setq readme nil)) | 964 | (unless (equal pkg-name name-str) |
| 942 | ;; Turn string version numbers into list form. | 965 | (error "Package has inconsistent names")) |
| 943 | (if (eq (car requires) 'quote) | 966 | ;; Kind of a hack. |
| 944 | (setq requires (car (cdr requires)))) | 967 | (if (string-match ": Not found in archive" readme) |
| 945 | (setq requires | 968 | (setq readme nil)) |
| 946 | (mapcar (lambda (elt) | 969 | ;; Turn string version numbers into list form. |
| 947 | (list (car elt) | 970 | (if (eq (car requires) 'quote) |
| 948 | (version-to-list (cadr elt)))) | 971 | (setq requires (car (cdr requires)))) |
| 949 | requires)) | 972 | (setq requires |
| 950 | (vector pkg-name requires docstring version-string readme)))) | 973 | (mapcar (lambda (elt) |
| 974 | (list (car elt) | ||
| 975 | (version-to-list (cadr elt)))) | ||
| 976 | requires)) | ||
| 977 | (vector pkg-name requires docstring version-string readme))))) | ||
| 951 | 978 | ||
| 952 | ;;;###autoload | 979 | ;;;###autoload |
| 953 | (defun package-install-from-buffer (pkg-info type) | 980 | (defun package-install-from-buffer (pkg-info type) |
| @@ -1037,7 +1064,7 @@ makes them available for download." | |||
| 1037 | (unless (file-exists-p package-user-dir) | 1064 | (unless (file-exists-p package-user-dir) |
| 1038 | (make-directory package-user-dir t)) | 1065 | (make-directory package-user-dir t)) |
| 1039 | (dolist (archive package-archives) | 1066 | (dolist (archive package-archives) |
| 1040 | (condition-case nil | 1067 | (condition-case-no-debug nil |
| 1041 | (package--download-one-archive archive "archive-contents") | 1068 | (package--download-one-archive archive "archive-contents") |
| 1042 | (error (message "Failed to download `%s' archive." | 1069 | (error (message "Failed to download `%s' archive." |
| 1043 | (car archive))))) | 1070 | (car archive))))) |
| @@ -1465,7 +1492,7 @@ packages marked for deletion are removed." | |||
| 1465 | delete-list | 1492 | delete-list |
| 1466 | ", ")))) | 1493 | ", ")))) |
| 1467 | (dolist (elt delete-list) | 1494 | (dolist (elt delete-list) |
| 1468 | (condition-case err | 1495 | (condition-case-no-debug err |
| 1469 | (package-delete (car elt) (cdr elt)) | 1496 | (package-delete (car elt) (cdr elt)) |
| 1470 | (error (message (cadr err))))) | 1497 | (error (message (cadr err))))) |
| 1471 | (error "Aborted"))) | 1498 | (error "Aborted"))) |
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index d7162406879..a9e8f11c39a 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el | |||
| @@ -35,13 +35,51 @@ Eshell commands implemented in Lisp." | |||
| 35 | 35 | ||
| 36 | ;;; User Functions: | 36 | ;;; User Functions: |
| 37 | 37 | ||
| 38 | (defmacro eshell-eval-using-options (name macro-args | 38 | (defmacro eshell-eval-using-options (name macro-args options &rest body-forms) |
| 39 | options &rest body-forms) | ||
| 40 | "Process NAME's MACRO-ARGS using a set of command line OPTIONS. | 39 | "Process NAME's MACRO-ARGS using a set of command line OPTIONS. |
| 41 | After doing so, settings will be stored in local symbols as declared | 40 | After doing so, stores settings in local symbols as declared by OPTIONS; |
| 42 | by OPTIONS; FORMS will then be evaluated -- assuming all was OK. | 41 | then evaluates BODY-FORMS -- assuming all was OK. |
| 43 | 42 | ||
| 44 | The syntax of OPTIONS is: | 43 | OPTIONS is a list, beginning with one or more elements of the form: |
| 44 | \(SHORT LONG VALUE SYMBOL HELP-STRING) | ||
| 45 | Each of these elements represents a particular command-line switch. | ||
| 46 | |||
| 47 | SHORT is either nil, or a character that can be used as a switch -SHORT. | ||
| 48 | LONG is either nil, or a string that can be used as a switch --LONG. | ||
| 49 | At least one of SHORT and LONG must be non-nil. | ||
| 50 | VALUE is the value associated with the option. It can be either: | ||
| 51 | t - the option needs a value to be specified after the switch; | ||
| 52 | nil - the option is given the value t; | ||
| 53 | anything else - specifies the actual value for the option. | ||
| 54 | SYMBOL is either nil, or the name of the Lisp symbol that will be bound | ||
| 55 | to VALUE. A nil SYMBOL calls `eshell-show-usage', and so is appropriate | ||
| 56 | for a \"--help\" type option. | ||
| 57 | HELP-STRING is a documentation string for the option. | ||
| 58 | |||
| 59 | Any remaining elements of OPTIONS are :KEYWORD arguments. Some take | ||
| 60 | arguments, some do not. The recognized :KEYWORDS are: | ||
| 61 | |||
| 62 | :external STRING | ||
| 63 | STRING is an external command to run if there are unknown switches. | ||
| 64 | |||
| 65 | :usage STRING | ||
| 66 | STRING is the initial part of the command's documentation string. | ||
| 67 | It appears before the options are listed. | ||
| 68 | |||
| 69 | :post-usage STRING | ||
| 70 | STRING is an optional trailing part of the command's documentation string. | ||
| 71 | It appears after the options, but before the final part of the | ||
| 72 | documentation about the associated external command (if there is one). | ||
| 73 | |||
| 74 | :show-usage | ||
| 75 | If present, then show the usage message if the command is called with no | ||
| 76 | arguments. | ||
| 77 | |||
| 78 | :preserve-args | ||
| 79 | If present, do not pass MACRO-ARGS through `eshell-flatten-list' | ||
| 80 | and `eshell-stringify-list'. | ||
| 81 | |||
| 82 | For example, OPTIONS might look like: | ||
| 45 | 83 | ||
| 46 | '((?C nil nil multi-column \"multi-column display\") | 84 | '((?C nil nil multi-column \"multi-column display\") |
| 47 | (nil \"help\" nil nil \"show this usage display\") | 85 | (nil \"help\" nil nil \"show this usage display\") |
| @@ -52,8 +90,9 @@ The syntax of OPTIONS is: | |||
| 52 | Sort entries alphabetically across.\") | 90 | Sort entries alphabetically across.\") |
| 53 | 91 | ||
| 54 | `eshell-eval-using-options' returns the value of the last form in | 92 | `eshell-eval-using-options' returns the value of the last form in |
| 55 | BODY-FORMS. If instead an external command is run, the tag | 93 | BODY-FORMS. If instead an external command is run (because of |
| 56 | `eshell-external' will be thrown with the new process for its value. | 94 | an unknown option), the tag `eshell-external' will be thrown with |
| 95 | the new process for its value. | ||
| 57 | 96 | ||
| 58 | Lastly, any remaining arguments will be available in a locally | 97 | Lastly, any remaining arguments will be available in a locally |
| 59 | interned variable `args' (created using a `let' form)." | 98 | interned variable `args' (created using a `let' form)." |
| @@ -200,7 +239,7 @@ switch is unrecognized." | |||
| 200 | 239 | ||
| 201 | (defun eshell-process-args (name args options) | 240 | (defun eshell-process-args (name args options) |
| 202 | "Process the given ARGS using OPTIONS. | 241 | "Process the given ARGS using OPTIONS. |
| 203 | This assumes that symbols have been intern'd by `eshell-with-options'." | 242 | This assumes that symbols have been intern'd by `eshell-eval-using-options'." |
| 204 | (let ((ai 0) arg) | 243 | (let ((ai 0) arg) |
| 205 | (while (< ai (length args)) | 244 | (while (< ai (length args)) |
| 206 | (setq arg (nth ai args)) | 245 | (setq arg (nth ai args)) |
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index dbe4f824deb..424d246a2b6 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el | |||
| @@ -138,7 +138,8 @@ function `string-to-number'." | |||
| 138 | (memq system-type '(ms-dos windows-nt))) | 138 | (memq system-type '(ms-dos windows-nt))) |
| 139 | 139 | ||
| 140 | (defmacro eshell-condition-case (tag form &rest handlers) | 140 | (defmacro eshell-condition-case (tag form &rest handlers) |
| 141 | "Like `condition-case', but only if `eshell-pass-through-errors' is nil." | 141 | "If `eshell-handle-errors' is non-nil, this is `condition-case'. |
| 142 | Otherwise, evaluates FORM with no error handling." | ||
| 142 | (if eshell-handle-errors | 143 | (if eshell-handle-errors |
| 143 | `(condition-case ,tag | 144 | `(condition-case ,tag |
| 144 | ,form | 145 | ,form |
diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 97862afb678..fffe09a84a5 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el | |||
| @@ -567,18 +567,12 @@ You can change the color sort order by customizing `list-colors-sort'." | |||
| 567 | (with-help-window buffer-name | 567 | (with-help-window buffer-name |
| 568 | (with-current-buffer standard-output | 568 | (with-current-buffer standard-output |
| 569 | (erase-buffer) | 569 | (erase-buffer) |
| 570 | (list-colors-print list callback) | ||
| 571 | (set-buffer-modified-p nil) | ||
| 570 | (setq truncate-lines t))) | 572 | (setq truncate-lines t))) |
| 571 | (let ((buf (get-buffer buffer-name)) | 573 | (when callback |
| 572 | (inhibit-read-only t)) | 574 | (pop-to-buffer buffer-name) |
| 573 | ;; Display buffer before generating content, to allow | 575 | (message "Click on a color to select it."))) |
| 574 | ;; `list-colors-print' to get the right window-width. | ||
| 575 | (with-selected-window (or (get-buffer-window buf t) (selected-window)) | ||
| 576 | (with-current-buffer buf | ||
| 577 | (list-colors-print list callback) | ||
| 578 | (set-buffer-modified-p nil))) | ||
| 579 | (when callback | ||
| 580 | (pop-to-buffer buf) | ||
| 581 | (message "Click on a color to select it.")))) | ||
| 582 | 576 | ||
| 583 | (defun list-colors-print (list &optional callback) | 577 | (defun list-colors-print (list &optional callback) |
| 584 | (let ((callback-fn | 578 | (let ((callback-fn |
| @@ -595,30 +589,19 @@ You can change the color sort order by customizing `list-colors-sort'." | |||
| 595 | (let* ((opoint (point)) | 589 | (let* ((opoint (point)) |
| 596 | (color-values (color-values (car color))) | 590 | (color-values (color-values (car color))) |
| 597 | (light-p (>= (apply 'max color-values) | 591 | (light-p (>= (apply 'max color-values) |
| 598 | (* (car (color-values "white")) .5))) | 592 | (* (car (color-values "white")) .5)))) |
| 599 | (max-len (max (- (window-width) 33) 20))) | ||
| 600 | (insert (car color)) | 593 | (insert (car color)) |
| 601 | (indent-to 22) | 594 | (indent-to 22) |
| 602 | (put-text-property opoint (point) 'face `(:background ,(car color))) | 595 | (put-text-property opoint (point) 'face `(:background ,(car color))) |
| 603 | (put-text-property | 596 | (put-text-property |
| 604 | (prog1 (point) | 597 | (prog1 (point) |
| 605 | (insert " ") | 598 | (insert " ") |
| 606 | (if (cdr color) | 599 | ;; Insert all color names. |
| 607 | ;; Insert as many color names as possible, fitting max-len. | 600 | (insert (mapconcat 'identity color ","))) |
| 608 | (let ((names (list (car color))) | ||
| 609 | (others (cdr color)) | ||
| 610 | (len (length (car color))) | ||
| 611 | newlen) | ||
| 612 | (while (and others | ||
| 613 | (< (setq newlen (+ len 2 (length (car others)))) | ||
| 614 | max-len)) | ||
| 615 | (setq len newlen) | ||
| 616 | (push (pop others) names)) | ||
| 617 | (insert (mapconcat 'identity (nreverse names) ", "))) | ||
| 618 | (insert (car color)))) | ||
| 619 | (point) | 601 | (point) |
| 620 | 'face (list :foreground (car color))) | 602 | 'face (list :foreground (car color))) |
| 621 | (indent-to (max (- (window-width) 8) 44)) | 603 | (insert (propertize " " 'display '(space :align-to (- right 9)))) |
| 604 | (insert " ") | ||
| 622 | (insert (propertize | 605 | (insert (propertize |
| 623 | (apply 'format "#%02x%02x%02x" | 606 | (apply 'format "#%02x%02x%02x" |
| 624 | (mapcar (lambda (c) (lsh c -8)) | 607 | (mapcar (lambda (c) (lsh c -8)) |
diff --git a/lisp/files.el b/lisp/files.el index caf0a9752c5..38047f2fa43 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -3896,11 +3896,17 @@ See also `file-name-version-regexp'." | |||
| 3896 | (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) | 3896 | (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) |
| 3897 | (if handler | 3897 | (if handler |
| 3898 | (funcall handler 'file-ownership-preserved-p file) | 3898 | (funcall handler 'file-ownership-preserved-p file) |
| 3899 | (let ((attributes (file-attributes file))) | 3899 | (let ((attributes (file-attributes file 'integer))) |
| 3900 | ;; Return t if the file doesn't exist, since it's true that no | 3900 | ;; Return t if the file doesn't exist, since it's true that no |
| 3901 | ;; information would be lost by an (attempted) delete and create. | 3901 | ;; information would be lost by an (attempted) delete and create. |
| 3902 | (or (null attributes) | 3902 | (or (null attributes) |
| 3903 | (= (nth 2 attributes) (user-uid))))))) | 3903 | (= (nth 2 attributes) (user-uid)) |
| 3904 | ;; Files created on Windows by Administrator (RID=500) | ||
| 3905 | ;; have the Administrators group (RID=544) recorded as | ||
| 3906 | ;; their owner. Rewriting them will still preserve the | ||
| 3907 | ;; owner. | ||
| 3908 | (and (eq system-type 'windows-nt) | ||
| 3909 | (= (user-uid) 500) (= (nth 2 attributes) 544))))))) | ||
| 3904 | 3910 | ||
| 3905 | (defun file-name-sans-extension (filename) | 3911 | (defun file-name-sans-extension (filename) |
| 3906 | "Return FILENAME sans final \"extension\". | 3912 | "Return FILENAME sans final \"extension\". |
diff --git a/lisp/font-lock.el b/lisp/font-lock.el index b7b617fcffe..988e821d7e2 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el | |||
| @@ -2242,7 +2242,7 @@ in which C preprocessor directives are used. e.g. `asm-mode' and | |||
| 2242 | "\\)\\)\\>" | 2242 | "\\)\\)\\>" |
| 2243 | ;; Any whitespace and defined object. | 2243 | ;; Any whitespace and defined object. |
| 2244 | "[ \t'\(]*" | 2244 | "[ \t'\(]*" |
| 2245 | "\\(setf[ \t]+\\sw+)\\|\\sw+\\)?") | 2245 | "\\(setf[ \t]+\\sw+\\|\\sw+\\)?") |
| 2246 | (1 font-lock-keyword-face) | 2246 | (1 font-lock-keyword-face) |
| 2247 | (9 (cond ((match-beginning 3) font-lock-function-name-face) | 2247 | (9 (cond ((match-beginning 3) font-lock-function-name-face) |
| 2248 | ((match-beginning 6) font-lock-variable-name-face) | 2248 | ((match-beginning 6) font-lock-variable-name-face) |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index c14c79a92cb..7eca03bd93b 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,182 @@ | |||
| 1 | 2011-03-18 Julien Danjou <julien@danjou.info> | ||
| 2 | |||
| 3 | * gnus-util.el (gnus-buffer-live-p): Simplify gnus-buffer-live-p. | ||
| 4 | (gnus-buffer-live-p): Check that buffer is not nil. | ||
| 5 | |||
| 6 | 2011-03-17 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 7 | |||
| 8 | * gnus-art.el: Require mouse, which the build bot seems to say is | ||
| 9 | needed. | ||
| 10 | |||
| 11 | * gravatar.el (gravatar-retrieve-synchronously): Use `url-retrieve' on | ||
| 12 | XEmacs, since it doesn't have url-retrieve-synchronously. | ||
| 13 | |||
| 14 | 2011-03-17 Antoine Levitt <antoine.levitt@gmail.com> | ||
| 15 | |||
| 16 | * gnus-group.el (gnus-group-list-ticked): New function. | ||
| 17 | (gnus-group-make-menu-bar): Provide a menu entry for it. | ||
| 18 | (gnus-group-list-map): Provide a binding for it. | ||
| 19 | |||
| 20 | 2011-03-17 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 21 | |||
| 22 | * shr.el (shr-visit-file): New command. | ||
| 23 | |||
| 24 | * nnimap.el (nnimap-fetch-inbox): Rewrite slightly last patch. | ||
| 25 | |||
| 26 | 2011-03-17 Bjørn Mork <bjorn@mork.no> | ||
| 27 | |||
| 28 | * nnimap.el (nnimap-fetch-inbox): Don't download bodies on ver4-capable | ||
| 29 | servers. | ||
| 30 | |||
| 31 | 2011-03-16 Julien Danjou <julien@danjou.info> | ||
| 32 | |||
| 33 | * mm-uu.el (mm-uu-dissect-text-parts): Only dissect handle that are | ||
| 34 | inline. | ||
| 35 | |||
| 36 | * gnus-art.el (article-hide-list-identifiers): Use | ||
| 37 | gnus-group-get-list-identifiers. | ||
| 38 | |||
| 39 | * gnus-sum.el (gnus-group-get-list-identifiers): New function. | ||
| 40 | (gnus-summary-remove-list-identifiers): Use | ||
| 41 | gnus-group-get-list-identifiers to get regexp. | ||
| 42 | (gnus-select-newsgroup, gnus-summary-insert-subject) | ||
| 43 | (gnus-summary-insert-articles): Call | ||
| 44 | gnus-summary-remove-list-identifiers unconditionally. | ||
| 45 | |||
| 46 | 2011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 47 | |||
| 48 | * gnus-sum.el (gnus-articles-to-read): Revert back to old behaviour if | ||
| 49 | we're selecting a group with unread articles. | ||
| 50 | |||
| 51 | * nnimap.el (nnimap-open-connection-1): Allow `network-only', too. | ||
| 52 | |||
| 53 | * gssapi.el: New file separated out from imap.el to provide a general | ||
| 54 | Kerberos 5 connection facility for Emacs. | ||
| 55 | |||
| 56 | * message.el (message-elide-ellipsis): Document the format spec | ||
| 57 | ellipsis. | ||
| 58 | |||
| 59 | 2011-03-15 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 60 | |||
| 61 | * message.el (message-elide-region): Allow the ellipsis to say how many | ||
| 62 | lines were removed. | ||
| 63 | |||
| 64 | 2011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 65 | |||
| 66 | * gnus-win.el (gnus-configure-frame): Protect against trying to restore | ||
| 67 | window configurations containing buffers that are now dead. | ||
| 68 | |||
| 69 | * nnimap.el (nnimap-parse-flags): Remove all MODSEQ entries before | ||
| 70 | parsing to avoid integer overflows. | ||
| 71 | (nnimap-parse-flags): Simplify the last change. | ||
| 72 | (nnimap-parse-flags): Store HIGHESTMODSEQ as a string, since it may be | ||
| 73 | too large for 32-bit Emacsen. | ||
| 74 | |||
| 75 | 2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 76 | |||
| 77 | * auth-source.el (auth-source-netrc-create): | ||
| 78 | * message.el (message-yank-original): Fix use of `case'. | ||
| 79 | |||
| 80 | 2011-03-15 Nelson Ferreira <nelson.ferreira@ieee.org> (tiny change) | ||
| 81 | |||
| 82 | * gnus-art.el (gnus-article-treat-body-boundary): Fix boundary width on | ||
| 83 | XEmacs, which was one character too wide. | ||
| 84 | |||
| 85 | 2011-03-09 Antoine Levitt <antoine.levitt@gmail.com> | ||
| 86 | |||
| 87 | * gnus-sum.el (gnus-articles-to-read): Use gnus-large-newsgroup as | ||
| 88 | default number of articles to display. | ||
| 89 | (gnus-articles-to-read): Use pretty names for prompt. | ||
| 90 | |||
| 91 | 2011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 92 | |||
| 93 | * gnus-int.el (gnus-open-server): Ditto. | ||
| 94 | |||
| 95 | * gnus-start.el (gnus-activate-group): Give a backtrace if | ||
| 96 | debug-on-quit is set and the user hits `C-g'. | ||
| 97 | (gnus-read-active-file): Ditto. | ||
| 98 | |||
| 99 | * gnus-group.el (gnus-group-read-ephemeral-group): Ditto. | ||
| 100 | |||
| 101 | 2011-03-15 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 102 | |||
| 103 | * message.el (message-yank-original): Use cond instead of CL case. | ||
| 104 | |||
| 105 | 2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 106 | |||
| 107 | * auth-source.el (auth-source-netrc-create): Use usual format for the | ||
| 108 | default in prompts. | ||
| 109 | |||
| 110 | 2011-03-13 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 111 | |||
| 112 | * auth-source.el (auth-source-netrc-create): Show the default in the | ||
| 113 | prompt when prompting for token creation. | ||
| 114 | |||
| 115 | 2011-03-12 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 116 | |||
| 117 | * auth-source.el (auth-source-format-prompt): Always convert the value | ||
| 118 | to a string to avoid evaluating non-string arguments. | ||
| 119 | (auth-source-netrc-create): Offer default properly, not as initial | ||
| 120 | content in `read-string'. | ||
| 121 | (auth-source-netrc-saver): Use a cache keyed by file name and MD5 hash | ||
| 122 | of line to determine if we've been run before. If so, don't run again, | ||
| 123 | but print a trivial message to indicate the cache was hit instead. | ||
| 124 | |||
| 125 | 2011-03-11 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 126 | |||
| 127 | * gnus-sync.el (gnus-sync-install-hooks, gnus-sync-unload-hook): | ||
| 128 | Don't install `gnus-sync-read' to any hooks by default. It's buggy. | ||
| 129 | The user will have to run `gnus-sync-read' manually and wait for Cloudy | ||
| 130 | Gnus. | ||
| 131 | |||
| 132 | 2011-03-11 Julien Danjou <julien@danjou.info> | ||
| 133 | |||
| 134 | * mm-uu.el (mm-uu-type-alist): Add support for diff starting with "=== | ||
| 135 | modified file". | ||
| 136 | |||
| 137 | 2011-03-09 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 138 | |||
| 139 | * auth-source.el (auth-source-read-char-choice): New function to read a | ||
| 140 | character choice using `dropdown-list', `read-char-choice', or | ||
| 141 | `read-char'. It appends "[a/b/c] " to the prompt if the choices were | ||
| 142 | '(?a ?b ?c). The `dropdown-list' support is disabled for now. Use | ||
| 143 | `eval-when-compile' to load `dropdown-list'. Remove `dropdown-list'. | ||
| 144 | (auth-source-netrc-saver): Use it. | ||
| 145 | (auth-source-pick-first-password): New convenience function. | ||
| 146 | |||
| 147 | 2011-03-08 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 148 | |||
| 149 | * nnimap.el (nnimap-credentials): Keep the :save-function as the third | ||
| 150 | parameter in the credentials. | ||
| 151 | (nnimap-open-connection-1): Use it after a successful login. | ||
| 152 | (nnimap-credentials): Add IMAP-specific user and password prompt. | ||
| 153 | |||
| 154 | * auth-source.el (auth-source-search): Add :require parameter, taking a | ||
| 155 | list. Document it and the :save-function return token. Pass :require | ||
| 156 | down. Change the CREATED message from a warning to a debug statement. | ||
| 157 | (auth-source-search-backends): Pass :require down. | ||
| 158 | (auth-source-netrc-search): Pass :require down. | ||
| 159 | (auth-source-netrc-parse): Use :require, if it's given, as a filter. | ||
| 160 | Change save prompt to indicate all modifications saved here are | ||
| 161 | deletions. | ||
| 162 | (auth-source-netrc-create): Take user login name as default in user | ||
| 163 | prompt. Move all the save functionality to a lexically bound function | ||
| 164 | under the :save-function token in the returned list. Set up clearer | ||
| 165 | default prompts for user, host, port, and secret. | ||
| 166 | (auth-source-netrc-saver): New function, intended to be wrapped for | ||
| 167 | :save-function. | ||
| 168 | |||
| 169 | 2011-03-07 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 170 | |||
| 171 | * shr.el (shr-table-horizontal-line): Change the defaults for the table | ||
| 172 | lines to be spaces instead. | ||
| 173 | |||
| 174 | 2011-03-07 Julien Danjou <julien@danjou.info> | ||
| 175 | |||
| 176 | * sieve-manage.el (sieve-sasl-auth): Create auth-info if not found. | ||
| 177 | (sieve-sasl-auth): Check that auth-source-search did return something, | ||
| 178 | or just return an empty string. | ||
| 179 | |||
| 1 | 2011-03-05 Antoine Levitt <antoine.levitt@gmail.com> | 180 | 2011-03-05 Antoine Levitt <antoine.levitt@gmail.com> |
| 2 | 181 | ||
| 3 | * gnus.el (gnus-interactive): Use read-directory-name. | 182 | * gnus.el (gnus-interactive): Use read-directory-name. |
| @@ -12,6 +191,13 @@ | |||
| 12 | 191 | ||
| 13 | 2011-03-05 Lars Magne Ingebrigtsen <larsi@gnus.org> | 192 | 2011-03-05 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 14 | 193 | ||
| 194 | * gnus-start.el (gnus-group-change-level): Allow putting foreign groups | ||
| 195 | onto the list of killed groups, too. This makes killed nnimap groups, | ||
| 196 | for instance, more reliably not reappear. | ||
| 197 | |||
| 198 | * nnimap.el (nnimap-request-thread): Don't bug out when we can't find | ||
| 199 | the parent. | ||
| 200 | |||
| 15 | * gnus-sum.el (gnus-update-read-articles): Fix typo. | 201 | * gnus-sum.el (gnus-update-read-articles): Fix typo. |
| 16 | 202 | ||
| 17 | * gnus.el (gnus-valid-select-methods): Mark nnimap as a backend that | 203 | * gnus.el (gnus-valid-select-methods): Mark nnimap as a backend that |
| @@ -24,8 +210,8 @@ | |||
| 24 | 210 | ||
| 25 | 2011-03-05 Antoine Levitt <antoine.levitt@gmail.com> | 211 | 2011-03-05 Antoine Levitt <antoine.levitt@gmail.com> |
| 26 | 212 | ||
| 27 | * message.el (message-cite-reply-position, message-cite-style): New | 213 | * message.el (message-cite-reply-position, message-cite-style): |
| 28 | variables. | 214 | New variables. |
| 29 | (message-yank-original): Use the new citation styles. | 215 | (message-yank-original): Use the new citation styles. |
| 30 | 216 | ||
| 31 | 2011-03-04 Daiki Ueno <ueno@unixuser.org> | 217 | 2011-03-04 Daiki Ueno <ueno@unixuser.org> |
| @@ -139,14 +325,14 @@ | |||
| 139 | 325 | ||
| 140 | 2011-02-23 Lars Ingebrigtsen <larsi@gnus.org> | 326 | 2011-02-23 Lars Ingebrigtsen <larsi@gnus.org> |
| 141 | 327 | ||
| 142 | * gnus-start.el (gnus-dribble-read-file): Set | 328 | * gnus-start.el (gnus-dribble-read-file): |
| 143 | buffer-save-without-query, since we always want to save the dribble | 329 | Set buffer-save-without-query, since we always want to save the dribble |
| 144 | file, probably. | 330 | file, probably. |
| 145 | 331 | ||
| 146 | * nnmail.el (nnmail-article-group): Allow a final "" split to work on | 332 | * nnmail.el (nnmail-article-group): Allow a final "" split to work on |
| 147 | nnimap. | 333 | nnimap. |
| 148 | 334 | ||
| 149 | * gnus-sum.el (gnus-user-date-format-alist): Renamed back again from | 335 | * gnus-sum.el (gnus-user-date-format-alist): Rename back again from |
| 150 | -summary- since it's a user-visible variable. | 336 | -summary- since it's a user-visible variable. |
| 151 | 337 | ||
| 152 | * nnimap.el (nnimap-retrieve-group-data-early): Don't do QRESYNC the | 338 | * nnimap.el (nnimap-retrieve-group-data-early): Don't do QRESYNC the |
| @@ -392,8 +578,8 @@ | |||
| 392 | 2011-02-14 Teodor Zlatanov <tzz@lifelogs.com> | 578 | 2011-02-14 Teodor Zlatanov <tzz@lifelogs.com> |
| 393 | 579 | ||
| 394 | * auth-source.el (auth-source-backend-parse-parameters): Don't rely on | 580 | * auth-source.el (auth-source-backend-parse-parameters): Don't rely on |
| 395 | `plist-get' to accept non-list parameters (XEmacs issue). Fix | 581 | `plist-get' to accept non-list parameters (XEmacs issue). |
| 396 | docstring. | 582 | Fix docstring. |
| 397 | (auth-source-secrets-search): Use `delete-dups', `append mapcar', and | 583 | (auth-source-secrets-search): Use `delete-dups', `append mapcar', and |
| 398 | `butlast' instead of `remove-duplicates', `mapcan', and `subseq'. | 584 | `butlast' instead of `remove-duplicates', `mapcan', and `subseq'. |
| 399 | (auth-sources, auth-source-backend-parse, auth-source-secrets-search): | 585 | (auth-sources, auth-source-backend-parse, auth-source-secrets-search): |
| @@ -433,8 +619,8 @@ | |||
| 433 | 619 | ||
| 434 | 2011-02-13 Tassilo Horn <tassilo@member.fsf.org> (tiny change) | 620 | 2011-02-13 Tassilo Horn <tassilo@member.fsf.org> (tiny change) |
| 435 | 621 | ||
| 436 | * nnimap.el (nnimap-request-accept-article, nnimap-process-quirk): Fix | 622 | * nnimap.el (nnimap-request-accept-article, nnimap-process-quirk): |
| 437 | Gcc processing on imap. | 623 | Fix Gcc processing on imap. |
| 438 | 624 | ||
| 439 | 2011-02-10 Stefan Monnier <monnier@iro.umontreal.ca> | 625 | 2011-02-10 Stefan Monnier <monnier@iro.umontreal.ca> |
| 440 | 626 | ||
| @@ -522,8 +708,8 @@ | |||
| 522 | 708 | ||
| 523 | 2011-02-06 Michael Albinus <michael.albinus@gmx.de> | 709 | 2011-02-06 Michael Albinus <michael.albinus@gmx.de> |
| 524 | 710 | ||
| 525 | * auth-source.el (top): Require 'eieio unconditionally. Autoload | 711 | * auth-source.el (top): Require 'eieio unconditionally. |
| 526 | `secrets-get-attributes' instead of `secrets-get-attribute'. | 712 | Autoload `secrets-get-attributes' instead of `secrets-get-attribute'. |
| 527 | (auth-source-secrets-search): Limit search when `max' is greater than | 713 | (auth-source-secrets-search): Limit search when `max' is greater than |
| 528 | number of results. | 714 | number of results. |
| 529 | 715 | ||
| @@ -559,7 +745,7 @@ | |||
| 559 | (auth-source-protocol-defaults, auth-source-user-or-password-imap) | 745 | (auth-source-protocol-defaults, auth-source-user-or-password-imap) |
| 560 | (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh) | 746 | (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh) |
| 561 | (auth-source-user-or-password-sftp) | 747 | (auth-source-user-or-password-sftp) |
| 562 | (auth-source-user-or-password-smtp): Removed. | 748 | (auth-source-user-or-password-smtp): Remove. |
| 563 | (auth-source-user-or-password): Deprecated and modified to be a wrapper | 749 | (auth-source-user-or-password): Deprecated and modified to be a wrapper |
| 564 | around `auth-source-search'. Not tested thoroughly. | 750 | around `auth-source-search'. Not tested thoroughly. |
| 565 | 751 | ||
| @@ -725,16 +911,16 @@ | |||
| 725 | * gnus-group.el (gnus-group-jump-to-group): Allow jumping to groups | 911 | * gnus-group.el (gnus-group-jump-to-group): Allow jumping to groups |
| 726 | that Gnus doesn't know exists again. | 912 | that Gnus doesn't know exists again. |
| 727 | 913 | ||
| 728 | * gnus-art.el (gnus-article-date-lapsed-new-header): Removed. | 914 | * gnus-art.el (gnus-article-date-lapsed-new-header): Remove. |
| 729 | (gnus-treat-date-ut): Ditto. | 915 | (gnus-treat-date-ut): Ditto. |
| 730 | (gnus-article-update-date-header): Renamed. | 916 | (gnus-article-update-date-header): Rename. |
| 731 | (gnus-treat-date-local): Removed. | 917 | (gnus-treat-date-local): Remove. |
| 732 | (gnus-treat-date-english): Removed. | 918 | (gnus-treat-date-english): Remove. |
| 733 | (gnus-treat-date-lapsed): Removed. | 919 | (gnus-treat-date-lapsed): Remove. |
| 734 | (gnus-treat-date-combined-lapsed): Removed. | 920 | (gnus-treat-date-combined-lapsed): Remove. |
| 735 | (gnus-treat-date-original): Removed. | 921 | (gnus-treat-date-original): Remove. |
| 736 | (gnus-treat-date-iso8601): Removed. | 922 | (gnus-treat-date-iso8601): Remove. |
| 737 | (gnus-treat-date-user-defined): Removed. | 923 | (gnus-treat-date-user-defined): Remove. |
| 738 | (gnus-article-date-headers): New variable to control all the date | 924 | (gnus-article-date-headers): New variable to control all the date |
| 739 | header options. | 925 | header options. |
| 740 | (article-date-ut): Rewrite to allow using the new way to format date | 926 | (article-date-ut): Rewrite to allow using the new way to format date |
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 500de10b71c..e0bea324a25 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el | |||
| @@ -54,6 +54,8 @@ | |||
| 54 | (autoload 'secrets-list-collections "secrets") | 54 | (autoload 'secrets-list-collections "secrets") |
| 55 | (autoload 'secrets-search-items "secrets") | 55 | (autoload 'secrets-search-items "secrets") |
| 56 | 56 | ||
| 57 | (autoload 'rfc2104-hash "rfc2104") | ||
| 58 | |||
| 57 | (defvar secrets-enabled) | 59 | (defvar secrets-enabled) |
| 58 | 60 | ||
| 59 | (defgroup auth-source nil | 61 | (defgroup auth-source nil |
| @@ -286,6 +288,28 @@ If the value is not a list, symmetric encryption will be used." | |||
| 286 | msg)) | 288 | msg)) |
| 287 | 289 | ||
| 288 | 290 | ||
| 291 | ;;; (auth-source-read-char-choice "enter choice? " '(?a ?b ?q)) | ||
| 292 | (defun auth-source-read-char-choice (prompt choices) | ||
| 293 | "Read one of CHOICES by `read-char-choice', or `read-char'. | ||
| 294 | `dropdown-list' support is disabled because it doesn't work reliably. | ||
| 295 | Only one of CHOICES will be returned. The PROMPT is augmented | ||
| 296 | with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)." | ||
| 297 | (when choices | ||
| 298 | (let* ((prompt-choices | ||
| 299 | (apply 'concat (loop for c in choices | ||
| 300 | collect (format "%c/" c)))) | ||
| 301 | (prompt-choices (concat "[" (substring prompt-choices 0 -1) "] ")) | ||
| 302 | (full-prompt (concat prompt prompt-choices)) | ||
| 303 | k) | ||
| 304 | |||
| 305 | (while (not (memq k choices)) | ||
| 306 | (setq k (cond | ||
| 307 | ((fboundp 'read-char-choice) | ||
| 308 | (read-char-choice full-prompt choices)) | ||
| 309 | (t (message "%s" full-prompt) | ||
| 310 | (setq k (read-char)))))) | ||
| 311 | k))) | ||
| 312 | |||
| 289 | ;; (auth-source-pick nil :host "any" :port 'imap :user "joe") | 313 | ;; (auth-source-pick nil :host "any" :port 'imap :user "joe") |
| 290 | ;; (auth-source-pick t :host "any" :port 'imap :user "joe") | 314 | ;; (auth-source-pick t :host "any" :port 'imap :user "joe") |
| 291 | ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe") | 315 | ;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe") |
| @@ -393,7 +417,7 @@ parameters." | |||
| 393 | 417 | ||
| 394 | (defun* auth-source-search (&rest spec | 418 | (defun* auth-source-search (&rest spec |
| 395 | &key type max host user port secret | 419 | &key type max host user port secret |
| 396 | create delete | 420 | require create delete |
| 397 | &allow-other-keys) | 421 | &allow-other-keys) |
| 398 | "Search or modify authentication backends according to SPEC. | 422 | "Search or modify authentication backends according to SPEC. |
| 399 | 423 | ||
| @@ -487,6 +511,11 @@ should `catch' the backend-specific error as usual. Some | |||
| 487 | backends (netrc, at least) will prompt the user rather than throw | 511 | backends (netrc, at least) will prompt the user rather than throw |
| 488 | an error. | 512 | an error. |
| 489 | 513 | ||
| 514 | :require (A B C) means that only results that contain those | ||
| 515 | tokens will be returned. Thus for instance requiring :secret | ||
| 516 | will ensure that any results will actually have a :secret | ||
| 517 | property. | ||
| 518 | |||
| 490 | :delete t means to delete any found entries. nil by default. | 519 | :delete t means to delete any found entries. nil by default. |
| 491 | Use `auth-source-delete' in ELisp code instead of calling | 520 | Use `auth-source-delete' in ELisp code instead of calling |
| 492 | `auth-source-search' directly with this parameter. | 521 | `auth-source-search' directly with this parameter. |
| @@ -516,11 +545,17 @@ is a plist with keys :backend :host :port :user, plus any other | |||
| 516 | keys provided by the backend (notably :secret). But note the | 545 | keys provided by the backend (notably :secret). But note the |
| 517 | exception for :max 0, which see above. | 546 | exception for :max 0, which see above. |
| 518 | 547 | ||
| 548 | The token can hold a :save-function key. If you call that, the | ||
| 549 | user will be prompted to save the data to the backend. You can't | ||
| 550 | request that this should happen right after creation, because | ||
| 551 | `auth-source-search' has no way of knowing if the token is | ||
| 552 | actually useful. So the caller must arrange to call this function. | ||
| 553 | |||
| 519 | The token's :secret key can hold a function. In that case you | 554 | The token's :secret key can hold a function. In that case you |
| 520 | must call it to obtain the actual value." | 555 | must call it to obtain the actual value." |
| 521 | (let* ((backends (mapcar 'auth-source-backend-parse auth-sources)) | 556 | (let* ((backends (mapcar 'auth-source-backend-parse auth-sources)) |
| 522 | (max (or max 1)) | 557 | (max (or max 1)) |
| 523 | (ignored-keys '(:create :delete :max)) | 558 | (ignored-keys '(:require :create :delete :max)) |
| 524 | (keys (loop for i below (length spec) by 2 | 559 | (keys (loop for i below (length spec) by 2 |
| 525 | unless (memq (nth i spec) ignored-keys) | 560 | unless (memq (nth i spec) ignored-keys) |
| 526 | collect (nth i spec))) | 561 | collect (nth i spec))) |
| @@ -539,6 +574,10 @@ must call it to obtain the actual value." | |||
| 539 | (or (eq t create) (listp create)) t | 574 | (or (eq t create) (listp create)) t |
| 540 | "Invalid auth-source :create parameter (must be t or a list): %s %s") | 575 | "Invalid auth-source :create parameter (must be t or a list): %s %s") |
| 541 | 576 | ||
| 577 | (assert | ||
| 578 | (listp require) t | ||
| 579 | "Invalid auth-source :require parameter (must be a list): %s") | ||
| 580 | |||
| 542 | (setq filtered-backends (copy-sequence backends)) | 581 | (setq filtered-backends (copy-sequence backends)) |
| 543 | (dolist (backend backends) | 582 | (dolist (backend backends) |
| 544 | (dolist (key keys) | 583 | (dolist (key keys) |
| @@ -562,8 +601,9 @@ must call it to obtain the actual value." | |||
| 562 | spec | 601 | spec |
| 563 | ;; to exit early | 602 | ;; to exit early |
| 564 | max | 603 | max |
| 565 | ;; create and delete | 604 | ;; create is always nil here |
| 566 | nil delete)) | 605 | nil delete |
| 606 | require)) | ||
| 567 | 607 | ||
| 568 | (auth-source-do-debug | 608 | (auth-source-do-debug |
| 569 | "auth-source-search: found %d results (max %d) matching %S" | 609 | "auth-source-search: found %d results (max %d) matching %S" |
| @@ -577,9 +617,9 @@ must call it to obtain the actual value." | |||
| 577 | spec | 617 | spec |
| 578 | ;; to exit early | 618 | ;; to exit early |
| 579 | max | 619 | max |
| 580 | ;; create and delete | 620 | create delete |
| 581 | create delete)) | 621 | require)) |
| 582 | (auth-source-do-warn | 622 | (auth-source-do-debug |
| 583 | "auth-source-search: CREATED %d results (max %d) matching %S" | 623 | "auth-source-search: CREATED %d results (max %d) matching %S" |
| 584 | (length found) max spec)) | 624 | (length found) max spec)) |
| 585 | 625 | ||
| @@ -589,18 +629,19 @@ must call it to obtain the actual value." | |||
| 589 | 629 | ||
| 590 | found)) | 630 | found)) |
| 591 | 631 | ||
| 592 | (defun auth-source-search-backends (backends spec max create delete) | 632 | (defun auth-source-search-backends (backends spec max create delete require) |
| 593 | (let (matches) | 633 | (let (matches) |
| 594 | (dolist (backend backends) | 634 | (dolist (backend backends) |
| 595 | (when (> max (length matches)) ; when we need more matches... | 635 | (when (> max (length matches)) ; when we need more matches... |
| 596 | (let ((bmatches (apply | 636 | (let* ((bmatches (apply |
| 597 | (slot-value backend 'search-function) | 637 | (slot-value backend 'search-function) |
| 598 | :backend backend | 638 | :backend backend |
| 599 | ;; note we're overriding whatever the spec | 639 | ;; note we're overriding whatever the spec |
| 600 | ;; has for :create and :delete | 640 | ;; has for :require, :create, and :delete |
| 601 | :create create | 641 | :require require |
| 602 | :delete delete | 642 | :create create |
| 603 | spec))) | 643 | :delete delete |
| 644 | spec))) | ||
| 604 | (when bmatches | 645 | (when bmatches |
| 605 | (auth-source-do-trivia | 646 | (auth-source-do-trivia |
| 606 | "auth-source-search-backend: got %d (max %d) in %s:%s matching %S" | 647 | "auth-source-search-backend: got %d (max %d) in %s:%s matching %S" |
| @@ -713,7 +754,28 @@ while \(:host t) would find all host entries." | |||
| 713 | (return 'no))) | 754 | (return 'no))) |
| 714 | 'no)))) | 755 | 'no)))) |
| 715 | 756 | ||
| 716 | ;;; Backend specific parsing: netrc/authinfo backend | 757 | ;;; (auth-source-pick-first-password :host "z.lifelogs.com") |
| 758 | ;;; (auth-source-pick-first-password :port "imap") | ||
| 759 | (defun auth-source-pick-first-password (&rest spec) | ||
| 760 | "Pick the first secret found from applying SPEC to `auth-source-search'." | ||
| 761 | (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1)))) | ||
| 762 | (secret (plist-get result :secret))) | ||
| 763 | |||
| 764 | (if (functionp secret) | ||
| 765 | (funcall secret) | ||
| 766 | secret))) | ||
| 767 | |||
| 768 | ;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host"))) | ||
| 769 | (defun auth-source-format-prompt (prompt alist) | ||
| 770 | "Format PROMPT using %x (for any character x) specifiers in ALIST." | ||
| 771 | (dolist (cell alist) | ||
| 772 | (let ((c (nth 0 cell)) | ||
| 773 | (v (nth 1 cell))) | ||
| 774 | (when (and c v) | ||
| 775 | (setq prompt (replace-regexp-in-string (format "%%%c" c) | ||
| 776 | (format "%s" v) | ||
| 777 | prompt))))) | ||
| 778 | prompt) | ||
| 717 | 779 | ||
| 718 | (defun auth-source-ensure-strings (values) | 780 | (defun auth-source-ensure-strings (values) |
| 719 | (unless (listp values) | 781 | (unless (listp values) |
| @@ -724,12 +786,14 @@ while \(:host t) would find all host entries." | |||
| 724 | value)) | 786 | value)) |
| 725 | values)) | 787 | values)) |
| 726 | 788 | ||
| 789 | ;;; Backend specific parsing: netrc/authinfo backend | ||
| 790 | |||
| 727 | (defvar auth-source-netrc-cache nil) | 791 | (defvar auth-source-netrc-cache nil) |
| 728 | 792 | ||
| 729 | ;;; (auth-source-netrc-parse "~/.authinfo.gpg") | 793 | ;;; (auth-source-netrc-parse "~/.authinfo.gpg") |
| 730 | (defun* auth-source-netrc-parse (&rest | 794 | (defun* auth-source-netrc-parse (&rest |
| 731 | spec | 795 | spec |
| 732 | &key file max host user port delete | 796 | &key file max host user port delete require |
| 733 | &allow-other-keys) | 797 | &allow-other-keys) |
| 734 | "Parse FILE and return a list of all entries in the file. | 798 | "Parse FILE and return a list of all entries in the file. |
| 735 | Note that the MAX parameter is used so we can exit the parse early." | 799 | Note that the MAX parameter is used so we can exit the parse early." |
| @@ -828,7 +892,15 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 828 | (or | 892 | (or |
| 829 | (aget alist "port") | 893 | (aget alist "port") |
| 830 | (aget alist "protocol") | 894 | (aget alist "protocol") |
| 831 | t))) | 895 | t)) |
| 896 | (or | ||
| 897 | ;; the required list of keys is nil, or | ||
| 898 | (null require) | ||
| 899 | ;; every element of require is in the normalized list | ||
| 900 | (let ((normalized (nth 0 (auth-source-netrc-normalize | ||
| 901 | (list alist))))) | ||
| 902 | (loop for req in require | ||
| 903 | always (plist-get normalized req))))) | ||
| 832 | (decf max) | 904 | (decf max) |
| 833 | (push (nreverse alist) result) | 905 | (push (nreverse alist) result) |
| 834 | ;; to delete a line, we just comment it out | 906 | ;; to delete a line, we just comment it out |
| @@ -853,7 +925,7 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 853 | (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) | 925 | (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) |
| 854 | 926 | ||
| 855 | ;; ask AFTER we've successfully opened the file | 927 | ;; ask AFTER we've successfully opened the file |
| 856 | (when (y-or-n-p (format "Save file %s? (%d modifications)" | 928 | (when (y-or-n-p (format "Save file %s? (%d deletions)" |
| 857 | file modified)) | 929 | file modified)) |
| 858 | (write-region (point-min) (point-max) file nil 'silent) | 930 | (write-region (point-min) (point-max) file nil 'silent) |
| 859 | (auth-source-do-debug | 931 | (auth-source-do-debug |
| @@ -893,7 +965,7 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 893 | 965 | ||
| 894 | (defun* auth-source-netrc-search (&rest | 966 | (defun* auth-source-netrc-search (&rest |
| 895 | spec | 967 | spec |
| 896 | &key backend create delete | 968 | &key backend require create delete |
| 897 | type max host user port | 969 | type max host user port |
| 898 | &allow-other-keys) | 970 | &allow-other-keys) |
| 899 | "Given a property list SPEC, return search matches from the :backend. | 971 | "Given a property list SPEC, return search matches from the :backend. |
| @@ -905,6 +977,7 @@ See `auth-source-search' for details on SPEC." | |||
| 905 | (let ((results (auth-source-netrc-normalize | 977 | (let ((results (auth-source-netrc-normalize |
| 906 | (auth-source-netrc-parse | 978 | (auth-source-netrc-parse |
| 907 | :max max | 979 | :max max |
| 980 | :require require | ||
| 908 | :delete delete | 981 | :delete delete |
| 909 | :file (oref backend source) | 982 | :file (oref backend source) |
| 910 | :host (or host t) | 983 | :host (or host t) |
| @@ -933,17 +1006,6 @@ See `auth-source-search' for details on SPEC." | |||
| 933 | (nth 0 v) | 1006 | (nth 0 v) |
| 934 | v)) | 1007 | v)) |
| 935 | 1008 | ||
| 936 | ;; (auth-source-format-prompt "test %u %h %p" '((?u "user") (?h "host"))) | ||
| 937 | |||
| 938 | (defun auth-source-format-prompt (prompt alist) | ||
| 939 | "Format PROMPT using %x (for any character x) specifiers in ALIST." | ||
| 940 | (dolist (cell alist) | ||
| 941 | (let ((c (nth 0 cell)) | ||
| 942 | (v (nth 1 cell))) | ||
| 943 | (when (and c v) | ||
| 944 | (setq prompt (replace-regexp-in-string (format "%%%c" c) v prompt))))) | ||
| 945 | prompt) | ||
| 946 | |||
| 947 | ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) | 1009 | ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) |
| 948 | ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) | 1010 | ;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) |
| 949 | 1011 | ||
| @@ -992,12 +1054,12 @@ See `auth-source-search' for details on SPEC." | |||
| 992 | (data (auth-source-netrc-element-or-first data)) | 1054 | (data (auth-source-netrc-element-or-first data)) |
| 993 | ;; this is the default to be offered | 1055 | ;; this is the default to be offered |
| 994 | (given-default (aget auth-source-creation-defaults r)) | 1056 | (given-default (aget auth-source-creation-defaults r)) |
| 995 | ;; the default supplementals are simple: for the user, | 1057 | ;; the default supplementals are simple: |
| 996 | ;; try (user-login-name), otherwise take given-default | 1058 | ;; for the user, try `given-default' and then (user-login-name); |
| 1059 | ;; otherwise take `given-default' | ||
| 997 | (default (cond | 1060 | (default (cond |
| 998 | ;; don't default the user name | 1061 | ((and (not given-default) (eq r 'user)) |
| 999 | ;; ((and (not given-default) (eq r 'user)) | 1062 | (user-login-name)) |
| 1000 | ;; (user-login-name)) | ||
| 1001 | (t given-default))) | 1063 | (t given-default))) |
| 1002 | (printable-defaults (list | 1064 | (printable-defaults (list |
| 1003 | (cons 'user | 1065 | (cons 'user |
| @@ -1020,10 +1082,10 @@ See `auth-source-search' for details on SPEC." | |||
| 1020 | "[any port]")))) | 1082 | "[any port]")))) |
| 1021 | (prompt (or (aget auth-source-creation-prompts r) | 1083 | (prompt (or (aget auth-source-creation-prompts r) |
| 1022 | (case r | 1084 | (case r |
| 1023 | ('secret "%p password for user %u, host %h: ") | 1085 | (secret "%p password for %u@%h: ") |
| 1024 | ('user "%p user name: ") | 1086 | (user "%p user name for %h: ") |
| 1025 | ('host "%p host name for user %u: ") | 1087 | (host "%p host name for user %u: ") |
| 1026 | ('port "%p port for user %u and host %h: ")) | 1088 | (port "%p port for %u@%h: ")) |
| 1027 | (format "Enter %s (%%u@%%h:%%p): " r))) | 1089 | (format "Enter %s (%%u@%%h:%%p): " r))) |
| 1028 | (prompt (auth-source-format-prompt | 1090 | (prompt (auth-source-format-prompt |
| 1029 | prompt | 1091 | prompt |
| @@ -1031,14 +1093,20 @@ See `auth-source-search' for details on SPEC." | |||
| 1031 | (?h ,(aget printable-defaults 'host)) | 1093 | (?h ,(aget printable-defaults 'host)) |
| 1032 | (?p ,(aget printable-defaults 'port)))))) | 1094 | (?p ,(aget printable-defaults 'port)))))) |
| 1033 | 1095 | ||
| 1034 | ;; store the data, prompting for the password if needed | 1096 | ;; Store the data, prompting for the password if needed. |
| 1035 | (setq data | 1097 | (setq data |
| 1036 | (cond | 1098 | (cond |
| 1037 | ((and (null data) (eq r 'secret)) | 1099 | ((and (null data) (eq r 'secret)) |
| 1038 | ;; special case prompt for passwords | 1100 | ;; Special case prompt for passwords. |
| 1039 | (read-passwd prompt)) | 1101 | (read-passwd prompt)) |
| 1040 | ((null data) | 1102 | ((null data) |
| 1041 | (read-string prompt default)) | 1103 | (when default |
| 1104 | (setq prompt | ||
| 1105 | (if (string-match ": *\\'" prompt) | ||
| 1106 | (concat (substring prompt 0 (match-beginning 0)) | ||
| 1107 | " (default " default "): ") | ||
| 1108 | (concat prompt "(default " default ") ")))) | ||
| 1109 | (read-string prompt nil nil default)) | ||
| 1042 | (t (or data default)))) | 1110 | (t (or data default)))) |
| 1043 | 1111 | ||
| 1044 | (when data | 1112 | (when data |
| @@ -1049,7 +1117,7 @@ See `auth-source-search' for details on SPEC." | |||
| 1049 | (lambda () data)) | 1117 | (lambda () data)) |
| 1050 | data)))) | 1118 | data)))) |
| 1051 | 1119 | ||
| 1052 | ;; when r is not an empty string... | 1120 | ;; When r is not an empty string... |
| 1053 | (when (and (stringp data) | 1121 | (when (and (stringp data) |
| 1054 | (< 0 (length data))) | 1122 | (< 0 (length data))) |
| 1055 | ;; this function is not strictly necessary but I think it | 1123 | ;; this function is not strictly necessary but I think it |
| @@ -1062,79 +1130,99 @@ See `auth-source-search' for details on SPEC." | |||
| 1062 | (if (zerop (length add)) "" " ") | 1130 | (if (zerop (length add)) "" " ") |
| 1063 | ;; remap auth-source tokens to netrc | 1131 | ;; remap auth-source tokens to netrc |
| 1064 | (case r | 1132 | (case r |
| 1065 | ('user "login") | 1133 | (user "login") |
| 1066 | ('host "machine") | 1134 | (host "machine") |
| 1067 | ('secret "password") | 1135 | (secret "password") |
| 1068 | ('port "port") ; redundant but clearer | 1136 | (port "port") ; redundant but clearer |
| 1069 | (t (symbol-name r))) | 1137 | (t (symbol-name r))) |
| 1070 | ;; the value will be printed in %S format | 1138 | ;; the value will be printed in %S format |
| 1071 | data)))) | 1139 | data)))) |
| 1072 | (setq add (concat add (funcall printer))))))) | 1140 | (setq add (concat add (funcall printer))))))) |
| 1073 | 1141 | ||
| 1074 | (with-temp-buffer | 1142 | (plist-put |
| 1075 | (when (file-exists-p file) | 1143 | artificial |
| 1076 | (insert-file-contents file)) | 1144 | :save-function |
| 1077 | (when auth-source-gpg-encrypt-to | 1145 | (lexical-let ((file file) |
| 1078 | ;; (see bug#7487) making `epa-file-encrypt-to' local to | 1146 | (add add)) |
| 1079 | ;; this buffer lets epa-file skip the key selection query | 1147 | (lambda () (auth-source-netrc-saver file add)))) |
| 1080 | ;; (see the `local-variable-p' check in | 1148 | |
| 1081 | ;; `epa-file-write-region'). | 1149 | (list artificial))) |
| 1082 | (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) | 1150 | |
| 1083 | (make-local-variable 'epa-file-encrypt-to)) | 1151 | ;;(funcall (plist-get (nth 0 (auth-source-search :host '("nonesuch2") :user "tzz" :port "imap" :create t :max 1)) :save-function)) |
| 1084 | (if (listp auth-source-gpg-encrypt-to) | 1152 | (defun auth-source-netrc-saver (file add) |
| 1085 | (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) | 1153 | "Save a line ADD in FILE, prompting along the way. |
| 1086 | (goto-char (point-max)) | 1154 | Respects `auth-source-save-behavior'. Uses |
| 1087 | 1155 | `auth-source-netrc-cache' to avoid prompting more than once." | |
| 1088 | ;; ask AFTER we've successfully opened the file | 1156 | (let* ((key (format "%s %s" file (rfc2104-hash 'md5 64 16 file add))) |
| 1089 | (let ((prompt (format "Save auth info to file %s? %s: " | 1157 | (cached (assoc key auth-source-netrc-cache))) |
| 1090 | file | 1158 | |
| 1091 | "y/n/N/e/?")) | 1159 | (if cached |
| 1092 | (done (not (eq auth-source-save-behavior 'ask))) | 1160 | (auth-source-do-trivia |
| 1093 | (bufname "*auth-source Help*") | 1161 | "auth-source-netrc-saver: found previous run for key %s, returning" |
| 1094 | k) | 1162 | key) |
| 1095 | (while (not done) | 1163 | (with-temp-buffer |
| 1096 | (message "%s" prompt) | 1164 | (when (file-exists-p file) |
| 1097 | (setq k (read-char)) | 1165 | (insert-file-contents file)) |
| 1098 | (case k | 1166 | (when auth-source-gpg-encrypt-to |
| 1099 | (?y (setq done t)) | 1167 | ;; (see bug#7487) making `epa-file-encrypt-to' local to |
| 1100 | (?? (save-excursion | 1168 | ;; this buffer lets epa-file skip the key selection query |
| 1101 | (with-output-to-temp-buffer bufname | 1169 | ;; (see the `local-variable-p' check in |
| 1102 | (princ | 1170 | ;; `epa-file-write-region'). |
| 1103 | (concat "(y)es, save\n" | 1171 | (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) |
| 1104 | "(n)o but use the info\n" | 1172 | (make-local-variable 'epa-file-encrypt-to)) |
| 1105 | "(N)o and don't ask to save again\n" | 1173 | (if (listp auth-source-gpg-encrypt-to) |
| 1106 | "(e)dit the line\n" | 1174 | (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) |
| 1107 | "(?) for help as you can see.\n")) | 1175 | ;; we want the new data to be found first, so insert at beginning |
| 1108 | (set-buffer standard-output) | 1176 | (goto-char (point-min)) |
| 1109 | (help-mode)))) | 1177 | |
| 1110 | (?n (setq add "" | 1178 | ;; Ask AFTER we've successfully opened the file. |
| 1111 | done t)) | 1179 | (let ((prompt (format "Save auth info to file %s? " file)) |
| 1112 | (?N (setq add "" | 1180 | (done (not (eq auth-source-save-behavior 'ask))) |
| 1113 | done t | 1181 | (bufname "*auth-source Help*") |
| 1114 | auth-source-save-behavior nil)) | 1182 | k) |
| 1115 | (?e (setq add (read-string "Line to add: " add))) | 1183 | (while (not done) |
| 1116 | (t nil))) | 1184 | (setq k (auth-source-read-char-choice prompt '(?y ?n ?N ?e ??))) |
| 1117 | 1185 | (case k | |
| 1118 | (when (get-buffer-window bufname) | 1186 | (?y (setq done t)) |
| 1119 | (delete-window (get-buffer-window bufname))) | 1187 | (?? (save-excursion |
| 1120 | 1188 | (with-output-to-temp-buffer bufname | |
| 1121 | ;; make sure the info is not saved | 1189 | (princ |
| 1122 | (when (null auth-source-save-behavior) | 1190 | (concat "(y)es, save\n" |
| 1123 | (setq add "")) | 1191 | "(n)o but use the info\n" |
| 1124 | 1192 | "(N)o and don't ask to save again\n" | |
| 1125 | (when (< 0 (length add)) | 1193 | "(e)dit the line\n" |
| 1126 | (progn | 1194 | "(?) for help as you can see.\n")) |
| 1127 | (unless (bolp) | 1195 | ;; Why? Doesn't with-output-to-temp-buffer already do |
| 1128 | (insert "\n")) | 1196 | ;; the exact same thing anyway? --Stef |
| 1129 | (insert add "\n") | 1197 | (set-buffer standard-output) |
| 1130 | (write-region (point-min) (point-max) file nil 'silent) | 1198 | (help-mode)))) |
| 1131 | (auth-source-do-warn | 1199 | (?n (setq add "" |
| 1132 | "auth-source-netrc-create: wrote 1 new line to %s" | 1200 | done t)) |
| 1133 | file) | 1201 | (?N (setq add "" |
| 1134 | nil)) | 1202 | done t |
| 1135 | 1203 | auth-source-save-behavior nil)) | |
| 1136 | (when (eq done t) | 1204 | (?e (setq add (read-string "Line to add: " add))) |
| 1137 | (list artificial)))))) | 1205 | (t nil))) |
| 1206 | |||
| 1207 | (when (get-buffer-window bufname) | ||
| 1208 | (delete-window (get-buffer-window bufname))) | ||
| 1209 | |||
| 1210 | ;; Make sure the info is not saved. | ||
| 1211 | (when (null auth-source-save-behavior) | ||
| 1212 | (setq add "")) | ||
| 1213 | |||
| 1214 | (when (< 0 (length add)) | ||
| 1215 | (progn | ||
| 1216 | (unless (bolp) | ||
| 1217 | (insert "\n")) | ||
| 1218 | (insert add "\n") | ||
| 1219 | (write-region (point-min) (point-max) file nil 'silent) | ||
| 1220 | (auth-source-do-debug | ||
| 1221 | "auth-source-netrc-create: wrote 1 new line to %s" | ||
| 1222 | file) | ||
| 1223 | (message "Saved new authentication information to %s" file) | ||
| 1224 | nil)))) | ||
| 1225 | (aput 'auth-source-netrc-cache key "ran")))) | ||
| 1138 | 1226 | ||
| 1139 | ;;; Backend specific parsing: Secrets API backend | 1227 | ;;; Backend specific parsing: Secrets API backend |
| 1140 | 1228 | ||
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c64138b43d7..7c7e0531926 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -44,6 +44,7 @@ | |||
| 44 | (require 'wid-edit) | 44 | (require 'wid-edit) |
| 45 | (require 'mm-uu) | 45 | (require 'mm-uu) |
| 46 | (require 'message) | 46 | (require 'message) |
| 47 | (require 'mouse) | ||
| 47 | 48 | ||
| 48 | (autoload 'gnus-msg-mail "gnus-msg" nil t) | 49 | (autoload 'gnus-msg-mail "gnus-msg" nil t) |
| 49 | (autoload 'gnus-button-mailto "gnus-msg") | 50 | (autoload 'gnus-button-mailto "gnus-msg") |
| @@ -2337,10 +2338,12 @@ long lines if and only if arg is positive." | |||
| 2337 | (let ((start (point))) | 2338 | (let ((start (point))) |
| 2338 | (insert "X-Boundary: ") | 2339 | (insert "X-Boundary: ") |
| 2339 | (gnus-add-text-properties start (point) '(invisible t intangible t)) | 2340 | (gnus-add-text-properties start (point) '(invisible t intangible t)) |
| 2340 | (insert (let (str) | 2341 | (insert (let (str (max (window-width))) |
| 2341 | (while (>= (window-width) (length str)) | 2342 | (if (featurep 'xemacs) |
| 2343 | (setq max (1- max))) | ||
| 2344 | (while (>= max (length str)) | ||
| 2342 | (setq str (concat str gnus-body-boundary-delimiter))) | 2345 | (setq str (concat str gnus-body-boundary-delimiter))) |
| 2343 | (substring str 0 (window-width))) | 2346 | (substring str 0 max)) |
| 2344 | "\n") | 2347 | "\n") |
| 2345 | (gnus-put-text-property start (point) 'gnus-decoration 'header))))) | 2348 | (gnus-put-text-property start (point) 'gnus-decoration 'header))))) |
| 2346 | 2349 | ||
| @@ -3074,10 +3077,7 @@ images if any to the browser, and deletes them when exiting the group | |||
| 3074 | The `gnus-list-identifiers' variable specifies what to do." | 3077 | The `gnus-list-identifiers' variable specifies what to do." |
| 3075 | (interactive) | 3078 | (interactive) |
| 3076 | (let ((inhibit-point-motion-hooks t) | 3079 | (let ((inhibit-point-motion-hooks t) |
| 3077 | (regexp (or (gnus-parameter-list-identifier gnus-newsgroup-name) | 3080 | (regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) |
| 3078 | (if (consp gnus-list-identifiers) | ||
| 3079 | (mapconcat 'identity gnus-list-identifiers " *\\|") | ||
| 3080 | gnus-list-identifiers))) | ||
| 3081 | (inhibit-read-only t)) | 3081 | (inhibit-read-only t)) |
| 3082 | (when regexp | 3082 | (when regexp |
| 3083 | (save-excursion | 3083 | (save-excursion |
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 9ed3cf02a49..c265538e19c 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el | |||
| @@ -697,7 +697,8 @@ simple manner.") | |||
| 697 | "M" gnus-group-list-all-matching | 697 | "M" gnus-group-list-all-matching |
| 698 | "l" gnus-group-list-level | 698 | "l" gnus-group-list-level |
| 699 | "c" gnus-group-list-cached | 699 | "c" gnus-group-list-cached |
| 700 | "?" gnus-group-list-dormant) | 700 | "?" gnus-group-list-dormant |
| 701 | "!" gnus-group-list-ticked) | ||
| 701 | 702 | ||
| 702 | (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) | 703 | (gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map) |
| 703 | "k" gnus-group-list-limit | 704 | "k" gnus-group-list-limit |
| @@ -849,7 +850,8 @@ simple manner.") | |||
| 849 | ["List all groups matching..." gnus-group-list-all-matching t] | 850 | ["List all groups matching..." gnus-group-list-all-matching t] |
| 850 | ["List active file" gnus-group-list-active t] | 851 | ["List active file" gnus-group-list-active t] |
| 851 | ["List groups with cached" gnus-group-list-cached t] | 852 | ["List groups with cached" gnus-group-list-cached t] |
| 852 | ["List groups with dormant" gnus-group-list-dormant t]) | 853 | ["List groups with dormant" gnus-group-list-dormant t] |
| 854 | ["List groups with ticked" gnus-group-list-ticked t]) | ||
| 853 | ("Sort" | 855 | ("Sort" |
| 854 | ["Default sort" gnus-group-sort-groups t] | 856 | ["Default sort" gnus-group-sort-groups t] |
| 855 | ["Sort by method" gnus-group-sort-groups-by-method t] | 857 | ["Sort by method" gnus-group-sort-groups-by-method t] |
| @@ -2313,9 +2315,10 @@ Return the name of the group if selection was successful." | |||
| 2313 | gnus-fetch-old-ephemeral-headers)) | 2315 | gnus-fetch-old-ephemeral-headers)) |
| 2314 | (gnus-group-read-group (or number t) t group select-articles)) | 2316 | (gnus-group-read-group (or number t) t group select-articles)) |
| 2315 | group) | 2317 | group) |
| 2316 | ;;(error nil) | ||
| 2317 | (quit | 2318 | (quit |
| 2318 | (message "Quit reading the ephemeral group") | 2319 | (if debug-on-quit |
| 2320 | (debug "Quit") | ||
| 2321 | (message "Quit reading the ephemeral group")) | ||
| 2319 | nil))))) | 2322 | nil))))) |
| 2320 | 2323 | ||
| 2321 | (defcustom gnus-gmane-group-download-format | 2324 | (defcustom gnus-gmane-group-download-format |
| @@ -4535,6 +4538,28 @@ This command may read the active file." | |||
| 4535 | (goto-char (point-min)) | 4538 | (goto-char (point-min)) |
| 4536 | (gnus-group-position-point)) | 4539 | (gnus-group-position-point)) |
| 4537 | 4540 | ||
| 4541 | (defun gnus-group-list-ticked (level &optional lowest) | ||
| 4542 | "List all groups with ticked articles. | ||
| 4543 | If the prefix LEVEL is non-nil, it should be a number that says which | ||
| 4544 | level to cut off listing groups. | ||
| 4545 | If LOWEST, don't list groups with level lower than LOWEST. | ||
| 4546 | |||
| 4547 | This command may read the active file." | ||
| 4548 | (interactive "P") | ||
| 4549 | (when level | ||
| 4550 | (setq level (prefix-numeric-value level))) | ||
| 4551 | (when (or (not level) (>= level gnus-level-zombie)) | ||
| 4552 | (gnus-cache-open)) | ||
| 4553 | (funcall gnus-group-prepare-function | ||
| 4554 | (or level gnus-level-subscribed) | ||
| 4555 | #'(lambda (info) | ||
| 4556 | (let ((marks (gnus-info-marks info))) | ||
| 4557 | (assq 'tick marks))) | ||
| 4558 | lowest | ||
| 4559 | 'ignore) | ||
| 4560 | (goto-char (point-min)) | ||
| 4561 | (gnus-group-position-point)) | ||
| 4562 | |||
| 4538 | (defun gnus-group-listed-groups () | 4563 | (defun gnus-group-listed-groups () |
| 4539 | "Return a list of listed groups." | 4564 | "Return a list of listed groups." |
| 4540 | (let (point groups) | 4565 | (let (point groups) |
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index a67063bb970..ef15a479892 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el | |||
| @@ -270,7 +270,9 @@ If it is down, start it up (again)." | |||
| 270 | server (error-message-string err)) | 270 | server (error-message-string err)) |
| 271 | nil) | 271 | nil) |
| 272 | (quit | 272 | (quit |
| 273 | (gnus-message 1 "Quit trying to open server %s" server) | 273 | (if debug-on-quit |
| 274 | (debug "Quit") | ||
| 275 | (gnus-message 1 "Quit trying to open server %s" server)) | ||
| 274 | nil))) | 276 | nil))) |
| 275 | open-offline) | 277 | open-offline) |
| 276 | ;; If this hasn't been opened before, we add it to the list. | 278 | ;; If this hasn't been opened before, we add it to the list. |
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index ebfa53f841e..afded87fe37 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el | |||
| @@ -1306,16 +1306,13 @@ for new groups, and subscribe the new groups as zombies." | |||
| 1306 | ((>= level gnus-level-zombie) | 1306 | ((>= level gnus-level-zombie) |
| 1307 | ;; Remove from the hash table. | 1307 | ;; Remove from the hash table. |
| 1308 | (gnus-sethash group nil gnus-newsrc-hashtb) | 1308 | (gnus-sethash group nil gnus-newsrc-hashtb) |
| 1309 | ;; We do not enter foreign groups into the list of dead | 1309 | (if (= level gnus-level-zombie) |
| 1310 | ;; groups. | 1310 | (push group gnus-zombie-list) |
| 1311 | (unless (gnus-group-foreign-p group) | 1311 | (if (= oldlevel gnus-level-killed) |
| 1312 | (if (= level gnus-level-zombie) | 1312 | ;; Remove from active hashtb. |
| 1313 | (push group gnus-zombie-list) | 1313 | (unintern group gnus-active-hashtb) |
| 1314 | (if (= oldlevel gnus-level-killed) | 1314 | ;; Don't add it into killed-list if it was killed. |
| 1315 | ;; Remove from active hashtb. | 1315 | (push group gnus-killed-list)))) |
| 1316 | (unintern group gnus-active-hashtb) | ||
| 1317 | ;; Don't add it into killed-list if it was killed. | ||
| 1318 | (push group gnus-killed-list))))) | ||
| 1319 | (t | 1316 | (t |
| 1320 | ;; If the list is to be entered into the newsrc assoc, and | 1317 | ;; If the list is to be entered into the newsrc assoc, and |
| 1321 | ;; it was killed, we have to create an entry in the newsrc | 1318 | ;; it was killed, we have to create an entry in the newsrc |
| @@ -1465,9 +1462,10 @@ If SCAN, request a scan of that group as well." | |||
| 1465 | (inline (gnus-request-group group (or dont-sub-check dont-check) | 1462 | (inline (gnus-request-group group (or dont-sub-check dont-check) |
| 1466 | method | 1463 | method |
| 1467 | (gnus-get-info group))) | 1464 | (gnus-get-info group))) |
| 1468 | ;;(error nil) | ||
| 1469 | (quit | 1465 | (quit |
| 1470 | (message "Quit activating %s" group) | 1466 | (if debug-on-quit |
| 1467 | (debug "Quit") | ||
| 1468 | (message "Quit activating %s" group)) | ||
| 1471 | nil))) | 1469 | nil))) |
| 1472 | (unless dont-check | 1470 | (unless dont-check |
| 1473 | (setq active (gnus-parse-active)) | 1471 | (setq active (gnus-parse-active)) |
| @@ -2007,7 +2005,9 @@ If SCAN, request a scan of that group as well." | |||
| 2007 | ;; We catch C-g so that we can continue past servers | 2005 | ;; We catch C-g so that we can continue past servers |
| 2008 | ;; that do not respond. | 2006 | ;; that do not respond. |
| 2009 | (quit | 2007 | (quit |
| 2010 | (message "Quit reading the active file") | 2008 | (if debug-on-quit |
| 2009 | (debug "Quit") | ||
| 2010 | (message "Quit reading the active file")) | ||
| 2011 | nil)))))))) | 2011 | nil)))))))) |
| 2012 | 2012 | ||
| 2013 | (defun gnus-read-active-file-1 (method force) | 2013 | (defun gnus-read-active-file-1 (method force) |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index a8786e39c7b..29a98b7d11d 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -5510,12 +5510,17 @@ or a straight list of headers." | |||
| 5510 | (cdr (assq number gnus-newsgroup-scored)) | 5510 | (cdr (assq number gnus-newsgroup-scored)) |
| 5511 | (memq number gnus-newsgroup-processable)))))) | 5511 | (memq number gnus-newsgroup-processable)))))) |
| 5512 | 5512 | ||
| 5513 | (defun gnus-group-get-list-identifiers (group) | ||
| 5514 | "Get list identifier regexp for GROUP." | ||
| 5515 | (or (gnus-parameter-list-identifier group) | ||
| 5516 | (if (consp gnus-list-identifiers) | ||
| 5517 | (mapconcat 'identity gnus-list-identifiers " *\\|") | ||
| 5518 | gnus-list-identifiers))) | ||
| 5519 | |||
| 5513 | (defun gnus-summary-remove-list-identifiers () | 5520 | (defun gnus-summary-remove-list-identifiers () |
| 5514 | "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." | 5521 | "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." |
| 5515 | (let ((regexp (if (consp gnus-list-identifiers) | 5522 | (let ((regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) |
| 5516 | (mapconcat 'identity gnus-list-identifiers " *\\|") | 5523 | changed subject) |
| 5517 | gnus-list-identifiers)) | ||
| 5518 | changed subject) | ||
| 5519 | (when regexp | 5524 | (when regexp |
| 5520 | (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)")) | 5525 | (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)")) |
| 5521 | (dolist (header gnus-newsgroup-headers) | 5526 | (dolist (header gnus-newsgroup-headers) |
| @@ -5707,8 +5712,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 5707 | (when gnus-agent | 5712 | (when gnus-agent |
| 5708 | (gnus-agent-get-undownloaded-list)) | 5713 | (gnus-agent-get-undownloaded-list)) |
| 5709 | ;; Remove list identifiers from subject | 5714 | ;; Remove list identifiers from subject |
| 5710 | (when gnus-list-identifiers | 5715 | (gnus-summary-remove-list-identifiers) |
| 5711 | (gnus-summary-remove-list-identifiers)) | ||
| 5712 | ;; Check whether auto-expire is to be done in this group. | 5716 | ;; Check whether auto-expire is to be done in this group. |
| 5713 | (setq gnus-newsgroup-auto-expire | 5717 | (setq gnus-newsgroup-auto-expire |
| 5714 | (gnus-group-auto-expirable-p group)) | 5718 | (gnus-group-auto-expirable-p group)) |
| @@ -5798,7 +5802,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 5798 | 5802 | ||
| 5799 | (defun gnus-articles-to-read (group &optional read-all) | 5803 | (defun gnus-articles-to-read (group &optional read-all) |
| 5800 | "Find out what articles the user wants to read." | 5804 | "Find out what articles the user wants to read." |
| 5801 | (let* ((articles | 5805 | (let* ((only-read-p t) |
| 5806 | (articles | ||
| 5802 | ;; Select all articles if `read-all' is non-nil, or if there | 5807 | ;; Select all articles if `read-all' is non-nil, or if there |
| 5803 | ;; are no unread articles. | 5808 | ;; are no unread articles. |
| 5804 | (if (or read-all | 5809 | (if (or read-all |
| @@ -5822,6 +5827,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 5822 | (gnus-uncompress-range (gnus-active group))) | 5827 | (gnus-uncompress-range (gnus-active group))) |
| 5823 | (gnus-cache-articles-in-group group)) | 5828 | (gnus-cache-articles-in-group group)) |
| 5824 | ;; Select only the "normal" subset of articles. | 5829 | ;; Select only the "normal" subset of articles. |
| 5830 | (setq only-read-p nil) | ||
| 5825 | (gnus-sorted-nunion | 5831 | (gnus-sorted-nunion |
| 5826 | (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked) | 5832 | (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked) |
| 5827 | gnus-newsgroup-unreads))) | 5833 | gnus-newsgroup-unreads))) |
| @@ -5845,16 +5851,25 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 5845 | (let* ((cursor-in-echo-area nil) | 5851 | (let* ((cursor-in-echo-area nil) |
| 5846 | (initial (gnus-parameter-large-newsgroup-initial | 5852 | (initial (gnus-parameter-large-newsgroup-initial |
| 5847 | gnus-newsgroup-name)) | 5853 | gnus-newsgroup-name)) |
| 5854 | (default (if only-read-p | ||
| 5855 | (or initial gnus-large-newsgroup) | ||
| 5856 | number)) | ||
| 5848 | (input | 5857 | (input |
| 5849 | (read-string | 5858 | (read-string |
| 5850 | (format | 5859 | (if only-read-p |
| 5851 | "How many articles from %s (%s %d): " | 5860 | (format |
| 5852 | (gnus-group-decoded-name gnus-newsgroup-name) | 5861 | "How many articles from %s (available %d, default %d): " |
| 5853 | (if initial "max" "default") | 5862 | (gnus-group-decoded-name |
| 5854 | number) | 5863 | (gnus-group-real-name gnus-newsgroup-name)) |
| 5855 | (if initial | 5864 | number default) |
| 5856 | (cons (number-to-string initial) | 5865 | (format |
| 5857 | 0))))) | 5866 | "How many articles from %s (%d available): " |
| 5867 | (gnus-group-decoded-name | ||
| 5868 | (gnus-group-real-name gnus-newsgroup-name)) | ||
| 5869 | default)) | ||
| 5870 | nil | ||
| 5871 | nil | ||
| 5872 | (number-to-string default)))) | ||
| 5858 | (if (string-match "^[ \t]*$" input) number input))) | 5873 | (if (string-match "^[ \t]*$" input) number input))) |
| 5859 | ((and (> scored marked) (< scored number) | 5874 | ((and (> scored marked) (< scored number) |
| 5860 | (> (- scored number) 20)) | 5875 | (> (- scored number) 20)) |
| @@ -5862,7 +5877,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." | |||
| 5862 | (read-string | 5877 | (read-string |
| 5863 | (format "%s %s (%d scored, %d total): " | 5878 | (format "%s %s (%d scored, %d total): " |
| 5864 | "How many articles from" | 5879 | "How many articles from" |
| 5865 | (gnus-group-decoded-name group) | 5880 | (gnus-group-decoded-name |
| 5881 | (gnus-group-real-name gnus-newsgroup-name)) | ||
| 5866 | scored number)))) | 5882 | scored number)))) |
| 5867 | (if (string-match "^[ \t]*$" input) | 5883 | (if (string-match "^[ \t]*$" input) |
| 5868 | number input))) | 5884 | number input))) |
| @@ -6564,9 +6580,8 @@ the subject line on." | |||
| 6564 | (1+ (point-at-eol)) | 6580 | (1+ (point-at-eol)) |
| 6565 | (gnus-delete-line)))))) | 6581 | (gnus-delete-line)))))) |
| 6566 | ;; Remove list identifiers from subject. | 6582 | ;; Remove list identifiers from subject. |
| 6567 | (when gnus-list-identifiers | 6583 | (let ((gnus-newsgroup-headers (list header))) |
| 6568 | (let ((gnus-newsgroup-headers (list header))) | 6584 | (gnus-summary-remove-list-identifiers)) |
| 6569 | (gnus-summary-remove-list-identifiers))) | ||
| 6570 | (when old-header | 6585 | (when old-header |
| 6571 | (mail-header-set-number header (mail-header-number old-header))) | 6586 | (mail-header-set-number header (mail-header-number old-header))) |
| 6572 | (setq gnus-newsgroup-sparse | 6587 | (setq gnus-newsgroup-sparse |
| @@ -12670,8 +12685,7 @@ returned." | |||
| 12670 | (when gnus-agent | 12685 | (when gnus-agent |
| 12671 | (gnus-agent-get-undownloaded-list)) | 12686 | (gnus-agent-get-undownloaded-list)) |
| 12672 | ;; Remove list identifiers from subject | 12687 | ;; Remove list identifiers from subject |
| 12673 | (when gnus-list-identifiers | 12688 | (gnus-summary-remove-list-identifiers) |
| 12674 | (gnus-summary-remove-list-identifiers)) | ||
| 12675 | ;; First and last article in this newsgroup. | 12689 | ;; First and last article in this newsgroup. |
| 12676 | (when gnus-newsgroup-headers | 12690 | (when gnus-newsgroup-headers |
| 12677 | (setq gnus-newsgroup-begin | 12691 | (setq gnus-newsgroup-begin |
diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el index 892b10a0d0e..fbdacdd2fbe 100644 --- a/lisp/gnus/gnus-sync.el +++ b/lisp/gnus/gnus-sync.el | |||
| @@ -25,7 +25,8 @@ | |||
| 25 | ;; This is the gnus-sync.el package. | 25 | ;; This is the gnus-sync.el package. |
| 26 | 26 | ||
| 27 | ;; It's due for a rewrite using gnus-after-set-mark-hook and | 27 | ;; It's due for a rewrite using gnus-after-set-mark-hook and |
| 28 | ;; gnus-before-update-mark-hook. Until then please consider it | 28 | ;; gnus-before-update-mark-hook, and my plan is to do this once No |
| 29 | ;; Gnus development is done. Until then please consider it | ||
| 29 | ;; experimental. | 30 | ;; experimental. |
| 30 | 31 | ||
| 31 | ;; Put this in your startup file (~/.gnus.el for instance) | 32 | ;; Put this in your startup file (~/.gnus.el for instance) |
| @@ -42,7 +43,8 @@ | |||
| 42 | 43 | ||
| 43 | ;; TODO: | 44 | ;; TODO: |
| 44 | 45 | ||
| 45 | ;; - after gnus-sync-read, the message counts are wrong | 46 | ;; - after gnus-sync-read, the message counts are wrong. So it's not |
| 47 | ;; run automatically, you have to call it with M-x gnus-sync-read | ||
| 46 | 48 | ||
| 47 | ;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to | 49 | ;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to |
| 48 | ;; catch the mark updates | 50 | ;; catch the mark updates |
| @@ -220,13 +222,13 @@ synchronized, I believe). Also see `gnus-variable-list'." | |||
| 220 | "Install the sync hooks." | 222 | "Install the sync hooks." |
| 221 | (interactive) | 223 | (interactive) |
| 222 | ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read) | 224 | ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read) |
| 223 | (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save) | 225 | ;; (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read) |
| 224 | (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) | 226 | (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save)) |
| 225 | 227 | ||
| 226 | (defun gnus-sync-unload-hook () | 228 | (defun gnus-sync-unload-hook () |
| 227 | "Uninstall the sync hooks." | 229 | "Uninstall the sync hooks." |
| 228 | (interactive) | 230 | (interactive) |
| 229 | ;; (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read) | 231 | (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read) |
| 230 | (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save) | 232 | (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save) |
| 231 | (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) | 233 | (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) |
| 232 | 234 | ||
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 42dbd5948cf..3f66b45aaab 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el | |||
| @@ -672,11 +672,9 @@ If N, return the Nth ancestor instead." | |||
| 672 | (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references) | 672 | (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references) |
| 673 | (match-string 1 references)))))) | 673 | (match-string 1 references)))))) |
| 674 | 674 | ||
| 675 | (defun gnus-buffer-live-p (buffer) | 675 | (defsubst gnus-buffer-live-p (buffer) |
| 676 | "Say whether BUFFER is alive or not." | 676 | "Say whether BUFFER is alive or not." |
| 677 | (and buffer | 677 | (and buffer (buffer-live-p (get-buffer buffer)))) |
| 678 | (get-buffer buffer) | ||
| 679 | (buffer-name (get-buffer buffer)))) | ||
| 680 | 678 | ||
| 681 | (defun gnus-horizontal-recenter () | 679 | (defun gnus-horizontal-recenter () |
| 682 | "Recenter the current buffer horizontally." | 680 | "Recenter the current buffer horizontally." |
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 156f9a020fd..c38f57d96cb 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el | |||
| @@ -268,8 +268,10 @@ See the Gnus manual for an explanation of the syntax used.") | |||
| 268 | (error "Invalid buffer type: %s" type)) | 268 | (error "Invalid buffer type: %s" type)) |
| 269 | (let ((buf (gnus-get-buffer-create | 269 | (let ((buf (gnus-get-buffer-create |
| 270 | (gnus-window-to-buffer-helper buffer)))) | 270 | (gnus-window-to-buffer-helper buffer)))) |
| 271 | (if (eq buf (window-buffer (selected-window))) (set-buffer buf) | 271 | (when (buffer-name buf) |
| 272 | (switch-to-buffer buf))) | 272 | (if (eq buf (window-buffer (selected-window))) |
| 273 | (set-buffer buf) | ||
| 274 | (switch-to-buffer buf)))) | ||
| 273 | (when (memq 'frame-focus split) | 275 | (when (memq 'frame-focus split) |
| 274 | (setq gnus-window-frame-focus window)) | 276 | (setq gnus-window-frame-focus window)) |
| 275 | ;; We return the window if it has the `point' spec. | 277 | ;; We return the window if it has the `point' spec. |
diff --git a/lisp/gnus/gravatar.el b/lisp/gnus/gravatar.el index 0c97080d847..4b0c9a16283 100644 --- a/lisp/gnus/gravatar.el +++ b/lisp/gnus/gravatar.el | |||
| @@ -129,8 +129,10 @@ You can provide a list of argument to pass to CB in CBARGS." | |||
| 129 | "Retrieve MAIL-ADDRESS gravatar and returns it." | 129 | "Retrieve MAIL-ADDRESS gravatar and returns it." |
| 130 | (let ((url (gravatar-build-url mail-address))) | 130 | (let ((url (gravatar-build-url mail-address))) |
| 131 | (if (gravatar-cache-expired url) | 131 | (if (gravatar-cache-expired url) |
| 132 | (with-current-buffer (url-retrieve-synchronously url) | 132 | (with-current-buffer (if (featurep 'xemacs) |
| 133 | (when gravatar-automatic-caching | 133 | (url-retrieve url) |
| 134 | (url-retrieve-synchronously url)) | ||
| 135 | (when gravatar-automatic-caching | ||
| 134 | (url-store-in-cache (current-buffer))) | 136 | (url-store-in-cache (current-buffer))) |
| 135 | (let ((data (gravatar-data->image))) | 137 | (let ((data (gravatar-data->image))) |
| 136 | (kill-buffer (current-buffer)) | 138 | (kill-buffer (current-buffer)) |
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el new file mode 100644 index 00000000000..3765fb84ee8 --- /dev/null +++ b/lisp/gnus/gssapi.el | |||
| @@ -0,0 +1,105 @@ | |||
| 1 | ;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs | ||
| 2 | |||
| 3 | ;; Copyright (C) 2011 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Simon Josefsson <simon@josefsson.org> | ||
| 6 | ;; Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 7 | ;; Keywords: network | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 14 | ;; (at your option) any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 23 | |||
| 24 | ;;; Commentary: | ||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | |||
| 28 | (require 'format-spec) | ||
| 29 | |||
| 30 | (defcustom gssapi-program (list | ||
| 31 | (concat "gsasl %s %p " | ||
| 32 | "--mechanism GSSAPI " | ||
| 33 | "--authentication-id %l") | ||
| 34 | "imtest -m gssapi -u %l -p %p %s") | ||
| 35 | "List of strings containing commands for GSSAPI (krb5) authentication. | ||
| 36 | %s is replaced with server hostname, %p with port to connect to, and | ||
| 37 | %l with the value of `imap-default-user'. The program should accept | ||
| 38 | IMAP commands on stdin and return responses to stdout. Each entry in | ||
| 39 | the list is tried until a successful connection is made." | ||
| 40 | :group 'network | ||
| 41 | :type '(repeat string)) | ||
| 42 | |||
| 43 | (defun open-gssapi-stream (name buffer server port) | ||
| 44 | (let ((cmds gssapi-program) | ||
| 45 | cmd done) | ||
| 46 | (with-current-buffer buffer | ||
| 47 | (while (and (not done) | ||
| 48 | (setq cmd (pop cmds))) | ||
| 49 | (message "Opening GSSAPI connection with `%s'..." cmd) | ||
| 50 | (erase-buffer) | ||
| 51 | (let* ((coding-system-for-read 'binary) | ||
| 52 | (coding-system-for-write 'binary) | ||
| 53 | (process (start-process | ||
| 54 | name buffer shell-file-name shell-command-switch | ||
| 55 | (format-spec | ||
| 56 | cmd | ||
| 57 | (format-spec-make | ||
| 58 | ?s server | ||
| 59 | ?p (number-to-string port) | ||
| 60 | ?l imap-default-user)))) | ||
| 61 | response) | ||
| 62 | (when process | ||
| 63 | (while (and (memq (process-status process) '(open run)) | ||
| 64 | (goto-char (point-min)) | ||
| 65 | ;; Athena IMTEST can output SSL verify errors | ||
| 66 | (or (while (looking-at "^verify error:num=") | ||
| 67 | (forward-line)) | ||
| 68 | t) | ||
| 69 | (or (while (looking-at "^TLS connection established") | ||
| 70 | (forward-line)) | ||
| 71 | t) | ||
| 72 | ;; cyrus 1.6.x (13? < x <= 22) queries capabilities | ||
| 73 | (or (while (looking-at "^C:") | ||
| 74 | (forward-line)) | ||
| 75 | t) | ||
| 76 | ;; cyrus 1.6 imtest print "S: " before server greeting | ||
| 77 | (or (not (looking-at "S: ")) | ||
| 78 | (forward-char 3) | ||
| 79 | t) | ||
| 80 | ;; GNU SASL may print 'Trying ...' first. | ||
| 81 | (or (not (looking-at "Trying ")) | ||
| 82 | (forward-line) | ||
| 83 | t) | ||
| 84 | (not (and (looking-at "\\* \\(OK\\|PREAUTH\\|BYE\\) ") | ||
| 85 | ;; success in imtest 1.6: | ||
| 86 | (re-search-forward | ||
| 87 | (concat "^\\(\\(Authenticat.*\\)\\|\\(" | ||
| 88 | "Client authentication " | ||
| 89 | "finished.*\\)\\)") | ||
| 90 | nil t) | ||
| 91 | (setq response (match-string 1))))) | ||
| 92 | (accept-process-output process 1) | ||
| 93 | (sit-for 1)) | ||
| 94 | (erase-buffer) | ||
| 95 | (message "GSSAPI IMAP connection: %s" (or response "failed")) | ||
| 96 | (if (and response (let ((case-fold-search nil)) | ||
| 97 | (not (string-match "failed" response)))) | ||
| 98 | (setq done process) | ||
| 99 | (delete-process process) | ||
| 100 | nil)))) | ||
| 101 | done))) | ||
| 102 | |||
| 103 | (provide 'gssapi) | ||
| 104 | |||
| 105 | ;;; gssapi.el ends here | ||
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 08c59b00bfc..bb9215aca7c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -49,6 +49,7 @@ | |||
| 49 | (require 'mail-parse) | 49 | (require 'mail-parse) |
| 50 | (require 'mml) | 50 | (require 'mml) |
| 51 | (require 'rfc822) | 51 | (require 'rfc822) |
| 52 | (require 'format-spec) | ||
| 52 | 53 | ||
| 53 | (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ | 54 | (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ |
| 54 | 55 | ||
| @@ -438,7 +439,10 @@ whitespace)." | |||
| 438 | :group 'message-various) | 439 | :group 'message-various) |
| 439 | 440 | ||
| 440 | (defcustom message-elide-ellipsis "\n[...]\n\n" | 441 | (defcustom message-elide-ellipsis "\n[...]\n\n" |
| 441 | "*The string which is inserted for elided text." | 442 | "*The string which is inserted for elided text. |
| 443 | This is a format-spec string, and you can use %l to say how many | ||
| 444 | lines were removed, and %c to say how many characters were | ||
| 445 | removed." | ||
| 442 | :type 'string | 446 | :type 'string |
| 443 | :link '(custom-manual "(message)Various Commands") | 447 | :link '(custom-manual "(message)Various Commands") |
| 444 | :group 'message-various) | 448 | :group 'message-various) |
| @@ -3535,8 +3539,12 @@ Note that this should not be used in newsgroups." | |||
| 3535 | An ellipsis (from `message-elide-ellipsis') will be inserted where the | 3539 | An ellipsis (from `message-elide-ellipsis') will be inserted where the |
| 3536 | text was killed." | 3540 | text was killed." |
| 3537 | (interactive "r") | 3541 | (interactive "r") |
| 3538 | (kill-region b e) | 3542 | (let ((lines (count-lines b e)) |
| 3539 | (insert message-elide-ellipsis)) | 3543 | (chars (- e b))) |
| 3544 | (kill-region b e) | ||
| 3545 | (insert (format-spec message-elide-ellipsis | ||
| 3546 | `((?l . ,lines) | ||
| 3547 | (?c . ,chars)))))) | ||
| 3540 | 3548 | ||
| 3541 | (defvar message-caesar-translation-table nil) | 3549 | (defvar message-caesar-translation-table nil) |
| 3542 | 3550 | ||
| @@ -3749,12 +3757,12 @@ prefix, and don't delete any headers." | |||
| 3749 | (insert-before-markers ?\n) | 3757 | (insert-before-markers ?\n) |
| 3750 | (goto-char pt)))) | 3758 | (goto-char pt)))) |
| 3751 | (case message-cite-reply-position | 3759 | (case message-cite-reply-position |
| 3752 | ('above | 3760 | (above |
| 3753 | (message-goto-body) | 3761 | (message-goto-body) |
| 3754 | (insert body-text) | 3762 | (insert body-text) |
| 3755 | (insert (if (bolp) "\n" "\n\n")) | 3763 | (insert (if (bolp) "\n" "\n\n")) |
| 3756 | (message-goto-body)) | 3764 | (message-goto-body)) |
| 3757 | ('below | 3765 | (below |
| 3758 | (message-goto-signature))) | 3766 | (message-goto-signature))) |
| 3759 | ;; Add a `message-setup-very-last-hook' here? | 3767 | ;; Add a `message-setup-very-last-hook' here? |
| 3760 | ;; Add `gnus-article-highlight-citation' here? | 3768 | ;; Add `gnus-article-highlight-citation' here? |
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 14b44198303..4f7b5ed26b3 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el | |||
| @@ -158,6 +158,12 @@ This can be either \"inline\" or \"attachment\".") | |||
| 158 | mm-uu-diff-extract | 158 | mm-uu-diff-extract |
| 159 | nil | 159 | nil |
| 160 | mm-uu-diff-test) | 160 | mm-uu-diff-test) |
| 161 | (diff | ||
| 162 | "^=== modified file " | ||
| 163 | nil | ||
| 164 | mm-uu-diff-extract | ||
| 165 | nil | ||
| 166 | mm-uu-diff-test) | ||
| 161 | (git-format-patch | 167 | (git-format-patch |
| 162 | "^diff --git " | 168 | "^diff --git " |
| 163 | "^-- " | 169 | "^-- " |
| @@ -699,6 +705,8 @@ Assume text has been decoded if DECODED is non-nil." | |||
| 699 | ;; Mutt still uses application/pgp even though | 705 | ;; Mutt still uses application/pgp even though |
| 700 | ;; it has already been withdrawn. | 706 | ;; it has already been withdrawn. |
| 701 | (string-match "\\`text/\\|\\`application/pgp\\'" type) | 707 | (string-match "\\`text/\\|\\`application/pgp\\'" type) |
| 708 | (equal (car (mm-handle-disposition handle)) | ||
| 709 | "inline") | ||
| 702 | (setq | 710 | (setq |
| 703 | children | 711 | children |
| 704 | (with-current-buffer buffer | 712 | (with-current-buffer buffer |
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index aa4ecbc3b0f..bcbe7b678d5 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el | |||
| @@ -279,16 +279,21 @@ textual parts.") | |||
| 279 | (current-buffer))) | 279 | (current-buffer))) |
| 280 | 280 | ||
| 281 | (defun nnimap-credentials (address ports) | 281 | (defun nnimap-credentials (address ports) |
| 282 | (let ((found (nth 0 (auth-source-search :max 1 | 282 | (let* ((auth-source-creation-prompts |
| 283 | :host address | 283 | '((user . "IMAP user at %h: ") |
| 284 | :port ports | 284 | (secret . "IMAP password for %u@%h: "))) |
| 285 | :create t)))) | 285 | (found (nth 0 (auth-source-search :max 1 |
| 286 | :host address | ||
| 287 | :port ports | ||
| 288 | :require '(:user :secret) | ||
| 289 | :create t)))) | ||
| 286 | (if found | 290 | (if found |
| 287 | (list (plist-get found :user) | 291 | (list (plist-get found :user) |
| 288 | (let ((secret (plist-get found :secret))) | 292 | (let ((secret (plist-get found :secret))) |
| 289 | (if (functionp secret) | 293 | (if (functionp secret) |
| 290 | (funcall secret) | 294 | (funcall secret) |
| 291 | secret))) | 295 | secret)) |
| 296 | (plist-get found :save-function)) | ||
| 292 | nil))) | 297 | nil))) |
| 293 | 298 | ||
| 294 | (defun nnimap-keepalive () | 299 | (defun nnimap-keepalive () |
| @@ -335,6 +340,7 @@ textual parts.") | |||
| 335 | (ports | 340 | (ports |
| 336 | (cond | 341 | (cond |
| 337 | ((or (eq nnimap-stream 'network) | 342 | ((or (eq nnimap-stream 'network) |
| 343 | (eq nnimap-stream 'network-only) | ||
| 338 | (eq nnimap-stream 'starttls)) | 344 | (eq nnimap-stream 'starttls)) |
| 339 | (nnheader-message 7 "Opening connection to %s..." | 345 | (nnheader-message 7 "Opening connection to %s..." |
| 340 | nnimap-address) | 346 | nnimap-address) |
| @@ -396,7 +402,12 @@ textual parts.") | |||
| 396 | (let ((nnimap-inhibit-logging t)) | 402 | (let ((nnimap-inhibit-logging t)) |
| 397 | (setq login-result | 403 | (setq login-result |
| 398 | (nnimap-login (car credentials) (cadr credentials)))) | 404 | (nnimap-login (car credentials) (cadr credentials)))) |
| 399 | (unless (car login-result) | 405 | (if (car login-result) |
| 406 | ;; save the credentials if a save function exists | ||
| 407 | ;; (such a function will only be passed if a new | ||
| 408 | ;; token was created) | ||
| 409 | (when (functionp (nth 2 credentials)) | ||
| 410 | (funcall (nth 2 credentials))) | ||
| 400 | ;; If the login failed, then forget the credentials | 411 | ;; If the login failed, then forget the credentials |
| 401 | ;; that are now possibly cached. | 412 | ;; that are now possibly cached. |
| 402 | (dolist (host (list (nnoo-current-server 'nnimap) | 413 | (dolist (host (list (nnoo-current-server 'nnimap) |
| @@ -1442,6 +1453,11 @@ textual parts.") | |||
| 1442 | ;; Change \Delete etc to %Delete, so that the reader can read it. | 1453 | ;; Change \Delete etc to %Delete, so that the reader can read it. |
| 1443 | (subst-char-in-region (point-min) (point-max) | 1454 | (subst-char-in-region (point-min) (point-max) |
| 1444 | ?\\ ?% t) | 1455 | ?\\ ?% t) |
| 1456 | ;; Remove any MODSEQ entries in the buffer, because they may contain | ||
| 1457 | ;; numbers that are too large for 32-bit Emacsen. | ||
| 1458 | (while (re-search-forward " MODSEQ ([0-9]+)" nil t) | ||
| 1459 | (replace-match "" t t)) | ||
| 1460 | (goto-char (point-min)) | ||
| 1445 | (let (start end articles groups uidnext elems permanent-flags | 1461 | (let (start end articles groups uidnext elems permanent-flags |
| 1446 | uidvalidity vanished highestmodseq) | 1462 | uidvalidity vanished highestmodseq) |
| 1447 | (dolist (elem sequences) | 1463 | (dolist (elem sequences) |
| @@ -1481,9 +1497,9 @@ textual parts.") | |||
| 1481 | (match-string 1))) | 1497 | (match-string 1))) |
| 1482 | (goto-char start) | 1498 | (goto-char start) |
| 1483 | (setq highestmodseq | 1499 | (setq highestmodseq |
| 1484 | (and (search-forward "HIGHESTMODSEQ " | 1500 | (and (re-search-forward "HIGHESTMODSEQ \\([0-9]+\\)" |
| 1485 | (or end (point-min)) t) | 1501 | (or end (point-min)) t) |
| 1486 | (read (current-buffer)))) | 1502 | (match-string 1))) |
| 1487 | (goto-char end) | 1503 | (goto-char end) |
| 1488 | (forward-line -1)) | 1504 | (forward-line -1)) |
| 1489 | ;; The UID FETCH FLAGS was successful. | 1505 | ;; The UID FETCH FLAGS was successful. |
| @@ -1497,18 +1513,7 @@ textual parts.") | |||
| 1497 | (goto-char end)) | 1513 | (goto-char end)) |
| 1498 | (while (re-search-forward "^\\* [0-9]+ FETCH " start t) | 1514 | (while (re-search-forward "^\\* [0-9]+ FETCH " start t) |
| 1499 | (let ((p (point))) | 1515 | (let ((p (point))) |
| 1500 | ;; FIXME: For FETCH lines like "* 2971 FETCH (FLAGS (%Recent) UID | 1516 | (setq elems (read (current-buffer))) |
| 1501 | ;; 12509 MODSEQ (13419098521433281274))" we get an | ||
| 1502 | ;; overflow-error. The handler simply deletes that large number | ||
| 1503 | ;; and reads again. But maybe there's a better fix... | ||
| 1504 | (setq elems (condition-case nil (read (current-buffer)) | ||
| 1505 | (overflow-error | ||
| 1506 | ;; After an overflow-error, point is just after | ||
| 1507 | ;; the too large number. So delete it and try | ||
| 1508 | ;; again. | ||
| 1509 | (delete-region (point) (progn (backward-word) (point))) | ||
| 1510 | (goto-char p) | ||
| 1511 | (read (current-buffer))))) | ||
| 1512 | (push (cons (cadr (memq 'UID elems)) | 1517 | (push (cons (cadr (memq 'UID elems)) |
| 1513 | (cadr (memq 'FLAGS elems))) | 1518 | (cadr (memq 'FLAGS elems))) |
| 1514 | articles))) | 1519 | articles))) |
| @@ -1545,10 +1550,11 @@ textual parts.") | |||
| 1545 | refid refid value))))) | 1550 | refid refid value))))) |
| 1546 | (result (with-current-buffer (nnimap-buffer) | 1551 | (result (with-current-buffer (nnimap-buffer) |
| 1547 | (nnimap-command "UID SEARCH %s" cmd)))) | 1552 | (nnimap-command "UID SEARCH %s" cmd)))) |
| 1548 | (gnus-fetch-headers | 1553 | (when result |
| 1549 | (and (car result) (delete 0 (mapcar #'string-to-number | 1554 | (gnus-fetch-headers |
| 1550 | (cdr (assoc "SEARCH" (cdr result)))))) | 1555 | (and (car result) (delete 0 (mapcar #'string-to-number |
| 1551 | nil t))) | 1556 | (cdr (assoc "SEARCH" (cdr result)))))) |
| 1557 | nil t)))) | ||
| 1552 | 1558 | ||
| 1553 | (defun nnimap-possibly-change-group (group server) | 1559 | (defun nnimap-possibly-change-group (group server) |
| 1554 | (let ((open-result t)) | 1560 | (let ((open-result t)) |
| @@ -1663,6 +1669,8 @@ textual parts.") | |||
| 1663 | (goto-char (point-max))) | 1669 | (goto-char (point-max))) |
| 1664 | openp) | 1670 | openp) |
| 1665 | (quit | 1671 | (quit |
| 1672 | (when debug-on-quit | ||
| 1673 | (debug "Quit")) | ||
| 1666 | ;; The user hit C-g while we were waiting: kill the process, in case | 1674 | ;; The user hit C-g while we were waiting: kill the process, in case |
| 1667 | ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind | 1675 | ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind |
| 1668 | ;; NAT routers). | 1676 | ;; NAT routers). |
| @@ -1754,11 +1762,15 @@ textual parts.") | |||
| 1754 | (format "(UID %s%s)" | 1762 | (format "(UID %s%s)" |
| 1755 | (format | 1763 | (format |
| 1756 | (if (nnimap-ver4-p) | 1764 | (if (nnimap-ver4-p) |
| 1757 | "BODY.PEEK[HEADER] BODY.PEEK" | 1765 | "BODY.PEEK" |
| 1758 | "RFC822.PEEK")) | 1766 | "RFC822.PEEK")) |
| 1759 | (if nnimap-split-download-body-default | 1767 | (cond |
| 1760 | "[]" | 1768 | (nnimap-split-download-body-default |
| 1761 | "[1]"))) | 1769 | "[]") |
| 1770 | ((nnimap-ver4-p) | ||
| 1771 | "[HEADER]") | ||
| 1772 | (t | ||
| 1773 | "[1]")))) | ||
| 1762 | t)) | 1774 | t)) |
| 1763 | 1775 | ||
| 1764 | (defun nnimap-split-incoming-mail () | 1776 | (defun nnimap-split-incoming-mail () |
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index bb9695ebb72..113137a0046 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el | |||
| @@ -53,17 +53,17 @@ fit these criteria." | |||
| 53 | :group 'shr | 53 | :group 'shr |
| 54 | :type 'regexp) | 54 | :type 'regexp) |
| 55 | 55 | ||
| 56 | (defcustom shr-table-horizontal-line ?- | 56 | (defcustom shr-table-horizontal-line ? |
| 57 | "Character used to draw horizontal table lines." | 57 | "Character used to draw horizontal table lines." |
| 58 | :group 'shr | 58 | :group 'shr |
| 59 | :type 'character) | 59 | :type 'character) |
| 60 | 60 | ||
| 61 | (defcustom shr-table-vertical-line ?| | 61 | (defcustom shr-table-vertical-line ? |
| 62 | "Character used to draw vertical table lines." | 62 | "Character used to draw vertical table lines." |
| 63 | :group 'shr | 63 | :group 'shr |
| 64 | :type 'character) | 64 | :type 'character) |
| 65 | 65 | ||
| 66 | (defcustom shr-table-corner ?+ | 66 | (defcustom shr-table-corner ? |
| 67 | "Character used to draw table corners." | 67 | "Character used to draw table corners." |
| 68 | :group 'shr | 68 | :group 'shr |
| 69 | :type 'character) | 69 | :type 'character) |
| @@ -113,6 +113,15 @@ cid: URL as the argument.") | |||
| 113 | 113 | ||
| 114 | ;; Public functions and commands. | 114 | ;; Public functions and commands. |
| 115 | 115 | ||
| 116 | (defun shr-visit-file (file) | ||
| 117 | (interactive "fHTML file name: ") | ||
| 118 | (pop-to-buffer "*html*") | ||
| 119 | (erase-buffer) | ||
| 120 | (shr-insert-document | ||
| 121 | (with-temp-buffer | ||
| 122 | (insert-file-contents file) | ||
| 123 | (libxml-parse-html-region (point-min) (point-max))))) | ||
| 124 | |||
| 116 | ;;;###autoload | 125 | ;;;###autoload |
| 117 | (defun shr-insert-document (dom) | 126 | (defun shr-insert-document (dom) |
| 118 | (setq shr-content-cache nil) | 127 | (setq shr-content-cache nil) |
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index c9a0df20590..5c2e775a211 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el | |||
| @@ -275,9 +275,10 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") | |||
| 275 | (with-current-buffer buffer | 275 | (with-current-buffer buffer |
| 276 | (let* ((auth-info (auth-source-search :host sieve-manage-server | 276 | (let* ((auth-info (auth-source-search :host sieve-manage-server |
| 277 | :port "sieve" | 277 | :port "sieve" |
| 278 | :max 1)) | 278 | :max 1 |
| 279 | (user-name (plist-get (nth 0 auth-info) :user)) | 279 | :create t)) |
| 280 | (user-password (plist-get (nth 0 auth-info) :secret)) | 280 | (user-name (or (plist-get (nth 0 auth-info) :user) "")) |
| 281 | (user-password (or (plist-get (nth 0 auth-info) :secret) "")) | ||
| 281 | (user-password (if (functionp user-password) | 282 | (user-password (if (functionp user-password) |
| 282 | (funcall user-password) | 283 | (funcall user-password) |
| 283 | user-password)) | 284 | user-password)) |
diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 8209cdebd3c..392e894965c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el | |||
| @@ -575,6 +575,7 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound." | |||
| 575 | (with-syntax-table emacs-lisp-mode-syntax-table | 575 | (with-syntax-table emacs-lisp-mode-syntax-table |
| 576 | (or (condition-case () | 576 | (or (condition-case () |
| 577 | (save-excursion | 577 | (save-excursion |
| 578 | (skip-chars-forward "'") | ||
| 578 | (or (not (zerop (skip-syntax-backward "_w"))) | 579 | (or (not (zerop (skip-syntax-backward "_w"))) |
| 579 | (eq (char-syntax (following-char)) ?w) | 580 | (eq (char-syntax (following-char)) ?w) |
| 580 | (eq (char-syntax (following-char)) ?_) | 581 | (eq (char-syntax (following-char)) ?_) |
diff --git a/lisp/help.el b/lisp/help.el index 9fcb06c559f..e148e5ef6ab 100644 --- a/lisp/help.el +++ b/lisp/help.el | |||
| @@ -871,7 +871,17 @@ whose documentation describes the minor mode." | |||
| 871 | (let ((start (point))) | 871 | (let ((start (point))) |
| 872 | (insert (format-mode-line mode nil nil buffer)) | 872 | (insert (format-mode-line mode nil nil buffer)) |
| 873 | (add-text-properties start (point) '(face bold))))) | 873 | (add-text-properties start (point) '(face bold))))) |
| 874 | (princ " mode:\n") | 874 | (princ " mode") |
| 875 | (let* ((mode major-mode) | ||
| 876 | (file-name (find-lisp-object-file-name mode nil))) | ||
| 877 | (when file-name | ||
| 878 | (princ (concat " defined in `" (file-name-nondirectory file-name) "'")) | ||
| 879 | ;; Make a hyperlink to the library. | ||
| 880 | (with-current-buffer standard-output | ||
| 881 | (save-excursion | ||
| 882 | (re-search-backward "`\\([^`']+\\)'" nil t) | ||
| 883 | (help-xref-button 1 'help-function-def mode file-name))))) | ||
| 884 | (princ ":\n") | ||
| 875 | (princ (documentation major-mode))))) | 885 | (princ (documentation major-mode))))) |
| 876 | ;; For the sake of IELM and maybe others | 886 | ;; For the sake of IELM and maybe others |
| 877 | nil) | 887 | nil) |
diff --git a/lisp/ido.el b/lisp/ido.el index 2e67e367a8f..2a5c7cf2f0e 100644 --- a/lisp/ido.el +++ b/lisp/ido.el | |||
| @@ -1983,7 +1983,7 @@ If INITIAL is non-nil, it specifies the initial input string." | |||
| 1983 | (setq ido-exit nil) | 1983 | (setq ido-exit nil) |
| 1984 | (setq ido-final-text | 1984 | (setq ido-final-text |
| 1985 | (catch 'ido | 1985 | (catch 'ido |
| 1986 | (completing-read | 1986 | (completing-read-default |
| 1987 | (ido-make-prompt item prompt) | 1987 | (ido-make-prompt item prompt) |
| 1988 | '(("dummy" . 1)) nil nil ; table predicate require-match | 1988 | '(("dummy" . 1)) nil nil ; table predicate require-match |
| 1989 | (prog1 ido-text-init (setq ido-text-init nil)) ;initial-contents | 1989 | (prog1 ido-text-init (setq ido-text-init nil)) ;initial-contents |
| @@ -4740,13 +4740,13 @@ See `read-directory-name' for additional parameters." | |||
| 4740 | (concat ido-current-directory filename))))) | 4740 | (concat ido-current-directory filename))))) |
| 4741 | 4741 | ||
| 4742 | ;;;###autoload | 4742 | ;;;###autoload |
| 4743 | (defun ido-completing-read (prompt choices &optional predicate require-match initial-input hist def) | 4743 | (defun ido-completing-read (prompt choices &optional predicate require-match initial-input hist def inherit-input-method) |
| 4744 | "Ido replacement for the built-in `completing-read'. | 4744 | "Ido replacement for the built-in `completing-read'. |
| 4745 | Read a string in the minibuffer with ido-style completion. | 4745 | Read a string in the minibuffer with ido-style completion. |
| 4746 | PROMPT is a string to prompt with; normally it ends in a colon and a space. | 4746 | PROMPT is a string to prompt with; normally it ends in a colon and a space. |
| 4747 | CHOICES is a list of strings which are the possible completions. | 4747 | CHOICES is a list of strings which are the possible completions. |
| 4748 | PREDICATE is currently ignored; it is included to be compatible | 4748 | PREDICATE and INHERIT-INPUT-METHOD is currently ignored; it is included |
| 4749 | with `completing-read'. | 4749 | to be compatible with `completing-read'. |
| 4750 | If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless | 4750 | If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless |
| 4751 | the input is (or completes to) an element of CHOICES or is null. | 4751 | the input is (or completes to) an element of CHOICES or is null. |
| 4752 | If the input is null, `ido-completing-read' returns DEF, or an empty | 4752 | If the input is null, `ido-completing-read' returns DEF, or an empty |
diff --git a/lisp/info.el b/lisp/info.el index bc2062e72b2..fb753659737 100644 --- a/lisp/info.el +++ b/lisp/info.el | |||
| @@ -594,15 +594,15 @@ in `Info-file-supports-index-cookies-list'." | |||
| 594 | (defun info-initialize () | 594 | (defun info-initialize () |
| 595 | "Initialize `Info-directory-list', if that hasn't been done yet." | 595 | "Initialize `Info-directory-list', if that hasn't been done yet." |
| 596 | (unless Info-directory-list | 596 | (unless Info-directory-list |
| 597 | (let ((path (getenv "INFOPATH"))) | 597 | (let ((path (getenv "INFOPATH")) |
| 598 | (sep (regexp-quote path-separator))) | ||
| 598 | (setq Info-directory-list | 599 | (setq Info-directory-list |
| 599 | (prune-directory-list | 600 | (prune-directory-list |
| 600 | (if path | 601 | (if path |
| 601 | (if (string-match ":\\'" path) | 602 | (if (string-match-p (concat sep "\\'") path) |
| 602 | (append (split-string (substring path 0 -1) | 603 | (append (split-string (substring path 0 -1) sep) |
| 603 | (regexp-quote path-separator)) | ||
| 604 | (Info-default-dirs)) | 604 | (Info-default-dirs)) |
| 605 | (split-string path (regexp-quote path-separator))) | 605 | (split-string path sep)) |
| 606 | (Info-default-dirs))))))) | 606 | (Info-default-dirs))))))) |
| 607 | 607 | ||
| 608 | ;;;###autoload | 608 | ;;;###autoload |
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 9a892f493d7..200aadda651 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el | |||
| @@ -2306,11 +2306,11 @@ change; nil means current message." | |||
| 2306 | ;;;; *** Rmail Message Selection And Support *** | 2306 | ;;;; *** Rmail Message Selection And Support *** |
| 2307 | 2307 | ||
| 2308 | (defun rmail-msgend (n) | 2308 | (defun rmail-msgend (n) |
| 2309 | "Return the start position for message number N." | 2309 | "Return the end position for message number N." |
| 2310 | (marker-position (aref rmail-message-vector (1+ n)))) | 2310 | (marker-position (aref rmail-message-vector (1+ n)))) |
| 2311 | 2311 | ||
| 2312 | (defun rmail-msgbeg (n) | 2312 | (defun rmail-msgbeg (n) |
| 2313 | "Return the end position for message number N." | 2313 | "Return the start position for message number N." |
| 2314 | (marker-position (aref rmail-message-vector n))) | 2314 | (marker-position (aref rmail-message-vector n))) |
| 2315 | 2315 | ||
| 2316 | (defun rmail-apply-in-message (msgnum function &rest args) | 2316 | (defun rmail-apply-in-message (msgnum function &rest args) |
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 531a0e26eaf..4a2deb6b3bf 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el | |||
| @@ -698,7 +698,15 @@ scroll the window of possible completions." | |||
| 698 | (when last | 698 | (when last |
| 699 | (setcdr last nil) | 699 | (setcdr last nil) |
| 700 | ;; Prefer shorter completions. | 700 | ;; Prefer shorter completions. |
| 701 | (setq all (sort all (lambda (c1 c2) (< (length c1) (length c2))))) | 701 | (setq all (sort all (lambda (c1 c2) |
| 702 | (let ((s1 (get-text-property | ||
| 703 | 0 :completion-cycle-penalty c1)) | ||
| 704 | (s2 (get-text-property | ||
| 705 | 0 :completion-cycle-penalty c2))) | ||
| 706 | (if (eq s1 s2) | ||
| 707 | (< (length c1) (length c2)) | ||
| 708 | (< (or s1 (length c1)) | ||
| 709 | (or s2 (length c2)))))))) | ||
| 702 | ;; Prefer recently used completions. | 710 | ;; Prefer recently used completions. |
| 703 | (let ((hist (symbol-value minibuffer-history-variable))) | 711 | (let ((hist (symbol-value minibuffer-history-variable))) |
| 704 | (setq all (sort all (lambda (c1 c2) | 712 | (setq all (sort all (lambda (c1 c2) |
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 3ccad277ffb..2caf8dec30f 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el | |||
| @@ -36,6 +36,8 @@ | |||
| 36 | (require 'custom) | 36 | (require 'custom) |
| 37 | (eval-when-compile (require 'cl)) | 37 | (eval-when-compile (require 'cl)) |
| 38 | 38 | ||
| 39 | (autoload 'auth-source-search "auth-source") | ||
| 40 | |||
| 39 | (defgroup ldap nil | 41 | (defgroup ldap nil |
| 40 | "Lightweight Directory Access Protocol." | 42 | "Lightweight Directory Access Protocol." |
| 41 | :version "21.1" | 43 | :version "21.1" |
| @@ -480,6 +482,22 @@ Additional search parameters can be specified through | |||
| 480 | "Perform a search on a LDAP server. | 482 | "Perform a search on a LDAP server. |
| 481 | SEARCH-PLIST is a property list describing the search request. | 483 | SEARCH-PLIST is a property list describing the search request. |
| 482 | Valid keys in that list are: | 484 | Valid keys in that list are: |
| 485 | |||
| 486 | `auth-source', if non-nil, will use `auth-source-search' and | ||
| 487 | will grab the :host, :secret, :base, and (:user or :binddn) | ||
| 488 | tokens into the `host', `passwd', `base', and `binddn' parameters | ||
| 489 | respectively if they are not provided in SEARCH-PLIST. So for | ||
| 490 | instance *each* of these netrc lines has the same effect if you | ||
| 491 | ask for the host \"ldapserver:2400\": | ||
| 492 | |||
| 493 | machine ldapserver:2400 login myDN secret myPassword base myBase | ||
| 494 | machine ldapserver:2400 binddn myDN secret myPassword port ldap | ||
| 495 | login myDN secret myPassword base myBase | ||
| 496 | |||
| 497 | but if you have more than one in your netrc file, only the first | ||
| 498 | matching one will be used. Note the \"port ldap\" part is NOT | ||
| 499 | required. | ||
| 500 | |||
| 483 | `host' is a string naming one or more (blank-separated) LDAP servers to | 501 | `host' is a string naming one or more (blank-separated) LDAP servers to |
| 484 | to try to connect to. Each host name may optionally be of the form HOST:PORT. | 502 | to try to connect to. Each host name may optionally be of the form HOST:PORT. |
| 485 | `filter' is a filter string for the search as described in RFC 1558. | 503 | `filter' is a filter string for the search as described in RFC 1558. |
| @@ -500,19 +518,34 @@ not their associated values. | |||
| 500 | its distinguished name DN. | 518 | its distinguished name DN. |
| 501 | The function returns a list of matching entries. Each entry is itself | 519 | The function returns a list of matching entries. Each entry is itself |
| 502 | an alist of attribute/value pairs." | 520 | an alist of attribute/value pairs." |
| 503 | (let ((buf (get-buffer-create " *ldap-search*")) | 521 | (let* ((buf (get-buffer-create " *ldap-search*")) |
| 504 | (bufval (get-buffer-create " *ldap-value*")) | 522 | (bufval (get-buffer-create " *ldap-value*")) |
| 505 | (host (or (plist-get search-plist 'host) | 523 | (host (or (plist-get search-plist 'host) |
| 506 | ldap-default-host)) | 524 | ldap-default-host)) |
| 525 | ;; find entries with port "ldap" that match the requested host if any | ||
| 526 | (asfound (when (plist-get search-plist 'auth-source) | ||
| 527 | (nth 0 (auth-source-search :host (or host t) | ||
| 528 | :create t)))) | ||
| 529 | ;; if no host was requested, get it from the auth-source entry | ||
| 530 | (host (or host (plist-get asfound :host))) | ||
| 531 | ;; get the password from the auth-source | ||
| 532 | (passwd (or (plist-get search-plist 'passwd) | ||
| 533 | (plist-get asfound :secret))) | ||
| 534 | ;; convert the password from a function call if needed | ||
| 535 | (passwd (if (functionp passwd) (funcall passwd) passwd)) | ||
| 536 | ;; get the binddn from the search-list or from the | ||
| 537 | ;; auth-source user or binddn tokens | ||
| 538 | (binddn (or (plist-get search-plist 'binddn) | ||
| 539 | (plist-get asfound :user) | ||
| 540 | (plist-get asfound :binddn))) | ||
| 541 | (base (or (plist-get search-plist 'base) | ||
| 542 | (plist-get asfound :base) | ||
| 543 | ldap-default-base)) | ||
| 507 | (filter (plist-get search-plist 'filter)) | 544 | (filter (plist-get search-plist 'filter)) |
| 508 | (attributes (plist-get search-plist 'attributes)) | 545 | (attributes (plist-get search-plist 'attributes)) |
| 509 | (attrsonly (plist-get search-plist 'attrsonly)) | 546 | (attrsonly (plist-get search-plist 'attrsonly)) |
| 510 | (base (or (plist-get search-plist 'base) | ||
| 511 | ldap-default-base)) | ||
| 512 | (scope (plist-get search-plist 'scope)) | 547 | (scope (plist-get search-plist 'scope)) |
| 513 | (binddn (plist-get search-plist 'binddn)) | ||
| 514 | (auth (plist-get search-plist 'auth)) | 548 | (auth (plist-get search-plist 'auth)) |
| 515 | (passwd (plist-get search-plist 'passwd)) | ||
| 516 | (deref (plist-get search-plist 'deref)) | 549 | (deref (plist-get search-plist 'deref)) |
| 517 | (timelimit (plist-get search-plist 'timelimit)) | 550 | (timelimit (plist-get search-plist 'timelimit)) |
| 518 | (sizelimit (plist-get search-plist 'sizelimit)) | 551 | (sizelimit (plist-get search-plist 'sizelimit)) |
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index 4045a443640..c3da1707165 100644 --- a/lisp/net/quickurl.el +++ b/lisp/net/quickurl.el | |||
| @@ -511,15 +511,15 @@ TYPE dictates what will be inserted, options are: | |||
| 511 | (with-current-buffer quickurl-list-last-buffer | 511 | (with-current-buffer quickurl-list-last-buffer |
| 512 | (insert | 512 | (insert |
| 513 | (case type | 513 | (case type |
| 514 | ('url (funcall quickurl-format-function url)) | 514 | (url (funcall quickurl-format-function url)) |
| 515 | ('naked-url (quickurl-url-url url)) | 515 | (naked-url (quickurl-url-url url)) |
| 516 | ('with-lookup (format "%s <URL:%s>" | 516 | (with-lookup (format "%s <URL:%s>" |
| 517 | (quickurl-url-keyword url) | 517 | (quickurl-url-keyword url) |
| 518 | (quickurl-url-url url))) | 518 | (quickurl-url-url url))) |
| 519 | ('with-desc (format "%S <URL:%s>" | 519 | (with-desc (format "%S <URL:%s>" |
| 520 | (quickurl-url-description url) | 520 | (quickurl-url-description url) |
| 521 | (quickurl-url-url url))) | 521 | (quickurl-url-url url))) |
| 522 | ('lookup (quickurl-url-keyword url))))) | 522 | (lookup (quickurl-url-keyword url))))) |
| 523 | (error "No URL details on that line")) | 523 | (error "No URL details on that line")) |
| 524 | url)) | 524 | url)) |
| 525 | 525 | ||
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 1e3ee91092d..71aa0dd22bc 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el | |||
| @@ -548,7 +548,7 @@ If ARG is non-nil, instead prompt for connection parameters." | |||
| 548 | (add-hook 'auto-save-hook 'rcirc-log-write) | 548 | (add-hook 'auto-save-hook 'rcirc-log-write) |
| 549 | 549 | ||
| 550 | ;; identify | 550 | ;; identify |
| 551 | (when password | 551 | (unless (zerop (length password)) |
| 552 | (rcirc-send-string process (concat "PASS " password))) | 552 | (rcirc-send-string process (concat "PASS " password))) |
| 553 | (rcirc-send-string process (concat "NICK " nick)) | 553 | (rcirc-send-string process (concat "NICK " nick)) |
| 554 | (rcirc-send-string process (concat "USER " user-name | 554 | (rcirc-send-string process (concat "USER " user-name |
| @@ -2449,8 +2449,7 @@ keywords when no KEYWORD is given." | |||
| 2449 | (if rcirc-auto-authenticate-flag | 2449 | (if rcirc-auto-authenticate-flag |
| 2450 | (if rcirc-authenticate-before-join | 2450 | (if rcirc-authenticate-before-join |
| 2451 | (progn | 2451 | (progn |
| 2452 | (with-rcirc-process-buffer process | 2452 | (add-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t t) |
| 2453 | (add-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t t)) | ||
| 2454 | (rcirc-authenticate)) | 2453 | (rcirc-authenticate)) |
| 2455 | (rcirc-authenticate) | 2454 | (rcirc-authenticate) |
| 2456 | (rcirc-join-channels process rcirc-startup-channels)) | 2455 | (rcirc-join-channels process rcirc-startup-channels)) |
| @@ -2515,7 +2514,7 @@ the only argument." | |||
| 2515 | (and ;; quakenet | 2514 | (and ;; quakenet |
| 2516 | (string= sender "Q") | 2515 | (string= sender "Q") |
| 2517 | (string= target rcirc-nick) | 2516 | (string= target rcirc-nick) |
| 2518 | (string-match message "\\`You are now logged in as .+\\.\\'"))) | 2517 | (string-match "\\`You are now logged in as .+\\.\\'" message))) |
| 2519 | (setq rcirc-user-authenticated t) | 2518 | (setq rcirc-user-authenticated t) |
| 2520 | (run-hook-with-args 'rcirc-authenticated-hook process) | 2519 | (run-hook-with-args 'rcirc-authenticated-hook process) |
| 2521 | (remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t)))))) | 2520 | (remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t)))))) |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 63a4c19eccf..ec5c46b2897 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -90,7 +90,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 90 | (tramp-login-args (("%h") ("-l" "%u"))) | 90 | (tramp-login-args (("%h") ("-l" "%u"))) |
| 91 | (tramp-remote-sh "/bin/sh") | 91 | (tramp-remote-sh "/bin/sh") |
| 92 | (tramp-copy-program "rcp") | 92 | (tramp-copy-program "rcp") |
| 93 | (tramp-copy-args (("%k" "-p") ("-r"))) | 93 | (tramp-copy-args (("-p" "%k") ("-r"))) |
| 94 | (tramp-copy-keep-date t) | 94 | (tramp-copy-keep-date t) |
| 95 | (tramp-copy-recursive t))) | 95 | (tramp-copy-recursive t))) |
| 96 | ;;;###tramp-autoload | 96 | ;;;###tramp-autoload |
| @@ -100,7 +100,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 100 | (tramp-login-args (("%h") ("-l" "%u"))) | 100 | (tramp-login-args (("%h") ("-l" "%u"))) |
| 101 | (tramp-remote-sh "/bin/sh") | 101 | (tramp-remote-sh "/bin/sh") |
| 102 | (tramp-copy-program "rcp") | 102 | (tramp-copy-program "rcp") |
| 103 | (tramp-copy-args (("%k" "-p"))) | 103 | (tramp-copy-args (("-p" "%k"))) |
| 104 | (tramp-copy-keep-date t))) | 104 | (tramp-copy-keep-date t))) |
| 105 | ;;;###tramp-autoload | 105 | ;;;###tramp-autoload |
| 106 | (add-to-list 'tramp-methods | 106 | (add-to-list 'tramp-methods |
| @@ -110,7 +110,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 110 | (tramp-async-args (("-q"))) | 110 | (tramp-async-args (("-q"))) |
| 111 | (tramp-remote-sh "/bin/sh") | 111 | (tramp-remote-sh "/bin/sh") |
| 112 | (tramp-copy-program "scp") | 112 | (tramp-copy-program "scp") |
| 113 | (tramp-copy-args (("-P" "%p") ("%k" "-p") ("-q") ("-r"))) | 113 | (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r"))) |
| 114 | (tramp-copy-keep-date t) | 114 | (tramp-copy-keep-date t) |
| 115 | (tramp-copy-recursive t) | 115 | (tramp-copy-recursive t) |
| 116 | (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") | 116 | (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") |
| @@ -126,7 +126,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 126 | (tramp-async-args (("-q"))) | 126 | (tramp-async-args (("-q"))) |
| 127 | (tramp-remote-sh "/bin/sh") | 127 | (tramp-remote-sh "/bin/sh") |
| 128 | (tramp-copy-program "scp") | 128 | (tramp-copy-program "scp") |
| 129 | (tramp-copy-args (("-1") ("-P" "%p") ("%k" "-p") ("-q") ("-r"))) | 129 | (tramp-copy-args (("-1") ("-P" "%p") ("-p" "%k") ("-q") ("-r"))) |
| 130 | (tramp-copy-keep-date t) | 130 | (tramp-copy-keep-date t) |
| 131 | (tramp-copy-recursive t) | 131 | (tramp-copy-recursive t) |
| 132 | (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") | 132 | (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") |
| @@ -142,7 +142,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 142 | (tramp-async-args (("-q"))) | 142 | (tramp-async-args (("-q"))) |
| 143 | (tramp-remote-sh "/bin/sh") | 143 | (tramp-remote-sh "/bin/sh") |
| 144 | (tramp-copy-program "scp") | 144 | (tramp-copy-program "scp") |
| 145 | (tramp-copy-args (("-2") ("-P" "%p") ("%k" "-p") ("-q") ("-r"))) | 145 | (tramp-copy-args (("-2") ("-P" "%p") ("-p" "%k") ("-q") ("-r"))) |
| 146 | (tramp-copy-keep-date t) | 146 | (tramp-copy-keep-date t) |
| 147 | (tramp-copy-recursive t) | 147 | (tramp-copy-recursive t) |
| 148 | (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") | 148 | (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") |
| @@ -160,7 +160,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 160 | (tramp-async-args (("-q"))) | 160 | (tramp-async-args (("-q"))) |
| 161 | (tramp-remote-sh "/bin/sh") | 161 | (tramp-remote-sh "/bin/sh") |
| 162 | (tramp-copy-program "scp") | 162 | (tramp-copy-program "scp") |
| 163 | (tramp-copy-args (("-P" "%p") ("%k" "-p") ("-q") ("-r") | 163 | (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r") |
| 164 | ("-o" "ControlPath=%t.%%r@%%h:%%p") | 164 | ("-o" "ControlPath=%t.%%r@%%h:%%p") |
| 165 | ("-o" "ControlMaster=auto"))) | 165 | ("-o" "ControlMaster=auto"))) |
| 166 | (tramp-copy-keep-date t) | 166 | (tramp-copy-keep-date t) |
| @@ -179,7 +179,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 179 | (tramp-async-args (("-q"))) | 179 | (tramp-async-args (("-q"))) |
| 180 | (tramp-remote-sh "/bin/sh") | 180 | (tramp-remote-sh "/bin/sh") |
| 181 | (tramp-copy-program "scp") | 181 | (tramp-copy-program "scp") |
| 182 | (tramp-copy-args (("-P" "%p") ("%k" "-p") ("-q") ("-r"))) | 182 | (tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r"))) |
| 183 | (tramp-copy-keep-date t) | 183 | (tramp-copy-keep-date t) |
| 184 | (tramp-copy-recursive t) | 184 | (tramp-copy-recursive t) |
| 185 | (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") | 185 | (tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null") |
| @@ -202,7 +202,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 202 | (tramp-async-args (("-q"))) | 202 | (tramp-async-args (("-q"))) |
| 203 | (tramp-remote-sh "/bin/sh") | 203 | (tramp-remote-sh "/bin/sh") |
| 204 | (tramp-copy-program "rsync") | 204 | (tramp-copy-program "rsync") |
| 205 | (tramp-copy-args (("-e" "ssh") ("%k" "-t") ("-r"))) | 205 | (tramp-copy-args (("-e" "ssh") ("-t" "%k") ("-r"))) |
| 206 | (tramp-copy-keep-date t) | 206 | (tramp-copy-keep-date t) |
| 207 | (tramp-copy-keep-tmpfile t) | 207 | (tramp-copy-keep-tmpfile t) |
| 208 | (tramp-copy-recursive t))) | 208 | (tramp-copy-recursive t))) |
| @@ -217,7 +217,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 217 | (tramp-async-args (("-q"))) | 217 | (tramp-async-args (("-q"))) |
| 218 | (tramp-remote-sh "/bin/sh") | 218 | (tramp-remote-sh "/bin/sh") |
| 219 | (tramp-copy-program "rsync") | 219 | (tramp-copy-program "rsync") |
| 220 | (tramp-copy-args (("%k" "-t") ("-r"))) | 220 | (tramp-copy-args (("-t" "%k") ("-r"))) |
| 221 | (tramp-copy-env (("RSYNC_RSH") | 221 | (tramp-copy-env (("RSYNC_RSH") |
| 222 | (,(concat | 222 | (,(concat |
| 223 | "ssh" | 223 | "ssh" |
| @@ -353,7 +353,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 353 | (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) | 353 | (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) |
| 354 | (tramp-remote-sh "/bin/sh") | 354 | (tramp-remote-sh "/bin/sh") |
| 355 | (tramp-copy-program "pscp") | 355 | (tramp-copy-program "pscp") |
| 356 | (tramp-copy-args (("-P" "%p") ("-scp") ("%k" "-p") | 356 | (tramp-copy-args (("-P" "%p") ("-scp") ("-p" "%k") |
| 357 | ("-q") ("-r"))) | 357 | ("-q") ("-r"))) |
| 358 | (tramp-copy-keep-date t) | 358 | (tramp-copy-keep-date t) |
| 359 | (tramp-copy-recursive t) | 359 | (tramp-copy-recursive t) |
| @@ -366,7 +366,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 366 | (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) | 366 | (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) |
| 367 | (tramp-remote-sh "/bin/sh") | 367 | (tramp-remote-sh "/bin/sh") |
| 368 | (tramp-copy-program "pscp") | 368 | (tramp-copy-program "pscp") |
| 369 | (tramp-copy-args (("-P" "%p") ("-sftp") ("%k" "-p") | 369 | (tramp-copy-args (("-P" "%p") ("-sftp") ("-p" "%k") |
| 370 | ("-q") ("-r"))) | 370 | ("-q") ("-r"))) |
| 371 | (tramp-copy-keep-date t) | 371 | (tramp-copy-keep-date t) |
| 372 | (tramp-copy-recursive t) | 372 | (tramp-copy-recursive t) |
| @@ -378,7 +378,7 @@ detected as prompt when being sent on echoing hosts, therefore.") | |||
| 378 | (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i"))) | 378 | (tramp-login-args (("%h") ("-l" "%u") ("sh" "-i"))) |
| 379 | (tramp-remote-sh "/bin/sh -i") | 379 | (tramp-remote-sh "/bin/sh -i") |
| 380 | (tramp-copy-program "fcp") | 380 | (tramp-copy-program "fcp") |
| 381 | (tramp-copy-args (("%k" "-p"))) | 381 | (tramp-copy-args (("-p" "%k"))) |
| 382 | (tramp-copy-keep-date t))) | 382 | (tramp-copy-keep-date t))) |
| 383 | 383 | ||
| 384 | ;;;###tramp-autoload | 384 | ;;;###tramp-autoload |
| @@ -2251,11 +2251,15 @@ The method used must be an out-of-band method." | |||
| 2251 | 'identity) | 2251 | 'identity) |
| 2252 | (if t2 (tramp-make-copy-program-file-name v) newname))) | 2252 | (if t2 (tramp-make-copy-program-file-name v) newname))) |
| 2253 | 2253 | ||
| 2254 | ;; Check for port number. Until now, there's no need for handling | 2254 | ;; Check for host and port number. We cannot use |
| 2255 | ;; like method, user, host. | 2255 | ;; `tramp-file-name-port', because this returns also |
| 2256 | (setq host (tramp-file-name-real-host v) | 2256 | ;; `tramp-default-port', which might clash with settings in |
| 2257 | port (tramp-file-name-port v) | 2257 | ;; "~/.ssh/config". |
| 2258 | port (or (and port (number-to-string port)) "")) | 2258 | (setq host (tramp-file-name-host v) |
| 2259 | port "") | ||
| 2260 | (when (string-match tramp-host-with-port-regexp host) | ||
| 2261 | (setq host (string-to-number (match-string 1 host)) | ||
| 2262 | port (string-to-number (match-string 2 host)))) | ||
| 2259 | 2263 | ||
| 2260 | ;; Compose copy command. | 2264 | ;; Compose copy command. |
| 2261 | (setq spec (format-spec-make | 2265 | (setq spec (format-spec-make |
| @@ -2270,7 +2274,7 @@ The method used must be an out-of-band method." | |||
| 2270 | copy-args | 2274 | copy-args |
| 2271 | (delete | 2275 | (delete |
| 2272 | ;; " " has either been a replacement of "%k" (when | 2276 | ;; " " has either been a replacement of "%k" (when |
| 2273 | ;; keep-date argument is non-nil), or a replacemtent | 2277 | ;; keep-date argument is non-nil), or a replacement |
| 2274 | ;; for the whole keep-date sublist. | 2278 | ;; for the whole keep-date sublist. |
| 2275 | " " | 2279 | " " |
| 2276 | (dolist | 2280 | (dolist |
| @@ -2281,7 +2285,7 @@ The method used must be an out-of-band method." | |||
| 2281 | (append | 2285 | (append |
| 2282 | copy-args | 2286 | copy-args |
| 2283 | (let ((y (mapcar (lambda (z) (format-spec z spec)) x))) | 2287 | (let ((y (mapcar (lambda (z) (format-spec z spec)) x))) |
| 2284 | (if (zerop (length (car y))) '(" ") y)))))) | 2288 | (if (member "" y) '(" ") y)))))) |
| 2285 | copy-env | 2289 | copy-env |
| 2286 | (delq | 2290 | (delq |
| 2287 | nil | 2291 | nil |
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 1f3064c7066..462b8f11397 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el | |||
| @@ -31,7 +31,7 @@ | |||
| 31 | ;; should be changed only there. | 31 | ;; should be changed only there. |
| 32 | 32 | ||
| 33 | ;;;###tramp-autoload | 33 | ;;;###tramp-autoload |
| 34 | (defconst tramp-version "2.2.1-pre" | 34 | (defconst tramp-version "2.2.1" |
| 35 | "This version of Tramp.") | 35 | "This version of Tramp.") |
| 36 | 36 | ||
| 37 | ;;;###tramp-autoload | 37 | ;;;###tramp-autoload |
| @@ -44,7 +44,7 @@ | |||
| 44 | (= emacs-major-version 21) | 44 | (= emacs-major-version 21) |
| 45 | (>= emacs-minor-version 4))) | 45 | (>= emacs-minor-version 4))) |
| 46 | "ok" | 46 | "ok" |
| 47 | (format "Tramp 2.2.1-pre is not fit for %s" | 47 | (format "Tramp 2.2.1 is not fit for %s" |
| 48 | (when (string-match "^.*$" (emacs-version)) | 48 | (when (string-match "^.*$" (emacs-version)) |
| 49 | (match-string 0 (emacs-version))))))) | 49 | (match-string 0 (emacs-version))))))) |
| 50 | (unless (string-match "\\`ok\\'" x) (error "%s" x))) | 50 | (unless (string-match "\\`ok\\'" x) (error "%s" x))) |
diff --git a/lisp/net/xesam.el b/lisp/net/xesam.el index 21a22749408..64c26cfb2c9 100644 --- a/lisp/net/xesam.el +++ b/lisp/net/xesam.el | |||
| @@ -414,18 +414,18 @@ If there is no registered search engine at all, the function returns `nil'." | |||
| 414 | ;; Hopefully, this will change later. | 414 | ;; Hopefully, this will change later. |
| 415 | (setq hit-fields | 415 | (setq hit-fields |
| 416 | (case (intern vendor-id) | 416 | (case (intern vendor-id) |
| 417 | ('Beagle | 417 | (Beagle |
| 418 | '("xesam:mimeType" "xesam:url")) | 418 | '("xesam:mimeType" "xesam:url")) |
| 419 | ('Strigi | 419 | (Strigi |
| 420 | '("xesam:author" "xesam:cc" "xesam:charset" | 420 | '("xesam:author" "xesam:cc" "xesam:charset" |
| 421 | "xesam:contentType" "xesam:fileExtension" | 421 | "xesam:contentType" "xesam:fileExtension" |
| 422 | "xesam:id" "xesam:lineCount" "xesam:links" | 422 | "xesam:id" "xesam:lineCount" "xesam:links" |
| 423 | "xesam:mimeType" "xesam:name" "xesam:size" | 423 | "xesam:mimeType" "xesam:name" "xesam:size" |
| 424 | "xesam:sourceModified" "xesam:subject" "xesam:to" | 424 | "xesam:sourceModified" "xesam:subject" "xesam:to" |
| 425 | "xesam:url")) | 425 | "xesam:url")) |
| 426 | ('TrackerXesamSession | 426 | (TrackerXesamSession |
| 427 | '("xesam:relevancyRating" "xesam:url")) | 427 | '("xesam:relevancyRating" "xesam:url")) |
| 428 | ('Debbugs | 428 | (Debbugs |
| 429 | '("xesam:keyword" "xesam:owner" "xesam:title" | 429 | '("xesam:keyword" "xesam:owner" "xesam:title" |
| 430 | "xesam:url" "xesam:sourceModified" "xesam:mimeType" | 430 | "xesam:url" "xesam:sourceModified" "xesam:mimeType" |
| 431 | "debbugs:key")) | 431 | "debbugs:key")) |
diff --git a/lisp/notifications.el b/lisp/notifications.el index 893b9ed095f..adb9fdd641a 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el | |||
| @@ -210,8 +210,8 @@ used to manipulate the notification item with | |||
| 210 | (add-to-list 'hints `(:dict-entry | 210 | (add-to-list 'hints `(:dict-entry |
| 211 | "urgency" | 211 | "urgency" |
| 212 | (:variant :byte ,(case urgency | 212 | (:variant :byte ,(case urgency |
| 213 | ('low 0) | 213 | (low 0) |
| 214 | ('critical 2) | 214 | (critical 2) |
| 215 | (t 1)))) t)) | 215 | (t 1)))) t)) |
| 216 | (when category | 216 | (when category |
| 217 | (add-to-list 'hints `(:dict-entry | 217 | (add-to-list 'hints `(:dict-entry |
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index e75821b6860..44a2cb15b7e 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog | |||
| @@ -1,3 +1,13 @@ | |||
| 1 | 2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * org-src.el (org-src-switch-to-buffer): | ||
| 4 | * org-plot.el (org-plot/gnuplot-script, org-plot/gnuplot): | ||
| 5 | * org-mouse.el (org-mouse-agenda-type): | ||
| 6 | * org-freemind.el (org-freemind-node-to-org): | ||
| 7 | * ob-sql.el (org-babel-execute:sql): | ||
| 8 | * ob-exp.el (org-babel-exp-do-export, org-babel-exp-code): | ||
| 9 | * ob-ref.el (org-babel-ref-resolve): Fix use of case. | ||
| 10 | |||
| 1 | 2011-03-06 Juanma Barranquero <lekktu@gmail.com> | 11 | 2011-03-06 Juanma Barranquero <lekktu@gmail.com> |
| 2 | 12 | ||
| 3 | * org.el (org-blank-before-new-entry, org-context-in-file-links) | 13 | * org.el (org-blank-before-new-entry, org-context-in-file-links) |
diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 1be45198e0d..3215bcf4d8a 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el | |||
| @@ -231,10 +231,10 @@ The function respects the value of the :exports header argument." | |||
| 231 | (org-babel-exp-results info type 'silent)))) | 231 | (org-babel-exp-results info type 'silent)))) |
| 232 | (clean () (org-babel-remove-result info))) | 232 | (clean () (org-babel-remove-result info))) |
| 233 | (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) | 233 | (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) |
| 234 | ('none (silently) (clean) "") | 234 | (none (silently) (clean) "") |
| 235 | ('code (silently) (clean) (org-babel-exp-code info type)) | 235 | (code (silently) (clean) (org-babel-exp-code info type)) |
| 236 | ('results (org-babel-exp-results info type)) | 236 | (results (org-babel-exp-results info type)) |
| 237 | ('both (concat (org-babel-exp-code info type) | 237 | (both (concat (org-babel-exp-code info type) |
| 238 | "\n\n" | 238 | "\n\n" |
| 239 | (org-babel-exp-results info type)))))) | 239 | (org-babel-exp-results info type)))))) |
| 240 | 240 | ||
| @@ -250,8 +250,8 @@ The code block is not evaluated." | |||
| 250 | (name (nth 4 info)) | 250 | (name (nth 4 info)) |
| 251 | (args (mapcar #'cdr (org-babel-get-header (nth 2 info) :var)))) | 251 | (args (mapcar #'cdr (org-babel-get-header (nth 2 info) :var)))) |
| 252 | (case type | 252 | (case type |
| 253 | ('inline (format "=%s=" body)) | 253 | (inline (format "=%s=" body)) |
| 254 | ('block | 254 | (block |
| 255 | (let ((str | 255 | (let ((str |
| 256 | (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body | 256 | (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body |
| 257 | (if (and body (string-match "\n$" body)) | 257 | (if (and body (string-match "\n$" body)) |
| @@ -265,7 +265,7 @@ The code block is not evaluated." | |||
| 265 | (mapconcat #'identity args ", "))) | 265 | (mapconcat #'identity args ", "))) |
| 266 | str)) | 266 | str)) |
| 267 | str)) | 267 | str)) |
| 268 | ('lob | 268 | (lob |
| 269 | (let ((call-line (and (string-match "results=" (car args)) | 269 | (let ((call-line (and (string-match "results=" (car args)) |
| 270 | (substring (car args) (match-end 0))))) | 270 | (substring (car args) (match-end 0))))) |
| 271 | (cond | 271 | (cond |
diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 7b06e90f924..96819df8ea1 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el | |||
| @@ -147,12 +147,12 @@ the variable." | |||
| 147 | (let ((params (append args '((:results . "silent"))))) | 147 | (let ((params (append args '((:results . "silent"))))) |
| 148 | (setq result | 148 | (setq result |
| 149 | (case type | 149 | (case type |
| 150 | ('results-line (org-babel-read-result)) | 150 | (results-line (org-babel-read-result)) |
| 151 | ('table (org-babel-read-table)) | 151 | (table (org-babel-read-table)) |
| 152 | ('list (org-babel-read-list)) | 152 | (list (org-babel-read-list)) |
| 153 | ('file (org-babel-read-link)) | 153 | (file (org-babel-read-link)) |
| 154 | ('source-block (org-babel-execute-src-block nil nil params)) | 154 | (source-block (org-babel-execute-src-block nil nil params)) |
| 155 | ('lob (org-babel-execute-src-block nil lob-info params))))) | 155 | (lob (org-babel-execute-src-block nil lob-info params))))) |
| 156 | (if (symbolp result) | 156 | (if (symbolp result) |
| 157 | (format "%S" result) | 157 | (format "%S" result) |
| 158 | (if (and index (listp result)) | 158 | (if (and index (listp result)) |
diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 3bd10d6b2bd..49859d24a17 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el | |||
| @@ -66,18 +66,18 @@ This function is called by `org-babel-execute-src-block'." | |||
| 66 | (out-file (or (cdr (assoc :out-file params)) | 66 | (out-file (or (cdr (assoc :out-file params)) |
| 67 | (org-babel-temp-file "sql-out-"))) | 67 | (org-babel-temp-file "sql-out-"))) |
| 68 | (command (case (intern engine) | 68 | (command (case (intern engine) |
| 69 | ('msosql (format "osql %s -s \"\t\" -i %s -o %s" | 69 | (msosql (format "osql %s -s \"\t\" -i %s -o %s" |
| 70 | (or cmdline "") | ||
| 71 | (org-babel-process-file-name in-file) | ||
| 72 | (org-babel-process-file-name out-file))) | ||
| 73 | ('mysql (format "mysql %s -e \"source %s\" > %s" | ||
| 74 | (or cmdline "") | 70 | (or cmdline "") |
| 75 | (org-babel-process-file-name in-file) | 71 | (org-babel-process-file-name in-file) |
| 76 | (org-babel-process-file-name out-file))) | 72 | (org-babel-process-file-name out-file))) |
| 77 | ('postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" | 73 | (mysql (format "mysql %s -e \"source %s\" > %s" |
| 78 | (org-babel-process-file-name in-file) | 74 | (or cmdline "") |
| 79 | (org-babel-process-file-name out-file) | 75 | (org-babel-process-file-name in-file) |
| 80 | (or cmdline ""))) | 76 | (org-babel-process-file-name out-file))) |
| 77 | (postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" | ||
| 78 | (org-babel-process-file-name in-file) | ||
| 79 | (org-babel-process-file-name out-file) | ||
| 80 | (or cmdline ""))) | ||
| 81 | (t (error "no support for the %s sql engine" engine))))) | 81 | (t (error "no support for the %s sql engine" engine))))) |
| 82 | (with-temp-file in-file | 82 | (with-temp-file in-file |
| 83 | (insert (org-babel-expand-body:sql body params))) | 83 | (insert (org-babel-expand-body:sql body params))) |
diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el index c85b4bac36a..dccdf449296 100644 --- a/lisp/org/org-freemind.el +++ b/lisp/org/org-freemind.el | |||
| @@ -1172,8 +1172,8 @@ PATH should be a list of steps, where each step has the form | |||
| 1172 | (when (< 0 (- level skip-levels)) | 1172 | (when (< 0 (- level skip-levels)) |
| 1173 | (dolist (attrib attributes) | 1173 | (dolist (attrib attributes) |
| 1174 | (case (car attrib) | 1174 | (case (car attrib) |
| 1175 | ('TEXT (setq text (cdr attrib))) | 1175 | (TEXT (setq text (cdr attrib))) |
| 1176 | ('text (setq text (cdr attrib))))) | 1176 | (text (setq text (cdr attrib))))) |
| 1177 | (unless text | 1177 | (unless text |
| 1178 | ;; There should be a richcontent node holding the text: | 1178 | ;; There should be a richcontent node holding the text: |
| 1179 | (setq text (org-freemind-get-richcontent-node-text node))) | 1179 | (setq text (org-freemind-get-richcontent-node-text node))) |
| @@ -1193,7 +1193,7 @@ PATH should be a list of steps, where each step has the form | |||
| 1193 | (setq text (replace-regexp-in-string "\n $" "" text)) | 1193 | (setq text (replace-regexp-in-string "\n $" "" text)) |
| 1194 | (insert text)) | 1194 | (insert text)) |
| 1195 | (case qname | 1195 | (case qname |
| 1196 | ('node | 1196 | (node |
| 1197 | (insert (make-string (- level skip-levels) ?*) " " text "\n") | 1197 | (insert (make-string (- level skip-levels) ?*) " " text "\n") |
| 1198 | (when note | 1198 | (when note |
| 1199 | (insert ":COMMENT:\n" note "\n:END:\n")) | 1199 | (insert ":COMMENT:\n" note "\n:END:\n")) |
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index d30f172f42f..cec19d89de1 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el | |||
| @@ -476,11 +476,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" | |||
| 476 | 476 | ||
| 477 | (defun org-mouse-agenda-type (type) | 477 | (defun org-mouse-agenda-type (type) |
| 478 | (case type | 478 | (case type |
| 479 | ('tags "Tags: ") | 479 | (tags "Tags: ") |
| 480 | ('todo "TODO: ") | 480 | (todo "TODO: ") |
| 481 | ('tags-tree "Tags tree: ") | 481 | (tags-tree "Tags tree: ") |
| 482 | ('todo-tree "TODO tree: ") | 482 | (todo-tree "TODO tree: ") |
| 483 | ('occur-tree "Occur tree: ") | 483 | (occur-tree "Occur tree: ") |
| 484 | (t "Agenda command ???"))) | 484 | (t "Agenda command ???"))) |
| 485 | 485 | ||
| 486 | 486 | ||
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index c5f4bff24fa..10722403f7e 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el | |||
| @@ -206,18 +206,18 @@ manner suitable for prepending to a user-specified script." | |||
| 206 | (y-labels (plist-get params :ylabels)) | 206 | (y-labels (plist-get params :ylabels)) |
| 207 | (plot-str "'%s' using %s%d%s with %s title '%s'") | 207 | (plot-str "'%s' using %s%d%s with %s title '%s'") |
| 208 | (plot-cmd (case type | 208 | (plot-cmd (case type |
| 209 | ('2d "plot") | 209 | (2d "plot") |
| 210 | ('3d "splot") | 210 | (3d "splot") |
| 211 | ('grid "splot"))) | 211 | (grid "splot"))) |
| 212 | (script "reset") plot-lines) | 212 | (script "reset") plot-lines) |
| 213 | (flet ((add-to-script (line) (setf script (format "%s\n%s" script line)))) | 213 | (flet ((add-to-script (line) (setf script (format "%s\n%s" script line)))) |
| 214 | (when file ;; output file | 214 | (when file ;; output file |
| 215 | (add-to-script (format "set term %s" (file-name-extension file))) | 215 | (add-to-script (format "set term %s" (file-name-extension file))) |
| 216 | (add-to-script (format "set output '%s'" file))) | 216 | (add-to-script (format "set output '%s'" file))) |
| 217 | (case type ;; type | 217 | (case type ;; type |
| 218 | ('2d ()) | 218 | (2d ()) |
| 219 | ('3d (if map (add-to-script "set map"))) | 219 | (3d (if map (add-to-script "set map"))) |
| 220 | ('grid (if map | 220 | (grid (if map |
| 221 | (add-to-script "set pm3d map") | 221 | (add-to-script "set pm3d map") |
| 222 | (add-to-script "set pm3d")))) | 222 | (add-to-script "set pm3d")))) |
| 223 | (when title (add-to-script (format "set title '%s'" title))) ;; title | 223 | (when title (add-to-script (format "set title '%s'" title))) ;; title |
| @@ -243,7 +243,7 @@ manner suitable for prepending to a user-specified script." | |||
| 243 | "%Y-%m-%d-%H:%M:%S") "\""))) | 243 | "%Y-%m-%d-%H:%M:%S") "\""))) |
| 244 | (unless preface | 244 | (unless preface |
| 245 | (case type ;; plot command | 245 | (case type ;; plot command |
| 246 | ('2d (dotimes (col num-cols) | 246 | (2d (dotimes (col num-cols) |
| 247 | (unless (and (equal type '2d) | 247 | (unless (and (equal type '2d) |
| 248 | (or (and ind (equal (+ 1 col) ind)) | 248 | (or (and ind (equal (+ 1 col) ind)) |
| 249 | (and deps (not (member (+ 1 col) deps))))) | 249 | (and deps (not (member (+ 1 col) deps))))) |
| @@ -258,10 +258,10 @@ manner suitable for prepending to a user-specified script." | |||
| 258 | with | 258 | with |
| 259 | (or (nth col col-labels) (format "%d" (+ 1 col)))) | 259 | (or (nth col col-labels) (format "%d" (+ 1 col)))) |
| 260 | plot-lines))))) | 260 | plot-lines))))) |
| 261 | ('3d | 261 | (3d |
| 262 | (setq plot-lines (list (format "'%s' matrix with %s title ''" | 262 | (setq plot-lines (list (format "'%s' matrix with %s title ''" |
| 263 | data-file with)))) | 263 | data-file with)))) |
| 264 | ('grid | 264 | (grid |
| 265 | (setq plot-lines (list (format "'%s' with %s title ''" | 265 | (setq plot-lines (list (format "'%s' with %s title ''" |
| 266 | data-file with))))) | 266 | data-file with))))) |
| 267 | (add-to-script | 267 | (add-to-script |
| @@ -305,9 +305,9 @@ line directly before or after the table." | |||
| 305 | (setf params (org-plot/collect-options params)))) | 305 | (setf params (org-plot/collect-options params)))) |
| 306 | ;; dump table to datafile (very different for grid) | 306 | ;; dump table to datafile (very different for grid) |
| 307 | (case (plist-get params :plot-type) | 307 | (case (plist-get params :plot-type) |
| 308 | ('2d (org-plot/gnuplot-to-data table data-file params)) | 308 | (2d (org-plot/gnuplot-to-data table data-file params)) |
| 309 | ('3d (org-plot/gnuplot-to-data table data-file params)) | 309 | (3d (org-plot/gnuplot-to-data table data-file params)) |
| 310 | ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data | 310 | (grid (let ((y-labels (org-plot/gnuplot-to-grid-data |
| 311 | table data-file params))) | 311 | table data-file params))) |
| 312 | (when y-labels (plist-put params :ylabels y-labels))))) | 312 | (when y-labels (plist-put params :ylabels y-labels))))) |
| 313 | ;; check for timestamp ind column | 313 | ;; check for timestamp ind column |
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 98fdb75423d..bd1c3802044 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el | |||
| @@ -335,26 +335,26 @@ buffer." | |||
| 335 | 335 | ||
| 336 | (defun org-src-switch-to-buffer (buffer context) | 336 | (defun org-src-switch-to-buffer (buffer context) |
| 337 | (case org-src-window-setup | 337 | (case org-src-window-setup |
| 338 | ('current-window | 338 | (current-window |
| 339 | (switch-to-buffer buffer)) | 339 | (switch-to-buffer buffer)) |
| 340 | ('other-window | 340 | (other-window |
| 341 | (switch-to-buffer-other-window buffer)) | 341 | (switch-to-buffer-other-window buffer)) |
| 342 | ('other-frame | 342 | (other-frame |
| 343 | (case context | 343 | (case context |
| 344 | ('exit | 344 | (exit |
| 345 | (let ((frame (selected-frame))) | 345 | (let ((frame (selected-frame))) |
| 346 | (switch-to-buffer-other-frame buffer) | 346 | (switch-to-buffer-other-frame buffer) |
| 347 | (delete-frame frame))) | 347 | (delete-frame frame))) |
| 348 | ('save | 348 | (save |
| 349 | (kill-buffer (current-buffer)) | 349 | (kill-buffer (current-buffer)) |
| 350 | (switch-to-buffer buffer)) | 350 | (switch-to-buffer buffer)) |
| 351 | (t | 351 | (t |
| 352 | (switch-to-buffer-other-frame buffer)))) | 352 | (switch-to-buffer-other-frame buffer)))) |
| 353 | ('reorganize-frame | 353 | (reorganize-frame |
| 354 | (if (eq context 'edit) (delete-other-windows)) | 354 | (if (eq context 'edit) (delete-other-windows)) |
| 355 | (org-switch-to-buffer-other-window buffer) | 355 | (org-switch-to-buffer-other-window buffer) |
| 356 | (if (eq context 'exit) (delete-other-windows))) | 356 | (if (eq context 'exit) (delete-other-windows))) |
| 357 | ('switch-invisibly | 357 | (switch-invisibly |
| 358 | (set-buffer buffer)) | 358 | (set-buffer buffer)) |
| 359 | (t | 359 | (t |
| 360 | (message "Invalid value %s for org-src-window-setup" | 360 | (message "Invalid value %s for org-src-window-setup" |
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index 8fea2cef6ad..0dc556007ba 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el | |||
| @@ -719,57 +719,57 @@ static char * dot3d_xpm[] = { | |||
| 719 | (defsubst bubbles--grid-width () | 719 | (defsubst bubbles--grid-width () |
| 720 | "Return the grid width for the current game theme." | 720 | "Return the grid width for the current game theme." |
| 721 | (car (case bubbles-game-theme | 721 | (car (case bubbles-game-theme |
| 722 | ('easy | 722 | (easy |
| 723 | bubbles--grid-small) | 723 | bubbles--grid-small) |
| 724 | ('medium | 724 | (medium |
| 725 | bubbles--grid-medium) | 725 | bubbles--grid-medium) |
| 726 | ('difficult | 726 | (difficult |
| 727 | bubbles--grid-large) | 727 | bubbles--grid-large) |
| 728 | ('hard | 728 | (hard |
| 729 | bubbles--grid-huge) | 729 | bubbles--grid-huge) |
| 730 | ('user-defined | 730 | (user-defined |
| 731 | bubbles-grid-size)))) | 731 | bubbles-grid-size)))) |
| 732 | 732 | ||
| 733 | (defsubst bubbles--grid-height () | 733 | (defsubst bubbles--grid-height () |
| 734 | "Return the grid height for the current game theme." | 734 | "Return the grid height for the current game theme." |
| 735 | (cdr (case bubbles-game-theme | 735 | (cdr (case bubbles-game-theme |
| 736 | ('easy | 736 | (easy |
| 737 | bubbles--grid-small) | 737 | bubbles--grid-small) |
| 738 | ('medium | 738 | (medium |
| 739 | bubbles--grid-medium) | 739 | bubbles--grid-medium) |
| 740 | ('difficult | 740 | (difficult |
| 741 | bubbles--grid-large) | 741 | bubbles--grid-large) |
| 742 | ('hard | 742 | (hard |
| 743 | bubbles--grid-huge) | 743 | bubbles--grid-huge) |
| 744 | ('user-defined | 744 | (user-defined |
| 745 | bubbles-grid-size)))) | 745 | bubbles-grid-size)))) |
| 746 | 746 | ||
| 747 | (defsubst bubbles--colors () | 747 | (defsubst bubbles--colors () |
| 748 | "Return the color list for the current game theme." | 748 | "Return the color list for the current game theme." |
| 749 | (case bubbles-game-theme | 749 | (case bubbles-game-theme |
| 750 | ('easy | 750 | (easy |
| 751 | bubbles--colors-2) | 751 | bubbles--colors-2) |
| 752 | ('medium | 752 | (medium |
| 753 | bubbles--colors-3) | 753 | bubbles--colors-3) |
| 754 | ('difficult | 754 | (difficult |
| 755 | bubbles--colors-4) | 755 | bubbles--colors-4) |
| 756 | ('hard | 756 | (hard |
| 757 | bubbles--colors-5) | 757 | bubbles--colors-5) |
| 758 | ('user-defined | 758 | (user-defined |
| 759 | bubbles-colors))) | 759 | bubbles-colors))) |
| 760 | 760 | ||
| 761 | (defsubst bubbles--shift-mode () | 761 | (defsubst bubbles--shift-mode () |
| 762 | "Return the shift mode for the current game theme." | 762 | "Return the shift mode for the current game theme." |
| 763 | (case bubbles-game-theme | 763 | (case bubbles-game-theme |
| 764 | ('easy | 764 | (easy |
| 765 | 'default) | 765 | 'default) |
| 766 | ('medium | 766 | (medium |
| 767 | 'default) | 767 | 'default) |
| 768 | ('difficult | 768 | (difficult |
| 769 | 'always) | 769 | 'always) |
| 770 | ('hard | 770 | (hard |
| 771 | 'always) | 771 | 'always) |
| 772 | ('user-defined | 772 | (user-defined |
| 773 | bubbles-shift-mode))) | 773 | bubbles-shift-mode))) |
| 774 | 774 | ||
| 775 | (defun bubbles-save-settings () | 775 | (defun bubbles-save-settings () |
| @@ -1346,11 +1346,11 @@ Return t if new char is non-empty." | |||
| 1346 | (when (and (display-images-p) | 1346 | (when (and (display-images-p) |
| 1347 | (not (eq bubbles-graphics-theme 'ascii))) | 1347 | (not (eq bubbles-graphics-theme 'ascii))) |
| 1348 | (let ((template (case bubbles-graphics-theme | 1348 | (let ((template (case bubbles-graphics-theme |
| 1349 | ('circles bubbles--image-template-circle) | 1349 | (circles bubbles--image-template-circle) |
| 1350 | ('balls bubbles--image-template-ball) | 1350 | (balls bubbles--image-template-ball) |
| 1351 | ('squares bubbles--image-template-square) | 1351 | (squares bubbles--image-template-square) |
| 1352 | ('diamonds bubbles--image-template-diamond) | 1352 | (diamonds bubbles--image-template-diamond) |
| 1353 | ('emacs bubbles--image-template-emacs)))) | 1353 | (emacs bubbles--image-template-emacs)))) |
| 1354 | (setq bubbles--empty-image | 1354 | (setq bubbles--empty-image |
| 1355 | (create-image (replace-regexp-in-string | 1355 | (create-image (replace-regexp-in-string |
| 1356 | "^\"\\(.*\\)\t.*c .*\",$" | 1356 | "^\"\\(.*\\)\t.*c .*\",$" |
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index d3d8350a43f..99e3b487437 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el | |||
| @@ -213,19 +213,19 @@ static unsigned char gamegrid_bits[] = { | |||
| 213 | (let ((data (gamegrid-match-spec-list data-spec-list)) | 213 | (let ((data (gamegrid-match-spec-list data-spec-list)) |
| 214 | (color (gamegrid-match-spec-list color-spec-list))) | 214 | (color (gamegrid-match-spec-list color-spec-list))) |
| 215 | (case data | 215 | (case data |
| 216 | ('color-x | 216 | (color-x |
| 217 | (gamegrid-make-color-x-face color)) | 217 | (gamegrid-make-color-x-face color)) |
| 218 | ('grid-x | 218 | (grid-x |
| 219 | (unless gamegrid-grid-x-face | 219 | (unless gamegrid-grid-x-face |
| 220 | (setq gamegrid-grid-x-face (gamegrid-make-grid-x-face))) | 220 | (setq gamegrid-grid-x-face (gamegrid-make-grid-x-face))) |
| 221 | gamegrid-grid-x-face) | 221 | gamegrid-grid-x-face) |
| 222 | ('mono-x | 222 | (mono-x |
| 223 | (unless gamegrid-mono-x-face | 223 | (unless gamegrid-mono-x-face |
| 224 | (setq gamegrid-mono-x-face (gamegrid-make-mono-x-face))) | 224 | (setq gamegrid-mono-x-face (gamegrid-make-mono-x-face))) |
| 225 | gamegrid-mono-x-face) | 225 | gamegrid-mono-x-face) |
| 226 | ('color-tty | 226 | (color-tty |
| 227 | (gamegrid-make-color-tty-face color)) | 227 | (gamegrid-make-color-tty-face color)) |
| 228 | ('mono-tty | 228 | (mono-tty |
| 229 | (unless gamegrid-mono-tty-face | 229 | (unless gamegrid-mono-tty-face |
| 230 | (setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face))) | 230 | (setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face))) |
| 231 | gamegrid-mono-tty-face)))) | 231 | gamegrid-mono-tty-face)))) |
diff --git a/lisp/play/morse.el b/lisp/play/morse.el index d4a0224ede5..b88f1b264cb 100644 --- a/lisp/play/morse.el +++ b/lisp/play/morse.el | |||
| @@ -25,6 +25,9 @@ | |||
| 25 | ;; Converts text to Morse code and back with M-x morse-region and | 25 | ;; Converts text to Morse code and back with M-x morse-region and |
| 26 | ;; M-x unmorse-region (though Morse code is no longer official :-(). | 26 | ;; M-x unmorse-region (though Morse code is no longer official :-(). |
| 27 | 27 | ||
| 28 | ;; Converts text to NATO phonetic alphabet and back with M-x | ||
| 29 | ;; nato-region and M-x denato-region. | ||
| 30 | |||
| 28 | ;;; Code: | 31 | ;;; Code: |
| 29 | 32 | ||
| 30 | (defvar morse-code '(("a" . ".-") | 33 | (defvar morse-code '(("a" . ".-") |
| @@ -91,10 +94,64 @@ | |||
| 91 | ("@" . ".--.-.")) | 94 | ("@" . ".--.-.")) |
| 92 | "Morse code character set.") | 95 | "Morse code character set.") |
| 93 | 96 | ||
| 97 | (defvar nato-alphabet '(("a" . "Alfa") | ||
| 98 | ("b" . "Bravo") | ||
| 99 | ("c" . "Charlie") | ||
| 100 | ("d" . "Delta") | ||
| 101 | ("e" . "Echo") | ||
| 102 | ("f" . "Foxtrot") | ||
| 103 | ("g" . "Golf") | ||
| 104 | ("h" . "Hotel") | ||
| 105 | ("i" . "India") | ||
| 106 | ("j" . "Juliett") | ||
| 107 | ("k" . "Kilo") | ||
| 108 | ("l" . "Lima") | ||
| 109 | ("m" . "Mike") | ||
| 110 | ("n" . "November") | ||
| 111 | ("o" . "Oscar") | ||
| 112 | ("p" . "Papa") | ||
| 113 | ("q" . "Quebec") | ||
| 114 | ("r" . "Romeo") | ||
| 115 | ("s" . "Sierra") | ||
| 116 | ("t" . "Tango") | ||
| 117 | ("u" . "Uniform") | ||
| 118 | ("v" . "Victor") | ||
| 119 | ("w" . "Whiskey") | ||
| 120 | ("x" . "Xray") | ||
| 121 | ("y" . "Yankee") | ||
| 122 | ("z" . "Zulu") | ||
| 123 | ;; Numbers | ||
| 124 | ("0" . "Zero") | ||
| 125 | ("1" . "One") | ||
| 126 | ("2" . "Two") | ||
| 127 | ("3" . "Three") | ||
| 128 | ("4" . "Four") | ||
| 129 | ("5" . "Five") | ||
| 130 | ("6" . "Six") | ||
| 131 | ("7" . "Seven") | ||
| 132 | ("8" . "Eight") | ||
| 133 | ("9" . "Niner") | ||
| 134 | ;; Punctuation is not part of standard | ||
| 135 | ("=" . "Equals") | ||
| 136 | ("?" . "Query") | ||
| 137 | ("/" . "Slash") | ||
| 138 | ("," . "Comma") | ||
| 139 | ("." . "Stop") | ||
| 140 | (":" . "Colon") | ||
| 141 | ("'" . "Apostrophe") | ||
| 142 | ("-" . "Dash") | ||
| 143 | ("(" . "Open") | ||
| 144 | (")" . "Close") | ||
| 145 | ("@" . "At")) | ||
| 146 | "NATO phonetic alphabet. | ||
| 147 | See ''International Code of Signals'' (INTERCO), United States | ||
| 148 | Edition, 1969 Edition (Revised 2003) available from National | ||
| 149 | Geospatial-Intelligence Agency at http://www.nga.mil/") | ||
| 150 | |||
| 94 | ;;;###autoload | 151 | ;;;###autoload |
| 95 | (defun morse-region (beg end) | 152 | (defun morse-region (beg end) |
| 96 | "Convert all text in a given region to morse code." | 153 | "Convert all text in a given region to morse code." |
| 97 | (interactive "r") | 154 | (interactive "*r") |
| 98 | (if (integerp end) | 155 | (if (integerp end) |
| 99 | (setq end (copy-marker end))) | 156 | (setq end (copy-marker end))) |
| 100 | (save-excursion | 157 | (save-excursion |
| @@ -117,7 +174,7 @@ | |||
| 117 | ;;;###autoload | 174 | ;;;###autoload |
| 118 | (defun unmorse-region (beg end) | 175 | (defun unmorse-region (beg end) |
| 119 | "Convert morse coded text in region to ordinary ASCII text." | 176 | "Convert morse coded text in region to ordinary ASCII text." |
| 120 | (interactive "r") | 177 | (interactive "*r") |
| 121 | (if (integerp end) | 178 | (if (integerp end) |
| 122 | (setq end (copy-marker end))) | 179 | (setq end (copy-marker end))) |
| 123 | (save-excursion | 180 | (save-excursion |
| @@ -136,6 +193,53 @@ | |||
| 136 | (if (looking-at "/") | 193 | (if (looking-at "/") |
| 137 | (delete-char 1)))))))) | 194 | (delete-char 1)))))))) |
| 138 | 195 | ||
| 196 | ;;;###autoload | ||
| 197 | (defun nato-region (beg end) | ||
| 198 | "Convert all text in a given region to NATO phonetic alphabet." | ||
| 199 | ;; Copied from morse-region. -- ashawley 2009-02-10 | ||
| 200 | (interactive "*r") | ||
| 201 | (if (integerp end) | ||
| 202 | (setq end (copy-marker end))) | ||
| 203 | (save-excursion | ||
| 204 | (let ((sep "") | ||
| 205 | str nato) | ||
| 206 | (goto-char beg) | ||
| 207 | (while (< (point) end) | ||
| 208 | (setq str (downcase (buffer-substring (point) (1+ (point))))) | ||
| 209 | (cond ((looking-at "\\s-+") | ||
| 210 | (goto-char (match-end 0)) | ||
| 211 | (setq sep "")) | ||
| 212 | ((setq nato (assoc str nato-alphabet)) | ||
| 213 | (delete-char 1) | ||
| 214 | (insert sep (cdr nato)) | ||
| 215 | (setq sep "-")) | ||
| 216 | (t | ||
| 217 | (forward-char 1) | ||
| 218 | (setq sep ""))))))) | ||
| 219 | |||
| 220 | ;;;###autoload | ||
| 221 | (defun denato-region (beg end) | ||
| 222 | "Convert NATO phonetic alphabet in region to ordinary ASCII text." | ||
| 223 | ;; Copied from unmorse-region. -- ashawley 2009-02-10 | ||
| 224 | (interactive "*r") | ||
| 225 | (if (integerp end) | ||
| 226 | (setq end (copy-marker end))) | ||
| 227 | (save-excursion | ||
| 228 | (let (str paren nato) | ||
| 229 | (goto-char beg) | ||
| 230 | (while (< (point) end) | ||
| 231 | (if (null (looking-at "[a-z]+")) | ||
| 232 | (forward-char 1) | ||
| 233 | (setq str (buffer-substring (match-beginning 0) (match-end 0))) | ||
| 234 | (if (null (setq nato (rassoc str nato-alphabet))) | ||
| 235 | (goto-char (match-end 0)) | ||
| 236 | (replace-match | ||
| 237 | (if (string-equal "(" (car nato)) | ||
| 238 | (if (setq paren (null paren)) "(" ")") | ||
| 239 | (car nato)) t) | ||
| 240 | (if (looking-at "-") | ||
| 241 | (delete-char 1)))))))) | ||
| 242 | |||
| 139 | (provide 'morse) | 243 | (provide 'morse) |
| 140 | 244 | ||
| 141 | ;;; morse.el ends here | 245 | ;;; morse.el ends here |
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 5ac30bc28ce..0f873e678c3 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el | |||
| @@ -2564,19 +2564,12 @@ be more \"DWIM:ey\"." | |||
| 2564 | ;; Are we about to move backwards into or out of a | 2564 | ;; Are we about to move backwards into or out of a |
| 2565 | ;; preprocessor command? If so, locate its beginning. | 2565 | ;; preprocessor command? If so, locate its beginning. |
| 2566 | (when (eq (cdr res) 'macro-boundary) | 2566 | (when (eq (cdr res) 'macro-boundary) |
| 2567 | (setq macro-fence | 2567 | (save-excursion |
| 2568 | (save-excursion | 2568 | (beginning-of-line) |
| 2569 | (if macro-fence | 2569 | (setq macro-fence |
| 2570 | (progn | 2570 | (and (not (bobp)) |
| 2571 | (end-of-line) | 2571 | (progn (c-skip-ws-backward) (c-beginning-of-macro)) |
| 2572 | (and (not (eobp)) | 2572 | (point))))) |
| 2573 | (progn (c-skip-ws-forward) | ||
| 2574 | (c-beginning-of-macro)) | ||
| 2575 | (progn (c-end-of-macro) | ||
| 2576 | (point)))) | ||
| 2577 | (and (not (eobp)) | ||
| 2578 | (c-beginning-of-macro) | ||
| 2579 | (progn (c-end-of-macro) (point))))))) | ||
| 2580 | ;; Are we about to move backwards into a literal? | 2573 | ;; Are we about to move backwards into a literal? |
| 2581 | (when (memq (cdr res) '(macro-boundary literal)) | 2574 | (when (memq (cdr res) '(macro-boundary literal)) |
| 2582 | (setq range (c-ascertain-preceding-literal))) | 2575 | (setq range (c-ascertain-preceding-literal))) |
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 88f418f934a..40383c6bc31 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -860,27 +860,29 @@ POS and RES.") | |||
| 860 | (car compilation--previous-directory-cache))) | 860 | (car compilation--previous-directory-cache))) |
| 861 | (prev | 861 | (prev |
| 862 | (previous-single-property-change | 862 | (previous-single-property-change |
| 863 | pos 'compilation-directory nil cache))) | 863 | pos 'compilation-directory nil cache)) |
| 864 | (cond | 864 | (res |
| 865 | ((null cache) | 865 | (cond |
| 866 | (setq compilation--previous-directory-cache | 866 | ((null cache) |
| 867 | (cons (copy-marker pos) (copy-marker prev))) | 867 | (setq compilation--previous-directory-cache |
| 868 | prev) | 868 | (cons (copy-marker pos) (if prev (copy-marker prev)))) |
| 869 | ((eq prev cache) | 869 | prev) |
| 870 | (if cache | 870 | ((and prev (= prev cache)) |
| 871 | (set-marker (car compilation--previous-directory-cache) pos) | 871 | (if cache |
| 872 | (setq compilation--previous-directory-cache | 872 | (set-marker (car compilation--previous-directory-cache) pos) |
| 873 | (cons (copy-marker pos) nil))) | 873 | (setq compilation--previous-directory-cache |
| 874 | (cdr compilation--previous-directory-cache)) | 874 | (cons (copy-marker pos) nil))) |
| 875 | (t | 875 | (cdr compilation--previous-directory-cache)) |
| 876 | (if cache | 876 | (t |
| 877 | (progn | 877 | (if cache |
| 878 | (set-marker (car compilation--previous-directory-cache) pos) | 878 | (progn |
| 879 | (setcdr compilation--previous-directory-cache | 879 | (set-marker cache pos) |
| 880 | (copy-marker prev))) | 880 | (setcdr compilation--previous-directory-cache |
| 881 | (setq compilation--previous-directory-cache | 881 | (copy-marker prev))) |
| 882 | (cons (copy-marker pos) (copy-marker prev)))) | 882 | (setq compilation--previous-directory-cache |
| 883 | prev))))) | 883 | (cons (copy-marker pos) (if prev (copy-marker prev))))) |
| 884 | prev)))) | ||
| 885 | (if (markerp res) (marker-position res) res)))) | ||
| 884 | 886 | ||
| 885 | ;; Internal function for calculating the text properties of a directory | 887 | ;; Internal function for calculating the text properties of a directory |
| 886 | ;; change message. The compilation-directory property is important, because it | 888 | ;; change message. The compilation-directory property is important, because it |
| @@ -889,7 +891,7 @@ POS and RES.") | |||
| 889 | (defun compilation-directory-properties (idx leave) | 891 | (defun compilation-directory-properties (idx leave) |
| 890 | (if leave (setq leave (match-end leave))) | 892 | (if leave (setq leave (match-end leave))) |
| 891 | ;; find previous stack, and push onto it, or if `leave' pop it | 893 | ;; find previous stack, and push onto it, or if `leave' pop it |
| 892 | (let ((dir (compilation--previous-directory (point)))) | 894 | (let ((dir (compilation--previous-directory (match-beginning 0)))) |
| 893 | (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory) | 895 | (setq dir (if dir (or (get-text-property (1- dir) 'compilation-directory) |
| 894 | (get-text-property dir 'compilation-directory)))) | 896 | (get-text-property dir 'compilation-directory)))) |
| 895 | `(font-lock-face ,(if leave | 897 | `(font-lock-face ,(if leave |
| @@ -948,7 +950,8 @@ POS and RES.") | |||
| 948 | (match-string-no-properties file)))) | 950 | (match-string-no-properties file)))) |
| 949 | (let ((dir | 951 | (let ((dir |
| 950 | (unless (file-name-absolute-p file) | 952 | (unless (file-name-absolute-p file) |
| 951 | (let ((pos (compilation--previous-directory (point)))) | 953 | (let ((pos (compilation--previous-directory |
| 954 | (match-beginning 0)))) | ||
| 952 | (when pos | 955 | (when pos |
| 953 | (or (get-text-property (1- pos) 'compilation-directory) | 956 | (or (get-text-property (1- pos) 'compilation-directory) |
| 954 | (get-text-property pos 'compilation-directory))))))) | 957 | (get-text-property pos 'compilation-directory))))))) |
diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index c376b25fae0..0f823c806e0 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el | |||
| @@ -26,14 +26,14 @@ | |||
| 26 | 26 | ||
| 27 | ;; To enter Delphi mode when you find a Delphi source file, one must override | 27 | ;; To enter Delphi mode when you find a Delphi source file, one must override |
| 28 | ;; the auto-mode-alist to associate Delphi with .pas (and .dpr and .dpk) | 28 | ;; the auto-mode-alist to associate Delphi with .pas (and .dpr and .dpk) |
| 29 | ;; files. Emacs, by default, will otherwise enter Pascal mode. E.g. | 29 | ;; files. Emacs, by default, will otherwise enter Pascal mode. E.g. |
| 30 | ;; | 30 | ;; |
| 31 | ;; (autoload 'delphi-mode "delphi") | 31 | ;; (autoload 'delphi-mode "delphi") |
| 32 | ;; (setq auto-mode-alist | 32 | ;; (setq auto-mode-alist |
| 33 | ;; (cons '("\\.\\(pas\\|dpr\\|dpk\\)$" . delphi-mode) auto-mode-alist)) | 33 | ;; (cons '("\\.\\(pas\\|dpr\\|dpk\\)$" . delphi-mode) auto-mode-alist)) |
| 34 | 34 | ||
| 35 | ;; To get keyword, comment, and string literal coloring, be sure that font-lock | 35 | ;; To get keyword, comment, and string literal coloring, be sure that font-lock |
| 36 | ;; is running. One can manually do M-x font-lock-mode in a Delphi buffer, or | 36 | ;; is running. One can manually do M-x font-lock-mode in a Delphi buffer, or |
| 37 | ;; one can put in .emacs: | 37 | ;; one can put in .emacs: |
| 38 | ;; | 38 | ;; |
| 39 | ;; (add-hook 'delphi-mode-hook 'turn-on-font-lock) | 39 | ;; (add-hook 'delphi-mode-hook 'turn-on-font-lock) |
| @@ -56,8 +56,8 @@ | |||
| 56 | ;; When you have entered Delphi mode, you may get more info by pressing | 56 | ;; When you have entered Delphi mode, you may get more info by pressing |
| 57 | ;; C-h m. | 57 | ;; C-h m. |
| 58 | 58 | ||
| 59 | ;; This delphi mode implementation is fairly tolerant of syntax errors, relying | 59 | ;; This Delphi mode implementation is fairly tolerant of syntax errors, relying |
| 60 | ;; as much as possible on the indentation of the previous statement. This also | 60 | ;; as much as possible on the indentation of the previous statement. This also |
| 61 | ;; makes it faster and simpler, since there is less searching for properly | 61 | ;; makes it faster and simpler, since there is less searching for properly |
| 62 | ;; constructed beginnings. | 62 | ;; constructed beginnings. |
| 63 | 63 | ||
| @@ -74,15 +74,16 @@ | |||
| 74 | "True if in debug mode.") | 74 | "True if in debug mode.") |
| 75 | 75 | ||
| 76 | (defcustom delphi-search-path "." | 76 | (defcustom delphi-search-path "." |
| 77 | "*Directories to search when finding external units. It is a list of | 77 | "*Directories to search when finding external units. |
| 78 | directory strings. If only a single directory, it can be a single | 78 | It is a list of directory strings. If only a single directory, |
| 79 | string instead of a list. If a directory ends in \"...\" then that | 79 | it can be a single string instead of a list. If a directory |
| 80 | directory is recursively searched." | 80 | ends in \"...\" then that directory is recursively searched." |
| 81 | :type 'string | 81 | :type 'string |
| 82 | :group 'delphi) | 82 | :group 'delphi) |
| 83 | 83 | ||
| 84 | (defcustom delphi-indent-level 3 | 84 | (defcustom delphi-indent-level 3 |
| 85 | "*Indentation of Delphi statements with respect to containing block. E.g. | 85 | "*Indentation of Delphi statements with respect to containing block. |
| 86 | E.g. | ||
| 86 | 87 | ||
| 87 | begin | 88 | begin |
| 88 | // This is an indent of 3. | 89 | // This is an indent of 3. |
| @@ -117,7 +118,7 @@ end; end;" | |||
| 117 | :group 'delphi) | 118 | :group 'delphi) |
| 118 | 119 | ||
| 119 | (defcustom delphi-verbose t ; nil | 120 | (defcustom delphi-verbose t ; nil |
| 120 | "*If true then delphi token processing progress is reported to the user." | 121 | "*If true then Delphi token processing progress is reported to the user." |
| 121 | :type 'boolean | 122 | :type 'boolean |
| 122 | :group 'delphi) | 123 | :group 'delphi) |
| 123 | 124 | ||
| @@ -137,17 +138,17 @@ differs from the default." | |||
| 137 | :group 'delphi) | 138 | :group 'delphi) |
| 138 | 139 | ||
| 139 | (defcustom delphi-comment-face 'font-lock-comment-face | 140 | (defcustom delphi-comment-face 'font-lock-comment-face |
| 140 | "*Face used to color delphi comments." | 141 | "*Face used to color Delphi comments." |
| 141 | :type 'face | 142 | :type 'face |
| 142 | :group 'delphi) | 143 | :group 'delphi) |
| 143 | 144 | ||
| 144 | (defcustom delphi-string-face 'font-lock-string-face | 145 | (defcustom delphi-string-face 'font-lock-string-face |
| 145 | "*Face used to color delphi strings." | 146 | "*Face used to color Delphi strings." |
| 146 | :type 'face | 147 | :type 'face |
| 147 | :group 'delphi) | 148 | :group 'delphi) |
| 148 | 149 | ||
| 149 | (defcustom delphi-keyword-face 'font-lock-keyword-face | 150 | (defcustom delphi-keyword-face 'font-lock-keyword-face |
| 150 | "*Face used to color delphi keywords." | 151 | "*Face used to color Delphi keywords." |
| 151 | :type 'face | 152 | :type 'face |
| 152 | :group 'delphi) | 153 | :group 'delphi) |
| 153 | 154 | ||
| @@ -720,9 +721,9 @@ routine.") | |||
| 720 | (delphi-progress-done))))) | 721 | (delphi-progress-done))))) |
| 721 | 722 | ||
| 722 | (defvar delphi-ignore-changes t | 723 | (defvar delphi-ignore-changes t |
| 723 | "Internal flag to control if the delphi-mode responds to buffer changes. | 724 | "Internal flag to control if the Delphi mode responds to buffer changes. |
| 724 | Defaults to t in case the delphi-after-change function is called on a | 725 | Defaults to t in case the `delphi-after-change' function is called on a |
| 725 | non-delphi buffer. Set to nil in a delphi buffer. To override, just do: | 726 | non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: |
| 726 | (let ((delphi-ignore-changes t)) ...)") | 727 | (let ((delphi-ignore-changes t)) ...)") |
| 727 | 728 | ||
| 728 | (defun delphi-after-change (change-start change-end old-length) | 729 | (defun delphi-after-change (change-start change-end old-length) |
| @@ -1521,8 +1522,8 @@ non-delphi buffer. Set to nil in a delphi buffer. To override, just do: | |||
| 1521 | indent))) | 1522 | indent))) |
| 1522 | 1523 | ||
| 1523 | (defun delphi-indent-line () | 1524 | (defun delphi-indent-line () |
| 1524 | "Indent the current line according to the current language construct. If | 1525 | "Indent the current line according to the current language construct. |
| 1525 | before the indent, the point is moved to the indent." | 1526 | If before the indent, the point is moved to the indent." |
| 1526 | (interactive) | 1527 | (interactive) |
| 1527 | (delphi-save-match-data | 1528 | (delphi-save-match-data |
| 1528 | (let ((marked-point (point-marker)) ; Maintain our position reliably. | 1529 | (let ((marked-point (point-marker)) ; Maintain our position reliably. |
| @@ -1547,7 +1548,7 @@ before the indent, the point is moved to the indent." | |||
| 1547 | (set-marker marked-point nil)))) | 1548 | (set-marker marked-point nil)))) |
| 1548 | 1549 | ||
| 1549 | (defvar delphi-mode-abbrev-table nil | 1550 | (defvar delphi-mode-abbrev-table nil |
| 1550 | "Abbrev table in use in delphi-mode buffers.") | 1551 | "Abbrev table in use in Delphi mode buffers.") |
| 1551 | (define-abbrev-table 'delphi-mode-abbrev-table ()) | 1552 | (define-abbrev-table 'delphi-mode-abbrev-table ()) |
| 1552 | 1553 | ||
| 1553 | (defmacro delphi-ensure-buffer (buffer-var buffer-name) | 1554 | (defmacro delphi-ensure-buffer (buffer-var buffer-name) |
| @@ -1568,7 +1569,7 @@ before the indent, the point is moved to the indent." | |||
| 1568 | ;; Debugging helpers: | 1569 | ;; Debugging helpers: |
| 1569 | 1570 | ||
| 1570 | (defvar delphi-debug-buffer nil | 1571 | (defvar delphi-debug-buffer nil |
| 1571 | "Buffer to write delphi-mode debug messages to. Created on demand.") | 1572 | "Buffer to write Delphi mode debug messages to. Created on demand.") |
| 1572 | 1573 | ||
| 1573 | (defun delphi-debug-log (format-string &rest args) | 1574 | (defun delphi-debug-log (format-string &rest args) |
| 1574 | ;; Writes a message to the log buffer. | 1575 | ;; Writes a message to the log buffer. |
| @@ -1679,7 +1680,7 @@ before the indent, the point is moved to the indent." | |||
| 1679 | 1680 | ||
| 1680 | (defun delphi-tab () | 1681 | (defun delphi-tab () |
| 1681 | "Indent the region, when Transient Mark mode is enabled and the region is | 1682 | "Indent the region, when Transient Mark mode is enabled and the region is |
| 1682 | active. Otherwise, indent the current line or insert a TAB, depending on the | 1683 | active. Otherwise, indent the current line or insert a TAB, depending on the |
| 1683 | value of `delphi-tab-always-indents' and the current line position." | 1684 | value of `delphi-tab-always-indents' and the current line position." |
| 1684 | (interactive) | 1685 | (interactive) |
| 1685 | (cond ((use-region-p) | 1686 | (cond ((use-region-p) |
| @@ -1768,8 +1769,8 @@ value of `delphi-tab-always-indents' and the current line position." | |||
| 1768 | nil)) | 1769 | nil)) |
| 1769 | 1770 | ||
| 1770 | (defun delphi-find-unit (unit) | 1771 | (defun delphi-find-unit (unit) |
| 1771 | "Finds the specified delphi source file according to `delphi-search-path'. | 1772 | "Find the specified Delphi source file according to `delphi-search-path'. |
| 1772 | If no extension is specified, .pas is assumed. Creates a buffer for the unit." | 1773 | If no extension is specified, .pas is assumed. Creates a buffer for the unit." |
| 1773 | (interactive "sDelphi unit name: ") | 1774 | (interactive "sDelphi unit name: ") |
| 1774 | (let* ((unit-file (if (string-match "^\\(.*\\)\\.[a-z]+$" unit) | 1775 | (let* ((unit-file (if (string-match "^\\(.*\\)\\.[a-z]+$" unit) |
| 1775 | unit | 1776 | unit |
| @@ -1791,7 +1792,7 @@ If no extension is specified, .pas is assumed. Creates a buffer for the unit." | |||
| 1791 | "Find the definition of the identifier under the current point, searching | 1792 | "Find the definition of the identifier under the current point, searching |
| 1792 | in external units if necessary (as listed in the current unit's use clause). | 1793 | in external units if necessary (as listed in the current unit's use clause). |
| 1793 | The set of directories to search for a unit is specified by the global variable | 1794 | The set of directories to search for a unit is specified by the global variable |
| 1794 | delphi-search-path." | 1795 | `delphi-search-path'." |
| 1795 | (interactive) | 1796 | (interactive) |
| 1796 | (error "delphi-find-current-xdef: not implemented yet")) | 1797 | (error "delphi-find-current-xdef: not implemented yet")) |
| 1797 | 1798 | ||
| @@ -1802,7 +1803,7 @@ it is a routine." | |||
| 1802 | (error "delphi-find-current-body: not implemented yet")) | 1803 | (error "delphi-find-current-body: not implemented yet")) |
| 1803 | 1804 | ||
| 1804 | (defun delphi-fill-comment () | 1805 | (defun delphi-fill-comment () |
| 1805 | "Fills the text of the current comment, according to `fill-column'. | 1806 | "Fill the text of the current comment, according to `fill-column'. |
| 1806 | An error is raised if not in a comment." | 1807 | An error is raised if not in a comment." |
| 1807 | (interactive) | 1808 | (interactive) |
| 1808 | (save-excursion | 1809 | (save-excursion |
| @@ -1888,8 +1889,8 @@ An error is raised if not in a comment." | |||
| 1888 | (delphi-progress-done))))))) | 1889 | (delphi-progress-done))))))) |
| 1889 | 1890 | ||
| 1890 | (defun delphi-new-comment-line () | 1891 | (defun delphi-new-comment-line () |
| 1891 | "If in a // comment, does a newline, indented such that one is still in the | 1892 | "If in a // comment, do a newline, indented such that one is still in the |
| 1892 | comment block. If not in a // comment, just does a normal newline." | 1893 | comment block. If not in a // comment, just does a normal newline." |
| 1893 | (interactive) | 1894 | (interactive) |
| 1894 | (let ((comment (delphi-current-token))) | 1895 | (let ((comment (delphi-current-token))) |
| 1895 | (if (not (eq 'comment-single-line (delphi-token-kind comment))) | 1896 | (if (not (eq 'comment-single-line (delphi-token-kind comment))) |
| @@ -1923,7 +1924,7 @@ comment block. If not in a // comment, just does a normal newline." | |||
| 1923 | nil ; Syntax begin movement doesn't apply | 1924 | nil ; Syntax begin movement doesn't apply |
| 1924 | (font-lock-fontify-region-function . delphi-fontify-region) | 1925 | (font-lock-fontify-region-function . delphi-fontify-region) |
| 1925 | (font-lock-verbose . delphi-fontifying-progress-step)) | 1926 | (font-lock-verbose . delphi-fontifying-progress-step)) |
| 1926 | "Delphi mode font-lock defaults. Syntactic fontification is ignored.") | 1927 | "Delphi mode font-lock defaults. Syntactic fontification is ignored.") |
| 1927 | 1928 | ||
| 1928 | (defvar delphi-debug-mode-map | 1929 | (defvar delphi-debug-mode-map |
| 1929 | (let ((kmap (make-sparse-keymap))) | 1930 | (let ((kmap (make-sparse-keymap))) |
| @@ -1944,7 +1945,7 @@ comment block. If not in a // comment, just does a normal newline." | |||
| 1944 | ("x" delphi-debug-show-is-stable) | 1945 | ("x" delphi-debug-show-is-stable) |
| 1945 | )) | 1946 | )) |
| 1946 | kmap) | 1947 | kmap) |
| 1947 | "Keystrokes for delphi-mode debug commands.") | 1948 | "Keystrokes for Delphi mode debug commands.") |
| 1948 | 1949 | ||
| 1949 | (defvar delphi-mode-map | 1950 | (defvar delphi-mode-map |
| 1950 | (let ((kmap (make-sparse-keymap))) | 1951 | (let ((kmap (make-sparse-keymap))) |
| @@ -1964,7 +1965,7 @@ comment block. If not in a // comment, just does a normal newline." | |||
| 1964 | "Keymap used in Delphi mode.") | 1965 | "Keymap used in Delphi mode.") |
| 1965 | 1966 | ||
| 1966 | (defconst delphi-mode-syntax-table (make-syntax-table) | 1967 | (defconst delphi-mode-syntax-table (make-syntax-table) |
| 1967 | "Delphi mode's syntax table. It is just a standard syntax table. | 1968 | "Delphi mode's syntax table. It is just a standard syntax table. |
| 1968 | This is ok since we do our own keyword/comment/string face coloring.") | 1969 | This is ok since we do our own keyword/comment/string face coloring.") |
| 1969 | 1970 | ||
| 1970 | ;;;###autoload | 1971 | ;;;###autoload |
| @@ -1976,7 +1977,7 @@ This is ok since we do our own keyword/comment/string face coloring.") | |||
| 1976 | \\[delphi-fill-comment]\t- Fill the current comment. | 1977 | \\[delphi-fill-comment]\t- Fill the current comment. |
| 1977 | \\[delphi-new-comment-line]\t- If in a // comment, do a new comment line. | 1978 | \\[delphi-new-comment-line]\t- If in a // comment, do a new comment line. |
| 1978 | 1979 | ||
| 1979 | M-x indent-region also works for indenting a whole region. | 1980 | \\[indent-region] also works for indenting a whole region. |
| 1980 | 1981 | ||
| 1981 | Customization: | 1982 | Customization: |
| 1982 | 1983 | ||
| @@ -1996,21 +1997,21 @@ Customization: | |||
| 1996 | `delphi-search-path' (default .) | 1997 | `delphi-search-path' (default .) |
| 1997 | Directories to search when finding external units. | 1998 | Directories to search when finding external units. |
| 1998 | `delphi-verbose' (default nil) | 1999 | `delphi-verbose' (default nil) |
| 1999 | If true then delphi token processing progress is reported to the user. | 2000 | If true then Delphi token processing progress is reported to the user. |
| 2000 | 2001 | ||
| 2001 | Coloring: | 2002 | Coloring: |
| 2002 | 2003 | ||
| 2003 | `delphi-comment-face' (default font-lock-comment-face) | 2004 | `delphi-comment-face' (default font-lock-comment-face) |
| 2004 | Face used to color delphi comments. | 2005 | Face used to color Delphi comments. |
| 2005 | `delphi-string-face' (default font-lock-string-face) | 2006 | `delphi-string-face' (default font-lock-string-face) |
| 2006 | Face used to color delphi strings. | 2007 | Face used to color Delphi strings. |
| 2007 | `delphi-keyword-face' (default font-lock-keyword-face) | 2008 | `delphi-keyword-face' (default font-lock-keyword-face) |
| 2008 | Face used to color delphi keywords. | 2009 | Face used to color Delphi keywords. |
| 2009 | `delphi-other-face' (default nil) | 2010 | `delphi-other-face' (default nil) |
| 2010 | Face used to color everything else. | 2011 | Face used to color everything else. |
| 2011 | 2012 | ||
| 2012 | Turning on Delphi mode calls the value of the variable delphi-mode-hook with | 2013 | Turning on Delphi mode calls the value of the variable `delphi-mode-hook' |
| 2013 | no args, if that value is non-nil." | 2014 | with no args, if that value is non-nil." |
| 2014 | (interactive) | 2015 | (interactive) |
| 2015 | (kill-all-local-variables) | 2016 | (kill-all-local-variables) |
| 2016 | (use-local-map delphi-mode-map) | 2017 | (use-local-map delphi-mode-map) |
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index d674484345a..87e5875c943 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el | |||
| @@ -3566,12 +3566,12 @@ KIND is an additional string printed in the buffer." | |||
| 3566 | (insert kind) | 3566 | (insert kind) |
| 3567 | (indent-to 50) | 3567 | (indent-to 50) |
| 3568 | (insert (case (second info) | 3568 | (insert (case (second info) |
| 3569 | ('ebrowse-ts-member-functions "member function") | 3569 | (ebrowse-ts-member-functions "member function") |
| 3570 | ('ebrowse-ts-member-variables "member variable") | 3570 | (ebrowse-ts-member-variables "member variable") |
| 3571 | ('ebrowse-ts-static-functions "static function") | 3571 | (ebrowse-ts-static-functions "static function") |
| 3572 | ('ebrowse-ts-static-variables "static variable") | 3572 | (ebrowse-ts-static-variables "static variable") |
| 3573 | ('ebrowse-ts-friends (if globals-p "define" "friend")) | 3573 | (ebrowse-ts-friends (if globals-p "define" "friend")) |
| 3574 | ('ebrowse-ts-types "type") | 3574 | (ebrowse-ts-types "type") |
| 3575 | (t "unknown")) | 3575 | (t "unknown")) |
| 3576 | "\n"))) | 3576 | "\n"))) |
| 3577 | 3577 | ||
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 25d1410621a..ab315f9eefd 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el | |||
| @@ -648,21 +648,36 @@ detailed description of this mode. | |||
| 648 | (set (make-local-variable 'gud-minor-mode) 'gdbmi) | 648 | (set (make-local-variable 'gud-minor-mode) 'gdbmi) |
| 649 | (setq comint-input-sender 'gdb-send) | 649 | (setq comint-input-sender 'gdb-send) |
| 650 | (when (ring-empty-p comint-input-ring) ; cf shell-mode | 650 | (when (ring-empty-p comint-input-ring) ; cf shell-mode |
| 651 | (let (hfile) | 651 | (let ((hfile (expand-file-name (or (getenv "GBDHISTFILE") |
| 652 | (when (catch 'done | 652 | (if (eq system-type 'ms-dos) |
| 653 | (dolist (file '(".gdbinit" "~/.gdbinit")) | 653 | "_gdb_history" |
| 654 | (if (file-readable-p (setq file (expand-file-name file))) | 654 | ".gdb_history")))) |
| 655 | (with-temp-buffer | 655 | ;; gdb defaults to 256, but we'll default to comint-input-ring-size. |
| 656 | (insert-file-contents file) | 656 | (hsize (getenv "HISTSIZE"))) |
| 657 | (and (re-search-forward | 657 | (dolist (file (append '("~/.gdbinit") |
| 658 | "^ *set history filename *\\(.*\\)" nil t) | 658 | (unless (string-equal (expand-file-name ".") |
| 659 | (file-readable-p | 659 | (expand-file-name "~")) |
| 660 | (setq hfile (expand-file-name | 660 | '(".gdbinit")))) |
| 661 | (match-string 1) | 661 | (if (file-readable-p (setq file (expand-file-name file))) |
| 662 | (file-name-directory file)))) | 662 | (with-temp-buffer |
| 663 | (throw 'done t)))))) | 663 | (insert-file-contents file) |
| 664 | (set (make-local-variable 'comint-input-ring-file-name) hfile) | 664 | ;; TODO? check for "set history save\\( *on\\)?" and do |
| 665 | (comint-read-input-ring t)))) | 665 | ;; not use history otherwise? |
| 666 | (while (re-search-forward | ||
| 667 | "^ *set history \\(filename\\|size\\) *\\(.*\\)" nil t) | ||
| 668 | (cond ((string-equal (match-string 1) "filename") | ||
| 669 | (setq hfile (expand-file-name | ||
| 670 | (match-string 2) | ||
| 671 | (file-name-directory file)))) | ||
| 672 | ((string-equal (match-string 1) "size") | ||
| 673 | (setq hsize (match-string 2)))))))) | ||
| 674 | (and (stringp hsize) | ||
| 675 | (integerp (setq hsize (string-to-number hsize))) | ||
| 676 | (> hsize 0) | ||
| 677 | (set (make-local-variable 'comint-input-ring-size) hsize)) | ||
| 678 | (if (stringp hfile) | ||
| 679 | (set (make-local-variable 'comint-input-ring-file-name) hfile)) | ||
| 680 | (comint-read-input-ring t))) | ||
| 666 | (gud-def gud-tbreak "tbreak %f:%l" "\C-t" | 681 | (gud-def gud-tbreak "tbreak %f:%l" "\C-t" |
| 667 | "Set temporary breakpoint at current line.") | 682 | "Set temporary breakpoint at current line.") |
| 668 | (gud-def gud-jump | 683 | (gud-def gud-jump |
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 53918b903ee..47cbdf19ed2 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el | |||
| @@ -3127,7 +3127,9 @@ class of the file (using s to separate nested class ids)." | |||
| 3127 | ("^document\\s-.*\\(\n\\)" (1 "< b")) | 3127 | ("^document\\s-.*\\(\n\\)" (1 "< b")) |
| 3128 | ("^end\\(\\>\\)" | 3128 | ("^end\\(\\>\\)" |
| 3129 | (1 (ignore | 3129 | (1 (ignore |
| 3130 | (unless (eq (match-beginning 0) (point-min)) | 3130 | (when (and (> (match-beginning 0) (point-min)) |
| 3131 | (eq 1 (nth 7 (save-excursion | ||
| 3132 | (syntax-ppss (1- (match-beginning 0))))))) | ||
| 3131 | ;; We change the \n in front, which is more difficult, but results | 3133 | ;; We change the \n in front, which is more difficult, but results |
| 3132 | ;; in better highlighting. If the doc is empty, the single \n is | 3134 | ;; in better highlighting. If the doc is empty, the single \n is |
| 3133 | ;; both the beginning and the end of the docstring, which can't be | 3135 | ;; both the beginning and the end of the docstring, which can't be |
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 9d40b4d8fd7..c8b156c5441 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el | |||
| @@ -974,7 +974,7 @@ With ARG, do it many times. Negative ARG means move forward." | |||
| 974 | (goto-char (scan-sexps (1+ (point)) -1)) | 974 | (goto-char (scan-sexps (1+ (point)) -1)) |
| 975 | (case (char-before) | 975 | (case (char-before) |
| 976 | (?% (forward-char -1)) | 976 | (?% (forward-char -1)) |
| 977 | ('(?q ?Q ?w ?W ?r ?x) | 977 | ((?q ?Q ?w ?W ?r ?x) |
| 978 | (if (eq (char-before (1- (point))) ?%) (forward-char -2)))) | 978 | (if (eq (char-before (1- (point))) ?%) (forward-char -2)))) |
| 979 | nil) | 979 | nil) |
| 980 | ((looking-at "\\s\"\\|\\\\\\S_") | 980 | ((looking-at "\\s\"\\|\\\\\\S_") |
diff --git a/lisp/server.el b/lisp/server.el index 019a16a43d7..ce14f133f0a 100644 --- a/lisp/server.el +++ b/lisp/server.el | |||
| @@ -486,7 +486,13 @@ See variable `server-auth-dir' for details." | |||
| 486 | (file-name-as-directory dir)) | 486 | (file-name-as-directory dir)) |
| 487 | :warning) | 487 | :warning) |
| 488 | (throw :safe t)) | 488 | (throw :safe t)) |
| 489 | (unless (eql uid (user-uid)) ; is the dir ours? | 489 | (unless (or (= uid (user-uid)) ; is the dir ours? |
| 490 | (and w32 | ||
| 491 | ;; Files created on Windows by | ||
| 492 | ;; Administrator (RID=500) have | ||
| 493 | ;; the Administrators (RID=544) | ||
| 494 | ;; group recorded as the owner. | ||
| 495 | (= uid 544) (= (user-uid) 500))) | ||
| 490 | (throw :safe nil)) | 496 | (throw :safe nil)) |
| 491 | (when w32 ; on NTFS? | 497 | (when w32 ; on NTFS? |
| 492 | (throw :safe t)) | 498 | (throw :safe t)) |
diff --git a/lisp/shell.el b/lisp/shell.el index 2f11cc6314c..dde81c6cb95 100644 --- a/lisp/shell.el +++ b/lisp/shell.el | |||
| @@ -459,7 +459,12 @@ buffer." | |||
| 459 | ;; shell-dependent assignments. | 459 | ;; shell-dependent assignments. |
| 460 | (when (ring-empty-p comint-input-ring) | 460 | (when (ring-empty-p comint-input-ring) |
| 461 | (let ((shell (file-name-nondirectory (car | 461 | (let ((shell (file-name-nondirectory (car |
| 462 | (process-command (get-buffer-process (current-buffer))))))) | 462 | (process-command (get-buffer-process (current-buffer)))))) |
| 463 | (hsize (getenv "HISTSIZE"))) | ||
| 464 | (and (stringp hsize) | ||
| 465 | (integerp (setq hsize (string-to-number hsize))) | ||
| 466 | (> hsize 0) | ||
| 467 | (set (make-local-variable 'comint-input-ring-size) hsize)) | ||
| 463 | (setq comint-input-ring-file-name | 468 | (setq comint-input-ring-file-name |
| 464 | (or (getenv "HISTFILE") | 469 | (or (getenv "HISTFILE") |
| 465 | (cond ((string-equal shell "bash") "~/.bash_history") | 470 | (cond ((string-equal shell "bash") "~/.bash_history") |
| @@ -578,6 +583,21 @@ Otherwise, one argument `-i' is passed to the shell. | |||
| 578 | (get-buffer-create (or buffer "*shell*")) | 583 | (get-buffer-create (or buffer "*shell*")) |
| 579 | ;; If the current buffer is a dead shell buffer, use it. | 584 | ;; If the current buffer is a dead shell buffer, use it. |
| 580 | (current-buffer))) | 585 | (current-buffer))) |
| 586 | |||
| 587 | ;; On remote hosts, the local `shell-file-name' might be useless. | ||
| 588 | (if (and (interactive-p) | ||
| 589 | (file-remote-p default-directory) | ||
| 590 | (null explicit-shell-file-name) | ||
| 591 | (null (getenv "ESHELL"))) | ||
| 592 | (with-current-buffer buffer | ||
| 593 | (set (make-local-variable 'explicit-shell-file-name) | ||
| 594 | (file-remote-p | ||
| 595 | (expand-file-name | ||
| 596 | (read-file-name | ||
| 597 | "Remote shell path: " default-directory shell-file-name | ||
| 598 | t shell-file-name)) | ||
| 599 | 'localname)))) | ||
| 600 | |||
| 581 | ;; Pop to buffer, so that the buffer's window will be correctly set | 601 | ;; Pop to buffer, so that the buffer's window will be correctly set |
| 582 | ;; when we call comint (so that comint sets the COLUMNS env var properly). | 602 | ;; when we call comint (so that comint sets the COLUMNS env var properly). |
| 583 | (pop-to-buffer buffer) | 603 | (pop-to-buffer buffer) |
diff --git a/lisp/simple.el b/lisp/simple.el index 7a191f0cc9a..e4c742b56f4 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -636,7 +636,9 @@ If the region is active, only delete whitespace within the region." | |||
| 636 | (if (looking-at ".*\f") | 636 | (if (looking-at ".*\f") |
| 637 | (goto-char (match-end 0)))) | 637 | (goto-char (match-end 0)))) |
| 638 | (delete-region (point) (match-end 0))) | 638 | (delete-region (point) (match-end 0))) |
| 639 | (set-marker end-marker nil))))) | 639 | (set-marker end-marker nil)))) |
| 640 | ;; Return nil for the benefit of `write-file-functions'. | ||
| 641 | nil) | ||
| 640 | 642 | ||
| 641 | (defun newline-and-indent () | 643 | (defun newline-and-indent () |
| 642 | "Insert a newline, then indent according to major mode. | 644 | "Insert a newline, then indent according to major mode. |
| @@ -2627,7 +2629,7 @@ specifies the value of ERROR-BUFFER." | |||
| 2627 | (with-output-to-string | 2629 | (with-output-to-string |
| 2628 | (with-current-buffer | 2630 | (with-current-buffer |
| 2629 | standard-output | 2631 | standard-output |
| 2630 | (call-process shell-file-name nil t nil shell-command-switch command)))) | 2632 | (process-file shell-file-name nil t nil shell-command-switch command)))) |
| 2631 | 2633 | ||
| 2632 | (defun process-file (program &optional infile buffer display &rest args) | 2634 | (defun process-file (program &optional infile buffer display &rest args) |
| 2633 | "Process files synchronously in a separate process. | 2635 | "Process files synchronously in a separate process. |
diff --git a/lisp/startup.el b/lisp/startup.el index 4dbf41d3ac6..765ca1540ee 100644 --- a/lisp/startup.el +++ b/lisp/startup.el | |||
| @@ -392,6 +392,15 @@ Warning Warning!!! Pure space overflow !!!Warning Warning | |||
| 392 | :type 'directory | 392 | :type 'directory |
| 393 | :initialize 'custom-initialize-delay) | 393 | :initialize 'custom-initialize-delay) |
| 394 | 394 | ||
| 395 | (defconst package-subdirectory-regexp | ||
| 396 | "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" | ||
| 397 | "Regular expression matching the name of a package subdirectory. | ||
| 398 | The first subexpression is the package name. | ||
| 399 | The second subexpression is the version string. | ||
| 400 | |||
| 401 | The regexp should not contain a starting \"\\`\" or a trailing | ||
| 402 | \"\\'\"; those are added automatically by callers.") | ||
| 403 | |||
| 395 | (defun normal-top-level-add-subdirs-to-load-path () | 404 | (defun normal-top-level-add-subdirs-to-load-path () |
| 396 | "Add all subdirectories of current directory to `load-path'. | 405 | "Add all subdirectories of current directory to `load-path'. |
| 397 | More precisely, this uses only the subdirectories whose names | 406 | More precisely, this uses only the subdirectories whose names |
| @@ -1006,19 +1015,23 @@ opening the first frame (e.g. open a connection to an X server).") | |||
| 1006 | (if init-file-user | 1015 | (if init-file-user |
| 1007 | (let ((user-init-file-1 | 1016 | (let ((user-init-file-1 |
| 1008 | (cond | 1017 | (cond |
| 1009 | ((eq system-type 'ms-dos) | 1018 | ((eq system-type 'ms-dos) |
| 1010 | (concat "~" init-file-user "/_emacs")) | 1019 | (concat "~" init-file-user "/_emacs")) |
| 1011 | ((eq system-type 'windows-nt) | 1020 | ((not (eq system-type 'windows-nt)) |
| 1012 | ;; Prefer .emacs on Windows. | 1021 | (concat "~" init-file-user "/.emacs")) |
| 1013 | (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$") | 1022 | ;; Else deal with the Windows situation |
| 1014 | "~/.emacs" | 1023 | ((directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$") |
| 1015 | ;; Also support _emacs for compatibility. | 1024 | ;; Prefer .emacs on Windows. |
| 1016 | (if (directory-files "~" nil "^_emacs\\(\\.elc?\\)?$") | 1025 | "~/.emacs") |
| 1017 | "~/_emacs" | 1026 | ((directory-files "~" nil "^_emacs\\(\\.elc?\\)?$") |
| 1018 | ;; But default to .emacs if _emacs does not exist. | 1027 | ;; Also support _emacs for compatibility, but warn about it. |
| 1019 | "~/.emacs"))) | 1028 | (display-warning |
| 1020 | (t | 1029 | 'initialization |
| 1021 | (concat "~" init-file-user "/.emacs"))))) | 1030 | "`_emacs' init file is deprecated, please use `.emacs'" |
| 1031 | :warning) | ||
| 1032 | "~/_emacs") | ||
| 1033 | (t ;; But default to .emacs if _emacs does not exist. | ||
| 1034 | "~/.emacs")))) | ||
| 1022 | ;; This tells `load' to store the file name found | 1035 | ;; This tells `load' to store the file name found |
| 1023 | ;; into user-init-file. | 1036 | ;; into user-init-file. |
| 1024 | (setq user-init-file t) | 1037 | (setq user-init-file t) |
| @@ -1190,9 +1203,9 @@ the `--debug-init' option to view a complete error backtrace." | |||
| 1190 | (when (file-directory-p dir) | 1203 | (when (file-directory-p dir) |
| 1191 | (dolist (subdir (directory-files dir)) | 1204 | (dolist (subdir (directory-files dir)) |
| 1192 | (when (and (file-directory-p (expand-file-name subdir dir)) | 1205 | (when (and (file-directory-p (expand-file-name subdir dir)) |
| 1193 | ;; package-subdirectory-regexp from package.el | 1206 | (string-match |
| 1194 | (string-match "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" | 1207 | (concat "\\`" package-subdirectory-regexp "\\'") |
| 1195 | subdir)) | 1208 | subdir)) |
| 1196 | (throw 'package-dir-found t))))))) | 1209 | (throw 'package-dir-found t))))))) |
| 1197 | (package-initialize)) | 1210 | (package-initialize)) |
| 1198 | 1211 | ||
diff --git a/lisp/subr.el b/lisp/subr.el index 45cfb56bdc1..9f4e35fcbe0 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -2066,24 +2066,24 @@ If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore | |||
| 2066 | keyboard-quit events while waiting for a valid input." | 2066 | keyboard-quit events while waiting for a valid input." |
| 2067 | (unless (consp chars) | 2067 | (unless (consp chars) |
| 2068 | (error "Called `read-char-choice' without valid char choices")) | 2068 | (error "Called `read-char-choice' without valid char choices")) |
| 2069 | (let ((cursor-in-echo-area t) | 2069 | (let (char done) |
| 2070 | (executing-kbd-macro executing-kbd-macro) | 2070 | (let ((cursor-in-echo-area t) |
| 2071 | char done) | 2071 | (executing-kbd-macro executing-kbd-macro)) |
| 2072 | (while (not done) | 2072 | (while (not done) |
| 2073 | (unless (get-text-property 0 'face prompt) | 2073 | (unless (get-text-property 0 'face prompt) |
| 2074 | (setq prompt (propertize prompt 'face 'minibuffer-prompt))) | 2074 | (setq prompt (propertize prompt 'face 'minibuffer-prompt))) |
| 2075 | (setq char (let ((inhibit-quit inhibit-keyboard-quit)) | 2075 | (setq char (let ((inhibit-quit inhibit-keyboard-quit)) |
| 2076 | (read-key prompt))) | 2076 | (read-key prompt))) |
| 2077 | (cond | 2077 | (cond |
| 2078 | ((not (numberp char))) | 2078 | ((not (numberp char))) |
| 2079 | ((memq char chars) | 2079 | ((memq char chars) |
| 2080 | (setq done t)) | 2080 | (setq done t)) |
| 2081 | ((and executing-kbd-macro (= char -1)) | 2081 | ((and executing-kbd-macro (= char -1)) |
| 2082 | ;; read-event returns -1 if we are in a kbd macro and | 2082 | ;; read-event returns -1 if we are in a kbd macro and |
| 2083 | ;; there are no more events in the macro. Attempt to | 2083 | ;; there are no more events in the macro. Attempt to |
| 2084 | ;; get an event interactively. | 2084 | ;; get an event interactively. |
| 2085 | (setq executing-kbd-macro nil)))) | 2085 | (setq executing-kbd-macro nil))))) |
| 2086 | ;; Display the question with the answer. | 2086 | ;; Display the question with the answer. But without cursor-in-echo-area. |
| 2087 | (message "%s%s" prompt (char-to-string char)) | 2087 | (message "%s%s" prompt (char-to-string char)) |
| 2088 | char)) | 2088 | char)) |
| 2089 | 2089 | ||
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index dfd12a005a9..7e9ce9aff6d 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el | |||
| @@ -318,11 +318,12 @@ chapter." | |||
| 318 | 318 | ||
| 319 | (defconst texinfo-environments | 319 | (defconst texinfo-environments |
| 320 | '("cartouche" "copying" "defcv" "deffn" "defivar" "defmac" | 320 | '("cartouche" "copying" "defcv" "deffn" "defivar" "defmac" |
| 321 | "defmethod" "defop" "defopt" "defspec" "deftp" "deftypefn" | 321 | "defmethod" "defop" "defopt" "defspec" "deftp" "deftypecv" |
| 322 | "deftypefun" "deftypevar" "deftypevr" "defun" "defvar" | 322 | "deftypefn" "deftypefun" "deftypeivar" "deftypemethod" |
| 323 | "deftypeop" "deftypevar" "deftypevr" "defun" "defvar" | ||
| 323 | "defvr" "description" "detailmenu" "direntry" "display" | 324 | "defvr" "description" "detailmenu" "direntry" "display" |
| 324 | "documentdescription" "enumerate" "example" "flushleft" | 325 | "documentdescription" "enumerate" "example" "flushleft" |
| 325 | "flushright" "format" "ftable" "group" "ifclear" "ifset" | 326 | "flushright" "format" "ftable" "group" "html" "ifclear" "ifset" |
| 326 | "ifhtml" "ifinfo" "ifnothtml" "ifnotinfo" "ifnotplaintext" | 327 | "ifhtml" "ifinfo" "ifnothtml" "ifnotinfo" "ifnotplaintext" |
| 327 | "ifnottex" "ifplaintext" "iftex" "ignore" "itemize" "lisp" | 328 | "ifnottex" "ifplaintext" "iftex" "ignore" "itemize" "lisp" |
| 328 | "macro" "menu" "multitable" "quotation" "smalldisplay" | 329 | "macro" "menu" "multitable" "quotation" "smalldisplay" |
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index f55629b3ea1..50f20cea779 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el | |||
| @@ -122,8 +122,7 @@ when editing big diffs)." | |||
| 122 | ("\C-m" . diff-goto-source) | 122 | ("\C-m" . diff-goto-source) |
| 123 | ([mouse-2] . diff-goto-source) | 123 | ([mouse-2] . diff-goto-source) |
| 124 | ;; From XEmacs' diff-mode. | 124 | ;; From XEmacs' diff-mode. |
| 125 | ;; Standard M-w is useful, so don't change M-W. | 125 | ("W" . widen) |
| 126 | ;;("W" . widen) | ||
| 127 | ;;("." . diff-goto-source) ;display-buffer | 126 | ;;("." . diff-goto-source) ;display-buffer |
| 128 | ;;("f" . diff-goto-source) ;find-file | 127 | ;;("f" . diff-goto-source) ;find-file |
| 129 | ("o" . diff-goto-source) ;other-window | 128 | ("o" . diff-goto-source) ;other-window |
| @@ -135,17 +134,21 @@ when editing big diffs)." | |||
| 135 | ;; Not useful if you have to metafy them. | 134 | ;; Not useful if you have to metafy them. |
| 136 | ;;(" " . scroll-up) | 135 | ;;(" " . scroll-up) |
| 137 | ;;("\177" . scroll-down) | 136 | ;;("\177" . scroll-down) |
| 138 | ;; Standard M-a is useful, so don't change M-A. | 137 | ("A" . diff-ediff-patch) |
| 139 | ;;("A" . diff-ediff-patch) | 138 | ("r" . diff-restrict-view) |
| 140 | ;; Standard M-r is useful, so don't change M-r or M-R. | 139 | ("R" . diff-reverse-direction)) |
| 141 | ;;("r" . diff-restrict-view) | ||
| 142 | ;;("R" . diff-reverse-direction) | ||
| 143 | ) | ||
| 144 | "Basic keymap for `diff-mode', bound to various prefix keys." | 140 | "Basic keymap for `diff-mode', bound to various prefix keys." |
| 145 | :inherit special-mode-map) | 141 | :inherit special-mode-map) |
| 146 | 142 | ||
| 147 | (easy-mmode-defmap diff-mode-map | 143 | (easy-mmode-defmap diff-mode-map |
| 148 | `(("\e" . ,diff-mode-shared-map) | 144 | `(("\e" . ,(let ((map (make-sparse-keymap))) |
| 145 | ;; We want to inherit most bindings from diff-mode-shared-map, | ||
| 146 | ;; but not all since they may hide useful M-<foo> global | ||
| 147 | ;; bindings when editing. | ||
| 148 | (set-keymap-parent map diff-mode-shared-map) | ||
| 149 | (dolist (key '("A" "r" "R" "g" "q" "W")) | ||
| 150 | (define-key map key nil)) | ||
| 151 | map)) | ||
| 149 | ;; From compilation-minor-mode. | 152 | ;; From compilation-minor-mode. |
| 150 | ("\C-c\C-c" . diff-goto-source) | 153 | ("\C-c\C-c" . diff-goto-source) |
| 151 | ;; By analogy with the global C-x 4 a binding. | 154 | ;; By analogy with the global C-x 4 a binding. |
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index 601b6b1e597..5435a840ac9 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el | |||
| @@ -3176,21 +3176,26 @@ See also `auto-save-file-name-p'." | |||
| 3176 | 3176 | ||
| 3177 | ;; Metacharacters that have to be protected from the shell when executing | 3177 | ;; Metacharacters that have to be protected from the shell when executing |
| 3178 | ;; a diff/diff3 command. | 3178 | ;; a diff/diff3 command. |
| 3179 | (defcustom emerge-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]" | 3179 | (defcustom emerge-metachars |
| 3180 | "Characters that must be quoted with \\ when used in a shell command line. | 3180 | (if (memq system-type '(ms-dos windows-nt)) |
| 3181 | "[ \t\"<>|?*^&=]" | ||
| 3182 | "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]") | ||
| 3183 | "Characters that must be quoted when used in a shell command line. | ||
| 3181 | More precisely, a [...] regexp to match any one such character." | 3184 | More precisely, a [...] regexp to match any one such character." |
| 3182 | :type 'regexp | 3185 | :type 'regexp |
| 3183 | :group 'emerge) | 3186 | :group 'emerge) |
| 3184 | 3187 | ||
| 3185 | ;; Quote metacharacters (using \) when executing a diff/diff3 command. | 3188 | ;; Quote metacharacters (using \) when executing a diff/diff3 command. |
| 3186 | (defun emerge-protect-metachars (s) | 3189 | (defun emerge-protect-metachars (s) |
| 3187 | (let ((limit 0)) | 3190 | (if (memq system-type '(ms-dos windows-nt)) |
| 3188 | (while (string-match emerge-metachars s limit) | 3191 | (shell-quote-argument s) |
| 3189 | (setq s (concat (substring s 0 (match-beginning 0)) | 3192 | (let ((limit 0)) |
| 3190 | "\\" | 3193 | (while (string-match emerge-metachars s limit) |
| 3191 | (substring s (match-beginning 0)))) | 3194 | (setq s (concat (substring s 0 (match-beginning 0)) |
| 3192 | (setq limit (1+ (match-end 0))))) | 3195 | "\\" |
| 3193 | s) | 3196 | (substring s (match-beginning 0)))) |
| 3197 | (setq limit (1+ (match-end 0))))) | ||
| 3198 | s)) | ||
| 3194 | 3199 | ||
| 3195 | (provide 'emerge) | 3200 | (provide 'emerge) |
| 3196 | 3201 | ||
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index a0a16601ed7..21cb86a9840 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el | |||
| @@ -435,8 +435,13 @@ If any error occurred in running `bzr status', then return nil." | |||
| 435 | (defun vc-bzr-state (file) | 435 | (defun vc-bzr-state (file) |
| 436 | (lexical-let ((result (vc-bzr-status file))) | 436 | (lexical-let ((result (vc-bzr-status file))) |
| 437 | (when (consp result) | 437 | (when (consp result) |
| 438 | (when (cdr result) | 438 | (let ((warnings (cdr result))) |
| 439 | (message "Warnings in `bzr' output: %s" (cdr result))) | 439 | (when warnings |
| 440 | ;; bzr 2.3.0 returns info about shelves, which is not really a warning | ||
| 441 | (when (string-match "[1-9]+ shel\\(f\\|ves\\) exists?\\..*?\n" warnings) | ||
| 442 | (setq warnings (replace-match "" nil nil warnings))) | ||
| 443 | (unless (string= warnings "") | ||
| 444 | (message "Warnings in `bzr' output: %s" warnings)))) | ||
| 440 | (cdr (assq (car result) | 445 | (cdr (assq (car result) |
| 441 | '((added . added) | 446 | '((added . added) |
| 442 | (kindchanged . edited) | 447 | (kindchanged . edited) |
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index d4970207b94..01b6f2fc26e 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el | |||
| @@ -104,7 +104,7 @@ See `run-hooks'." | |||
| 104 | ;; We pass a filename to create-file-buffer because it is what | 104 | ;; We pass a filename to create-file-buffer because it is what |
| 105 | ;; the function expects, and also what uniquify needs (if active) | 105 | ;; the function expects, and also what uniquify needs (if active) |
| 106 | (with-current-buffer (create-file-buffer (expand-file-name bname dir)) | 106 | (with-current-buffer (create-file-buffer (expand-file-name bname dir)) |
| 107 | (cd dir) | 107 | (setq default-directory dir) |
| 108 | (vc-setup-buffer (current-buffer)) | 108 | (vc-setup-buffer (current-buffer)) |
| 109 | ;; Reset the vc-parent-buffer-name so that it does not appear | 109 | ;; Reset the vc-parent-buffer-name so that it does not appear |
| 110 | ;; in the mode-line. | 110 | ;; in the mode-line. |
| @@ -1002,7 +1002,7 @@ specific headers." | |||
| 1002 | (generate-new-buffer (format " *VC-%s* tmp status" backend)))) | 1002 | (generate-new-buffer (format " *VC-%s* tmp status" backend)))) |
| 1003 | (lexical-let ((buffer (current-buffer))) | 1003 | (lexical-let ((buffer (current-buffer))) |
| 1004 | (with-current-buffer vc-dir-process-buffer | 1004 | (with-current-buffer vc-dir-process-buffer |
| 1005 | (cd def-dir) | 1005 | (setq default-directory def-dir) |
| 1006 | (erase-buffer) | 1006 | (erase-buffer) |
| 1007 | (vc-call-backend | 1007 | (vc-call-backend |
| 1008 | backend 'dir-status-files def-dir files default-state | 1008 | backend 'dir-status-files def-dir files default-state |
| @@ -1067,7 +1067,7 @@ Throw an error if another update process is in progress." | |||
| 1067 | (ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "") | 1067 | (ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "") |
| 1068 | (lexical-let ((buffer (current-buffer))) | 1068 | (lexical-let ((buffer (current-buffer))) |
| 1069 | (with-current-buffer vc-dir-process-buffer | 1069 | (with-current-buffer vc-dir-process-buffer |
| 1070 | (cd def-dir) | 1070 | (setq default-directory def-dir) |
| 1071 | (erase-buffer) | 1071 | (erase-buffer) |
| 1072 | (vc-call-backend | 1072 | (vc-call-backend |
| 1073 | backend 'dir-status def-dir | 1073 | backend 'dir-status def-dir |
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 3b4d0e5f421..711a573ba99 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el | |||
| @@ -119,6 +119,12 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." | |||
| 119 | :version "23.1" | 119 | :version "23.1" |
| 120 | :group 'vc) | 120 | :group 'vc) |
| 121 | 121 | ||
| 122 | (defcustom vc-git-program "git" | ||
| 123 | "Name of the Git executable (excluding any arguments)." | ||
| 124 | :version "24.1" | ||
| 125 | :type 'string | ||
| 126 | :group 'vc) | ||
| 127 | |||
| 122 | (defcustom vc-git-root-log-format | 128 | (defcustom vc-git-root-log-format |
| 123 | '("%d%h..: %an %ad %s" | 129 | '("%d%h..: %an %ad %s" |
| 124 | ;; The first shy group matches the characters drawn by --graph. | 130 | ;; The first shy group matches the characters drawn by --graph. |
| @@ -554,7 +560,7 @@ or an empty string if none." | |||
| 554 | "Return the existing branches, as a list of strings. | 560 | "Return the existing branches, as a list of strings. |
| 555 | The car of the list is the current branch." | 561 | The car of the list is the current branch." |
| 556 | (with-temp-buffer | 562 | (with-temp-buffer |
| 557 | (call-process "git" nil t nil "branch") | 563 | (call-process vc-git-program nil t nil "branch") |
| 558 | (goto-char (point-min)) | 564 | (goto-char (point-min)) |
| 559 | (let (current-branch branches) | 565 | (let (current-branch branches) |
| 560 | (while (not (eobp)) | 566 | (while (not (eobp)) |
| @@ -633,13 +639,13 @@ for the Git command to run." | |||
| 633 | (let* ((root (vc-git-root default-directory)) | 639 | (let* ((root (vc-git-root default-directory)) |
| 634 | (buffer (format "*vc-git : %s*" (expand-file-name root))) | 640 | (buffer (format "*vc-git : %s*" (expand-file-name root))) |
| 635 | (command "pull") | 641 | (command "pull") |
| 636 | (git-program "git") | 642 | (git-program vc-git-program) |
| 637 | args) | 643 | args) |
| 638 | ;; If necessary, prompt for the exact command. | 644 | ;; If necessary, prompt for the exact command. |
| 639 | (when prompt | 645 | (when prompt |
| 640 | (setq args (split-string | 646 | (setq args (split-string |
| 641 | (read-shell-command "Git pull command: " | 647 | (read-shell-command "Git pull command: " |
| 642 | "git pull" | 648 | (format "%s pull" git-program) |
| 643 | 'vc-git-history) | 649 | 'vc-git-history) |
| 644 | " " t)) | 650 | " " t)) |
| 645 | (setq git-program (car args) | 651 | (setq git-program (car args) |
| @@ -663,7 +669,7 @@ This prompts for a branch to merge from." | |||
| 663 | branches | 669 | branches |
| 664 | (cons "FETCH_HEAD" branches)) | 670 | (cons "FETCH_HEAD" branches)) |
| 665 | nil t))) | 671 | nil t))) |
| 666 | (apply 'vc-do-async-command buffer root "git" "merge" | 672 | (apply 'vc-do-async-command buffer root vc-git-program "merge" |
| 667 | (list merge-source)) | 673 | (list merge-source)) |
| 668 | (vc-set-async-update buffer))) | 674 | (vc-set-async-update buffer))) |
| 669 | 675 | ||
| @@ -1083,8 +1089,10 @@ This command shares argument histories with \\[rgrep] and \\[grep]." | |||
| 1083 | 1089 | ||
| 1084 | (defun vc-git-command (buffer okstatus file-or-list &rest flags) | 1090 | (defun vc-git-command (buffer okstatus file-or-list &rest flags) |
| 1085 | "A wrapper around `vc-do-command' for use in vc-git.el. | 1091 | "A wrapper around `vc-do-command' for use in vc-git.el. |
| 1086 | The difference to vc-do-command is that this function always invokes `git'." | 1092 | The difference to vc-do-command is that this function always invokes |
| 1087 | (apply 'vc-do-command (or buffer "*vc*") okstatus "git" file-or-list flags)) | 1093 | `vc-git-program'." |
| 1094 | (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program | ||
| 1095 | file-or-list flags)) | ||
| 1088 | 1096 | ||
| 1089 | (defun vc-git--empty-db-p () | 1097 | (defun vc-git--empty-db-p () |
| 1090 | "Check if the git db is empty (no commit done yet)." | 1098 | "Check if the git db is empty (no commit done yet)." |
| @@ -1095,7 +1103,7 @@ The difference to vc-do-command is that this function always invokes `git'." | |||
| 1095 | ;; We don't need to care the arguments. If there is a file name, it | 1103 | ;; We don't need to care the arguments. If there is a file name, it |
| 1096 | ;; is always a relative one. This works also for remote | 1104 | ;; is always a relative one. This works also for remote |
| 1097 | ;; directories. | 1105 | ;; directories. |
| 1098 | (apply 'process-file "git" nil buffer nil command args)) | 1106 | (apply 'process-file vc-git-program nil buffer nil command args)) |
| 1099 | 1107 | ||
| 1100 | (defun vc-git--out-ok (command &rest args) | 1108 | (defun vc-git--out-ok (command &rest args) |
| 1101 | (zerop (apply 'vc-git--call '(t nil) command args))) | 1109 | (zerop (apply 'vc-git--call '(t nil) command args))) |
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index d283c39362a..0516abbf024 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el | |||
| @@ -529,9 +529,9 @@ REV is the revision to check out into WORKFILE." | |||
| 529 | (insert (propertize | 529 | (insert (propertize |
| 530 | (format " (%s %s)" | 530 | (format " (%s %s)" |
| 531 | (case (vc-hg-extra-fileinfo->rename-state extra) | 531 | (case (vc-hg-extra-fileinfo->rename-state extra) |
| 532 | ('copied "copied from") | 532 | (copied "copied from") |
| 533 | ('renamed-from "renamed from") | 533 | (renamed-from "renamed from") |
| 534 | ('renamed-to "renamed to")) | 534 | (renamed-to "renamed to")) |
| 535 | (vc-hg-extra-fileinfo->extra-name extra)) | 535 | (vc-hg-extra-fileinfo->extra-name extra)) |
| 536 | 'face 'font-lock-comment-face))))) | 536 | 'face 'font-lock-comment-face))))) |
| 537 | 537 | ||
| @@ -663,14 +663,15 @@ then attempts to update the working directory." | |||
| 663 | (let* ((root (vc-hg-root default-directory)) | 663 | (let* ((root (vc-hg-root default-directory)) |
| 664 | (buffer (format "*vc-hg : %s*" (expand-file-name root))) | 664 | (buffer (format "*vc-hg : %s*" (expand-file-name root))) |
| 665 | (command "pull") | 665 | (command "pull") |
| 666 | (hg-program "hg") | 666 | (hg-program vc-hg-program) |
| 667 | ;; Fixme: before updating the working copy to the latest | 667 | ;; Fixme: before updating the working copy to the latest |
| 668 | ;; state, should check if it's visiting an old revision. | 668 | ;; state, should check if it's visiting an old revision. |
| 669 | (args '("-u"))) | 669 | (args '("-u"))) |
| 670 | ;; If necessary, prompt for the exact command. | 670 | ;; If necessary, prompt for the exact command. |
| 671 | (when prompt | 671 | (when prompt |
| 672 | (setq args (split-string | 672 | (setq args (split-string |
| 673 | (read-shell-command "Run Hg (like this): " "hg pull -u" | 673 | (read-shell-command "Run Hg (like this): " |
| 674 | (format "%s pull -u" hg-program) | ||
| 674 | 'vc-hg-history) | 675 | 'vc-hg-history) |
| 675 | " " t)) | 676 | " " t)) |
| 676 | (setq hg-program (car args) | 677 | (setq hg-program (car args) |
| @@ -685,7 +686,7 @@ then attempts to update the working directory." | |||
| 685 | This runs the command \"hg merge\"." | 686 | This runs the command \"hg merge\"." |
| 686 | (let* ((root (vc-hg-root default-directory)) | 687 | (let* ((root (vc-hg-root default-directory)) |
| 687 | (buffer (format "*vc-hg : %s*" (expand-file-name root)))) | 688 | (buffer (format "*vc-hg : %s*" (expand-file-name root)))) |
| 688 | (apply 'vc-do-async-command buffer root "hg" '("merge")) | 689 | (apply 'vc-do-async-command buffer root vc-hg-program '("merge")) |
| 689 | (vc-set-async-update buffer))) | 690 | (vc-set-async-update buffer))) |
| 690 | 691 | ||
| 691 | ;;; Internal functions | 692 | ;;; Internal functions |
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 200291bd925..7f55ffdbdad 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el | |||
| @@ -1115,9 +1115,12 @@ merge in the changes into your working copy." | |||
| 1115 | (dolist (file files) | 1115 | (dolist (file files) |
| 1116 | (unless (file-writable-p file) | 1116 | (unless (file-writable-p file) |
| 1117 | ;; Make the file+buffer read-write. | 1117 | ;; Make the file+buffer read-write. |
| 1118 | (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) | 1118 | (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file)) |
| 1119 | (error "Aborted")) | 1119 | (error "Aborted")) |
| 1120 | (set-file-modes file (logior (file-modes file) 128)) | 1120 | ;; Maybe we somehow lost permissions on the directory. |
| 1121 | (condition-case nil | ||
| 1122 | (set-file-modes file (logior (file-modes file) 128)) | ||
| 1123 | (error (error "Unable to make file writable"))) | ||
| 1121 | (let ((visited (get-file-buffer file))) | 1124 | (let ((visited (get-file-buffer file))) |
| 1122 | (when visited | 1125 | (when visited |
| 1123 | (with-current-buffer visited | 1126 | (with-current-buffer visited |