diff options
| author | Tom Tromey | 2013-06-13 11:29:06 -0600 |
|---|---|---|
| committer | Tom Tromey | 2013-06-13 11:29:06 -0600 |
| commit | 5ccb7e7b1ea2ca7f6e45d00d839e19f22cc961da (patch) | |
| tree | af9b79246f0b18d748c3e1c33b1bb1b33cf1fbe0 /lisp | |
| parent | 313dfb6277b3e1ef28c7bb76e776f10168e3f0a3 (diff) | |
| parent | 94fa6ec7b306b47c251f7b8b67662598027a7ff3 (diff) | |
| download | emacs-5ccb7e7b1ea2ca7f6e45d00d839e19f22cc961da.tar.gz emacs-5ccb7e7b1ea2ca7f6e45d00d839e19f22cc961da.zip | |
merge from trunk
Diffstat (limited to 'lisp')
66 files changed, 2594 insertions, 1500 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 29c912933c8..2d9fd3f28b4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,9 +1,412 @@ | |||
| 1 | 2013-06-13 Michael Albinus <michael.albinus@gmx.de> | ||
| 2 | |||
| 3 | Implement changes in Secret Service API. Make it backward compatible. | ||
| 4 | * net/secrets.el (secrets-struct-secret-content-type): New defonst. | ||
| 5 | (secrets-create-item): Use it. Prefix properties with interface. | ||
| 6 | |||
| 7 | 2013-06-13 Michael Hoffman <9qobl2n02@sneakemail.com> (tiny change) | ||
| 8 | |||
| 9 | * term.el (term-suppress-hard-newline): New option. (Bug#12017) | ||
| 10 | (term-emulate-terminal): Respect term-suppress-hard-newline. | ||
| 11 | |||
| 12 | 2013-06-13 E Sabof <esabof@gmail.com> (tiny change) | ||
| 13 | |||
| 14 | * image-dired.el (image-dired-dired-toggle-marked-thumbs): | ||
| 15 | Only remove a `thumb-file' overlay. (Bug#14548) | ||
| 16 | |||
| 17 | 2013-06-12 Grégoire Jadi <daimrod@gmail.com> | ||
| 18 | |||
| 19 | * mail/reporter.el (reporter-submit-bug-report): | ||
| 20 | Handle missing package-name. (Bug#14600) | ||
| 21 | |||
| 22 | 2013-06-12 Rüdiger Sonderfeld <ruediger@c-plusplus.de> | ||
| 23 | |||
| 24 | * textmodes/reftex-cite.el (reftex-cite-regexp-hist) | ||
| 25 | (reftex-citation-prompt, reftex-default-bibliography) | ||
| 26 | (reftex-bib-or-thebib, reftex-get-bibfile-list) | ||
| 27 | (reftex-pop-to-bibtex-entry, reftex-extract-bib-entries) | ||
| 28 | (reftex-bib-sort-author, reftex-bib-sort-year) | ||
| 29 | (reftex-bib-sort-year-reverse, reftex-get-crossref-alist) | ||
| 30 | (reftex-extract-bib-entries-from-thebibliography) | ||
| 31 | (reftex-get-bibkey-default, reftex-get-bib-names) | ||
| 32 | (reftex-parse-bibtex-entry, reftex-get-bib-field) | ||
| 33 | (reftex-format-bib-entry, reftex-parse-bibitem) | ||
| 34 | (reftex-format-bibitem, reftex-do-citation) | ||
| 35 | (reftex-figure-out-cite-format, reftex-offer-bib-menu) | ||
| 36 | (reftex-restrict-bib-matches, reftex-extract-bib-file) | ||
| 37 | (reftex-insert-bib-matches, reftex-format-citation) | ||
| 38 | (reftex-make-cite-echo-string, reftex-bibtex-selection-callback) | ||
| 39 | (reftex-create-bibtex-file): Add docstrings, mostly by converting | ||
| 40 | existing comments into docstrings. | ||
| 41 | |||
| 42 | 2013-06-12 Xue Fuqiao <xfq.free@gmail.com> | ||
| 43 | |||
| 44 | * ibuf-ext.el (ibuffer-mark-help-buffers): Doc fix. | ||
| 45 | |||
| 46 | 2013-06-12 Andreas Schwab <schwab@suse.de> | ||
| 47 | |||
| 48 | * international/mule.el (auto-coding-alist): Use utf-8-emacs-unix | ||
| 49 | for auto-save files. | ||
| 50 | |||
| 51 | 2013-06-12 Glenn Morris <rgm@gnu.org> | ||
| 52 | |||
| 53 | * ido.el (ido-delete-ignored-files): Remove. | ||
| 54 | (ido-wide-find-dirs-or-files, ido-make-file-list-1): | ||
| 55 | Go back to calling ido-ignore-item-p directly. | ||
| 56 | |||
| 57 | 2013-06-12 Eyal Lotem <eyal.lotem@gmail.com> (tiny change) | ||
| 58 | |||
| 59 | * ido.el (ido-wide-find-dirs-or-files): Respect ido-case-fold. | ||
| 60 | |||
| 61 | * ido.el (ido-delete-ignored-files): New function, | ||
| 62 | split from ido-make-file-list-1. | ||
| 63 | (ido-wide-find-dirs-or-files): Maybe ignore files. (Bug#13003) | ||
| 64 | (ido-make-file-list-1): Use ido-delete-ignored-files. | ||
| 65 | |||
| 66 | 2013-06-12 Leo Liu <sdl.web@gmail.com> | ||
| 67 | |||
| 68 | * progmodes/octave.el (inferior-octave-startup) | ||
| 69 | (inferior-octave-completion-table) | ||
| 70 | (inferior-octave-track-window-width-change) | ||
| 71 | (octave-eldoc-function-signatures, octave-help) | ||
| 72 | (octave-find-definition): Use single quoted strings. | ||
| 73 | (inferior-octave-startup-args): Change default value. | ||
| 74 | (inferior-octave-startup): Do not hard code "-i" and | ||
| 75 | "--no-line-editing". | ||
| 76 | (inferior-octave-resync-dirs): Add optional arg NOERROR. | ||
| 77 | (inferior-octave-directory-tracker): Use it. | ||
| 78 | (octave-goto-function-definition): Robustify. | ||
| 79 | (octave-help): Support highlighting operators in 'See also'. | ||
| 80 | (octave-find-definition): Find subfunctions only in Octave mode. | ||
| 81 | |||
| 82 | 2013-06-12 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 83 | |||
| 84 | * help-fns.el (help-fns--compiler-macro): If the handler function is | ||
| 85 | named, then put a link to it. | ||
| 86 | * help-mode.el (help-function-cmacro): Adjust regexp for cl-lib names. | ||
| 87 | * emacs-lisp/cl-macs.el (cl--compiler-macro-typep): New function. | ||
| 88 | (cl-typep): Use it. | ||
| 89 | (cl-eval-when): Simplify debug spec. | ||
| 90 | (cl-define-compiler-macro): Use eval-and-compile. Give a name to the | ||
| 91 | compiler-macro function instead of setting `compiler-macro-file'. | ||
| 92 | |||
| 93 | 2013-06-12 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 94 | Daniel Hackney <dan@haxney.org> | ||
| 95 | |||
| 96 | First part of Daniel Hackney's patch to package.el. | ||
| 97 | * emacs-lisp/package.el: Use defstruct. | ||
| 98 | (package-desc): New, main struct. | ||
| 99 | (package--bi-desc, package--ac-desc): New structs, used to describe the | ||
| 100 | format in external files. | ||
| 101 | (package-desc-vers): Replace with package-desc-version accessor. | ||
| 102 | (package-desc-doc): Replace with package-desc-summary accessor. | ||
| 103 | (package-activate-1): Remove `package' arg since the pkg-vec now | ||
| 104 | includes the name. | ||
| 105 | (define-package): Use package-desc-from-define. | ||
| 106 | (package-unpack-single): Change file-name arg to be a symbol. | ||
| 107 | (package--add-to-archive-contents): Use package-desc-create and new | ||
| 108 | accessor functions to package--ac-desc. | ||
| 109 | (package-buffer-info, package-tar-file-info): Return a package-desc. | ||
| 110 | (package-install-from-buffer): Remove `type' argument. Change pkg-info | ||
| 111 | arg to be a package-desc. | ||
| 112 | (package-install-file): Adjust accordingly. Use \' to match EOS. | ||
| 113 | (package--from-builtin): New function. | ||
| 114 | (describe-package-1, package-menu--generate): Use it. | ||
| 115 | (package--make-autoloads-and-compile): Change name arg to be a symbol. | ||
| 116 | (package-generate-autoloads): Idem and return the name of the file. | ||
| 117 | * emacs-lisp/package-x.el (package-upload-buffer-internal): | ||
| 118 | Change pkg-info arg to be a package-desc. | ||
| 119 | Use package-make-ac-desc. | ||
| 120 | (package-upload-file): Use \' to match EOS. | ||
| 121 | * finder.el (finder-compile-keywords): Use package-make-builtin. | ||
| 122 | |||
| 123 | 2013-06-11 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 124 | |||
| 125 | * vc/vc.el (vc-deduce-fileset): Change error message. | ||
| 126 | (vc-read-backend): New function. | ||
| 127 | (vc-next-action): Use it. | ||
| 128 | |||
| 129 | * subr.el (function-arity): Remove (mistakenly added) (bug#14590). | ||
| 130 | |||
| 131 | * progmodes/prolog.el (prolog-make-keywords-regexp): Remove. | ||
| 132 | (prolog-font-lock-keywords): Use regexp-opt instead. | ||
| 133 | Don't manually highlight strings. | ||
| 134 | (prolog-mode-variables): Simplify comment-start-skip. | ||
| 135 | (prolog-consult-compile): Use display-buffer. Remove unused old-filter. | ||
| 136 | |||
| 137 | * emacs-lisp/generic.el (generic--normalise-comments) | ||
| 138 | (generic-set-comment-syntax, generic-set-comment-vars): New functions. | ||
| 139 | (generic-mode-set-comments): Use them. | ||
| 140 | (generic-bracket-support): Use setq-local. | ||
| 141 | (generic-make-keywords-list): Declare obsolete. | ||
| 142 | |||
| 143 | 2013-06-11 Glenn Morris <rgm@gnu.org> | ||
| 144 | |||
| 145 | * emacs-lisp/lisp-mode.el (lisp-mode-variables): | ||
| 146 | Prettify after setting font-lock-defaults. (Bug#14574) | ||
| 147 | |||
| 148 | 2013-06-11 Juanma Barranquero <lekktu@gmail.com> | ||
| 149 | |||
| 150 | * replace.el (query-replace, occur-read-regexp-defaults-function) | ||
| 151 | (replace-search): | ||
| 152 | * subr.el (declare-function, number-sequence, local-set-key) | ||
| 153 | (substitute-key-definition, locate-user-emacs-file) | ||
| 154 | (with-silent-modifications, split-string, eval-after-load): | ||
| 155 | Fix typos, remove unneeded backslashes and reflow some docstrings. | ||
| 156 | |||
| 157 | 2013-06-11 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 158 | |||
| 159 | * international/mule-conf.el (file-coding-system-alist): Use utf-8 as | ||
| 160 | default for Elisp files. | ||
| 161 | |||
| 162 | 2013-06-11 Glenn Morris <rgm@gnu.org> | ||
| 163 | |||
| 164 | * vc/log-view.el (log-view-mode-map): Inherit from special-mode-map, | ||
| 165 | although define-derived-mode was doing this anyway. (Bug#14583) | ||
| 166 | |||
| 167 | 2013-06-10 Juanma Barranquero <lekktu@gmail.com> | ||
| 168 | |||
| 169 | * allout.el (allout-encryption-plaintext-sanitization-regexps): | ||
| 170 | Fix make-variable-buffer-local call to refer to the correct variable. | ||
| 171 | |||
| 172 | 2013-06-10 Aidan Gauland <aidalgol@amuri.net> | ||
| 173 | |||
| 174 | * eshell/em-term.el (eshell-visual-commands) | ||
| 175 | (eshell-visual-subcommands, eshell-visual-options): | ||
| 176 | Add summary line to docstrings. Add cross-references. | ||
| 177 | |||
| 178 | 2013-06-10 Glenn Morris <rgm@gnu.org> | ||
| 179 | |||
| 180 | * epa.el (epa-read-file-name): New function. (Bug#14510) | ||
| 181 | (epa-decrypt-file): Make plain-file optional. Use epa-read-file-name. | ||
| 182 | |||
| 183 | 2013-06-09 Xue Fuqiao <xfq.free@gmail.com> | ||
| 184 | |||
| 185 | * vc/vc-cvs.el (vc-cvs-stay-local): Doc fix. | ||
| 186 | * vc/vc-hooks.el (vc-stay-local): Doc fix. | ||
| 187 | |||
| 188 | 2013-06-09 Aidan Gauland <aidalgol@amuri.net> | ||
| 189 | |||
| 190 | * eshell/em-term.el (eshell-visual-command-p): Fix bug that caused | ||
| 191 | output redirection to be ignored with visual commands. | ||
| 192 | |||
| 193 | 2013-06-09 Aidan Gauland <aidalgol@amuri.net> | ||
| 194 | |||
| 195 | * eshell/em-term.el (eshell-visual-command-p): New function. | ||
| 196 | (eshell-term-initialize): Move long lambda to separate function | ||
| 197 | eshell-visual-command-p. | ||
| 198 | * eshell/em-dirs.el (eshell-dirs-initialise): | ||
| 199 | * eshell/em-script.el (eshell-script-initialize): | ||
| 200 | Add missing #' to lambda. | ||
| 201 | |||
| 202 | 2013-06-08 Leo Liu <sdl.web@gmail.com> | ||
| 203 | |||
| 204 | * progmodes/octave.el (octave-add-log-current-defun): New function. | ||
| 205 | (octave-mode): Set add-log-current-defun-function. | ||
| 206 | (octave-goto-function-definition): Do not move point if not found. | ||
| 207 | (octave-find-definition): Enhance to try subfunctions first. | ||
| 208 | |||
| 209 | 2013-06-08 Glenn Morris <rgm@gnu.org> | ||
| 210 | |||
| 211 | * emacs-lisp/bytecomp.el (byte-compile-char-before) | ||
| 212 | (byte-compile-backward-char, byte-compile-backward-word): | ||
| 213 | Improve previous change, to handle non-explicit nil. | ||
| 214 | |||
| 215 | 2013-06-07 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 216 | |||
| 217 | * emacs-lisp/smie.el: Improve show-paren-mode behavior. | ||
| 218 | (smie--opener/closer-at-point): New function. | ||
| 219 | (smie--matching-block-data): Use it. Don't match from right after an | ||
| 220 | opener or right before a closer. Obey smie-blink-matching-inners. | ||
| 221 | Don't signal a mismatch for repeated inners like "switch..case..case". | ||
| 222 | |||
| 223 | 2013-06-07 Leo Liu <sdl.web@gmail.com> | ||
| 224 | |||
| 225 | * progmodes/octave.el (octave-mode): Set comment-use-global-state | ||
| 226 | to t. (Bug#14303) | ||
| 227 | (octave-function-header-regexp): Fix. (Bug#14570) | ||
| 228 | (octave-help-mode-finish-hook, octave-help-mode-finish): | ||
| 229 | Remove. Just use temp-buffer-show-hook. | ||
| 230 | |||
| 231 | * newcomment.el (comment-search-backward): Revert last change. | ||
| 232 | (Bug#14434) | ||
| 233 | |||
| 234 | * emacs-lisp/smie.el (smie--matching-block-data): Minor simplification. | ||
| 235 | |||
| 236 | 2013-06-07 Eli Zaretskii <eliz@gnu.org> | ||
| 237 | |||
| 238 | * Makefile.in (TAGS TAGS-LISP): Pass the (long) list of *.el files | ||
| 239 | through xargs, to avoid failure due to MS-Windows limitations on | ||
| 240 | command-line length. | ||
| 241 | |||
| 242 | 2013-06-06 Glenn Morris <rgm@gnu.org> | ||
| 243 | |||
| 244 | * font-lock.el (lisp-font-lock-keywords-2): | ||
| 245 | Treat user-error like error. | ||
| 246 | |||
| 247 | * emacs-lisp/bytecomp.el (byte-compile-char-before) | ||
| 248 | (byte-compile-backward-char, byte-compile-backward-word): | ||
| 249 | Handle explicit nil arguments. (Bug#14565) | ||
| 250 | |||
| 251 | 2013-06-05 Alan Mackenzie <acm@muc.de> | ||
| 252 | |||
| 253 | * isearch.el (isearch-allow-prefix): New user option. | ||
| 254 | (isearch-other-meta-char): Don't exit isearch when a prefix | ||
| 255 | argument is typed whilst `isearch-allow-prefix' is non-nil. | ||
| 256 | (Bug#9706) | ||
| 257 | |||
| 258 | 2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 259 | |||
| 260 | * autorevert.el (auto-revert-notify-handler): Use memq. | ||
| 261 | Hide assertion failure. | ||
| 262 | |||
| 263 | * skeleton.el: Use cl-lib. | ||
| 264 | (skeleton-further-elements): Use defvar-local. | ||
| 265 | (skeleton-insert): Use cl-progv. | ||
| 266 | |||
| 267 | 2013-06-05 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 268 | |||
| 269 | * progmodes/prog-mode.el (prog-prettify-symbols) | ||
| 270 | (prog-prettify-install): Update docstrings. | ||
| 271 | |||
| 272 | 2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 273 | |||
| 274 | * simple.el: Move all the prog-mode code to prog-mode.el. | ||
| 275 | * progmodes/prog-mode.el: New file. | ||
| 276 | * loadup.el: Add prog-mode.el. | ||
| 277 | |||
| 278 | 2013-06-05 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 279 | |||
| 280 | * simple.el (prog-prettify-symbols): Add version. | ||
| 281 | (prog-prettify-install): Add convenience function to prettify symbols. | ||
| 282 | |||
| 283 | * progmodes/perl-mode.el (perl--augmented-font-lock-keywords) | ||
| 284 | (perl--augmented-font-lock-keywords-1) | ||
| 285 | (perl--augmented-font-lock-keywords-2, perl-mode): Remove unneeded | ||
| 286 | variables and use it. | ||
| 287 | |||
| 288 | * progmodes/cfengine.el (cfengine3--augmented-font-lock-keywords) | ||
| 289 | (cfengine3-mode): Remove unneeded variable and use it. | ||
| 290 | |||
| 291 | * emacs-lisp/lisp-mode.el (lisp--augmented-font-lock-keywords) | ||
| 292 | (lisp--augmented-font-lock-keywords-1) | ||
| 293 | (lisp--augmented-font-lock-keywords-2, lisp-mode-variables): | ||
| 294 | Remove unneeded variables and use it. | ||
| 295 | |||
| 296 | 2013-06-05 João Távora <joaotavora@gmail.com> | ||
| 297 | |||
| 298 | * net/tls.el (open-tls-stream): Remove unneeded buffer contents up | ||
| 299 | to point when opening the connection. (Bug#14380) | ||
| 300 | |||
| 301 | 2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 302 | |||
| 303 | * subr.el (load-history-regexp, load-history-filename-element) | ||
| 304 | (eval-after-load, after-load-functions, do-after-load-evaluation) | ||
| 305 | (eval-next-after-load, display-delayed-warnings) | ||
| 306 | (collapse-delayed-warnings, delayed-warnings-hook): Move after the | ||
| 307 | definition of save-match-data. | ||
| 308 | (overriding-local-map): Remove accidental obsolescence declaration. | ||
| 309 | |||
| 310 | * emacs-lisp/edebug.el (edebug-result): Move before first use. | ||
| 311 | |||
| 312 | 2013-06-05 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 313 | |||
| 314 | Generalize symbol prettify support to prog-mode and implement it | ||
| 315 | for perl-mode, cfengine3-mode, and emacs-lisp-mode. | ||
| 316 | * simple.el (prog-prettify-symbols-alist, prog-prettify-symbols) | ||
| 317 | (prog--prettify-font-lock-compose-symbol) | ||
| 318 | (prog-prettify-font-lock-symbols-keywords): New variables and | ||
| 319 | functions to support symbol prettification. | ||
| 320 | * emacs-lisp/lisp-mode.el (lisp--augmented-font-lock-keywords) | ||
| 321 | (lisp--augmented-font-lock-keywords-1) | ||
| 322 | (lisp--augmented-font-lock-keywords-2, lisp-mode-variables) | ||
| 323 | (lisp--prettify-symbols-alist): Implement prettify of lambda. | ||
| 324 | * progmodes/cfengine.el (cfengine3--augmented-font-lock-keywords) | ||
| 325 | (cfengine3--prettify-symbols-alist, cfengine3-mode): | ||
| 326 | Implement prettify of -> => :: strings. | ||
| 327 | * progmodes/perl-mode.el (perl-prettify-symbols) | ||
| 328 | (perl--font-lock-compose-symbol) | ||
| 329 | (perl--font-lock-symbols-keywords): Move to prog-mode. | ||
| 330 | (perl--prettify-symbols-alist): Prettify -> => :: strings. | ||
| 331 | (perl-font-lock-keywords-1) | ||
| 332 | (perl-font-lock-keywords-2): Remove explicit prettify support. | ||
| 333 | (perl--augmented-font-lock-keywords) | ||
| 334 | (perl--augmented-font-lock-keywords-1) | ||
| 335 | (perl--augmented-font-lock-keywords-2, perl-mode): | ||
| 336 | Implement prettify support. | ||
| 337 | |||
| 338 | 2013-06-05 Leo Liu <sdl.web@gmail.com> | ||
| 339 | |||
| 340 | Re-implement smie matching block highlight using | ||
| 341 | show-paren-data-function. (Bug#14395) | ||
| 342 | * emacs-lisp/smie.el (smie-matching-block-highlight) | ||
| 343 | (smie--highlight-matching-block-overlay) | ||
| 344 | (smie--highlight-matching-block-lastpos) | ||
| 345 | (smie-highlight-matching-block) | ||
| 346 | (smie-highlight-matching-block-mode): Remove. | ||
| 347 | (smie--matching-block-data-cache): New variable. | ||
| 348 | (smie--matching-block-data): New function. | ||
| 349 | (smie-setup): Use smie--matching-block-data for | ||
| 350 | show-paren-data-function. | ||
| 351 | |||
| 352 | * progmodes/octave.el (octave-mode-menu): Fix. | ||
| 353 | (octave-find-definition): Skip garbage lines. | ||
| 354 | |||
| 355 | 2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 356 | |||
| 357 | Fix compilation error with simultaneous dynamic+lexical scoping. | ||
| 358 | Add warning when a defvar appears after the first let-binding. | ||
| 359 | * emacs-lisp/bytecomp.el (byte-compile-lexical-variables): New var. | ||
| 360 | (byte-compile-close-variables): Initialize it. | ||
| 361 | (byte-compile--declare-var): New function. | ||
| 362 | (byte-compile-file-form-defvar) | ||
| 363 | (byte-compile-file-form-define-abbrev-table) | ||
| 364 | (byte-compile-file-form-custom-declare-variable): Use it. | ||
| 365 | (byte-compile-make-lambda-lexenv): Change the argument. Simplify. | ||
| 366 | (byte-compile-lambda): Share call to byte-compile-arglist-vars. | ||
| 367 | (byte-compile-bind): Handle dynamic bindings that shadow | ||
| 368 | lexical bindings. | ||
| 369 | (byte-compile-unbind): Make arg non-optional. | ||
| 370 | (byte-compile-let): Simplify. | ||
| 371 | * emacs-lisp/cconv.el (byte-compile-lexical-variables): Declare var. | ||
| 372 | (cconv--analyse-function, cconv-analyse-form): Populate it. | ||
| 373 | Protect byte-compile-bound-variables to limit the scope of defvars. | ||
| 374 | (cconv-analyse-form): Add missing rule for (defvar <foo>). | ||
| 375 | Remove unneeded rule for `declare'. | ||
| 376 | |||
| 377 | * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin): Use macroexp-let2 | ||
| 378 | so as to avoid depending on cl-adjoin at run-time. | ||
| 379 | * emacs-lisp/cl-lib.el (cl-pushnew): Use backquotes. | ||
| 380 | |||
| 381 | * emacs-lisp/macroexp.el (macroexp--compiling-p): New function. | ||
| 382 | (macroexp--warn-and-return): Use it. | ||
| 383 | |||
| 384 | 2013-06-05 Leo Liu <sdl.web@gmail.com> | ||
| 385 | |||
| 386 | * eshell/esh-mode.el (eshell-mode): Fix key bindings. | ||
| 387 | |||
| 388 | 2013-06-04 Leo Liu <sdl.web@gmail.com> | ||
| 389 | |||
| 390 | * progmodes/compile.el (compile-goto-error): Add optional arg NOMSG. | ||
| 391 | (compilation-auto-jump): Suppress the "Mark set" message to give | ||
| 392 | way to exit message. | ||
| 393 | |||
| 394 | 2013-06-04 Alan Mackenzie <acm@muc.de> | ||
| 395 | |||
| 396 | Remove faulty optimisation from indentation calculation. | ||
| 397 | * progmodes/cc-engine.el (c-guess-basic-syntax): Don't calculate | ||
| 398 | search limit based on 2000 characters back from indent-point. | ||
| 399 | |||
| 400 | 2013-06-03 Tassilo Horn <tsdh@gnu.org> | ||
| 401 | |||
| 402 | * eshell/em-term.el (cl-lib): Require `cl-lib'. | ||
| 403 | |||
| 1 | 2013-06-03 Stefan Monnier <monnier@iro.umontreal.ca> | 404 | 2013-06-03 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 405 | ||
| 3 | * emacs-lisp/lisp.el: Use lexical-binding. | 406 | * emacs-lisp/lisp.el: Use lexical-binding. |
| 4 | (lisp--local-variables-1, lisp--local-variables): New functions. | 407 | (lisp--local-variables-1, lisp--local-variables): New functions. |
| 5 | (lisp--local-variables-completion-table): New var. | 408 | (lisp--local-variables-completion-table): New var. |
| 6 | (lisp-completion-at-point): Use it to provide completion of let-bound vars. | 409 | (lisp-completion-at-point): Use it complete let-bound vars. |
| 7 | 410 | ||
| 8 | * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros | 411 | * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros |
| 9 | eagerly (bug#14422). | 412 | eagerly (bug#14422). |
| @@ -15,9 +418,9 @@ | |||
| 15 | (auto-revert-notify-event-p, auto-revert-notify-event-file-name) | 418 | (auto-revert-notify-event-p, auto-revert-notify-event-file-name) |
| 16 | (auto-revert-notify-handler): Handle also gfilenotify. | 419 | (auto-revert-notify-handler): Handle also gfilenotify. |
| 17 | 420 | ||
| 18 | * subr.el: (file-notify-handle-event): New defun. Replacing ... | 421 | * subr.el (file-notify-handle-event): New defun. Replacing ... |
| 19 | (inotify-event-p, inotify-handle-event, w32notify-handle-event): | 422 | (inotify-event-p, inotify-handle-event, w32notify-handle-event): |
| 20 | Removed. | 423 | Remove. |
| 21 | 424 | ||
| 22 | 2013-06-03 Juri Linkov <juri@jurta.org> | 425 | 2013-06-03 Juri Linkov <juri@jurta.org> |
| 23 | 426 | ||
| @@ -43,10 +446,15 @@ | |||
| 43 | 446 | ||
| 44 | 2013-06-03 Tassilo Horn <tsdh@gnu.org> | 447 | 2013-06-03 Tassilo Horn <tsdh@gnu.org> |
| 45 | 448 | ||
| 46 | * eshell/em-term.el (eshell-term-initialize): Use | 449 | * eshell/em-term.el (eshell-term-initialize): |
| 47 | `cl-intersection' rather than `intersection'. | 450 | Use `cl-intersection' rather than `intersection'. |
| 48 | 451 | ||
| 49 | 2013-06-02 Eric Ludlam <zappo@gnu.org> | 452 | 2013-06-02 Xue Fuqiao <xfq.free@gmail.com> |
| 453 | |||
| 454 | * vc/log-view.el: Doc fix. | ||
| 455 | (log-view-mode-map): Copy keymap from `special-mode-map'. | ||
| 456 | |||
| 457 | 2013-06-02 Eric Ludlam <zappo@gnu.org> | ||
| 50 | 458 | ||
| 51 | * emacs-lisp/eieio.el (eieio--defalias, eieio-hook) | 459 | * emacs-lisp/eieio.el (eieio--defalias, eieio-hook) |
| 52 | (eieio-error-unsupported-class-tags, eieio-skip-typecheck) | 460 | (eieio-error-unsupported-class-tags, eieio-skip-typecheck) |
| @@ -93,7 +501,7 @@ | |||
| 93 | (eieiomt-optimizing-obarray, eieiomt-install) | 501 | (eieiomt-optimizing-obarray, eieiomt-install) |
| 94 | (eieiomt-add, eieiomt-next, eieiomt-sym-optimize) | 502 | (eieiomt-add, eieiomt-next, eieiomt-sym-optimize) |
| 95 | (eieio-generic-form, eieio-defmethod, make-obsolete) | 503 | (eieio-generic-form, eieio-defmethod, make-obsolete) |
| 96 | (eieio-defgeneric, make-obsolete): Moved to eieio-core.el | 504 | (eieio-defgeneric, make-obsolete): Move to eieio-core.el |
| 97 | (defclass): Remove `eval-and-compile' from macro. | 505 | (defclass): Remove `eval-and-compile' from macro. |
| 98 | (call-next-method, shared-initialize): Instead of using | 506 | (call-next-method, shared-initialize): Instead of using |
| 99 | `scoped-class' variable, use new eieio--scoped-class, and | 507 | `scoped-class' variable, use new eieio--scoped-class, and |
| @@ -122,10 +530,10 @@ | |||
| 122 | (eshell-find-interpreter): Add new second parameter ARGS. | 530 | (eshell-find-interpreter): Add new second parameter ARGS. |
| 123 | 531 | ||
| 124 | * eshell/em-script.el (eshell-script-initialize): Add second arg | 532 | * eshell/em-script.el (eshell-script-initialize): Add second arg |
| 125 | to the function added as MATCH to `eshell-interpreter-alist' | 533 | to the function added as MATCH to `eshell-interpreter-alist'. |
| 126 | 534 | ||
| 127 | * eshell/em-dirs.el (eshell-dirs-initialize): Add second arg to | 535 | * eshell/em-dirs.el (eshell-dirs-initialize): Add second arg to |
| 128 | the function added as MATCH to `eshell-interpreter-alist' | 536 | the function added as MATCH to `eshell-interpreter-alist'. |
| 129 | 537 | ||
| 130 | * eshell/em-term.el (eshell-visual-subcommands): New defcustom. | 538 | * eshell/em-term.el (eshell-visual-subcommands): New defcustom. |
| 131 | (eshell-visual-options): New defcustom. | 539 | (eshell-visual-options): New defcustom. |
| @@ -185,8 +593,8 @@ | |||
| 185 | 593 | ||
| 186 | 2013-05-31 Dmitry Gutov <dgutov@yandex.ru> | 594 | 2013-05-31 Dmitry Gutov <dgutov@yandex.ru> |
| 187 | 595 | ||
| 188 | * progmodes/ruby-mode.el (ruby-syntax-expansion-allowed-p): New | 596 | * progmodes/ruby-mode.el (ruby-syntax-expansion-allowed-p): |
| 189 | function, checks if point is inside a literal that allows | 597 | New function, checks if point is inside a literal that allows |
| 190 | expression expansion. | 598 | expression expansion. |
| 191 | (ruby-syntax-propertize-expansion): Use it. | 599 | (ruby-syntax-propertize-expansion): Use it. |
| 192 | (ruby-syntax-propertize-function): Bind `case-fold-search' to nil | 600 | (ruby-syntax-propertize-function): Bind `case-fold-search' to nil |
| @@ -297,7 +705,7 @@ | |||
| 297 | * emacs-lisp/trace.el (trace--read-args): Provide a default. | 705 | * emacs-lisp/trace.el (trace--read-args): Provide a default. |
| 298 | 706 | ||
| 299 | * emacs-lisp/lisp-mode.el (lisp-mode-shared-map): Inherit from | 707 | * emacs-lisp/lisp-mode.el (lisp-mode-shared-map): Inherit from |
| 300 | prog-mode-map. | 708 | prog-mode-map (bug#14504). |
| 301 | 709 | ||
| 302 | 2013-05-29 Leo Liu <sdl.web@gmail.com> | 710 | 2013-05-29 Leo Liu <sdl.web@gmail.com> |
| 303 | 711 | ||
| @@ -329,7 +737,7 @@ | |||
| 329 | 737 | ||
| 330 | 2013-05-28 Aidan Gauland <aidalgol@amuri.net> | 738 | 2013-05-28 Aidan Gauland <aidalgol@amuri.net> |
| 331 | 739 | ||
| 332 | * eshell/em-unix.el: Added -r option to cp | 740 | * eshell/em-unix.el: Add -r option to cp. |
| 333 | 741 | ||
| 334 | 2013-05-28 Glenn Morris <rgm@gnu.org> | 742 | 2013-05-28 Glenn Morris <rgm@gnu.org> |
| 335 | 743 | ||
| @@ -2030,7 +2438,7 @@ | |||
| 2030 | 2438 | ||
| 2031 | * comint.el (comint-dynamic-complete-functions, comint-mode-map): | 2439 | * comint.el (comint-dynamic-complete-functions, comint-mode-map): |
| 2032 | `comint-dynamic-complete' is obsolete since 24.1, replaced by | 2440 | `comint-dynamic-complete' is obsolete since 24.1, replaced by |
| 2033 | `completion-at-point'. (Bug#13774) | 2441 | `completion-at-point'. (Bug#13774) |
| 2034 | 2442 | ||
| 2035 | * startup.el (normal-no-mouse-startup-screen): Bug fix, the | 2443 | * startup.el (normal-no-mouse-startup-screen): Bug fix, the |
| 2036 | default key binding for `describe-distribution' has been moved to | 2444 | default key binding for `describe-distribution' has been moved to |
| @@ -2059,7 +2467,8 @@ | |||
| 2059 | 2467 | ||
| 2060 | * comint.el (comint-redirect-original-filter-function): Remove. | 2468 | * comint.el (comint-redirect-original-filter-function): Remove. |
| 2061 | (comint-redirect-cleanup, comint-redirect-send-command-to-process): | 2469 | (comint-redirect-cleanup, comint-redirect-send-command-to-process): |
| 2062 | * vc/vc-cvs.el (vc-cvs-annotate-process-filter,vc-cvs-annotate-command): | 2470 | * vc/vc-cvs.el (vc-cvs-annotate-process-filter) |
| 2471 | (vc-cvs-annotate-command): | ||
| 2063 | * progmodes/octave-inf.el (inferior-octave-send-list-and-digest): | 2472 | * progmodes/octave-inf.el (inferior-octave-send-list-and-digest): |
| 2064 | * progmodes/prolog.el (prolog-consult-compile): | 2473 | * progmodes/prolog.el (prolog-consult-compile): |
| 2065 | * progmodes/gdb-mi.el (gdb, gdb--check-interpreter): | 2474 | * progmodes/gdb-mi.el (gdb, gdb--check-interpreter): |
| @@ -2081,9 +2490,9 @@ | |||
| 2081 | 2013-04-19 Masatake YAMATO <yamato@redhat.com> | 2490 | 2013-04-19 Masatake YAMATO <yamato@redhat.com> |
| 2082 | 2491 | ||
| 2083 | * progmodes/sh-script.el (sh-imenu-generic-expression): | 2492 | * progmodes/sh-script.el (sh-imenu-generic-expression): |
| 2084 | Handle function names with a single character. (Bug#14111) | 2493 | Handle function names with a single character. (Bug#14111) |
| 2085 | 2494 | ||
| 2086 | 2013-04-19 Dima Kogan <dima@secretsauce.net> (tiny change) | 2495 | 2013-04-19 Dima Kogan <dima@secretsauce.net> (tiny change) |
| 2087 | 2496 | ||
| 2088 | * progmodes/gud.el (gud-perldb-marker-filter): Understand position info | 2497 | * progmodes/gud.el (gud-perldb-marker-filter): Understand position info |
| 2089 | for subroutines defined in an eval (bug#14182). | 2498 | for subroutines defined in an eval (bug#14182). |
| @@ -3193,7 +3602,7 @@ | |||
| 3193 | 3602 | ||
| 3194 | Correct the position of point in some line-up functions. | 3603 | Correct the position of point in some line-up functions. |
| 3195 | * progmodes/cc-align.el (c-lineup-whitesmith-in-block) | 3604 | * progmodes/cc-align.el (c-lineup-whitesmith-in-block) |
| 3196 | (c-lineup-assignments, c-lineup-gcc-asm-reg ): take position of | 3605 | (c-lineup-assignments, c-lineup-gcc-asm-reg ): Take position of |
| 3197 | point at column 0 rather than at a random place in the line. | 3606 | point at column 0 rather than at a random place in the line. |
| 3198 | 3607 | ||
| 3199 | 2013-03-05 Michael Albinus <michael.albinus@gmx.de> | 3608 | 2013-03-05 Michael Albinus <michael.albinus@gmx.de> |
| @@ -4728,7 +5137,7 @@ | |||
| 4728 | 2013-01-12 Eli Zaretskii <eliz@gnu.org> | 5137 | 2013-01-12 Eli Zaretskii <eliz@gnu.org> |
| 4729 | 5138 | ||
| 4730 | * autorevert.el (auto-revert-notify-handler): Fix filtering of | 5139 | * autorevert.el (auto-revert-notify-handler): Fix filtering of |
| 4731 | file notification by ACTION. For filtering by file name, compare | 5140 | file notification by ACTION. For filtering by file name, compare |
| 4732 | only the non-directory part of the file name. | 5141 | only the non-directory part of the file name. |
| 4733 | 5142 | ||
| 4734 | 2013-01-12 Stefan Monnier <monnier@iro.umontreal.ca> | 5143 | 2013-01-12 Stefan Monnier <monnier@iro.umontreal.ca> |
| @@ -4811,7 +5220,7 @@ | |||
| 4811 | 2013-01-11 Julien Danjou <julien@danjou.info> | 5220 | 2013-01-11 Julien Danjou <julien@danjou.info> |
| 4812 | 5221 | ||
| 4813 | * color.el (color-rgb-to-hsv): Fix conversion computing in case min and | 5222 | * color.el (color-rgb-to-hsv): Fix conversion computing in case min and |
| 4814 | max are almost equal. Also return the correct value for V which is | 5223 | max are almost equal. Also return the correct value for V which is |
| 4815 | already between 0 and 1. | 5224 | already between 0 and 1. |
| 4816 | 5225 | ||
| 4817 | 2013-01-11 Dmitry Antipov <dmantipov@yandex.ru> | 5226 | 2013-01-11 Dmitry Antipov <dmantipov@yandex.ru> |
| @@ -5265,7 +5674,7 @@ | |||
| 5265 | 2012-12-31 Jürgen Hötzel <juergen@archlinux.org> | 5674 | 2012-12-31 Jürgen Hötzel <juergen@archlinux.org> |
| 5266 | 5675 | ||
| 5267 | * net/tramp-adb.el (tramp-adb-maybe-open-connection): Handle errors | 5676 | * net/tramp-adb.el (tramp-adb-maybe-open-connection): Handle errors |
| 5268 | (No device connected, invalid device name). (Bug #13299) | 5677 | (No device connected, invalid device name). (Bug #13299) |
| 5269 | 5678 | ||
| 5270 | 2012-12-31 Martin Rudalics <rudalics@gmx.at> | 5679 | 2012-12-31 Martin Rudalics <rudalics@gmx.at> |
| 5271 | 5680 | ||
| @@ -5650,7 +6059,7 @@ | |||
| 5650 | 6059 | ||
| 5651 | 2012-12-14 Paul Eggert <eggert@cs.ucla.edu> | 6060 | 2012-12-14 Paul Eggert <eggert@cs.ucla.edu> |
| 5652 | 6061 | ||
| 5653 | Fix permissions bugs with setgid directories etc. (Bug#13125) | 6062 | Fix permissions bugs with setgid directories etc. (Bug#13125) |
| 5654 | * files.el (backup-buffer): Don't rely on 9th output of | 6063 | * files.el (backup-buffer): Don't rely on 9th output of |
| 5655 | file-attributes, as it's now a placeholder. Instead, use the new | 6064 | file-attributes, as it's now a placeholder. Instead, use the new |
| 5656 | optional arg of file-ownership-preserved-p. | 6065 | optional arg of file-ownership-preserved-p. |
| @@ -6108,7 +6517,7 @@ | |||
| 6108 | * textmodes/ispell.el (ispell-init-process) | 6517 | * textmodes/ispell.el (ispell-init-process) |
| 6109 | (ispell-start-process, ispell-internal-change-dictionary): | 6518 | (ispell-start-process, ispell-internal-change-dictionary): |
| 6110 | Make sure personal dictionary name is expanded after initial | 6519 | Make sure personal dictionary name is expanded after initial |
| 6111 | `default-directory' value. Use expanded strings for | 6520 | `default-directory' value. Use expanded strings for |
| 6112 | keep/restart checks and for value (Bug#13019). | 6521 | keep/restart checks and for value (Bug#13019). |
| 6113 | 6522 | ||
| 6114 | 2012-12-03 Jay Belanger <jay.p.belanger@gmail.com> | 6523 | 2012-12-03 Jay Belanger <jay.p.belanger@gmail.com> |
| @@ -6790,7 +7199,7 @@ | |||
| 6790 | 7199 | ||
| 6791 | * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1): | 7200 | * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1): |
| 6792 | Don't signal an error with a score that is too low to add to the | 7201 | Don't signal an error with a score that is too low to add to the |
| 6793 | list of top scores. (Bug#12779) | 7202 | list of top scores. (Bug#12779) |
| 6794 | 7203 | ||
| 6795 | 2012-11-17 Chong Yidong <cyd@gnu.org> | 7204 | 2012-11-17 Chong Yidong <cyd@gnu.org> |
| 6796 | 7205 | ||
| @@ -6859,7 +7268,7 @@ | |||
| 6859 | 7268 | ||
| 6860 | * window.el (record-window-buffer) | 7269 | * window.el (record-window-buffer) |
| 6861 | (display-buffer-record-window): When copying the markers to | 7270 | (display-buffer-record-window): When copying the markers to |
| 6862 | window-point preserve window-point-insertion-type. (Bug#12588) | 7271 | window-point preserve window-point-insertion-type. (Bug#12588) |
| 6863 | 7272 | ||
| 6864 | 2012-11-16 Glenn Morris <rgm@gnu.org> | 7273 | 2012-11-16 Glenn Morris <rgm@gnu.org> |
| 6865 | 7274 | ||
| @@ -6947,8 +7356,8 @@ | |||
| 6947 | (ad-advice-definition): Redefine as functions. | 7356 | (ad-advice-definition): Redefine as functions. |
| 6948 | (ad-advice-classes): Move before first use. | 7357 | (ad-advice-classes): Move before first use. |
| 6949 | (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition) | 7358 | (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition) |
| 6950 | (ad-make-mapped-call, ad-make-advised-docstring,ad-make-plain-docstring) | 7359 | (ad-make-mapped-call, ad-make-advised-docstring) |
| 6951 | (ad--defalias-fset): Remove functions. | 7360 | (ad-make-plain-docstring, ad--defalias-fset): Remove functions. |
| 6952 | (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs. | 7361 | (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs. |
| 6953 | (ad-get-orig-definition): Rewrite. | 7362 | (ad-get-orig-definition): Rewrite. |
| 6954 | (ad-make-advised-definition-docstring): Change base docstring. | 7363 | (ad-make-advised-definition-docstring): Change base docstring. |
| @@ -7200,7 +7609,7 @@ | |||
| 7200 | 7609 | ||
| 7201 | 2012-11-09 Vincent Belaïche <vincentb1@users.sourceforge.net> | 7610 | 2012-11-09 Vincent Belaïche <vincentb1@users.sourceforge.net> |
| 7202 | 7611 | ||
| 7203 | * ses.el: symbol to coordinate mapping is made by symbol property | 7612 | * ses.el: Symbol to coordinate mapping is made by symbol property |
| 7204 | `ses-cell'. This means that the same mapping is done for all SES | 7613 | `ses-cell'. This means that the same mapping is done for all SES |
| 7205 | sheets. That is good enough for cells with standard A1 names, but | 7614 | sheets. That is good enough for cells with standard A1 names, but |
| 7206 | not for named cell. So a hash map is added for the latter. | 7615 | not for named cell. So a hash map is added for the latter. |
| @@ -7296,7 +7705,7 @@ | |||
| 7296 | buffer and calls `ispell-buffer' with debugging enabled. | 7705 | buffer and calls `ispell-buffer' with debugging enabled. |
| 7297 | 7706 | ||
| 7298 | * textmodes/ispell.el (ispell-region): Do not prefix sent string by | 7707 | * textmodes/ispell.el (ispell-region): Do not prefix sent string by |
| 7299 | comment in autoconf mode. (Bug#12768) | 7708 | comment in autoconf mode. (Bug#12768) |
| 7300 | 7709 | ||
| 7301 | 2012-11-06 Dmitry Antipov <dmantipov@yandex.ru> | 7710 | 2012-11-06 Dmitry Antipov <dmantipov@yandex.ru> |
| 7302 | 7711 | ||
| @@ -8441,13 +8850,13 @@ | |||
| 8441 | 8850 | ||
| 8442 | * textmodes/reftex-cite.el (reftex-create-bibtex-file): Make sure | 8851 | * textmodes/reftex-cite.el (reftex-create-bibtex-file): Make sure |
| 8443 | that entries with whitespace at various places are found. | 8852 | that entries with whitespace at various places are found. |
| 8444 | Doc fix. Include entries that are cross-referenced from cited entries. | 8853 | Doc fix. Include entries that are cross-referenced from cited entries. |
| 8445 | Include @String definitions in the resulting bib file. Add header | 8854 | Include @String definitions in the resulting bib file. Add header |
| 8446 | and footer defined in `reftex-create-bibtex-header' and | 8855 | and footer defined in `reftex-create-bibtex-header' and |
| 8447 | `reftex-create-bibtex-footer'. | 8856 | `reftex-create-bibtex-footer'. |
| 8448 | (reftex-do-citation): Make it possible again to insert | 8857 | (reftex-do-citation): Make it possible again to insert |
| 8449 | non-existent entries. Save match data when asking for optional | 8858 | non-existent entries. Save match data when asking for optional |
| 8450 | arguments. Return all keys, not just the first one. | 8859 | arguments. Return all keys, not just the first one. |
| 8451 | (reftex-all-used-citation-keys): Fix regexp to correctly extract | 8860 | (reftex-all-used-citation-keys): Fix regexp to correctly extract |
| 8452 | all citations in the same line. | 8861 | all citations in the same line. |
| 8453 | (reftex-parse-bibtex-entry): Accept additional optional argument | 8862 | (reftex-parse-bibtex-entry): Accept additional optional argument |
| @@ -8507,7 +8916,7 @@ | |||
| 8507 | 8916 | ||
| 8508 | * textmodes/reftex-sel.el | 8917 | * textmodes/reftex-sel.el |
| 8509 | (reftex-select-cycle-ref-style-internal): Adapt to new structure | 8918 | (reftex-select-cycle-ref-style-internal): Adapt to new structure |
| 8510 | of `reftex-ref-style-alist'. Remove code for testing macro type. | 8919 | of `reftex-ref-style-alist'. Remove code for testing macro type. |
| 8511 | (reftex-select-toggle-varioref) | 8920 | (reftex-select-toggle-varioref) |
| 8512 | (reftex-select-toggle-fancyref): Remove. | 8921 | (reftex-select-toggle-fancyref): Remove. |
| 8513 | (reftex-select-cycle-ref-style-internal) | 8922 | (reftex-select-cycle-ref-style-internal) |
| @@ -9049,7 +9458,7 @@ | |||
| 9049 | 9458 | ||
| 9050 | * textmodes/bibtex.el (bibtex-autokey-transcriptions): | 9459 | * textmodes/bibtex.el (bibtex-autokey-transcriptions): |
| 9051 | Transcribe also LaTeX hyphenation. | 9460 | Transcribe also LaTeX hyphenation. |
| 9052 | (bibtex-reformat): Bug fix. Do not quote twice the elements of | 9461 | (bibtex-reformat): Bug fix. Do not quote twice the elements of |
| 9053 | bibtex-reformat-previous-options. | 9462 | bibtex-reformat-previous-options. |
| 9054 | 9463 | ||
| 9055 | 2012-09-23 Roland Winkler <winkler@gnu.org> | 9464 | 2012-09-23 Roland Winkler <winkler@gnu.org> |
| @@ -11135,7 +11544,7 @@ | |||
| 11135 | * progmodes/python.el (python-shell-send-setup-max-wait): Delete var. | 11544 | * progmodes/python.el (python-shell-send-setup-max-wait): Delete var. |
| 11136 | (python-shell-make-comint): accept-process-output at startup. | 11545 | (python-shell-make-comint): accept-process-output at startup. |
| 11137 | (run-python-internal): Set inferior-python-mode-hook to nil. | 11546 | (run-python-internal): Set inferior-python-mode-hook to nil. |
| 11138 | (python-shell-internal-get-or-create-process): call sit-for. | 11547 | (python-shell-internal-get-or-create-process): Call sit-for. |
| 11139 | (python-preoutput-result): Add obsolete alias. | 11548 | (python-preoutput-result): Add obsolete alias. |
| 11140 | (python-shell-internal-send-string): Use it. | 11549 | (python-shell-internal-send-string): Use it. |
| 11141 | (python-shell-send-setup-code): Remove call to | 11550 | (python-shell-send-setup-code): Remove call to |
| @@ -11327,7 +11736,7 @@ | |||
| 11327 | 2012-07-27 Fabián Ezequiel Gallina <fgallina@cuca> | 11736 | 2012-07-27 Fabián Ezequiel Gallina <fgallina@cuca> |
| 11328 | 11737 | ||
| 11329 | Consistent completion in inferior python with emacs -nw. | 11738 | Consistent completion in inferior python with emacs -nw. |
| 11330 | * progmodes/python.el (inferior-python-mode): replace "<tab>" | 11739 | * progmodes/python.el (inferior-python-mode): Replace "<tab>" |
| 11331 | binding in inferior-python-mode-map with "\t". | 11740 | binding in inferior-python-mode-map with "\t". |
| 11332 | (python-shell-completion-complete-at-point) | 11741 | (python-shell-completion-complete-at-point) |
| 11333 | (python-completion-complete-at-point): Remove interactive spec. | 11742 | (python-completion-complete-at-point): Remove interactive spec. |
| @@ -12076,7 +12485,7 @@ | |||
| 12076 | (xml-name-start-char-re, xml-name-char-re, xml-name-re) | 12485 | (xml-name-start-char-re, xml-name-char-re, xml-name-re) |
| 12077 | (xml-names-re, xml-nmtoken-re, xml-nmtokens-re, xml-char-ref-re) | 12486 | (xml-names-re, xml-nmtoken-re, xml-nmtokens-re, xml-char-ref-re) |
| 12078 | (xml-entity-ref, xml-pe-reference-re) | 12487 | (xml-entity-ref, xml-pe-reference-re) |
| 12079 | (xml-reference-re,xml-att-value-re, xml-tokenized-type-re) | 12488 | (xml-reference-re, xml-att-value-re, xml-tokenized-type-re) |
| 12080 | (xml-notation-type-re, xml-enumeration-re, xml-enumerated-type-re) | 12489 | (xml-notation-type-re, xml-enumeration-re, xml-enumerated-type-re) |
| 12081 | (xml-att-type-re, xml-default-decl-re, xml-att-def-re) | 12490 | (xml-att-type-re, xml-default-decl-re, xml-att-def-re) |
| 12082 | (xml-entity-value-re): Use syntax references in regexps where | 12491 | (xml-entity-value-re): Use syntax references in regexps where |
| @@ -18891,8 +19300,8 @@ | |||
| 18891 | 19300 | ||
| 18892 | * progmodes/verilog-mode.el (verilog-read-defines): Fix reading | 19301 | * progmodes/verilog-mode.el (verilog-read-defines): Fix reading |
| 18893 | parameters with embedded comments. Reported by Ray Stevens. | 19302 | parameters with embedded comments. Reported by Ray Stevens. |
| 18894 | (verilog-calc-1, verilog-fork-wait-re) (verilog-forward-sexp, | 19303 | (verilog-calc-1, verilog-fork-wait-re, verilog-forward-sexp) |
| 18895 | verilog-wait-fork-re): Fix indentation of "wait fork", bug407. | 19304 | (verilog-wait-fork-re): Fix indentation of "wait fork", bug407. |
| 18896 | Reported by Tim Holt. | 19305 | Reported by Tim Holt. |
| 18897 | (verilog-auto): Fix AUTOing a upper module then AUTOing module | 19306 | (verilog-auto): Fix AUTOing a upper module then AUTOing module |
| 18898 | instantiated by upper module causing wrong expansion until AUTOed a | 19307 | instantiated by upper module causing wrong expansion until AUTOed a |
| @@ -20461,7 +20870,7 @@ | |||
| 20461 | 20870 | ||
| 20462 | 2011-10-07 Chong Yidong <cyd@stupidchicken.com> | 20871 | 2011-10-07 Chong Yidong <cyd@stupidchicken.com> |
| 20463 | 20872 | ||
| 20464 | * bindings.el ([M-left],[M-right]): Bind to left-word and | 20873 | * bindings.el ([M-left], [M-right]): Bind to left-word and |
| 20465 | right-word respectively. | 20874 | right-word respectively. |
| 20466 | 20875 | ||
| 20467 | 2011-10-07 Glenn Morris <rgm@gnu.org> | 20876 | 2011-10-07 Glenn Morris <rgm@gnu.org> |
| @@ -25783,15 +26192,15 @@ | |||
| 25783 | 2011-05-10 Jim Meyering <meyering@redhat.com> | 26192 | 2011-05-10 Jim Meyering <meyering@redhat.com> |
| 25784 | 26193 | ||
| 25785 | Fix doubled-word typos. | 26194 | Fix doubled-word typos. |
| 25786 | * international/quail.el (quail-insert-kbd-layout): and and -> and | 26195 | * international/quail.el (quail-insert-kbd-layout): and and -> and. |
| 25787 | * kermit.el: and and -> and | 26196 | * kermit.el: and and -> and. |
| 25788 | * net/ldap.el (ldap-search-internal): to to -> to | 26197 | * net/ldap.el (ldap-search-internal): to to -> to. |
| 25789 | * progmodes/vhdl-mode.el (vhdl-offsets-alist): Likewise. | 26198 | * progmodes/vhdl-mode.el (vhdl-offsets-alist): Likewise. |
| 25790 | * progmodes/js.el (js-mode): and and -> and | 26199 | * progmodes/js.el (js-mode): and and -> and. |
| 25791 | * textmodes/artist.el (artist-move-to-xy): at at -> at | 26200 | * textmodes/artist.el (artist-move-to-xy): at at -> at. |
| 25792 | (artist-draw-region-trim-line-endings): if if -> if | 26201 | (artist-draw-region-trim-line-endings): if if -> if. |
| 25793 | And Safetyc -> Safety. | 26202 | And Safetyc -> Safety. |
| 25794 | * textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a | 26203 | * textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a. |
| 25795 | 26204 | ||
| 25796 | 2011-05-10 Glenn Morris <rgm@gnu.org> | 26205 | 2011-05-10 Glenn Morris <rgm@gnu.org> |
| 25797 | Stefan Monnier <monnier@iro.umontreal.ca> | 26206 | Stefan Monnier <monnier@iro.umontreal.ca> |
diff --git a/lisp/ChangeLog.2 b/lisp/ChangeLog.2 index 3832f342d6f..fddc98a612d 100644 --- a/lisp/ChangeLog.2 +++ b/lisp/ChangeLog.2 | |||
| @@ -777,7 +777,7 @@ | |||
| 777 | 777 | ||
| 778 | 1987-12-21 Richard Stallman (rms@frosted-flakes) | 778 | 1987-12-21 Richard Stallman (rms@frosted-flakes) |
| 779 | 779 | ||
| 780 | * window.el (split-widow-{vertically,horizontally}): | 780 | * window.el (split-window-{vertically,horizontally}): |
| 781 | Make the arg optional. | 781 | Make the arg optional. |
| 782 | 782 | ||
| 783 | 1987-12-09 Richard Stallman (rms@frosted-flakes) | 783 | 1987-12-09 Richard Stallman (rms@frosted-flakes) |
| @@ -1392,7 +1392,7 @@ | |||
| 1392 | * shell.el: Minor doc fixes. | 1392 | * shell.el: Minor doc fixes. |
| 1393 | 1393 | ||
| 1394 | * rmail.el (rmail-get-new-mail): | 1394 | * rmail.el (rmail-get-new-mail): |
| 1395 | Handle errors competently. (Don't attempt to | 1395 | Handle errors competently. (Don't attempt to |
| 1396 | handle them, rather than botching the job) | 1396 | handle them, rather than botching the job) |
| 1397 | 1397 | ||
| 1398 | * rmail.el (rmail-insert-inbox-text): | 1398 | * rmail.el (rmail-insert-inbox-text): |
| @@ -3032,7 +3032,7 @@ | |||
| 3032 | 3032 | ||
| 3033 | Rename "kill" -> "delete" for both function-names and documentation. | 3033 | Rename "kill" -> "delete" for both function-names and documentation. |
| 3034 | 3034 | ||
| 3035 | Define C-d as Buffer-menu-delete-backwards. (also in ebuff-menu) | 3035 | Define C-d as Buffer-menu-delete-backwards (also in ebuff-menu). |
| 3036 | 3036 | ||
| 3037 | Save space: Merge buffer-menu-{execute,do-saves,do-kills}. | 3037 | Save space: Merge buffer-menu-{execute,do-saves,do-kills}. |
| 3038 | 3038 | ||
diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 4884213daeb..61449b66c9b 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in | |||
| @@ -209,8 +209,9 @@ update-authors: | |||
| 209 | $(emacs) -l authors -f batch-update-authors $(top_srcdir)/etc/AUTHORS $(top_srcdir) | 209 | $(emacs) -l authors -f batch-update-authors $(top_srcdir)/etc/AUTHORS $(top_srcdir) |
| 210 | 210 | ||
| 211 | TAGS TAGS-LISP: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) | 211 | TAGS TAGS-LISP: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) |
| 212 | els=`echo $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) | sed -e "s,$(lisp)/[^ ]*loaddefs[^ ]*,," -e "s,$(lisp)/ldefs-boot[^ ]*,,"`; \ | 212 | rm -f $@; touch $@; \ |
| 213 | ${ETAGS} -o $@ $$els | 213 | echo $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) | sed -e "s,$(lisp)/[^ ]*loaddefs[^ ]*,," -e "s,$(lisp)/ldefs-boot[^ ]*,," | \ |
| 214 | xargs $(XARGS_LIMIT) ${ETAGS} -a -o $@ | ||
| 214 | 215 | ||
| 215 | # The src/Makefile.in has its own set of dependencies and when they decide | 216 | # The src/Makefile.in has its own set of dependencies and when they decide |
| 216 | # that one Lisp file needs to be re-compiled, we had better recompile it as | 217 | # that one Lisp file needs to be re-compiled, we had better recompile it as |
diff --git a/lisp/allout.el b/lisp/allout.el index 5a9b03b7a0e..1e4134b3ccf 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -1561,7 +1561,7 @@ Each value can be a regexp or a list with a regexp followed by a | |||
| 1561 | substitution string. If it's just a regexp, all its matches are removed | 1561 | substitution string. If it's just a regexp, all its matches are removed |
| 1562 | before the text is encrypted. If it's a regexp and a substitution, the | 1562 | before the text is encrypted. If it's a regexp and a substitution, the |
| 1563 | substitution is used against the regexp matches, a la `replace-match'.") | 1563 | substitution is used against the regexp matches, a la `replace-match'.") |
| 1564 | (make-variable-buffer-local 'allout-encryption-text-removal-regexps) | 1564 | (make-variable-buffer-local 'allout-encryption-plaintext-sanitization-regexps) |
| 1565 | ;;;_ = allout-encryption-ciphertext-rejection-regexps | 1565 | ;;;_ = allout-encryption-ciphertext-rejection-regexps |
| 1566 | (defvar allout-encryption-ciphertext-rejection-regexps nil | 1566 | (defvar allout-encryption-ciphertext-rejection-regexps nil |
| 1567 | "Variable for regexps matching plaintext to remove before encryption. | 1567 | "Variable for regexps matching plaintext to remove before encryption. |
diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 90dda93a166..4a6d4cb4cc0 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el | |||
| @@ -578,7 +578,7 @@ will use an up-to-date value of `auto-revert-interval'" | |||
| 578 | ((featurep 'w32notify) (nth 2 event))))) | 578 | ((featurep 'w32notify) (nth 2 event))))) |
| 579 | 579 | ||
| 580 | (defun auto-revert-notify-handler (event) | 580 | (defun auto-revert-notify-handler (event) |
| 581 | "Handle an event returned from file notification." | 581 | "Handle an EVENT returned from file notification." |
| 582 | (when (auto-revert-notify-event-p event) | 582 | (when (auto-revert-notify-event-p event) |
| 583 | (let* ((descriptor (auto-revert-notify-event-descriptor event)) | 583 | (let* ((descriptor (auto-revert-notify-event-descriptor event)) |
| 584 | (action (auto-revert-notify-event-action event)) | 584 | (action (auto-revert-notify-event-action event)) |
| @@ -591,10 +591,12 @@ will use an up-to-date value of `auto-revert-interval'" | |||
| 591 | (cl-assert descriptor) | 591 | (cl-assert descriptor) |
| 592 | (cond | 592 | (cond |
| 593 | ((featurep 'gfilenotify) | 593 | ((featurep 'gfilenotify) |
| 594 | (cl-assert (or (eq 'attribute-changed action) | 594 | (cl-assert (memq action '(attribute-changed changed created deleted |
| 595 | (eq 'changed action) | 595 | ;; FIXME: I keep getting this action, so I |
| 596 | (eq 'created action) | 596 | ;; added it here, but I have no idea what |
| 597 | (eq 'deleted action)))) | 597 | ;; I'm doing. --Stef |
| 598 | changes-done-hint)) | ||
| 599 | t)) | ||
| 598 | ((featurep 'inotify) | 600 | ((featurep 'inotify) |
| 599 | (cl-assert (or (memq 'attrib action) | 601 | (cl-assert (or (memq 'attrib action) |
| 600 | (memq 'create action) | 602 | (memq 'create action) |
diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el index efaec4f63b4..629bbdee561 100644 --- a/lisp/cedet/semantic/ctxt.el +++ b/lisp/cedet/semantic/ctxt.el | |||
| @@ -366,7 +366,7 @@ For example, in the C statement: | |||
| 366 | If the cursor is on 'this', will move point to the ; after entry.") | 366 | If the cursor is on 'this', will move point to the ; after entry.") |
| 367 | 367 | ||
| 368 | (defun semantic-ctxt-end-of-symbol-default (&optional point) | 368 | (defun semantic-ctxt-end-of-symbol-default (&optional point) |
| 369 | "Move poin to the end of the current symbol under POINT. | 369 | "Move point to the end of the current symbol under POINT. |
| 370 | This will move past type/field names when applicable. | 370 | This will move past type/field names when applicable. |
| 371 | Depends on `semantic-type-relation-separator-character', and will | 371 | Depends on `semantic-type-relation-separator-character', and will |
| 372 | work on C like languages." | 372 | work on C like languages." |
| @@ -422,18 +422,18 @@ work on C like languages." | |||
| 422 | 422 | ||
| 423 | ;; Skip the separator and the symbol. | 423 | ;; Skip the separator and the symbol. |
| 424 | (goto-char (match-end 0)) | 424 | (goto-char (match-end 0)) |
| 425 | 425 | ||
| 426 | (if (looking-at "\\w\\|\\s_") | 426 | (if (looking-at "\\w\\|\\s_") |
| 427 | ;; Skip symbols | 427 | ;; Skip symbols |
| 428 | (forward-sexp 1) | 428 | (forward-sexp 1) |
| 429 | ;; No symbol, exit the search... | 429 | ;; No symbol, exit the search... |
| 430 | (setq continuesearch nil)) | 430 | (setq continuesearch nil)) |
| 431 | 431 | ||
| 432 | (setq end (point))) | 432 | (setq end (point))) |
| 433 | 433 | ||
| 434 | ;; Cont... | 434 | ;; Cont... |
| 435 | ) | 435 | ) |
| 436 | 436 | ||
| 437 | ;; Restore position if we go to far.... | 437 | ;; Restore position if we go to far.... |
| 438 | (error (goto-char end)) ) | 438 | (error (goto-char end)) ) |
| 439 | 439 | ||
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 3487e615168..a4aa535eb1a 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el | |||
| @@ -396,7 +396,7 @@ decoration API found in this library." | |||
| 396 | (let ((predicate (semantic-decorate-style-predicate name)) | 396 | (let ((predicate (semantic-decorate-style-predicate name)) |
| 397 | (highlighter (semantic-decorate-style-highlighter name)) | 397 | (highlighter (semantic-decorate-style-highlighter name)) |
| 398 | (predicatedef (semantic-decorate-style-predicate-default name)) | 398 | (predicatedef (semantic-decorate-style-predicate-default name)) |
| 399 | (highlighterdef (semantic-decorate-style-highlighter-default name)) | 399 | (highlighterdef (semantic-decorate-style-highlighter-default name)) |
| 400 | (defaultenable (if (plist-member flags :enabled) | 400 | (defaultenable (if (plist-member flags :enabled) |
| 401 | (plist-get flags :enabled) | 401 | (plist-get flags :enabled) |
| 402 | t)) | 402 | t)) |
| @@ -422,14 +422,14 @@ decoration API found in this library." | |||
| 422 | (add-to-list 'semantic-decoration-styles | 422 | (add-to-list 'semantic-decoration-styles |
| 423 | (cons ',(symbol-name name) | 423 | (cons ',(symbol-name name) |
| 424 | ,defaultenable)) | 424 | ,defaultenable)) |
| 425 | ;; If there is a load file, then create the autload tokens for | 425 | ;; If there is a load file, then create the autoload tokens for |
| 426 | ;; those functions to load the token, but only if the fsym | 426 | ;; those functions to load the token, but only if the fsym |
| 427 | ;; doesn't exist yet. | 427 | ;; doesn't exist yet. |
| 428 | (when (stringp ,loadfile) | 428 | (when (stringp ,loadfile) |
| 429 | (unless (fboundp ',predicatedef) | 429 | (unless (fboundp ',predicatedef) |
| 430 | (autoload ',predicatedef ',loadfile "Return non-nil to decorate TAG." | 430 | (autoload ',predicatedef ',loadfile "Return non-nil to decorate TAG." |
| 431 | nil 'function)) | 431 | nil 'function)) |
| 432 | 432 | ||
| 433 | (unless (fboundp ',highlighterdef) | 433 | (unless (fboundp ',highlighterdef) |
| 434 | (autoload ',highlighterdef ',loadfile "Decorate TAG." | 434 | (autoload ',highlighterdef ',loadfile "Decorate TAG." |
| 435 | nil 'function)) | 435 | nil 'function)) |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c910acdbc14..e603f76f41d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -411,6 +411,9 @@ specify different fields to sort on." | |||
| 411 | (defvar byte-compile-bound-variables nil | 411 | (defvar byte-compile-bound-variables nil |
| 412 | "List of dynamic variables bound in the context of the current form. | 412 | "List of dynamic variables bound in the context of the current form. |
| 413 | This list lives partly on the stack.") | 413 | This list lives partly on the stack.") |
| 414 | (defvar byte-compile-lexical-variables nil | ||
| 415 | "List of variables that have been treated as lexical. | ||
| 416 | Filled in `cconv-analyse-form' but initialized and consulted here.") | ||
| 414 | (defvar byte-compile-const-variables nil | 417 | (defvar byte-compile-const-variables nil |
| 415 | "List of variables declared as constants during compilation of this file.") | 418 | "List of variables declared as constants during compilation of this file.") |
| 416 | (defvar byte-compile-free-references) | 419 | (defvar byte-compile-free-references) |
| @@ -1489,6 +1492,7 @@ extra args." | |||
| 1489 | (byte-compile--outbuffer nil) | 1492 | (byte-compile--outbuffer nil) |
| 1490 | (byte-compile-function-environment nil) | 1493 | (byte-compile-function-environment nil) |
| 1491 | (byte-compile-bound-variables nil) | 1494 | (byte-compile-bound-variables nil) |
| 1495 | (byte-compile-lexical-variables nil) | ||
| 1492 | (byte-compile-const-variables nil) | 1496 | (byte-compile-const-variables nil) |
| 1493 | (byte-compile-free-references nil) | 1497 | (byte-compile-free-references nil) |
| 1494 | (byte-compile-free-assignments nil) | 1498 | (byte-compile-free-assignments nil) |
| @@ -2245,15 +2249,24 @@ list that represents a doc string reference. | |||
| 2245 | 2249 | ||
| 2246 | (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) | 2250 | (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) |
| 2247 | (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) | 2251 | (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) |
| 2248 | (defun byte-compile-file-form-defvar (form) | 2252 | |
| 2249 | (when (and (symbolp (nth 1 form)) | 2253 | (defun byte-compile--declare-var (sym) |
| 2250 | (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) | 2254 | (when (and (symbolp sym) |
| 2255 | (not (string-match "[-*/:$]" (symbol-name sym))) | ||
| 2251 | (byte-compile-warning-enabled-p 'lexical)) | 2256 | (byte-compile-warning-enabled-p 'lexical)) |
| 2252 | (byte-compile-warn "global/dynamic var `%s' lacks a prefix" | 2257 | (byte-compile-warn "global/dynamic var `%s' lacks a prefix" |
| 2253 | (nth 1 form))) | 2258 | sym)) |
| 2254 | (push (nth 1 form) byte-compile-bound-variables) | 2259 | (when (memq sym byte-compile-lexical-variables) |
| 2255 | (if (eq (car form) 'defconst) | 2260 | (setq byte-compile-lexical-variables |
| 2256 | (push (nth 1 form) byte-compile-const-variables)) | 2261 | (delq sym byte-compile-lexical-variables)) |
| 2262 | (byte-compile-warn "Variable `%S' declared after its first use" sym)) | ||
| 2263 | (push sym byte-compile-bound-variables)) | ||
| 2264 | |||
| 2265 | (defun byte-compile-file-form-defvar (form) | ||
| 2266 | (let ((sym (nth 1 form))) | ||
| 2267 | (byte-compile--declare-var sym) | ||
| 2268 | (if (eq (car form) 'defconst) | ||
| 2269 | (push sym byte-compile-const-variables))) | ||
| 2257 | (if (and (null (cddr form)) ;No `value' provided. | 2270 | (if (and (null (cddr form)) ;No `value' provided. |
| 2258 | (eq (car form) 'defvar)) ;Just a declaration. | 2271 | (eq (car form) 'defvar)) ;Just a declaration. |
| 2259 | nil | 2272 | nil |
| @@ -2267,7 +2280,7 @@ list that represents a doc string reference. | |||
| 2267 | 'byte-compile-file-form-define-abbrev-table) | 2280 | 'byte-compile-file-form-define-abbrev-table) |
| 2268 | (defun byte-compile-file-form-define-abbrev-table (form) | 2281 | (defun byte-compile-file-form-define-abbrev-table (form) |
| 2269 | (if (eq 'quote (car-safe (car-safe (cdr form)))) | 2282 | (if (eq 'quote (car-safe (car-safe (cdr form)))) |
| 2270 | (push (car-safe (cdr (cadr form))) byte-compile-bound-variables)) | 2283 | (byte-compile--declare-var (car-safe (cdr (cadr form))))) |
| 2271 | (byte-compile-keep-pending form)) | 2284 | (byte-compile-keep-pending form)) |
| 2272 | 2285 | ||
| 2273 | (put 'custom-declare-variable 'byte-hunk-handler | 2286 | (put 'custom-declare-variable 'byte-hunk-handler |
| @@ -2275,7 +2288,7 @@ list that represents a doc string reference. | |||
| 2275 | (defun byte-compile-file-form-custom-declare-variable (form) | 2288 | (defun byte-compile-file-form-custom-declare-variable (form) |
| 2276 | (when (byte-compile-warning-enabled-p 'callargs) | 2289 | (when (byte-compile-warning-enabled-p 'callargs) |
| 2277 | (byte-compile-nogroup-warn form)) | 2290 | (byte-compile-nogroup-warn form)) |
| 2278 | (push (nth 1 (nth 1 form)) byte-compile-bound-variables) | 2291 | (byte-compile--declare-var (nth 1 (nth 1 form))) |
| 2279 | (byte-compile-keep-pending form)) | 2292 | (byte-compile-keep-pending form)) |
| 2280 | 2293 | ||
| 2281 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) | 2294 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) |
| @@ -2576,19 +2589,16 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2576 | "Return a list of the variables in the lambda argument list ARGLIST." | 2589 | "Return a list of the variables in the lambda argument list ARGLIST." |
| 2577 | (remq '&rest (remq '&optional arglist))) | 2590 | (remq '&rest (remq '&optional arglist))) |
| 2578 | 2591 | ||
| 2579 | (defun byte-compile-make-lambda-lexenv (form) | 2592 | (defun byte-compile-make-lambda-lexenv (args) |
| 2580 | "Return a new lexical environment for a lambda expression FORM." | 2593 | "Return a new lexical environment for a lambda expression FORM." |
| 2581 | ;; See if this is a closure or not | 2594 | (let* ((lexenv nil) |
| 2582 | (let ((args (byte-compile-arglist-vars (cadr form)))) | 2595 | (stackpos 0)) |
| 2583 | (let ((lexenv nil)) | 2596 | ;; Add entries for each argument. |
| 2584 | ;; Fill in the initial stack contents | 2597 | (dolist (arg args) |
| 2585 | (let ((stackpos 0)) | 2598 | (push (cons arg stackpos) lexenv) |
| 2586 | ;; Add entries for each argument | 2599 | (setq stackpos (1+ stackpos))) |
| 2587 | (dolist (arg args) | 2600 | ;; Return the new lexical environment. |
| 2588 | (push (cons arg stackpos) lexenv) | 2601 | lexenv)) |
| 2589 | (setq stackpos (1+ stackpos))) | ||
| 2590 | ;; Return the new lexical environment | ||
| 2591 | lexenv)))) | ||
| 2592 | 2602 | ||
| 2593 | (defun byte-compile-make-args-desc (arglist) | 2603 | (defun byte-compile-make-args-desc (arglist) |
| 2594 | (let ((mandatory 0) | 2604 | (let ((mandatory 0) |
| @@ -2626,9 +2636,9 @@ for symbols generated by the byte compiler itself." | |||
| 2626 | (byte-compile-set-symbol-position 'lambda)) | 2636 | (byte-compile-set-symbol-position 'lambda)) |
| 2627 | (byte-compile-check-lambda-list (nth 1 fun)) | 2637 | (byte-compile-check-lambda-list (nth 1 fun)) |
| 2628 | (let* ((arglist (nth 1 fun)) | 2638 | (let* ((arglist (nth 1 fun)) |
| 2639 | (arglistvars (byte-compile-arglist-vars arglist)) | ||
| 2629 | (byte-compile-bound-variables | 2640 | (byte-compile-bound-variables |
| 2630 | (append (and (not lexical-binding) | 2641 | (append (if (not lexical-binding) arglistvars) |
| 2631 | (byte-compile-arglist-vars arglist)) | ||
| 2632 | byte-compile-bound-variables)) | 2642 | byte-compile-bound-variables)) |
| 2633 | (body (cdr (cdr fun))) | 2643 | (body (cdr (cdr fun))) |
| 2634 | (doc (if (stringp (car body)) | 2644 | (doc (if (stringp (car body)) |
| @@ -2676,7 +2686,8 @@ for symbols generated by the byte compiler itself." | |||
| 2676 | ;; args (since lambda expressions should be | 2686 | ;; args (since lambda expressions should be |
| 2677 | ;; closed by now). | 2687 | ;; closed by now). |
| 2678 | (and lexical-binding | 2688 | (and lexical-binding |
| 2679 | (byte-compile-make-lambda-lexenv fun)) | 2689 | (byte-compile-make-lambda-lexenv |
| 2690 | arglistvars)) | ||
| 2680 | reserved-csts))) | 2691 | reserved-csts))) |
| 2681 | ;; Build the actual byte-coded function. | 2692 | ;; Build the actual byte-coded function. |
| 2682 | (cl-assert (eq 'byte-code (car-safe compiled))) | 2693 | (cl-assert (eq 'byte-code (car-safe compiled))) |
| @@ -3435,32 +3446,38 @@ discarding." | |||
| 3435 | (byte-defop-compiler (/ byte-quo) byte-compile-quo) | 3446 | (byte-defop-compiler (/ byte-quo) byte-compile-quo) |
| 3436 | (byte-defop-compiler nconc) | 3447 | (byte-defop-compiler nconc) |
| 3437 | 3448 | ||
| 3449 | ;; Is this worth it? Both -before and -after are written in C. | ||
| 3438 | (defun byte-compile-char-before (form) | 3450 | (defun byte-compile-char-before (form) |
| 3439 | (cond ((= 2 (length form)) | 3451 | (cond ((or (= 1 (length form)) |
| 3452 | (and (= 2 (length form)) (not (nth 1 form)))) | ||
| 3453 | (byte-compile-form '(char-after (1- (point))))) | ||
| 3454 | ((= 2 (length form)) | ||
| 3440 | (byte-compile-form (list 'char-after (if (numberp (nth 1 form)) | 3455 | (byte-compile-form (list 'char-after (if (numberp (nth 1 form)) |
| 3441 | (1- (nth 1 form)) | 3456 | (1- (nth 1 form)) |
| 3442 | `(1- ,(nth 1 form)))))) | 3457 | `(1- (or ,(nth 1 form) |
| 3443 | ((= 1 (length form)) | 3458 | (point))))))) |
| 3444 | (byte-compile-form '(char-after (1- (point))))) | ||
| 3445 | (t (byte-compile-subr-wrong-args form "0-1")))) | 3459 | (t (byte-compile-subr-wrong-args form "0-1")))) |
| 3446 | 3460 | ||
| 3447 | ;; backward-... ==> forward-... with negated argument. | 3461 | ;; backward-... ==> forward-... with negated argument. |
| 3462 | ;; Is this worth it? Both -backward and -forward are written in C. | ||
| 3448 | (defun byte-compile-backward-char (form) | 3463 | (defun byte-compile-backward-char (form) |
| 3449 | (cond ((= 2 (length form)) | 3464 | (cond ((or (= 1 (length form)) |
| 3465 | (and (= 2 (length form)) (not (nth 1 form)))) | ||
| 3466 | (byte-compile-form '(forward-char -1))) | ||
| 3467 | ((= 2 (length form)) | ||
| 3450 | (byte-compile-form (list 'forward-char (if (numberp (nth 1 form)) | 3468 | (byte-compile-form (list 'forward-char (if (numberp (nth 1 form)) |
| 3451 | (- (nth 1 form)) | 3469 | (- (nth 1 form)) |
| 3452 | `(- ,(nth 1 form)))))) | 3470 | `(- (or ,(nth 1 form) 1)))))) |
| 3453 | ((= 1 (length form)) | ||
| 3454 | (byte-compile-form '(forward-char -1))) | ||
| 3455 | (t (byte-compile-subr-wrong-args form "0-1")))) | 3471 | (t (byte-compile-subr-wrong-args form "0-1")))) |
| 3456 | 3472 | ||
| 3457 | (defun byte-compile-backward-word (form) | 3473 | (defun byte-compile-backward-word (form) |
| 3458 | (cond ((= 2 (length form)) | 3474 | (cond ((or (= 1 (length form)) |
| 3475 | (and (= 2 (length form)) (not (nth 1 form)))) | ||
| 3476 | (byte-compile-form '(forward-word -1))) | ||
| 3477 | ((= 2 (length form)) | ||
| 3459 | (byte-compile-form (list 'forward-word (if (numberp (nth 1 form)) | 3478 | (byte-compile-form (list 'forward-word (if (numberp (nth 1 form)) |
| 3460 | (- (nth 1 form)) | 3479 | (- (nth 1 form)) |
| 3461 | `(- ,(nth 1 form)))))) | 3480 | `(- (or ,(nth 1 form) 1)))))) |
| 3462 | ((= 1 (length form)) | ||
| 3463 | (byte-compile-form '(forward-word -1))) | ||
| 3464 | (t (byte-compile-subr-wrong-args form "0-1")))) | 3481 | (t (byte-compile-subr-wrong-args form "0-1")))) |
| 3465 | 3482 | ||
| 3466 | (defun byte-compile-list (form) | 3483 | (defun byte-compile-list (form) |
| @@ -3862,9 +3879,8 @@ that suppresses all warnings during execution of BODY." | |||
| 3862 | "Emit byte-codes to push the initialization value for CLAUSE on the stack. | 3879 | "Emit byte-codes to push the initialization value for CLAUSE on the stack. |
| 3863 | Return the offset in the form (VAR . OFFSET)." | 3880 | Return the offset in the form (VAR . OFFSET)." |
| 3864 | (let* ((var (if (consp clause) (car clause) clause))) | 3881 | (let* ((var (if (consp clause) (car clause) clause))) |
| 3865 | ;; We record the stack position even of dynamic bindings and | 3882 | ;; We record the stack position even of dynamic bindings; we'll put |
| 3866 | ;; variables in non-stack lexical environments; we'll put | 3883 | ;; them in the proper place later. |
| 3867 | ;; them in the proper place below. | ||
| 3868 | (prog1 (cons var byte-compile-depth) | 3884 | (prog1 (cons var byte-compile-depth) |
| 3869 | (if (consp clause) | 3885 | (if (consp clause) |
| 3870 | (byte-compile-form (cadr clause)) | 3886 | (byte-compile-form (cadr clause)) |
| @@ -3882,33 +3898,41 @@ Return the offset in the form (VAR . OFFSET)." | |||
| 3882 | INIT-LEXENV should be a lexical-environment alist describing the | 3898 | INIT-LEXENV should be a lexical-environment alist describing the |
| 3883 | positions of the init value that have been pushed on the stack. | 3899 | positions of the init value that have been pushed on the stack. |
| 3884 | Return non-nil if the TOS value was popped." | 3900 | Return non-nil if the TOS value was popped." |
| 3885 | ;; The presence of lexical bindings mean that we may have to | 3901 | ;; The mix of lexical and dynamic bindings mean that we may have to |
| 3886 | ;; juggle things on the stack, to move them to TOS for | 3902 | ;; juggle things on the stack, to move them to TOS for |
| 3887 | ;; dynamic binding. | 3903 | ;; dynamic binding. |
| 3888 | (cond ((not (byte-compile-not-lexical-var-p var)) | 3904 | (if (and lexical-binding (not (byte-compile-not-lexical-var-p var))) |
| 3889 | ;; VAR is a simple stack-allocated lexical variable | 3905 | ;; VAR is a simple stack-allocated lexical variable. |
| 3890 | (push (assq var init-lexenv) | 3906 | (progn (push (assq var init-lexenv) |
| 3891 | byte-compile--lexical-environment) | 3907 | byte-compile--lexical-environment) |
| 3892 | nil) | 3908 | nil) |
| 3893 | ((eq var (caar init-lexenv)) | 3909 | ;; VAR should be dynamically bound. |
| 3894 | ;; VAR is dynamic and is on the top of the | 3910 | (while (assq var byte-compile--lexical-environment) |
| 3895 | ;; stack, so we can just bind it like usual | 3911 | ;; This dynamic binding shadows a lexical binding. |
| 3896 | (byte-compile-dynamic-variable-bind var) | 3912 | (setq byte-compile--lexical-environment |
| 3897 | t) | 3913 | (remq (assq var byte-compile--lexical-environment) |
| 3898 | (t | 3914 | byte-compile--lexical-environment))) |
| 3899 | ;; VAR is dynamic, but we have to get its | 3915 | (cond |
| 3900 | ;; value out of the middle of the stack | 3916 | ((eq var (caar init-lexenv)) |
| 3901 | (let ((stack-pos (cdr (assq var init-lexenv)))) | 3917 | ;; VAR is dynamic and is on the top of the |
| 3902 | (byte-compile-stack-ref stack-pos) | 3918 | ;; stack, so we can just bind it like usual. |
| 3903 | (byte-compile-dynamic-variable-bind var) | 3919 | (byte-compile-dynamic-variable-bind var) |
| 3904 | ;; Now we have to store nil into its temporary | 3920 | t) |
| 3905 | ;; stack position to avoid problems with GC | 3921 | (t |
| 3906 | (byte-compile-push-constant nil) | 3922 | ;; VAR is dynamic, but we have to get its |
| 3907 | (byte-compile-stack-set stack-pos)) | 3923 | ;; value out of the middle of the stack. |
| 3908 | nil))) | 3924 | (let ((stack-pos (cdr (assq var init-lexenv)))) |
| 3909 | 3925 | (byte-compile-stack-ref stack-pos) | |
| 3910 | (defun byte-compile-unbind (clauses init-lexenv | 3926 | (byte-compile-dynamic-variable-bind var) |
| 3911 | &optional preserve-body-value) | 3927 | ;; Now we have to store nil into its temporary |
| 3928 | ;; stack position so it doesn't prevent the value from being GC'd. | ||
| 3929 | ;; FIXME: Not worth the trouble. | ||
| 3930 | ;; (byte-compile-push-constant nil) | ||
| 3931 | ;; (byte-compile-stack-set stack-pos) | ||
| 3932 | ) | ||
| 3933 | nil)))) | ||
| 3934 | |||
| 3935 | (defun byte-compile-unbind (clauses init-lexenv preserve-body-value) | ||
| 3912 | "Emit byte-codes to unbind the variables bound by CLAUSES. | 3936 | "Emit byte-codes to unbind the variables bound by CLAUSES. |
| 3913 | CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a | 3937 | CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a |
| 3914 | lexical-environment alist describing the positions of the init value that | 3938 | lexical-environment alist describing the positions of the init value that |
| @@ -3916,7 +3940,7 @@ have been pushed on the stack. If PRESERVE-BODY-VALUE is true, | |||
| 3916 | then an additional value on the top of the stack, above any lexical binding | 3940 | then an additional value on the top of the stack, above any lexical binding |
| 3917 | slots, is preserved, so it will be on the top of the stack after all | 3941 | slots, is preserved, so it will be on the top of the stack after all |
| 3918 | binding slots have been popped." | 3942 | binding slots have been popped." |
| 3919 | ;; Unbind dynamic variables | 3943 | ;; Unbind dynamic variables. |
| 3920 | (let ((num-dynamic-bindings 0)) | 3944 | (let ((num-dynamic-bindings 0)) |
| 3921 | (dolist (clause clauses) | 3945 | (dolist (clause clauses) |
| 3922 | (unless (assq (if (consp clause) (car clause) clause) | 3946 | (unless (assq (if (consp clause) (car clause) clause) |
| @@ -3927,14 +3951,15 @@ binding slots have been popped." | |||
| 3927 | ;; Pop lexical variables off the stack, possibly preserving the | 3951 | ;; Pop lexical variables off the stack, possibly preserving the |
| 3928 | ;; return value of the body. | 3952 | ;; return value of the body. |
| 3929 | (when init-lexenv | 3953 | (when init-lexenv |
| 3930 | ;; INIT-LEXENV contains all init values left on the stack | 3954 | ;; INIT-LEXENV contains all init values left on the stack. |
| 3931 | (byte-compile-discard (length init-lexenv) preserve-body-value))) | 3955 | (byte-compile-discard (length init-lexenv) preserve-body-value))) |
| 3932 | 3956 | ||
| 3933 | (defun byte-compile-let (form) | 3957 | (defun byte-compile-let (form) |
| 3934 | "Generate code for the `let' form FORM." | 3958 | "Generate code for the `let' or `let*' form FORM." |
| 3935 | (let ((clauses (cadr form)) | 3959 | (let ((clauses (cadr form)) |
| 3936 | (init-lexenv nil)) | 3960 | (init-lexenv nil) |
| 3937 | (when (eq (car form) 'let) | 3961 | (is-let (eq (car form) 'let))) |
| 3962 | (when is-let | ||
| 3938 | ;; First compute the binding values in the old scope. | 3963 | ;; First compute the binding values in the old scope. |
| 3939 | (dolist (var clauses) | 3964 | (dolist (var clauses) |
| 3940 | (push (byte-compile-push-binding-init var) init-lexenv))) | 3965 | (push (byte-compile-push-binding-init var) init-lexenv))) |
| @@ -3946,28 +3971,20 @@ binding slots have been popped." | |||
| 3946 | ;; For `let', do it in reverse order, because it makes no | 3971 | ;; For `let', do it in reverse order, because it makes no |
| 3947 | ;; semantic difference, but it is a lot more efficient since the | 3972 | ;; semantic difference, but it is a lot more efficient since the |
| 3948 | ;; values are now in reverse order on the stack. | 3973 | ;; values are now in reverse order on the stack. |
| 3949 | (dolist (var (if (eq (car form) 'let) (reverse clauses) clauses)) | 3974 | (dolist (var (if is-let (reverse clauses) clauses)) |
| 3950 | (unless (eq (car form) 'let) | 3975 | (unless is-let |
| 3951 | (push (byte-compile-push-binding-init var) init-lexenv)) | 3976 | (push (byte-compile-push-binding-init var) init-lexenv)) |
| 3952 | (let ((var (if (consp var) (car var) var))) | 3977 | (let ((var (if (consp var) (car var) var))) |
| 3953 | (cond ((null lexical-binding) | 3978 | (if (byte-compile-bind var init-lexenv) |
| 3954 | ;; If there are no lexical bindings, we can do things simply. | 3979 | (pop init-lexenv)))) |
| 3955 | (byte-compile-dynamic-variable-bind var)) | ||
| 3956 | ((byte-compile-bind var init-lexenv) | ||
| 3957 | (pop init-lexenv))))) | ||
| 3958 | ;; Emit the body. | 3980 | ;; Emit the body. |
| 3959 | (let ((init-stack-depth byte-compile-depth)) | 3981 | (let ((init-stack-depth byte-compile-depth)) |
| 3960 | (byte-compile-body-do-effect (cdr (cdr form))) | 3982 | (byte-compile-body-do-effect (cdr (cdr form))) |
| 3961 | ;; Unbind the variables. | 3983 | ;; Unbind both lexical and dynamic variables. |
| 3962 | (if lexical-binding | 3984 | (cl-assert (or (eq byte-compile-depth init-stack-depth) |
| 3963 | ;; Unbind both lexical and dynamic variables. | 3985 | (eq byte-compile-depth (1+ init-stack-depth)))) |
| 3964 | (progn | 3986 | (byte-compile-unbind clauses init-lexenv |
| 3965 | (cl-assert (or (eq byte-compile-depth init-stack-depth) | 3987 | (> byte-compile-depth init-stack-depth)))))) |
| 3966 | (eq byte-compile-depth (1+ init-stack-depth)))) | ||
| 3967 | (byte-compile-unbind clauses init-lexenv (> byte-compile-depth | ||
| 3968 | init-stack-depth))) | ||
| 3969 | ;; Unbind dynamic variables. | ||
| 3970 | (byte-compile-out 'byte-unbind (length clauses))))))) | ||
| 3971 | 3988 | ||
| 3972 | 3989 | ||
| 3973 | 3990 | ||
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index ee84a9f69ba..761e33c059d 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el | |||
| @@ -81,7 +81,6 @@ | |||
| 81 | ;; and other oddities. | 81 | ;; and other oddities. |
| 82 | ;; - new byte codes for unwind-protect, catch, and condition-case so that | 82 | ;; - new byte codes for unwind-protect, catch, and condition-case so that |
| 83 | ;; closures aren't needed at all. | 83 | ;; closures aren't needed at all. |
| 84 | ;; - inline source code of different binding mode by first compiling it. | ||
| 85 | ;; - a reference to a var that is known statically to always hold a constant | 84 | ;; - a reference to a var that is known statically to always hold a constant |
| 86 | ;; should be turned into a byte-constant rather than a byte-stack-ref. | 85 | ;; should be turned into a byte-constant rather than a byte-stack-ref. |
| 87 | ;; Hmm... right, that's called constant propagation and could be done here, | 86 | ;; Hmm... right, that's called constant propagation and could be done here, |
| @@ -95,6 +94,7 @@ | |||
| 95 | 94 | ||
| 96 | ;; (defmacro dlet (binders &rest body) | 95 | ;; (defmacro dlet (binders &rest body) |
| 97 | ;; ;; Works in both lexical and non-lexical mode. | 96 | ;; ;; Works in both lexical and non-lexical mode. |
| 97 | ;; (declare (indent 1) (debug let)) | ||
| 98 | ;; `(progn | 98 | ;; `(progn |
| 99 | ;; ,@(mapcar (lambda (binder) | 99 | ;; ,@(mapcar (lambda (binder) |
| 100 | ;; `(defvar ,(if (consp binder) (car binder) binder))) | 100 | ;; `(defvar ,(if (consp binder) (car binder) binder))) |
| @@ -489,6 +489,7 @@ places where they originally did not directly appear." | |||
| 489 | (unless (fboundp 'byte-compile-not-lexical-var-p) | 489 | (unless (fboundp 'byte-compile-not-lexical-var-p) |
| 490 | ;; Only used to test the code in non-lexbind Emacs. | 490 | ;; Only used to test the code in non-lexbind Emacs. |
| 491 | (defalias 'byte-compile-not-lexical-var-p 'boundp)) | 491 | (defalias 'byte-compile-not-lexical-var-p 'boundp)) |
| 492 | (defvar byte-compile-lexical-variables) | ||
| 492 | 493 | ||
| 493 | (defun cconv--analyse-use (vardata form varkind) | 494 | (defun cconv--analyse-use (vardata form varkind) |
| 494 | "Analyze the use of a variable. | 495 | "Analyze the use of a variable. |
| @@ -530,6 +531,7 @@ FORM is the parent form that binds this var." | |||
| 530 | ;; outside of it. | 531 | ;; outside of it. |
| 531 | (envcopy | 532 | (envcopy |
| 532 | (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env)) | 533 | (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env)) |
| 534 | (byte-compile-bound-variables byte-compile-bound-variables) | ||
| 533 | (newenv envcopy)) | 535 | (newenv envcopy)) |
| 534 | ;; Push it before recursing, so cconv-freevars-alist contains entries in | 536 | ;; Push it before recursing, so cconv-freevars-alist contains entries in |
| 535 | ;; the order they'll be used by closure-convert-rec. | 537 | ;; the order they'll be used by closure-convert-rec. |
| @@ -541,6 +543,7 @@ FORM is the parent form that binds this var." | |||
| 541 | (format "Argument %S is not a lexical variable" arg))) | 543 | (format "Argument %S is not a lexical variable" arg))) |
| 542 | ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... | 544 | ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... |
| 543 | (t (let ((varstruct (list arg nil nil nil nil))) | 545 | (t (let ((varstruct (list arg nil nil nil nil))) |
| 546 | (cl-pushnew arg byte-compile-lexical-variables) | ||
| 544 | (push (cons (list arg) (cdr varstruct)) newvars) | 547 | (push (cons (list arg) (cdr varstruct)) newvars) |
| 545 | (push varstruct newenv))))) | 548 | (push varstruct newenv))))) |
| 546 | (dolist (form body) ;Analyze body forms. | 549 | (dolist (form body) ;Analyze body forms. |
| @@ -579,6 +582,7 @@ and updates the data stored in ENV." | |||
| 579 | (let ((orig-env env) | 582 | (let ((orig-env env) |
| 580 | (newvars nil) | 583 | (newvars nil) |
| 581 | (var nil) | 584 | (var nil) |
| 585 | (byte-compile-bound-variables byte-compile-bound-variables) | ||
| 582 | (value nil)) | 586 | (value nil)) |
| 583 | (dolist (binder binders) | 587 | (dolist (binder binders) |
| 584 | (if (not (consp binder)) | 588 | (if (not (consp binder)) |
| @@ -592,6 +596,7 @@ and updates the data stored in ENV." | |||
| 592 | (cconv-analyse-form value (if (eq letsym 'let*) env orig-env))) | 596 | (cconv-analyse-form value (if (eq letsym 'let*) env orig-env))) |
| 593 | 597 | ||
| 594 | (unless (byte-compile-not-lexical-var-p var) | 598 | (unless (byte-compile-not-lexical-var-p var) |
| 599 | (cl-pushnew var byte-compile-lexical-variables) | ||
| 595 | (let ((varstruct (list var nil nil nil nil))) | 600 | (let ((varstruct (list var nil nil nil nil))) |
| 596 | (push (cons binder (cdr varstruct)) newvars) | 601 | (push (cons binder (cdr varstruct)) newvars) |
| 597 | (push varstruct env)))) | 602 | (push varstruct env)))) |
| @@ -616,7 +621,8 @@ and updates the data stored in ENV." | |||
| 616 | 621 | ||
| 617 | (`((lambda . ,_) . ,_) ; First element is lambda expression. | 622 | (`((lambda . ,_) . ,_) ; First element is lambda expression. |
| 618 | (byte-compile-log-warning | 623 | (byte-compile-log-warning |
| 619 | "Use of deprecated ((lambda ...) ...) form" t :warning) | 624 | (format "Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form))) |
| 625 | t :warning) | ||
| 620 | (dolist (exp `((function ,(car form)) . ,(cdr form))) | 626 | (dolist (exp `((function ,(car form)) . ,(cdr form))) |
| 621 | (cconv-analyse-form exp env))) | 627 | (cconv-analyse-form exp env))) |
| 622 | 628 | ||
| @@ -645,6 +651,7 @@ and updates the data stored in ENV." | |||
| 645 | (`(track-mouse . ,body) | 651 | (`(track-mouse . ,body) |
| 646 | (cconv--analyse-function () body env form)) | 652 | (cconv--analyse-function () body env form)) |
| 647 | 653 | ||
| 654 | (`(defvar ,var) (push var byte-compile-bound-variables)) | ||
| 648 | (`(,(or `defconst `defvar) ,var ,value . ,_) | 655 | (`(,(or `defconst `defvar) ,var ,value . ,_) |
| 649 | (push var byte-compile-bound-variables) | 656 | (push var byte-compile-bound-variables) |
| 650 | (cconv-analyse-form value env)) | 657 | (cconv-analyse-form value env)) |
| @@ -668,7 +675,9 @@ and updates the data stored in ENV." | |||
| 668 | ;; seem worth the trouble. | 675 | ;; seem worth the trouble. |
| 669 | (dolist (form forms) (cconv-analyse-form form nil))) | 676 | (dolist (form forms) (cconv-analyse-form form nil))) |
| 670 | 677 | ||
| 671 | (`(declare . ,_) nil) ;The args don't contain code. | 678 | ;; `declare' should now be macro-expanded away (and if they're not, we're |
| 679 | ;; in trouble because they *can* contain code nowadays). | ||
| 680 | ;; (`(declare . ,_) nil) ;The args don't contain code. | ||
| 672 | 681 | ||
| 673 | (`(,_ . ,body-forms) ; First element is a function or whatever. | 682 | (`(,_ . ,body-forms) ; First element is a function or whatever. |
| 674 | (dolist (form body-forms) (cconv-analyse-form form env))) | 683 | (dolist (form body-forms) (cconv-analyse-form form env))) |
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index f3bf70b0190..52f123c83ec 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el | |||
| @@ -156,8 +156,8 @@ an element already on the list. | |||
| 156 | ;; earlier and should have triggered them already. | 156 | ;; earlier and should have triggered them already. |
| 157 | (with-no-warnings ,place) | 157 | (with-no-warnings ,place) |
| 158 | (setq ,place (cons ,var ,place)))) | 158 | (setq ,place (cons ,var ,place)))) |
| 159 | (list 'setq place (cl-list* 'cl-adjoin x place keys))) | 159 | `(setq ,place (cl-adjoin ,x ,place ,@keys))) |
| 160 | (cl-list* 'cl-callf2 'cl-adjoin x place keys))) | 160 | `(cl-callf2 cl-adjoin ,x ,place ,@keys))) |
| 161 | 161 | ||
| 162 | (defun cl--set-elt (seq n val) | 162 | (defun cl--set-elt (seq n val) |
| 163 | (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) | 163 | (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) |
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index af19db63f30..a06abb03b95 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el | |||
| @@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'. | |||
| 267 | ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when | 267 | ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when |
| 268 | ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp | 268 | ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp |
| 269 | ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) | 269 | ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) |
| 270 | ;;;;;; "cl-macs" "cl-macs.el" "b839ad3781c4f2f849df0639b4eba166") | 270 | ;;;;;; "cl-macs" "cl-macs.el" "fd824d987086eafec0b1cb2efa8312f4") |
| 271 | ;;; Generated autoloads from cl-macs.el | 271 | ;;; Generated autoloads from cl-macs.el |
| 272 | 272 | ||
| 273 | (autoload 'cl--compiler-macro-list* "cl-macs" "\ | 273 | (autoload 'cl--compiler-macro-list* "cl-macs" "\ |
| @@ -699,9 +699,10 @@ OPTION is either a single keyword or (KEYWORD VALUE) where | |||
| 699 | KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, | 699 | KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, |
| 700 | :type, :named, :initial-offset, :print-function, or :include. | 700 | :type, :named, :initial-offset, :print-function, or :include. |
| 701 | 701 | ||
| 702 | Each SLOT may instead take the form (SLOT SLOT-OPTS...), where | 702 | Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where |
| 703 | SLOT-OPTS are keyword-value pairs for that slot. Currently, only | 703 | SDEFAULT is the default value of that slot and SOPTIONS are keyword-value |
| 704 | one keyword is supported, `:read-only'. If this has a non-nil | 704 | pairs for that slot. |
| 705 | Currently, only one keyword is supported, `:read-only'. If this has a non-nil | ||
| 705 | value, that slot cannot be set via `setf'. | 706 | value, that slot cannot be set via `setf'. |
| 706 | 707 | ||
| 707 | \(fn NAME SLOTS...)" nil t) | 708 | \(fn NAME SLOTS...)" nil t) |
| @@ -724,6 +725,8 @@ TYPE is a Common Lisp-style type specifier. | |||
| 724 | 725 | ||
| 725 | \(fn OBJECT TYPE)" nil nil) | 726 | \(fn OBJECT TYPE)" nil nil) |
| 726 | 727 | ||
| 728 | (eval-and-compile (put 'cl-typep 'compiler-macro #'cl--compiler-macro-typep)) | ||
| 729 | |||
| 727 | (autoload 'cl-check-type "cl-macs" "\ | 730 | (autoload 'cl-check-type "cl-macs" "\ |
| 728 | Verify that FORM is of type TYPE; signal an error if not. | 731 | Verify that FORM is of type TYPE; signal an error if not. |
| 729 | STRING is an optional description of the desired type. | 732 | STRING is an optional description of the desired type. |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 4aae2c6efe5..34957d86796 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -584,7 +584,7 @@ If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. | |||
| 584 | If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. | 584 | If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. |
| 585 | 585 | ||
| 586 | \(fn (WHEN...) BODY...)" | 586 | \(fn (WHEN...) BODY...)" |
| 587 | (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body))) | 587 | (declare (indent 1) (debug (sexp body))) |
| 588 | (if (and (fboundp 'cl--compiling-file) (cl--compiling-file) | 588 | (if (and (fboundp 'cl--compiling-file) (cl--compiling-file) |
| 589 | (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge. | 589 | (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge. |
| 590 | (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) | 590 | (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) |
| @@ -2276,9 +2276,10 @@ OPTION is either a single keyword or (KEYWORD VALUE) where | |||
| 2276 | KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, | 2276 | KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, |
| 2277 | :type, :named, :initial-offset, :print-function, or :include. | 2277 | :type, :named, :initial-offset, :print-function, or :include. |
| 2278 | 2278 | ||
| 2279 | Each SLOT may instead take the form (SLOT SLOT-OPTS...), where | 2279 | Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where |
| 2280 | SLOT-OPTS are keyword-value pairs for that slot. Currently, only | 2280 | SDEFAULT is the default value of that slot and SOPTIONS are keyword-value |
| 2281 | one keyword is supported, `:read-only'. If this has a non-nil | 2281 | pairs for that slot. |
| 2282 | Currently, only one keyword is supported, `:read-only'. If this has a non-nil | ||
| 2282 | value, that slot cannot be set via `setf'. | 2283 | value, that slot cannot be set via `setf'. |
| 2283 | 2284 | ||
| 2284 | \(fn NAME SLOTS...)" | 2285 | \(fn NAME SLOTS...)" |
| @@ -2574,9 +2575,16 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." | |||
| 2574 | (defun cl-typep (object type) ; See compiler macro below. | 2575 | (defun cl-typep (object type) ; See compiler macro below. |
| 2575 | "Check that OBJECT is of type TYPE. | 2576 | "Check that OBJECT is of type TYPE. |
| 2576 | TYPE is a Common Lisp-style type specifier." | 2577 | TYPE is a Common Lisp-style type specifier." |
| 2578 | (declare (compiler-macro cl--compiler-macro-typep)) | ||
| 2577 | (let ((cl--object object)) ;; Yuck!! | 2579 | (let ((cl--object object)) ;; Yuck!! |
| 2578 | (eval (cl--make-type-test 'cl--object type)))) | 2580 | (eval (cl--make-type-test 'cl--object type)))) |
| 2579 | 2581 | ||
| 2582 | (defun cl--compiler-macro-typep (form val type) | ||
| 2583 | (if (macroexp-const-p type) | ||
| 2584 | (macroexp-let2 macroexp-copyable-p temp val | ||
| 2585 | (cl--make-type-test temp (cl--const-expr-val type))) | ||
| 2586 | form)) | ||
| 2587 | |||
| 2580 | ;;;###autoload | 2588 | ;;;###autoload |
| 2581 | (defmacro cl-check-type (form type &optional string) | 2589 | (defmacro cl-check-type (form type &optional string) |
| 2582 | "Verify that FORM is of type TYPE; signal an error if not. | 2590 | "Verify that FORM is of type TYPE; signal an error if not. |
| @@ -2635,19 +2643,13 @@ and then returning foo." | |||
| 2635 | (let ((p args) (res nil)) | 2643 | (let ((p args) (res nil)) |
| 2636 | (while (consp p) (push (pop p) res)) | 2644 | (while (consp p) (push (pop p) res)) |
| 2637 | (setq args (nconc (nreverse res) (and p (list '&rest p))))) | 2645 | (setq args (nconc (nreverse res) (and p (list '&rest p))))) |
| 2638 | `(cl-eval-when (compile load eval) | 2646 | (let ((fname (make-symbol (concat (symbol-name func) "--cmacro")))) |
| 2639 | (put ',func 'compiler-macro | 2647 | `(eval-and-compile |
| 2640 | (cl-function (lambda ,(if (memq '&whole args) (delq '&whole args) | 2648 | ;; Name the compiler-macro function, so that `symbol-file' can find it. |
| 2641 | (cons '_cl-whole-arg args)) | 2649 | (cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args) |
| 2642 | ,@body))) | 2650 | (cons '_cl-whole-arg args)) |
| 2643 | ;; This is so that describe-function can locate | 2651 | ,@body) |
| 2644 | ;; the macro definition. | 2652 | (put ',func 'compiler-macro #',fname)))) |
| 2645 | (let ((file ,(or buffer-file-name | ||
| 2646 | (and (boundp 'byte-compile-current-file) | ||
| 2647 | (stringp byte-compile-current-file) | ||
| 2648 | byte-compile-current-file)))) | ||
| 2649 | (if file (put ',func 'compiler-macro-file | ||
| 2650 | (purecopy (file-name-nondirectory file))))))) | ||
| 2651 | 2653 | ||
| 2652 | ;;;###autoload | 2654 | ;;;###autoload |
| 2653 | (defun cl-compiler-macroexpand (form) | 2655 | (defun cl-compiler-macroexpand (form) |
| @@ -2763,22 +2765,16 @@ surrounded by (cl-block NAME ...). | |||
| 2763 | 2765 | ||
| 2764 | ;;;###autoload | 2766 | ;;;###autoload |
| 2765 | (defun cl--compiler-macro-adjoin (form a list &rest keys) | 2767 | (defun cl--compiler-macro-adjoin (form a list &rest keys) |
| 2766 | (if (and (cl--simple-expr-p a) (cl--simple-expr-p list) | 2768 | (if (memq :key keys) form |
| 2767 | (not (memq :key keys))) | 2769 | (macroexp-let2 macroexp-copyable-p va a |
| 2768 | `(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list)) | 2770 | (macroexp-let2 macroexp-copyable-p vlist list |
| 2769 | form)) | 2771 | `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist)))))) |
| 2770 | 2772 | ||
| 2771 | (defun cl--compiler-macro-get (_form sym prop &optional def) | 2773 | (defun cl--compiler-macro-get (_form sym prop &optional def) |
| 2772 | (if def | 2774 | (if def |
| 2773 | `(cl-getf (symbol-plist ,sym) ,prop ,def) | 2775 | `(cl-getf (symbol-plist ,sym) ,prop ,def) |
| 2774 | `(get ,sym ,prop))) | 2776 | `(get ,sym ,prop))) |
| 2775 | 2777 | ||
| 2776 | (cl-define-compiler-macro cl-typep (&whole form val type) | ||
| 2777 | (if (macroexp-const-p type) | ||
| 2778 | (macroexp-let2 macroexp-copyable-p temp val | ||
| 2779 | (cl--make-type-test temp (cl--const-expr-val type))) | ||
| 2780 | form)) | ||
| 2781 | |||
| 2782 | (dolist (y '(cl-first cl-second cl-third cl-fourth | 2778 | (dolist (y '(cl-first cl-second cl-third cl-fourth |
| 2783 | cl-fifth cl-sixth cl-seventh | 2779 | cl-fifth cl-sixth cl-seventh |
| 2784 | cl-eighth cl-ninth cl-tenth | 2780 | cl-eighth cl-ninth cl-tenth |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 867f079ce5f..319af588eac 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -472,6 +472,8 @@ the option `edebug-all-forms'." | |||
| 472 | (or (fboundp 'edebug-original-eval-defun) | 472 | (or (fboundp 'edebug-original-eval-defun) |
| 473 | (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun))) | 473 | (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun))) |
| 474 | 474 | ||
| 475 | (defvar edebug-result) ; The result of the function call returned by body. | ||
| 476 | |||
| 475 | ;; We should somehow arrange to be able to do this | 477 | ;; We should somehow arrange to be able to do this |
| 476 | ;; without actually replacing the eval-defun command. | 478 | ;; without actually replacing the eval-defun command. |
| 477 | (defun edebug-eval-defun (edebug-it) | 479 | (defun edebug-eval-defun (edebug-it) |
| @@ -487,7 +489,7 @@ With a prefix argument, instrument the code for Edebug. | |||
| 487 | 489 | ||
| 488 | Setting option `edebug-all-defs' to a non-nil value reverses the meaning | 490 | Setting option `edebug-all-defs' to a non-nil value reverses the meaning |
| 489 | of the prefix argument. Code is then instrumented when this function is | 491 | of the prefix argument. Code is then instrumented when this function is |
| 490 | invoked without a prefix argument | 492 | invoked without a prefix argument. |
| 491 | 493 | ||
| 492 | If acting on a `defun' for FUNCTION, and the function was instrumented, | 494 | If acting on a `defun' for FUNCTION, and the function was instrumented, |
| 493 | `Edebug: FUNCTION' is printed in the minibuffer. If not instrumented, | 495 | `Edebug: FUNCTION' is printed in the minibuffer. If not instrumented, |
| @@ -2106,7 +2108,6 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 2106 | (defvar edebug-coverage) ; the coverage results of each expression of function. | 2108 | (defvar edebug-coverage) ; the coverage results of each expression of function. |
| 2107 | 2109 | ||
| 2108 | (defvar edebug-buffer) ; which buffer the function is in. | 2110 | (defvar edebug-buffer) ; which buffer the function is in. |
| 2109 | (defvar edebug-result) ; the result of the function call returned by body | ||
| 2110 | (defvar edebug-outside-executing-macro) | 2111 | (defvar edebug-outside-executing-macro) |
| 2111 | (defvar edebug-outside-defining-kbd-macro) | 2112 | (defvar edebug-outside-defining-kbd-macro) |
| 2112 | 2113 | ||
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index dd5ff0ec694..cb86a554335 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el | |||
| @@ -93,6 +93,8 @@ | |||
| 93 | 93 | ||
| 94 | ;;; Code: | 94 | ;;; Code: |
| 95 | 95 | ||
| 96 | (eval-when-compile (require 'pcase)) | ||
| 97 | |||
| 96 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 98 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 97 | ;; Internal Variables | 99 | ;; Internal Variables |
| 98 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 100 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| @@ -224,18 +226,11 @@ Some generic modes are defined in `generic-x.el'." | |||
| 224 | (funcall (intern mode))) | 226 | (funcall (intern mode))) |
| 225 | 227 | ||
| 226 | ;;; Comment Functionality | 228 | ;;; Comment Functionality |
| 227 | (defun generic-mode-set-comments (comment-list) | ||
| 228 | "Set up comment functionality for generic mode." | ||
| 229 | (let ((st (make-syntax-table)) | ||
| 230 | (chars nil) | ||
| 231 | (comstyles)) | ||
| 232 | (make-local-variable 'comment-start) | ||
| 233 | (make-local-variable 'comment-start-skip) | ||
| 234 | (make-local-variable 'comment-end) | ||
| 235 | 229 | ||
| 236 | ;; Go through all the comments | 230 | (defun generic--normalise-comments (comment-list) |
| 231 | (let ((normalized '())) | ||
| 237 | (dolist (start comment-list) | 232 | (dolist (start comment-list) |
| 238 | (let (end (comstyle "")) | 233 | (let (end) |
| 239 | ;; Normalize | 234 | ;; Normalize |
| 240 | (when (consp start) | 235 | (when (consp start) |
| 241 | (setq end (cdr start)) | 236 | (setq end (cdr start)) |
| @@ -244,58 +239,79 @@ Some generic modes are defined in `generic-x.el'." | |||
| 244 | (cond | 239 | (cond |
| 245 | ((characterp end) (setq end (char-to-string end))) | 240 | ((characterp end) (setq end (char-to-string end))) |
| 246 | ((zerop (length end)) (setq end "\n"))) | 241 | ((zerop (length end)) (setq end "\n"))) |
| 242 | (push (cons start end) normalized))) | ||
| 243 | (nreverse normalized))) | ||
| 247 | 244 | ||
| 248 | ;; Setup the vars for `comment-region' | 245 | (defun generic-set-comment-syntax (st comment-list) |
| 249 | (if comment-start | 246 | "Set up comment functionality for generic mode." |
| 250 | ;; We have already setup a comment-style, so use style b | 247 | (let ((chars nil) |
| 251 | (progn | 248 | (comstyles) |
| 252 | (setq comstyle "b") | 249 | (comstyle "") |
| 253 | (setq comment-start-skip | 250 | (comment-start nil)) |
| 254 | (concat comment-start-skip "\\|" (regexp-quote start) "+\\s-*"))) | 251 | |
| 255 | ;; First comment-style | 252 | ;; Go through all the comments. |
| 256 | (setq comment-start start) | 253 | (pcase-dolist (`(,start . ,end) comment-list) |
| 257 | (setq comment-end (if (string-equal end "\n") "" end)) | 254 | (let ((comstyle |
| 258 | (setq comment-start-skip (concat (regexp-quote start) "+\\s-*"))) | 255 | ;; Reuse comstyles if necessary. |
| 259 | |||
| 260 | ;; Reuse comstyles if necessary | ||
| 261 | (setq comstyle | ||
| 262 | (or (cdr (assoc start comstyles)) | 256 | (or (cdr (assoc start comstyles)) |
| 263 | (cdr (assoc end comstyles)) | 257 | (cdr (assoc end comstyles)) |
| 264 | comstyle)) | 258 | ;; Otherwise, use a style not yet in use. |
| 259 | (if (not (rassoc "" comstyles)) "") | ||
| 260 | (if (not (rassoc "b" comstyles)) "b") | ||
| 261 | "c"))) | ||
| 265 | (push (cons start comstyle) comstyles) | 262 | (push (cons start comstyle) comstyles) |
| 266 | (push (cons end comstyle) comstyles) | 263 | (push (cons end comstyle) comstyles) |
| 267 | 264 | ||
| 268 | ;; Setup the syntax table | 265 | ;; Setup the syntax table. |
| 269 | (if (= (length start) 1) | 266 | (if (= (length start) 1) |
| 270 | (modify-syntax-entry (string-to-char start) | 267 | (modify-syntax-entry (aref start 0) |
| 271 | (concat "< " comstyle) st) | 268 | (concat "< " comstyle) st) |
| 272 | (let ((c0 (elt start 0)) (c1 (elt start 1))) | 269 | (let ((c0 (aref start 0)) (c1 (aref start 1))) |
| 273 | ;; Store the relevant info but don't update yet | 270 | ;; Store the relevant info but don't update yet. |
| 274 | (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) | 271 | (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) |
| 275 | (push (cons c1 (concat (cdr (assoc c1 chars)) | 272 | (push (cons c1 (concat (cdr (assoc c1 chars)) |
| 276 | (concat "2" comstyle))) chars))) | 273 | (concat "2" comstyle))) chars))) |
| 277 | (if (= (length end) 1) | 274 | (if (= (length end) 1) |
| 278 | (modify-syntax-entry (string-to-char end) | 275 | (modify-syntax-entry (aref end 0) |
| 279 | (concat ">" comstyle) st) | 276 | (concat ">" comstyle) st) |
| 280 | (let ((c0 (elt end 0)) (c1 (elt end 1))) | 277 | (let ((c0 (aref end 0)) (c1 (aref end 1))) |
| 281 | ;; Store the relevant info but don't update yet | 278 | ;; Store the relevant info but don't update yet. |
| 282 | (push (cons c0 (concat (cdr (assoc c0 chars)) | 279 | (push (cons c0 (concat (cdr (assoc c0 chars)) |
| 283 | (concat "3" comstyle))) chars) | 280 | (concat "3" comstyle))) chars) |
| 284 | (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) | 281 | (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) |
| 285 | 282 | ||
| 286 | ;; Process the chars that were part of a 2-char comment marker | 283 | ;; Process the chars that were part of a 2-char comment marker |
| 284 | (with-syntax-table st ;For `char-syntax'. | ||
| 287 | (dolist (cs (nreverse chars)) | 285 | (dolist (cs (nreverse chars)) |
| 288 | (modify-syntax-entry (car cs) | 286 | (modify-syntax-entry (car cs) |
| 289 | (concat (char-to-string (char-syntax (car cs))) | 287 | (concat (char-to-string (char-syntax (car cs))) |
| 290 | " " (cdr cs)) | 288 | " " (cdr cs)) |
| 291 | st)) | 289 | st))))) |
| 290 | |||
| 291 | (defun generic-set-comment-vars (comment-list) | ||
| 292 | (when comment-list | ||
| 293 | (setq-local comment-start (caar comment-list)) | ||
| 294 | (setq-local comment-end | ||
| 295 | (let ((end (cdar comment-list))) | ||
| 296 | (if (string-equal end "\n") "" end))) | ||
| 297 | (setq-local comment-start-skip | ||
| 298 | (concat (regexp-opt (mapcar #'car comment-list)) | ||
| 299 | "+[ \t]*")) | ||
| 300 | (setq-local comment-end-skip | ||
| 301 | (concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list)))))) | ||
| 302 | |||
| 303 | (defun generic-mode-set-comments (comment-list) | ||
| 304 | "Set up comment functionality for generic mode." | ||
| 305 | (let ((st (make-syntax-table)) | ||
| 306 | (comment-list (generic--normalise-comments comment-list))) | ||
| 307 | (generic-set-comment-syntax st comment-list) | ||
| 308 | (generic-set-comment-vars comment-list) | ||
| 292 | (set-syntax-table st))) | 309 | (set-syntax-table st))) |
| 293 | 310 | ||
| 294 | (defun generic-bracket-support () | 311 | (defun generic-bracket-support () |
| 295 | "Imenu support for [KEYWORD] constructs found in INF, INI and Samba files." | 312 | "Imenu support for [KEYWORD] constructs found in INF, INI and Samba files." |
| 296 | (setq imenu-generic-expression | 313 | (setq-local imenu-generic-expression '((nil "^\\[\\(.*\\)\\]" 1))) |
| 297 | '((nil "^\\[\\(.*\\)\\]" 1)) | 314 | (setq-local imenu-case-fold-search t)) |
| 298 | imenu-case-fold-search t)) | ||
| 299 | 315 | ||
| 300 | ;;;###autoload | 316 | ;;;###autoload |
| 301 | (defun generic-make-keywords-list (keyword-list face &optional prefix suffix) | 317 | (defun generic-make-keywords-list (keyword-list face &optional prefix suffix) |
| @@ -306,6 +322,7 @@ expression that matches these keywords and concatenates it with | |||
| 306 | PREFIX and SUFFIX. Then it returns a construct based on this | 322 | PREFIX and SUFFIX. Then it returns a construct based on this |
| 307 | regular expression that can be used as an element of | 323 | regular expression that can be used as an element of |
| 308 | `font-lock-keywords'." | 324 | `font-lock-keywords'." |
| 325 | (declare (obsolete regexp-opt "24.4")) | ||
| 309 | (unless (listp keyword-list) | 326 | (unless (listp keyword-list) |
| 310 | (error "Keywords argument must be a list of strings")) | 327 | (error "Keywords argument must be a list of strings")) |
| 311 | (list (concat prefix "\\_<" | 328 | (list (concat prefix "\\_<" |
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 02b020fa241..cbd8854e7d6 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el | |||
| @@ -225,11 +225,13 @@ font-lock keywords will not be case sensitive." | |||
| 225 | (setq-local syntax-begin-function 'beginning-of-defun) | 225 | (setq-local syntax-begin-function 'beginning-of-defun) |
| 226 | (setq font-lock-defaults | 226 | (setq font-lock-defaults |
| 227 | `((lisp-font-lock-keywords | 227 | `((lisp-font-lock-keywords |
| 228 | lisp-font-lock-keywords-1 lisp-font-lock-keywords-2) | 228 | lisp-font-lock-keywords-1 |
| 229 | lisp-font-lock-keywords-2) | ||
| 229 | nil ,keywords-case-insensitive nil nil | 230 | nil ,keywords-case-insensitive nil nil |
| 230 | (font-lock-mark-block-function . mark-defun) | 231 | (font-lock-mark-block-function . mark-defun) |
| 231 | (font-lock-syntactic-face-function | 232 | (font-lock-syntactic-face-function |
| 232 | . lisp-font-lock-syntactic-face-function)))) | 233 | . lisp-font-lock-syntactic-face-function))) |
| 234 | (prog-prettify-install lisp--prettify-symbols-alist)) | ||
| 233 | 235 | ||
| 234 | (defun lisp-outline-level () | 236 | (defun lisp-outline-level () |
| 235 | "Lisp mode `outline-level' function." | 237 | "Lisp mode `outline-level' function." |
| @@ -448,6 +450,9 @@ All commands in `lisp-mode-shared-map' are inherited by this map.") | |||
| 448 | :type 'hook | 450 | :type 'hook |
| 449 | :group 'lisp) | 451 | :group 'lisp) |
| 450 | 452 | ||
| 453 | (defconst lisp--prettify-symbols-alist | ||
| 454 | '(("lambda" . ?λ))) | ||
| 455 | |||
| 451 | (define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp" | 456 | (define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp" |
| 452 | "Major mode for editing Lisp code to run in Emacs. | 457 | "Major mode for editing Lisp code to run in Emacs. |
| 453 | Commands: | 458 | Commands: |
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 6bb796434fd..e8b513fcd3e 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el | |||
| @@ -111,15 +111,20 @@ and also to avoid outputting the warning during normal execution." | |||
| 111 | (funcall (eval (cadr form))) | 111 | (funcall (eval (cadr form))) |
| 112 | (byte-compile-constant nil))) | 112 | (byte-compile-constant nil))) |
| 113 | 113 | ||
| 114 | (defun macroexp--compiling-p () | ||
| 115 | "Return non-nil if we're macroexpanding for the compiler." | ||
| 116 | ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this | ||
| 117 | ;; macro-expansion will be processed by the byte-compiler, we check | ||
| 118 | ;; circumstantial evidence. | ||
| 119 | (member '(declare-function . byte-compile-macroexpand-declare-function) | ||
| 120 | macroexpand-all-environment)) | ||
| 121 | |||
| 122 | |||
| 114 | (defun macroexp--warn-and-return (msg form) | 123 | (defun macroexp--warn-and-return (msg form) |
| 115 | (let ((when-compiled (lambda () (byte-compile-log-warning msg t)))) | 124 | (let ((when-compiled (lambda () (byte-compile-log-warning msg t)))) |
| 116 | (cond | 125 | (cond |
| 117 | ((null msg) form) | 126 | ((null msg) form) |
| 118 | ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this | 127 | ((macroexp--compiling-p) |
| 119 | ;; macro-expansion will be processed by the byte-compiler, we check | ||
| 120 | ;; circumstantial evidence. | ||
| 121 | ((member '(declare-function . byte-compile-macroexpand-declare-function) | ||
| 122 | macroexpand-all-environment) | ||
| 123 | `(progn | 128 | `(progn |
| 124 | (macroexp--funcall-if-compiled ',when-compiled) | 129 | (macroexp--funcall-if-compiled ',when-compiled) |
| 125 | ,form)) | 130 | ,form)) |
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index a3ce1672a63..17919d9bbeb 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el | |||
| @@ -162,9 +162,11 @@ DESCRIPTION is the text of the news item." | |||
| 162 | description | 162 | description |
| 163 | archive-url)) | 163 | archive-url)) |
| 164 | 164 | ||
| 165 | (defun package-upload-buffer-internal (pkg-info extension &optional archive-url) | 165 | (declare-function lm-commentary "lisp-mnt" (&optional file)) |
| 166 | |||
| 167 | (defun package-upload-buffer-internal (pkg-desc extension &optional archive-url) | ||
| 166 | "Upload a package whose contents are in the current buffer. | 168 | "Upload a package whose contents are in the current buffer. |
| 167 | PKG-INFO is the package info, see `package-buffer-info'. | 169 | PKG-DESC is the `package-desc'. |
| 168 | EXTENSION is the file extension, a string. It can be either | 170 | EXTENSION is the file extension, a string. It can be either |
| 169 | \"el\" or \"tar\". | 171 | \"el\" or \"tar\". |
| 170 | 172 | ||
| @@ -196,18 +198,18 @@ if it exists." | |||
| 196 | (error "Aborted"))) | 198 | (error "Aborted"))) |
| 197 | (save-excursion | 199 | (save-excursion |
| 198 | (save-restriction | 200 | (save-restriction |
| 199 | (let* ((file-type (cond | 201 | (let* ((file-type (package-desc-kind pkg-desc)) |
| 200 | ((equal extension "el") 'single) | 202 | (pkg-name (package-desc-name pkg-desc)) |
| 201 | ((equal extension "tar") 'tar) | 203 | (requires (package-desc-reqs pkg-desc)) |
| 202 | (t (error "Unknown extension `%s'" extension)))) | 204 | (desc (if (eq (package-desc-summary pkg-desc) |
| 203 | (file-name (aref pkg-info 0)) | 205 | package--default-summary) |
| 204 | (pkg-name (intern file-name)) | ||
| 205 | (requires (aref pkg-info 1)) | ||
| 206 | (desc (if (string= (aref pkg-info 2) "") | ||
| 207 | (read-string "Description of package: ") | 206 | (read-string "Description of package: ") |
| 208 | (aref pkg-info 2))) | 207 | (package-desc-summary pkg-desc))) |
| 209 | (pkg-version (aref pkg-info 3)) | 208 | (pkg-version (package-desc-version pkg-desc)) |
| 210 | (commentary (aref pkg-info 4)) | 209 | (commentary |
| 210 | (pcase file-type | ||
| 211 | (`single (lm-commentary)) | ||
| 212 | (`tar nil))) ;; FIXME: Get it from the README file. | ||
| 211 | (split-version (version-to-list pkg-version)) | 213 | (split-version (version-to-list pkg-version)) |
| 212 | (pkg-buffer (current-buffer))) | 214 | (pkg-buffer (current-buffer))) |
| 213 | 215 | ||
| @@ -215,7 +217,8 @@ if it exists." | |||
| 215 | ;; from `package-archive-upload-base' otherwise. | 217 | ;; from `package-archive-upload-base' otherwise. |
| 216 | (let ((contents (or (package--archive-contents-from-url archive-url) | 218 | (let ((contents (or (package--archive-contents-from-url archive-url) |
| 217 | (package--archive-contents-from-file))) | 219 | (package--archive-contents-from-file))) |
| 218 | (new-desc (vector split-version requires desc file-type))) | 220 | (new-desc (package-make-ac-desc |
| 221 | split-version requires desc file-type))) | ||
| 219 | (if (> (car contents) package-archive-version) | 222 | (if (> (car contents) package-archive-version) |
| 220 | (error "Unrecognized archive version %d" (car contents))) | 223 | (error "Unrecognized archive version %d" (car contents))) |
| 221 | (let ((elt (assq pkg-name (cdr contents)))) | 224 | (let ((elt (assq pkg-name (cdr contents)))) |
| @@ -232,6 +235,7 @@ if it exists." | |||
| 232 | ;; this and the package itself. For now we assume ELPA is | 235 | ;; this and the package itself. For now we assume ELPA is |
| 233 | ;; writable via file primitives. | 236 | ;; writable via file primitives. |
| 234 | (let ((print-level nil) | 237 | (let ((print-level nil) |
| 238 | (print-quoted t) | ||
| 235 | (print-length nil)) | 239 | (print-length nil)) |
| 236 | (write-region (concat (pp-to-string contents) "\n") | 240 | (write-region (concat (pp-to-string contents) "\n") |
| 237 | nil | 241 | nil |
| @@ -241,29 +245,29 @@ if it exists." | |||
| 241 | ;; If there is a commentary section, write it. | 245 | ;; If there is a commentary section, write it. |
| 242 | (when commentary | 246 | (when commentary |
| 243 | (write-region commentary nil | 247 | (write-region commentary nil |
| 244 | (expand-file-name | 248 | (expand-file-name |
| 245 | (concat (symbol-name pkg-name) "-readme.txt") | 249 | (concat (symbol-name pkg-name) "-readme.txt") |
| 246 | package-archive-upload-base))) | 250 | package-archive-upload-base))) |
| 247 | 251 | ||
| 248 | (set-buffer pkg-buffer) | 252 | (set-buffer pkg-buffer) |
| 249 | (write-region (point-min) (point-max) | 253 | (write-region (point-min) (point-max) |
| 250 | (expand-file-name | 254 | (expand-file-name |
| 251 | (concat file-name "-" pkg-version "." extension) | 255 | (format "%s-%s.%s" pkg-name pkg-version extension) |
| 252 | package-archive-upload-base) | 256 | package-archive-upload-base) |
| 253 | nil nil nil 'excl) | 257 | nil nil nil 'excl) |
| 254 | 258 | ||
| 255 | ;; Write a news entry. | 259 | ;; Write a news entry. |
| 256 | (and package-update-news-on-upload | 260 | (and package-update-news-on-upload |
| 257 | archive-url | 261 | archive-url |
| 258 | (package--update-news (concat file-name "." extension) | 262 | (package--update-news (format "%s.%s" pkg-name extension) |
| 259 | pkg-version desc archive-url)) | 263 | pkg-version desc archive-url)) |
| 260 | 264 | ||
| 261 | ;; special-case "package": write a second copy so that the | 265 | ;; special-case "package": write a second copy so that the |
| 262 | ;; installer can easily find the latest version. | 266 | ;; installer can easily find the latest version. |
| 263 | (if (string= file-name "package") | 267 | (if (eq pkg-name 'package) |
| 264 | (write-region (point-min) (point-max) | 268 | (write-region (point-min) (point-max) |
| 265 | (expand-file-name | 269 | (expand-file-name |
| 266 | (concat file-name "." extension) | 270 | (format "%s.%s" pkg-name extension) |
| 267 | package-archive-upload-base) | 271 | package-archive-upload-base) |
| 268 | nil nil nil 'ask)))))))) | 272 | nil nil nil 'ask)))))))) |
| 269 | 273 | ||
| @@ -275,8 +279,8 @@ destination, prompt for one." | |||
| 275 | (save-excursion | 279 | (save-excursion |
| 276 | (save-restriction | 280 | (save-restriction |
| 277 | ;; Find the package in this buffer. | 281 | ;; Find the package in this buffer. |
| 278 | (let ((pkg-info (package-buffer-info))) | 282 | (let ((pkg-desc (package-buffer-info))) |
| 279 | (package-upload-buffer-internal pkg-info "el"))))) | 283 | (package-upload-buffer-internal pkg-desc "el"))))) |
| 280 | 284 | ||
| 281 | (defun package-upload-file (file) | 285 | (defun package-upload-file (file) |
| 282 | "Upload the Emacs Lisp package FILE to the package archive. | 286 | "Upload the Emacs Lisp package FILE to the package archive. |
| @@ -288,12 +292,13 @@ destination, prompt for one." | |||
| 288 | (interactive "fPackage file name: ") | 292 | (interactive "fPackage file name: ") |
| 289 | (with-temp-buffer | 293 | (with-temp-buffer |
| 290 | (insert-file-contents-literally file) | 294 | (insert-file-contents-literally file) |
| 291 | (let ((info (cond | 295 | (let ((pkg-desc |
| 292 | ((string-match "\\.tar$" file) (package-tar-file-info file)) | 296 | (cond |
| 293 | ((string-match "\\.el$" file) (package-buffer-info)) | 297 | ((string-match "\\.tar\\'" file) (package-tar-file-info file)) |
| 294 | (t (error "Unrecognized extension `%s'" | 298 | ((string-match "\\.el\\'" file) (package-buffer-info)) |
| 295 | (file-name-extension file)))))) | 299 | (t (error "Unrecognized extension `%s'" |
| 296 | (package-upload-buffer-internal info (file-name-extension file))))) | 300 | (file-name-extension file)))))) |
| 301 | (package-upload-buffer-internal pkg-desc (file-name-extension file))))) | ||
| 297 | 302 | ||
| 298 | (defun package-gnus-summary-upload () | 303 | (defun package-gnus-summary-upload () |
| 299 | "Upload a package contained in the current *Article* buffer. | 304 | "Upload a package contained in the current *Article* buffer. |
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 41b635bbe30..d5176abded0 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -170,6 +170,8 @@ | |||
| 170 | 170 | ||
| 171 | ;;; Code: | 171 | ;;; Code: |
| 172 | 172 | ||
| 173 | (eval-when-compile (require 'cl-lib)) | ||
| 174 | |||
| 173 | (require 'tabulated-list) | 175 | (require 'tabulated-list) |
| 174 | 176 | ||
| 175 | (defgroup package nil | 177 | (defgroup package nil |
| @@ -262,11 +264,8 @@ Lower version numbers than this will probably be understood as well.") | |||
| 262 | ;; We don't prime the cache since it tends to get out of date. | 264 | ;; We don't prime the cache since it tends to get out of date. |
| 263 | (defvar package-archive-contents nil | 265 | (defvar package-archive-contents nil |
| 264 | "Cache of the contents of the Emacs Lisp Package Archive. | 266 | "Cache of the contents of the Emacs Lisp Package Archive. |
| 265 | This is an alist mapping package names (symbols) to package | 267 | This is an alist mapping package names (symbols) to |
| 266 | descriptor vectors. These are like the vectors for `package-alist' | 268 | `package--desc' structures.") |
| 267 | but have extra entries: one which is 'tar for tar packages and | ||
| 268 | 'single for single-file packages, and one which is the name of | ||
| 269 | the archive from which it came.") | ||
| 270 | (put 'package-archive-contents 'risky-local-variable t) | 269 | (put 'package-archive-contents 'risky-local-variable t) |
| 271 | 270 | ||
| 272 | (defcustom package-user-dir (locate-user-emacs-file "elpa") | 271 | (defcustom package-user-dir (locate-user-emacs-file "elpa") |
| @@ -297,6 +296,62 @@ contrast, `package-user-dir' contains packages for personal use." | |||
| 297 | :group 'package | 296 | :group 'package |
| 298 | :version "24.1") | 297 | :version "24.1") |
| 299 | 298 | ||
| 299 | (defvar package--default-summary "No description available.") | ||
| 300 | |||
| 301 | (cl-defstruct (package-desc | ||
| 302 | ;; Rename the default constructor from `make-package-desc'. | ||
| 303 | (:constructor package-desc-create) | ||
| 304 | ;; Has the same interface as the old `define-package', | ||
| 305 | ;; which is still used in the "foo-pkg.el" files. Extra | ||
| 306 | ;; options can be supported by adding additional keys. | ||
| 307 | (:constructor | ||
| 308 | package-desc-from-define | ||
| 309 | (name-string version-string &optional summary requirements | ||
| 310 | &key kind archive | ||
| 311 | &aux | ||
| 312 | (name (intern name-string)) | ||
| 313 | (version (version-to-list version-string)) | ||
| 314 | (reqs (mapcar #'(lambda (elt) | ||
| 315 | (list (car elt) | ||
| 316 | (version-to-list (cadr elt)))) | ||
| 317 | (if (eq 'quote (car requirements)) | ||
| 318 | (nth 1 requirements) | ||
| 319 | requirements)))))) | ||
| 320 | "Structure containing information about an individual package. | ||
| 321 | |||
| 322 | Slots: | ||
| 323 | |||
| 324 | `name' Name of the package, as a symbol. | ||
| 325 | |||
| 326 | `version' Version of the package, as a version list. | ||
| 327 | |||
| 328 | `summary' Short description of the package, typically taken from | ||
| 329 | the first line of the file. | ||
| 330 | |||
| 331 | `reqs' Requirements of the package. A list of (PACKAGE | ||
| 332 | VERSION-LIST) naming the dependent package and the minimum | ||
| 333 | required version. | ||
| 334 | |||
| 335 | `kind' The distribution format of the package. Currently, it is | ||
| 336 | either `single' or `tar'. | ||
| 337 | |||
| 338 | `archive' The name of the archive (as a string) whence this | ||
| 339 | package came." | ||
| 340 | name | ||
| 341 | version | ||
| 342 | (summary package--default-summary) | ||
| 343 | reqs | ||
| 344 | kind | ||
| 345 | archive) | ||
| 346 | |||
| 347 | ;; Package descriptor format used in finder-inf.el and package--builtins. | ||
| 348 | (cl-defstruct (package--bi-desc | ||
| 349 | (:constructor package-make-builtin (version summary)) | ||
| 350 | (:type vector)) | ||
| 351 | version | ||
| 352 | reqs | ||
| 353 | summary) | ||
| 354 | |||
| 300 | ;; The value is precomputed in finder-inf.el, but don't load that | 355 | ;; The value is precomputed in finder-inf.el, but don't load that |
| 301 | ;; until it's needed (i.e. when `package-initialize' is called). | 356 | ;; until it's needed (i.e. when `package-initialize' is called). |
| 302 | (defvar package--builtins nil | 357 | (defvar package--builtins nil |
| @@ -305,27 +360,14 @@ The actual value is initialized by loading the library | |||
| 305 | `finder-inf'; this is not done until it is needed, e.g. by the | 360 | `finder-inf'; this is not done until it is needed, e.g. by the |
| 306 | function `package-built-in-p'. | 361 | function `package-built-in-p'. |
| 307 | 362 | ||
| 308 | Each element has the form (PKG . DESC), where PKG is a package | 363 | Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package |
| 309 | name (a symbol) and DESC is a vector that describes the package. | 364 | name (a symbol) and DESC is a `package--bi-desc' structure.") |
| 310 | The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. | ||
| 311 | VERSION-LIST is a version list. | ||
| 312 | REQS is a list of packages required by the package, each | ||
| 313 | requirement having the form (NAME VL), where NAME is a string | ||
| 314 | and VL is a version list. | ||
| 315 | DOCSTRING is a brief description of the package.") | ||
| 316 | (put 'package--builtins 'risky-local-variable t) | 365 | (put 'package--builtins 'risky-local-variable t) |
| 317 | 366 | ||
| 318 | (defvar package-alist nil | 367 | (defvar package-alist nil |
| 319 | "Alist of all packages available for activation. | 368 | "Alist of all packages available for activation. |
| 320 | Each element has the form (PKG . DESC), where PKG is a package | 369 | Each element has the form (PKG . DESC), where PKG is a package |
| 321 | name (a symbol) and DESC is a vector that describes the package. | 370 | name (a symbol) and DESC is a `package-desc' structure. |
| 322 | |||
| 323 | The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. | ||
| 324 | VERSION-LIST is a version list. | ||
| 325 | REQS is a list of packages required by the package, each | ||
| 326 | requirement having the form (NAME VL) where NAME is a string | ||
| 327 | and VL is a version list. | ||
| 328 | DOCSTRING is a brief description of the package. | ||
| 329 | 371 | ||
| 330 | This variable is set automatically by `package-load-descriptor', | 372 | This variable is set automatically by `package-load-descriptor', |
| 331 | called via `package-initialize'. To change which packages are | 373 | called via `package-initialize'. To change which packages are |
| @@ -339,7 +381,10 @@ loaded and/or activated, customize `package-load-list'.") | |||
| 339 | (defvar package-obsolete-alist nil | 381 | (defvar package-obsolete-alist nil |
| 340 | "Representation of obsolete packages. | 382 | "Representation of obsolete packages. |
| 341 | Like `package-alist', but maps package name to a second alist. | 383 | Like `package-alist', but maps package name to a second alist. |
| 342 | The inner alist is keyed by version.") | 384 | The inner alist is keyed by version. |
| 385 | |||
| 386 | Each element of the list is (NAME . VERSION-ALIST), where each | ||
| 387 | entry in VERSION-ALIST is (VERSION-LIST . PACKAGE-DESC).") | ||
| 343 | (put 'package-obsolete-alist 'risky-local-variable t) | 388 | (put 'package-obsolete-alist 'risky-local-variable t) |
| 344 | 389 | ||
| 345 | (defun package-version-join (vlist) | 390 | (defun package-version-join (vlist) |
| @@ -430,26 +475,16 @@ the package by calling `package-load-descriptor'." | |||
| 430 | ;; Actually load the descriptor: | 475 | ;; Actually load the descriptor: |
| 431 | (package-load-descriptor dir subdir)))) | 476 | (package-load-descriptor dir subdir)))) |
| 432 | 477 | ||
| 433 | (defsubst package-desc-vers (desc) | 478 | (define-obsolete-function-alias 'package-desc-vers 'package-desc-version "24.4") |
| 434 | "Extract version from a package description vector." | ||
| 435 | (aref desc 0)) | ||
| 436 | 479 | ||
| 437 | (defsubst package-desc-reqs (desc) | 480 | (define-obsolete-function-alias 'package-desc-doc 'package-desc-summary "24.4") |
| 438 | "Extract requirements from a package description vector." | ||
| 439 | (aref desc 1)) | ||
| 440 | 481 | ||
| 441 | (defsubst package-desc-doc (desc) | ||
| 442 | "Extract doc string from a package description vector." | ||
| 443 | (aref desc 2)) | ||
| 444 | |||
| 445 | (defsubst package-desc-kind (desc) | ||
| 446 | "Extract the kind of download from an archive package description vector." | ||
| 447 | (aref desc 3)) | ||
| 448 | 482 | ||
| 449 | (defun package--dir (name version) | 483 | (defun package--dir (name version) |
| 484 | ;; FIXME: Keep this as a field in the package-desc. | ||
| 450 | "Return the directory where a package is installed, or nil if none. | 485 | "Return the directory where a package is installed, or nil if none. |
| 451 | NAME and VERSION are both strings." | 486 | NAME is a symbol and VERSION is a string." |
| 452 | (let* ((subdir (concat name "-" version)) | 487 | (let* ((subdir (format "%s-%s" name version)) |
| 453 | (dir-list (cons package-user-dir package-directory-list)) | 488 | (dir-list (cons package-user-dir package-directory-list)) |
| 454 | pkg-dir) | 489 | pkg-dir) |
| 455 | (while dir-list | 490 | (while dir-list |
| @@ -460,9 +495,9 @@ NAME and VERSION are both strings." | |||
| 460 | (setq dir-list (cdr dir-list))))) | 495 | (setq dir-list (cdr dir-list))))) |
| 461 | pkg-dir)) | 496 | pkg-dir)) |
| 462 | 497 | ||
| 463 | (defun package-activate-1 (package pkg-vec) | 498 | (defun package-activate-1 (pkg-desc) |
| 464 | (let* ((name (symbol-name package)) | 499 | (let* ((name (package-desc-name pkg-desc)) |
| 465 | (version-str (package-version-join (package-desc-vers pkg-vec))) | 500 | (version-str (package-version-join (package-desc-version pkg-desc))) |
| 466 | (pkg-dir (package--dir name version-str))) | 501 | (pkg-dir (package--dir name version-str))) |
| 467 | (unless pkg-dir | 502 | (unless pkg-dir |
| 468 | (error "Internal error: unable to find directory for `%s-%s'" | 503 | (error "Internal error: unable to find directory for `%s-%s'" |
| @@ -475,8 +510,8 @@ NAME and VERSION are both strings." | |||
| 475 | (push pkg-dir Info-directory-list)) | 510 | (push pkg-dir Info-directory-list)) |
| 476 | ;; Add to load path, add autoloads, and activate the package. | 511 | ;; Add to load path, add autoloads, and activate the package. |
| 477 | (push pkg-dir load-path) | 512 | (push pkg-dir load-path) |
| 478 | (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) | 513 | (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t) |
| 479 | (push package package-activated-list) | 514 | (push name package-activated-list) |
| 480 | ;; Don't return nil. | 515 | ;; Don't return nil. |
| 481 | t)) | 516 | t)) |
| 482 | 517 | ||
| @@ -489,7 +524,12 @@ specifying the minimum acceptable version." | |||
| 489 | (version-list-<= min-version (version-to-list emacs-version)) | 524 | (version-list-<= min-version (version-to-list emacs-version)) |
| 490 | (let ((elt (assq package package--builtins))) | 525 | (let ((elt (assq package package--builtins))) |
| 491 | (and elt (version-list-<= min-version | 526 | (and elt (version-list-<= min-version |
| 492 | (package-desc-vers (cdr elt))))))) | 527 | (package--bi-desc-version (cdr elt))))))) |
| 528 | |||
| 529 | (defun package--from-builtin (bi-desc) | ||
| 530 | (package-desc-create :name (pop bi-desc) | ||
| 531 | :version (package--bi-desc-version bi-desc) | ||
| 532 | :summary (package--bi-desc-summary bi-desc))) | ||
| 493 | 533 | ||
| 494 | ;; This function goes ahead and activates a newer version of a package | 534 | ;; This function goes ahead and activates a newer version of a package |
| 495 | ;; if an older one was already activated. This is not ideal; we'd at | 535 | ;; if an older one was already activated. This is not ideal; we'd at |
| @@ -504,7 +544,7 @@ Return nil if the package could not be activated." | |||
| 504 | available-version found) | 544 | available-version found) |
| 505 | ;; Check if PACKAGE is available in `package-alist'. | 545 | ;; Check if PACKAGE is available in `package-alist'. |
| 506 | (when pkg-vec | 546 | (when pkg-vec |
| 507 | (setq available-version (package-desc-vers pkg-vec) | 547 | (setq available-version (package-desc-version pkg-vec) |
| 508 | found (version-list-<= min-version available-version))) | 548 | found (version-list-<= min-version available-version))) |
| 509 | (cond | 549 | (cond |
| 510 | ;; If no such package is found, maybe it's built-in. | 550 | ;; If no such package is found, maybe it's built-in. |
| @@ -525,7 +565,7 @@ Return nil if the package could not be activated." | |||
| 525 | Required package `%s-%s' is unavailable" | 565 | Required package `%s-%s' is unavailable" |
| 526 | package (car fail) (package-version-join (cadr fail))) | 566 | package (car fail) (package-version-join (cadr fail))) |
| 527 | ;; If all goes well, activate the package itself. | 567 | ;; If all goes well, activate the package itself. |
| 528 | (package-activate-1 package pkg-vec))))))) | 568 | (package-activate-1 pkg-vec))))))) |
| 529 | 569 | ||
| 530 | (defun package-mark-obsolete (package pkg-vec) | 570 | (defun package-mark-obsolete (package pkg-vec) |
| 531 | "Put package on the obsolete list, if not already there." | 571 | "Put package on the obsolete list, if not already there." |
| @@ -533,11 +573,11 @@ Required package `%s-%s' is unavailable" | |||
| 533 | (if elt | 573 | (if elt |
| 534 | ;; If this obsolete version does not exist in the list, update | 574 | ;; If this obsolete version does not exist in the list, update |
| 535 | ;; it the list. | 575 | ;; it the list. |
| 536 | (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) | 576 | (unless (assoc (package-desc-version pkg-vec) (cdr elt)) |
| 537 | (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) | 577 | (setcdr elt (cons (cons (package-desc-version pkg-vec) pkg-vec) |
| 538 | (cdr elt)))) | 578 | (cdr elt)))) |
| 539 | ;; Make a new association. | 579 | ;; Make a new association. |
| 540 | (push (cons package (list (cons (package-desc-vers pkg-vec) | 580 | (push (cons package (list (cons (package-desc-version pkg-vec) |
| 541 | pkg-vec))) | 581 | pkg-vec))) |
| 542 | package-obsolete-alist)))) | 582 | package-obsolete-alist)))) |
| 543 | 583 | ||
| @@ -555,21 +595,17 @@ REQUIREMENTS is a list of dependencies on other packages. | |||
| 555 | EXTRA-PROPERTIES is currently unused." | 595 | EXTRA-PROPERTIES is currently unused." |
| 556 | (let* ((name (intern name-string)) | 596 | (let* ((name (intern name-string)) |
| 557 | (version (version-to-list version-string)) | 597 | (version (version-to-list version-string)) |
| 558 | (new-pkg-desc | 598 | (new-pkg-desc (cons name |
| 559 | (cons name | 599 | (package-desc-from-define name-string |
| 560 | (vector version | 600 | version-string |
| 561 | (mapcar | 601 | docstring |
| 562 | (lambda (elt) | 602 | requirements))) |
| 563 | (list (car elt) | ||
| 564 | (version-to-list (car (cdr elt))))) | ||
| 565 | requirements) | ||
| 566 | docstring))) | ||
| 567 | (old-pkg (assq name package-alist))) | 603 | (old-pkg (assq name package-alist))) |
| 568 | (cond | 604 | (cond |
| 569 | ;; If there's no old package, just add this to `package-alist'. | 605 | ;; If there's no old package, just add this to `package-alist'. |
| 570 | ((null old-pkg) | 606 | ((null old-pkg) |
| 571 | (push new-pkg-desc package-alist)) | 607 | (push new-pkg-desc package-alist)) |
| 572 | ((version-list-< (package-desc-vers (cdr old-pkg)) version) | 608 | ((version-list-< (package-desc-version (cdr old-pkg)) version) |
| 573 | ;; Remove the old package and declare it obsolete. | 609 | ;; Remove the old package and declare it obsolete. |
| 574 | (package-mark-obsolete name (cdr old-pkg)) | 610 | (package-mark-obsolete name (cdr old-pkg)) |
| 575 | (setq package-alist (cons new-pkg-desc | 611 | (setq package-alist (cons new-pkg-desc |
| @@ -577,7 +613,7 @@ EXTRA-PROPERTIES is currently unused." | |||
| 577 | ;; You can have two packages with the same version, e.g. one in | 613 | ;; You can have two packages with the same version, e.g. one in |
| 578 | ;; the system package directory and one in your private | 614 | ;; the system package directory and one in your private |
| 579 | ;; directory. We just let the first one win. | 615 | ;; directory. We just let the first one win. |
| 580 | ((not (version-list-= (package-desc-vers (cdr old-pkg)) version)) | 616 | ((not (version-list-= (package-desc-version (cdr old-pkg)) version)) |
| 581 | ;; The package is born obsolete. | 617 | ;; The package is born obsolete. |
| 582 | (package-mark-obsolete name (cdr new-pkg-desc)))))) | 618 | (package-mark-obsolete name (cdr new-pkg-desc)))))) |
| 583 | 619 | ||
| @@ -603,14 +639,15 @@ EXTRA-PROPERTIES is currently unused." | |||
| 603 | 639 | ||
| 604 | (defun package-generate-autoloads (name pkg-dir) | 640 | (defun package-generate-autoloads (name pkg-dir) |
| 605 | (require 'autoload) ;Load before we let-bind generated-autoload-file! | 641 | (require 'autoload) ;Load before we let-bind generated-autoload-file! |
| 606 | (let* ((auto-name (concat name "-autoloads.el")) | 642 | (let* ((auto-name (format "%s-autoloads.el" name)) |
| 607 | ;;(ignore-name (concat name "-pkg.el")) | 643 | ;;(ignore-name (concat name "-pkg.el")) |
| 608 | (generated-autoload-file (expand-file-name auto-name pkg-dir)) | 644 | (generated-autoload-file (expand-file-name auto-name pkg-dir)) |
| 609 | (version-control 'never)) | 645 | (version-control 'never)) |
| 610 | (package-autoload-ensure-default-file generated-autoload-file) | 646 | (package-autoload-ensure-default-file generated-autoload-file) |
| 611 | (update-directory-autoloads pkg-dir) | 647 | (update-directory-autoloads pkg-dir) |
| 612 | (let ((buf (find-buffer-visiting generated-autoload-file))) | 648 | (let ((buf (find-buffer-visiting generated-autoload-file))) |
| 613 | (when buf (kill-buffer buf))))) | 649 | (when buf (kill-buffer buf))) |
| 650 | auto-name)) | ||
| 614 | 651 | ||
| 615 | (defvar tar-parse-info) | 652 | (defvar tar-parse-info) |
| 616 | (declare-function tar-untar-buffer "tar-mode" ()) | 653 | (declare-function tar-untar-buffer "tar-mode" ()) |
| @@ -644,57 +681,62 @@ untar into a directory named DIR; otherwise, signal an error." | |||
| 644 | ;; FIXME: should we delete PKG-DIR if it exists? | 681 | ;; FIXME: should we delete PKG-DIR if it exists? |
| 645 | (let* ((default-directory (file-name-as-directory package-user-dir))) | 682 | (let* ((default-directory (file-name-as-directory package-user-dir))) |
| 646 | (package-untar-buffer dirname) | 683 | (package-untar-buffer dirname) |
| 647 | (package--make-autoloads-and-compile name pkg-dir)))) | 684 | (package--make-autoloads-and-compile package pkg-dir)))) |
| 648 | 685 | ||
| 649 | (defun package--make-autoloads-and-compile (name pkg-dir) | 686 | (defun package--make-autoloads-and-compile (name pkg-dir) |
| 650 | "Generate autoloads and do byte-compilation for package named NAME. | 687 | "Generate autoloads and do byte-compilation for package named NAME. |
| 651 | PKG-DIR is the name of the package directory." | 688 | PKG-DIR is the name of the package directory." |
| 652 | (package-generate-autoloads name pkg-dir) | 689 | (let ((auto-name (package-generate-autoloads name pkg-dir)) |
| 653 | (let ((load-path (cons pkg-dir load-path))) | 690 | (load-path (cons pkg-dir load-path))) |
| 654 | ;; We must load the autoloads file before byte compiling, in | 691 | ;; We must load the autoloads file before byte compiling, in |
| 655 | ;; case there are magic cookies to set up non-trivial paths. | 692 | ;; case there are magic cookies to set up non-trivial paths. |
| 656 | (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) | 693 | (load auto-name nil t) |
| 694 | ;; FIXME: Compilation should be done as a separate, optional, step. | ||
| 695 | ;; E.g. for multi-package installs, we should first install all packages | ||
| 696 | ;; and then compile them. | ||
| 657 | (byte-recompile-directory pkg-dir 0 t))) | 697 | (byte-recompile-directory pkg-dir 0 t))) |
| 658 | 698 | ||
| 659 | (defun package--write-file-no-coding (file-name) | 699 | (defun package--write-file-no-coding (file-name) |
| 660 | (let ((buffer-file-coding-system 'no-conversion)) | 700 | (let ((buffer-file-coding-system 'no-conversion)) |
| 661 | (write-region (point-min) (point-max) file-name))) | 701 | (write-region (point-min) (point-max) file-name))) |
| 662 | 702 | ||
| 663 | (defun package-unpack-single (file-name version desc requires) | 703 | (defun package-unpack-single (name version desc requires) |
| 664 | "Install the contents of the current buffer as a package." | 704 | "Install the contents of the current buffer as a package." |
| 665 | ;; Special case "package". | 705 | ;; Special case "package". FIXME: Should this still be supported? |
| 666 | (if (string= file-name "package") | 706 | (if (eq name 'package) |
| 667 | (package--write-file-no-coding | 707 | (package--write-file-no-coding |
| 668 | (expand-file-name (concat file-name ".el") package-user-dir)) | 708 | (expand-file-name (format "%s.el" name) package-user-dir)) |
| 669 | (let* ((pkg-dir (expand-file-name (concat file-name "-" | 709 | (let* ((pkg-dir (expand-file-name (format "%s-%s" name |
| 670 | (package-version-join | 710 | (package-version-join |
| 671 | (version-to-list version))) | 711 | (version-to-list version))) |
| 672 | package-user-dir)) | 712 | package-user-dir)) |
| 673 | (el-file (expand-file-name (concat file-name ".el") pkg-dir)) | 713 | (el-file (expand-file-name (format "%s.el" name) pkg-dir)) |
| 674 | (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) | 714 | (pkg-file (expand-file-name (format "%s-pkg.el" name) pkg-dir))) |
| 675 | (make-directory pkg-dir t) | 715 | (make-directory pkg-dir t) |
| 676 | (package--write-file-no-coding el-file) | 716 | (package--write-file-no-coding el-file) |
| 677 | (let ((print-level nil) | 717 | (let ((print-level nil) |
| 718 | (print-quoted t) | ||
| 678 | (print-length nil)) | 719 | (print-length nil)) |
| 679 | (write-region | 720 | (write-region |
| 680 | (concat | 721 | (concat |
| 681 | (prin1-to-string | 722 | (prin1-to-string |
| 682 | (list 'define-package | 723 | (list 'define-package |
| 683 | file-name | 724 | (symbol-name name) |
| 684 | version | 725 | version |
| 685 | desc | 726 | desc |
| 686 | (list 'quote | 727 | (when requires ;Don't bother quoting nil. |
| 687 | ;; Turn version lists into string form. | 728 | (list 'quote |
| 688 | (mapcar | 729 | ;; Turn version lists into string form. |
| 689 | (lambda (elt) | 730 | (mapcar |
| 690 | (list (car elt) | 731 | (lambda (elt) |
| 691 | (package-version-join (cadr elt)))) | 732 | (list (car elt) |
| 692 | requires)))) | 733 | (package-version-join (cadr elt)))) |
| 734 | requires))))) | ||
| 693 | "\n") | 735 | "\n") |
| 694 | nil | 736 | nil |
| 695 | pkg-file | 737 | pkg-file |
| 696 | nil nil nil 'excl)) | 738 | nil nil nil 'excl)) |
| 697 | (package--make-autoloads-and-compile file-name pkg-dir)))) | 739 | (package--make-autoloads-and-compile name pkg-dir)))) |
| 698 | 740 | ||
| 699 | (defmacro package--with-work-buffer (location file &rest body) | 741 | (defmacro package--with-work-buffer (location file &rest body) |
| 700 | "Run BODY in a buffer containing the contents of FILE at LOCATION. | 742 | "Run BODY in a buffer containing the contents of FILE at LOCATION. |
| @@ -744,7 +786,7 @@ It will move point to somewhere in the headers." | |||
| 744 | (let ((location (package-archive-base name)) | 786 | (let ((location (package-archive-base name)) |
| 745 | (file (concat (symbol-name name) "-" version ".el"))) | 787 | (file (concat (symbol-name name) "-" version ".el"))) |
| 746 | (package--with-work-buffer location file | 788 | (package--with-work-buffer location file |
| 747 | (package-unpack-single (symbol-name name) version desc requires)))) | 789 | (package-unpack-single name version desc requires)))) |
| 748 | 790 | ||
| 749 | (defun package-download-tar (name version) | 791 | (defun package-download-tar (name version) |
| 750 | "Download and install a tar package." | 792 | "Download and install a tar package." |
| @@ -762,7 +804,7 @@ MIN-VERSION should be a version list." | |||
| 762 | (let ((pkg-desc (assq package package-alist))) | 804 | (let ((pkg-desc (assq package package-alist))) |
| 763 | (if pkg-desc | 805 | (if pkg-desc |
| 764 | (version-list-<= min-version | 806 | (version-list-<= min-version |
| 765 | (package-desc-vers (cdr pkg-desc))) | 807 | (package-desc-version (cdr pkg-desc))) |
| 766 | ;; Also check built-in packages. | 808 | ;; Also check built-in packages. |
| 767 | (package-built-in-p package min-version)))) | 809 | (package-built-in-p package min-version)))) |
| 768 | 810 | ||
| @@ -785,7 +827,7 @@ not included in this list." | |||
| 785 | (unless (package-installed-p next-pkg next-version) | 827 | (unless (package-installed-p next-pkg next-version) |
| 786 | ;; A package is required, but not installed. It might also be | 828 | ;; A package is required, but not installed. It might also be |
| 787 | ;; blocked via `package-load-list'. | 829 | ;; blocked via `package-load-list'. |
| 788 | (let ((pkg-desc (assq next-pkg package-archive-contents)) | 830 | (let ((pkg-desc (cdr (assq next-pkg package-archive-contents))) |
| 789 | hold) | 831 | hold) |
| 790 | (when (setq hold (assq next-pkg package-load-list)) | 832 | (when (setq hold (assq next-pkg package-load-list)) |
| 791 | (setq hold (cadr hold)) | 833 | (setq hold (cadr hold)) |
| @@ -805,17 +847,17 @@ but version %s required" | |||
| 805 | (symbol-name next-pkg) | 847 | (symbol-name next-pkg) |
| 806 | (package-version-join next-version))) | 848 | (package-version-join next-version))) |
| 807 | (unless (version-list-<= next-version | 849 | (unless (version-list-<= next-version |
| 808 | (package-desc-vers (cdr pkg-desc))) | 850 | (package-desc-version pkg-desc)) |
| 809 | (error | 851 | (error |
| 810 | "Need package `%s-%s', but only %s is available" | 852 | "Need package `%s-%s', but only %s is available" |
| 811 | (symbol-name next-pkg) (package-version-join next-version) | 853 | (symbol-name next-pkg) (package-version-join next-version) |
| 812 | (package-version-join (package-desc-vers (cdr pkg-desc))))) | 854 | (package-version-join (package-desc-version pkg-desc)))) |
| 813 | ;; Move to front, so it gets installed early enough (bug#14082). | 855 | ;; Move to front, so it gets installed early enough (bug#14082). |
| 814 | (setq package-list (cons next-pkg (delq next-pkg package-list))) | 856 | (setq package-list (cons next-pkg (delq next-pkg package-list))) |
| 815 | (setq package-list | 857 | (setq package-list |
| 816 | (package-compute-transaction package-list | 858 | (package-compute-transaction package-list |
| 817 | (package-desc-reqs | 859 | (package-desc-reqs |
| 818 | (cdr pkg-desc)))))))) | 860 | pkg-desc))))))) |
| 819 | package-list) | 861 | package-list) |
| 820 | 862 | ||
| 821 | (defun package-read-from-string (str) | 863 | (defun package-read-from-string (str) |
| @@ -867,13 +909,29 @@ If the archive version is too new, signal an error." | |||
| 867 | (dolist (package contents) | 909 | (dolist (package contents) |
| 868 | (package--add-to-archive-contents package archive))))) | 910 | (package--add-to-archive-contents package archive))))) |
| 869 | 911 | ||
| 912 | ;; Package descriptor objects used inside the "archive-contents" file. | ||
| 913 | ;; Changing this defstruct implies changing the format of the | ||
| 914 | ;; "archive-contents" files. | ||
| 915 | (cl-defstruct (package--ac-desc | ||
| 916 | (:constructor package-make-ac-desc (version reqs summary kind)) | ||
| 917 | (:copier nil) | ||
| 918 | (:type vector)) | ||
| 919 | version reqs summary kind) | ||
| 920 | |||
| 870 | (defun package--add-to-archive-contents (package archive) | 921 | (defun package--add-to-archive-contents (package archive) |
| 871 | "Add the PACKAGE from the given ARCHIVE if necessary. | 922 | "Add the PACKAGE from the given ARCHIVE if necessary. |
| 872 | Also, add the originating archive to the end of the package vector." | 923 | PACKAGE should have the form (NAME . PACKAGE--AC-DESC). |
| 873 | (let* ((name (car package)) | 924 | Also, add the originating archive to the `package-desc' structure." |
| 874 | (version (package-desc-vers (cdr package))) | 925 | (let* ((name (car package)) |
| 875 | (entry (cons name | 926 | (pkg-desc |
| 876 | (vconcat (cdr package) (vector archive)))) | 927 | (package-desc-create |
| 928 | :name name | ||
| 929 | :version (package--ac-desc-version (cdr package)) | ||
| 930 | :reqs (package--ac-desc-reqs (cdr package)) | ||
| 931 | :summary (package--ac-desc-summary (cdr package)) | ||
| 932 | :kind (package--ac-desc-kind (cdr package)) | ||
| 933 | :archive archive)) | ||
| 934 | (entry (cons name pkg-desc)) | ||
| 877 | (existing-package (assq name package-archive-contents)) | 935 | (existing-package (assq name package-archive-contents)) |
| 878 | (pinned-to-archive (assoc name package-pinned-packages))) | 936 | (pinned-to-archive (assoc name package-pinned-packages))) |
| 879 | (cond ((and pinned-to-archive | 937 | (cond ((and pinned-to-archive |
| @@ -881,9 +939,9 @@ Also, add the originating archive to the end of the package vector." | |||
| 881 | (not (equal (cdr pinned-to-archive) archive))) | 939 | (not (equal (cdr pinned-to-archive) archive))) |
| 882 | nil) | 940 | nil) |
| 883 | ((not existing-package) | 941 | ((not existing-package) |
| 884 | (add-to-list 'package-archive-contents entry)) | 942 | (push entry package-archive-contents)) |
| 885 | ((version-list-< (package-desc-vers (cdr existing-package)) | 943 | ((version-list-< (package-desc-version (cdr existing-package)) |
| 886 | version) | 944 | (package-desc-version pkg-desc)) |
| 887 | ;; Replace the entry with this one. | 945 | ;; Replace the entry with this one. |
| 888 | (setq package-archive-contents | 946 | (setq package-archive-contents |
| 889 | (cons entry | 947 | (cons entry |
| @@ -902,14 +960,14 @@ using `package-compute-transaction'." | |||
| 902 | ;; `package-load-list', download the held version. | 960 | ;; `package-load-list', download the held version. |
| 903 | (hold (cadr (assq elt package-load-list))) | 961 | (hold (cadr (assq elt package-load-list))) |
| 904 | (v-string (or (and (stringp hold) hold) | 962 | (v-string (or (and (stringp hold) hold) |
| 905 | (package-version-join (package-desc-vers desc)))) | 963 | (package-version-join (package-desc-version desc)))) |
| 906 | (kind (package-desc-kind desc))) | 964 | (kind (package-desc-kind desc))) |
| 907 | (cond | 965 | (cond |
| 908 | ((eq kind 'tar) | 966 | ((eq kind 'tar) |
| 909 | (package-download-tar elt v-string)) | 967 | (package-download-tar elt v-string)) |
| 910 | ((eq kind 'single) | 968 | ((eq kind 'single) |
| 911 | (package-download-single elt v-string | 969 | (package-download-single elt v-string |
| 912 | (package-desc-doc desc) | 970 | (package-desc-summary desc) |
| 913 | (package-desc-reqs desc))) | 971 | (package-desc-reqs desc))) |
| 914 | (t | 972 | (t |
| 915 | (error "Unknown package kind: %s" (symbol-name kind)))) | 973 | (error "Unknown package kind: %s" (symbol-name kind)))) |
| @@ -961,17 +1019,7 @@ Otherwise return nil." | |||
| 961 | (error nil)))) | 1019 | (error nil)))) |
| 962 | 1020 | ||
| 963 | (defun package-buffer-info () | 1021 | (defun package-buffer-info () |
| 964 | "Return a vector describing the package in the current buffer. | 1022 | "Return a `package-desc' describing the package in the current buffer. |
| 965 | The vector has the form | ||
| 966 | |||
| 967 | [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] | ||
| 968 | |||
| 969 | FILENAME is the file name, a string, sans the \".el\" extension. | ||
| 970 | REQUIRES is a list of requirements, each requirement having the | ||
| 971 | form (NAME VER); NAME is a string and VER is a version list. | ||
| 972 | DESCRIPTION is the package description, a string. | ||
| 973 | VERSION is the version, a string. | ||
| 974 | COMMENTARY is the commentary section, a string, or nil if none. | ||
| 975 | 1023 | ||
| 976 | If the buffer does not contain a conforming package, signal an | 1024 | If the buffer does not contain a conforming package, signal an |
| 977 | error. If there is a package, narrow the buffer to the file's | 1025 | error. If there is a package, narrow the buffer to the file's |
| @@ -990,25 +1038,18 @@ boundaries." | |||
| 990 | (require 'lisp-mnt) | 1038 | (require 'lisp-mnt) |
| 991 | ;; Use some headers we've invented to drive the process. | 1039 | ;; Use some headers we've invented to drive the process. |
| 992 | (let* ((requires-str (lm-header "package-requires")) | 1040 | (let* ((requires-str (lm-header "package-requires")) |
| 993 | (requires (if requires-str | ||
| 994 | (package-read-from-string requires-str))) | ||
| 995 | ;; Prefer Package-Version; if defined, the package author | 1041 | ;; Prefer Package-Version; if defined, the package author |
| 996 | ;; probably wants us to use it. Otherwise try Version. | 1042 | ;; probably wants us to use it. Otherwise try Version. |
| 997 | (pkg-version | 1043 | (pkg-version |
| 998 | (or (package-strip-rcs-id (lm-header "package-version")) | 1044 | (or (package-strip-rcs-id (lm-header "package-version")) |
| 999 | (package-strip-rcs-id (lm-header "version")))) | 1045 | (package-strip-rcs-id (lm-header "version"))))) |
| 1000 | (commentary (lm-commentary))) | ||
| 1001 | (unless pkg-version | 1046 | (unless pkg-version |
| 1002 | (error | 1047 | (error |
| 1003 | "Package lacks a \"Version\" or \"Package-Version\" header")) | 1048 | "Package lacks a \"Version\" or \"Package-Version\" header")) |
| 1004 | ;; Turn string version numbers into list form. | 1049 | (package-desc-from-define |
| 1005 | (setq requires | 1050 | file-name pkg-version desc |
| 1006 | (mapcar | 1051 | (if requires-str (package-read-from-string requires-str)) |
| 1007 | (lambda (elt) | 1052 | :kind 'single)))) |
| 1008 | (list (car elt) | ||
| 1009 | (version-to-list (car (cdr elt))))) | ||
| 1010 | requires)) | ||
| 1011 | (vector file-name requires desc pkg-version commentary)))) | ||
| 1012 | 1053 | ||
| 1013 | (defun package-tar-file-info (file) | 1054 | (defun package-tar-file-info (file) |
| 1014 | "Find package information for a tar file. | 1055 | "Find package information for a tar file. |
| @@ -1025,67 +1066,46 @@ The return result is a vector like `package-buffer-info'." | |||
| 1025 | (pkg-def-contents (shell-command-to-string | 1066 | (pkg-def-contents (shell-command-to-string |
| 1026 | ;; Requires GNU tar. | 1067 | ;; Requires GNU tar. |
| 1027 | (concat "tar -xOf " file " " | 1068 | (concat "tar -xOf " file " " |
| 1028 | |||
| 1029 | pkg-name "-" pkg-version "/" | 1069 | pkg-name "-" pkg-version "/" |
| 1030 | pkg-name "-pkg.el"))) | 1070 | pkg-name "-pkg.el"))) |
| 1031 | (pkg-def-parsed (package-read-from-string pkg-def-contents))) | 1071 | (pkg-def-parsed (package-read-from-string pkg-def-contents))) |
| 1032 | (unless (eq (car pkg-def-parsed) 'define-package) | 1072 | (unless (eq (car pkg-def-parsed) 'define-package) |
| 1033 | (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) | 1073 | (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) |
| 1034 | (let ((name-str (nth 1 pkg-def-parsed)) | 1074 | (let ((pkg-desc |
| 1035 | (version-string (nth 2 pkg-def-parsed)) | 1075 | (apply #'package-desc-from-define (append (cdr pkg-def-parsed) |
| 1036 | (docstring (nth 3 pkg-def-parsed)) | 1076 | '(:kind tar))))) |
| 1037 | (requires (nth 4 pkg-def-parsed)) | 1077 | (unless (equal pkg-version |
| 1038 | (readme (shell-command-to-string | 1078 | (package-version-join (package-desc-version pkg-desc))) |
| 1039 | ;; Requires GNU tar. | ||
| 1040 | (concat "tar -xOf " file " " | ||
| 1041 | pkg-name "-" pkg-version "/README")))) | ||
| 1042 | (unless (equal pkg-version version-string) | ||
| 1043 | (error "Package has inconsistent versions")) | 1079 | (error "Package has inconsistent versions")) |
| 1044 | (unless (equal pkg-name name-str) | 1080 | (unless (equal pkg-name (symbol-name (package-desc-name pkg-desc))) |
| 1045 | (error "Package has inconsistent names")) | 1081 | (error "Package has inconsistent names")) |
| 1046 | ;; Kind of a hack. | 1082 | pkg-desc)))) |
| 1047 | (if (string-match ": Not found in archive" readme) | 1083 | |
| 1048 | (setq readme nil)) | ||
| 1049 | ;; Turn string version numbers into list form. | ||
| 1050 | (if (eq (car requires) 'quote) | ||
| 1051 | (setq requires (car (cdr requires)))) | ||
| 1052 | (setq requires | ||
| 1053 | (mapcar (lambda (elt) | ||
| 1054 | (list (car elt) | ||
| 1055 | (version-to-list (cadr elt)))) | ||
| 1056 | requires)) | ||
| 1057 | (vector pkg-name requires docstring version-string readme))))) | ||
| 1058 | 1084 | ||
| 1059 | ;;;###autoload | 1085 | ;;;###autoload |
| 1060 | (defun package-install-from-buffer (pkg-info type) | 1086 | (defun package-install-from-buffer (pkg-desc) |
| 1061 | "Install a package from the current buffer. | 1087 | "Install a package from the current buffer. |
| 1062 | When called interactively, the current buffer is assumed to be a | 1088 | When called interactively, the current buffer is assumed to be a |
| 1063 | single .el file that follows the packaging guidelines; see info | 1089 | single .el file that follows the packaging guidelines; see info |
| 1064 | node `(elisp)Packaging'. | 1090 | node `(elisp)Packaging'. |
| 1065 | 1091 | ||
| 1066 | When called from Lisp, PKG-INFO is a vector describing the | 1092 | When called from Lisp, PKG-DESC is a `package-desc' describing the |
| 1067 | information, of the type returned by `package-buffer-info'; and | 1093 | information)." |
| 1068 | TYPE is the package type (either `single' or `tar')." | 1094 | (interactive (list (package-buffer-info))) |
| 1069 | (interactive (list (package-buffer-info) 'single)) | ||
| 1070 | (save-excursion | 1095 | (save-excursion |
| 1071 | (save-restriction | 1096 | (save-restriction |
| 1072 | (let* ((file-name (aref pkg-info 0)) | 1097 | (let* ((name (package-desc-name pkg-desc)) |
| 1073 | (requires (aref pkg-info 1)) | 1098 | (requires (package-desc-reqs pkg-desc)) |
| 1074 | (desc (if (string= (aref pkg-info 2) "") | 1099 | (desc (package-desc-summary pkg-desc)) |
| 1075 | "No description available." | 1100 | (pkg-version (package-desc-version pkg-desc))) |
| 1076 | (aref pkg-info 2))) | ||
| 1077 | (pkg-version (aref pkg-info 3))) | ||
| 1078 | ;; Download and install the dependencies. | 1101 | ;; Download and install the dependencies. |
| 1079 | (let ((transaction (package-compute-transaction nil requires))) | 1102 | (let ((transaction (package-compute-transaction nil requires))) |
| 1080 | (package-download-transaction transaction)) | 1103 | (package-download-transaction transaction)) |
| 1081 | ;; Install the package itself. | 1104 | ;; Install the package itself. |
| 1082 | (cond | 1105 | (pcase (package-desc-kind pkg-desc) |
| 1083 | ((eq type 'single) | 1106 | (`single (package-unpack-single name pkg-version desc requires)) |
| 1084 | (package-unpack-single file-name pkg-version desc requires)) | 1107 | (`tar (package-unpack name pkg-version)) |
| 1085 | ((eq type 'tar) | 1108 | (type (error "Unknown type: %S" type))) |
| 1086 | (package-unpack (intern file-name) pkg-version)) | ||
| 1087 | (t | ||
| 1088 | (error "Unknown type: %s" (symbol-name type)))) | ||
| 1089 | ;; Try to activate it. | 1109 | ;; Try to activate it. |
| 1090 | (package-initialize))))) | 1110 | (package-initialize))))) |
| 1091 | 1111 | ||
| @@ -1097,10 +1117,10 @@ The file can either be a tar file or an Emacs Lisp file." | |||
| 1097 | (with-temp-buffer | 1117 | (with-temp-buffer |
| 1098 | (insert-file-contents-literally file) | 1118 | (insert-file-contents-literally file) |
| 1099 | (cond | 1119 | (cond |
| 1100 | ((string-match "\\.el$" file) | 1120 | ((string-match "\\.el\\'" file) |
| 1101 | (package-install-from-buffer (package-buffer-info) 'single)) | 1121 | (package-install-from-buffer (package-buffer-info))) |
| 1102 | ((string-match "\\.tar$" file) | 1122 | ((string-match "\\.tar\\'" file) |
| 1103 | (package-install-from-buffer (package-tar-file-info file) 'tar)) | 1123 | (package-install-from-buffer (package-tar-file-info file))) |
| 1104 | (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) | 1124 | (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) |
| 1105 | 1125 | ||
| 1106 | (defun package-delete (name version) | 1126 | (defun package-delete (name version) |
| @@ -1118,7 +1138,7 @@ The file can either be a tar file or an Emacs Lisp file." | |||
| 1118 | (defun package-archive-base (name) | 1138 | (defun package-archive-base (name) |
| 1119 | "Return the archive containing the package NAME." | 1139 | "Return the archive containing the package NAME." |
| 1120 | (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) | 1140 | (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) |
| 1121 | (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) | 1141 | (cdr (assoc (package-desc-archive desc) package-archives)))) |
| 1122 | 1142 | ||
| 1123 | (defun package--download-one-archive (archive file) | 1143 | (defun package--download-one-archive (archive file) |
| 1124 | "Retrieve an archive file FILE from ARCHIVE, and cache it. | 1144 | "Retrieve an archive file FILE from ARCHIVE, and cache it. |
| @@ -1163,7 +1183,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." | |||
| 1163 | (package-read-all-archive-contents) | 1183 | (package-read-all-archive-contents) |
| 1164 | (unless no-activate | 1184 | (unless no-activate |
| 1165 | (dolist (elt package-alist) | 1185 | (dolist (elt package-alist) |
| 1166 | (package-activate (car elt) (package-desc-vers (cdr elt))))) | 1186 | (package-activate (car elt) (package-desc-version (cdr elt))))) |
| 1167 | (setq package--initialized t)) | 1187 | (setq package--initialized t)) |
| 1168 | 1188 | ||
| 1169 | 1189 | ||
| @@ -1210,22 +1230,22 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." | |||
| 1210 | (cond | 1230 | (cond |
| 1211 | ;; Loaded packages are in `package-alist'. | 1231 | ;; Loaded packages are in `package-alist'. |
| 1212 | ((setq desc (cdr (assq package package-alist))) | 1232 | ((setq desc (cdr (assq package package-alist))) |
| 1213 | (setq version (package-version-join (package-desc-vers desc))) | 1233 | (setq version (package-version-join (package-desc-version desc))) |
| 1214 | (if (setq pkg-dir (package--dir package-name version)) | 1234 | (if (setq pkg-dir (package--dir package-name version)) |
| 1215 | (insert "an installed package.\n\n") | 1235 | (insert "an installed package.\n\n") |
| 1216 | ;; This normally does not happen. | 1236 | ;; This normally does not happen. |
| 1217 | (insert "a deleted package.\n\n"))) | 1237 | (insert "a deleted package.\n\n"))) |
| 1218 | ;; Available packages are in `package-archive-contents'. | 1238 | ;; Available packages are in `package-archive-contents'. |
| 1219 | ((setq desc (cdr (assq package package-archive-contents))) | 1239 | ((setq desc (cdr (assq package package-archive-contents))) |
| 1220 | (setq version (package-version-join (package-desc-vers desc)) | 1240 | (setq version (package-version-join (package-desc-version desc)) |
| 1221 | archive (aref desc (- (length desc) 1)) | 1241 | archive (package-desc-archive desc) |
| 1222 | installable t) | 1242 | installable t) |
| 1223 | (if built-in | 1243 | (if built-in |
| 1224 | (insert "a built-in package.\n\n") | 1244 | (insert "a built-in package.\n\n") |
| 1225 | (insert "an uninstalled package.\n\n"))) | 1245 | (insert "an uninstalled package.\n\n"))) |
| 1226 | (built-in | 1246 | (built-in |
| 1227 | (setq desc (cdr built-in) | 1247 | (setq desc (package--from-builtin built-in) |
| 1228 | version (package-version-join (package-desc-vers desc))) | 1248 | version (package-version-join (package-desc-version desc))) |
| 1229 | (insert "a built-in package.\n\n")) | 1249 | (insert "a built-in package.\n\n")) |
| 1230 | (t | 1250 | (t |
| 1231 | (insert "an orphan package.\n\n"))) | 1251 | (insert "an orphan package.\n\n"))) |
| @@ -1246,7 +1266,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." | |||
| 1246 | (insert "'."))) | 1266 | (insert "'."))) |
| 1247 | (installable | 1267 | (installable |
| 1248 | (if built-in | 1268 | (if built-in |
| 1249 | (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face) | 1269 | (insert (propertize "Built-in." |
| 1270 | 'font-lock-face 'font-lock-builtin-face) | ||
| 1250 | " Alternate version available") | 1271 | " Alternate version available") |
| 1251 | (insert "Available")) | 1272 | (insert "Available")) |
| 1252 | (insert " from " archive) | 1273 | (insert " from " archive) |
| @@ -1261,7 +1282,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." | |||
| 1261 | 'package-symbol package | 1282 | 'package-symbol package |
| 1262 | 'action 'package-install-button-action))) | 1283 | 'action 'package-install-button-action))) |
| 1263 | (built-in | 1284 | (built-in |
| 1264 | (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face))) | 1285 | (insert (propertize "Built-in." |
| 1286 | 'font-lock-face 'font-lock-builtin-face))) | ||
| 1265 | (t (insert "Deleted."))) | 1287 | (t (insert "Deleted."))) |
| 1266 | (insert "\n") | 1288 | (insert "\n") |
| 1267 | (and version (> (length version) 0) | 1289 | (and version (> (length version) 0) |
| @@ -1286,7 +1308,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." | |||
| 1286 | (help-insert-xref-button text 'help-package name)) | 1308 | (help-insert-xref-button text 'help-package name)) |
| 1287 | (insert "\n"))) | 1309 | (insert "\n"))) |
| 1288 | (insert " " (propertize "Summary" 'font-lock-face 'bold) | 1310 | (insert " " (propertize "Summary" 'font-lock-face 'bold) |
| 1289 | ": " (if desc (package-desc-doc desc)) "\n\n") | 1311 | ": " (if desc (package-desc-summary desc)) "\n\n") |
| 1290 | 1312 | ||
| 1291 | (if built-in | 1313 | (if built-in |
| 1292 | ;; For built-in packages, insert the commentary. | 1314 | ;; For built-in packages, insert the commentary. |
| @@ -1418,10 +1440,10 @@ If the alist stored in the symbol LISTNAME lacks an entry for a | |||
| 1418 | package PACKAGE with descriptor DESC, add one. The alist is | 1440 | package PACKAGE with descriptor DESC, add one. The alist is |
| 1419 | keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is | 1441 | keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is |
| 1420 | a symbol and VERSION-LIST is a version list." | 1442 | a symbol and VERSION-LIST is a version list." |
| 1421 | `(let* ((version (package-desc-vers ,desc)) | 1443 | `(let* ((version (package-desc-version ,desc)) |
| 1422 | (key (cons ,package version))) | 1444 | (key (cons ,package version))) |
| 1423 | (unless (assoc key ,listname) | 1445 | (unless (assoc key ,listname) |
| 1424 | (push (list key ,status (package-desc-doc ,desc)) ,listname)))) | 1446 | (push (list key ,status (package-desc-summary ,desc)) ,listname)))) |
| 1425 | 1447 | ||
| 1426 | (defun package-menu--generate (remember-pos packages) | 1448 | (defun package-menu--generate (remember-pos packages) |
| 1427 | "Populate the Package Menu. | 1449 | "Populate the Package Menu. |
| @@ -1444,7 +1466,7 @@ or a list of package names (symbols) to display." | |||
| 1444 | (setq name (car elt)) | 1466 | (setq name (car elt)) |
| 1445 | (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. | 1467 | (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. |
| 1446 | (or (eq packages t) (memq name packages))) | 1468 | (or (eq packages t) (memq name packages))) |
| 1447 | (package--push name (cdr elt) "built-in" info-list))) | 1469 | (package--push name (package--from-builtin elt) "built-in" info-list))) |
| 1448 | 1470 | ||
| 1449 | ;; Available and disabled packages: | 1471 | ;; Available and disabled packages: |
| 1450 | (dolist (elt package-archive-contents) | 1472 | (dolist (elt package-archive-contents) |
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index a88b9d70930..f9d0fd9366b 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el | |||
| @@ -957,7 +957,7 @@ If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\" | |||
| 957 | (let ((ender (funcall smie-backward-token-function))) | 957 | (let ((ender (funcall smie-backward-token-function))) |
| 958 | (cond | 958 | (cond |
| 959 | ((not (and ender (rassoc ender smie-closer-alist))) | 959 | ((not (and ender (rassoc ender smie-closer-alist))) |
| 960 | ;; This not is one of the begin..end we know how to check. | 960 | ;; This is not one of the begin..end we know how to check. |
| 961 | (blink-matching-check-mismatch start end)) | 961 | (blink-matching-check-mismatch start end)) |
| 962 | ((not start) t) | 962 | ((not start) t) |
| 963 | ((eq t (car (rassoc ender smie-closer-alist))) nil) | 963 | ((eq t (car (rassoc ender smie-closer-alist))) nil) |
| @@ -1012,6 +1012,9 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'. | |||
| 1012 | (or (eq (char-before) last-command-event) | 1012 | (or (eq (char-before) last-command-event) |
| 1013 | (not (memq (char-before) | 1013 | (not (memq (char-before) |
| 1014 | smie-blink-matching-triggers))) | 1014 | smie-blink-matching-triggers))) |
| 1015 | ;; FIXME: For octave's "switch ... case ... case" we flash | ||
| 1016 | ;; `switch' at the end of the first `case' and we burp | ||
| 1017 | ;; "mismatch" at the end of the second `case'. | ||
| 1015 | (or smie-blink-matching-inners | 1018 | (or smie-blink-matching-inners |
| 1016 | (not (numberp (nth 2 (assoc token smie-grammar)))))) | 1019 | (not (numberp (nth 2 (assoc token smie-grammar)))))) |
| 1017 | ;; The major mode might set blink-matching-check-function | 1020 | ;; The major mode might set blink-matching-check-function |
| @@ -1021,87 +1024,90 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'. | |||
| 1021 | (let ((blink-matching-check-function #'smie-blink-matching-check)) | 1024 | (let ((blink-matching-check-function #'smie-blink-matching-check)) |
| 1022 | (blink-matching-open)))))))) | 1025 | (blink-matching-open)))))))) |
| 1023 | 1026 | ||
| 1024 | (defface smie-matching-block-highlight '((t (:inherit highlight))) | 1027 | (defvar-local smie--matching-block-data-cache nil) |
| 1025 | "Face used to highlight matching block." | 1028 | |
| 1026 | :group 'smie) | 1029 | (defun smie--opener/closer-at-point () |
| 1027 | 1030 | "Return (OPENER TOKEN START END) or nil. | |
| 1028 | (defvar smie--highlight-matching-block-overlay nil) | 1031 | OPENER is non-nil if TOKEN is an opener and nil if it's a closer." |
| 1029 | (defvar-local smie--highlight-matching-block-lastpos -1) | 1032 | (let* ((start (point)) |
| 1030 | 1033 | ;; Move to a previous position outside of a token. | |
| 1031 | (defun smie-highlight-matching-block () | 1034 | (_ (funcall smie-backward-token-function)) |
| 1032 | (when (and smie-closer-alist | 1035 | ;; Move to the end of the token before point. |
| 1033 | (/= (point) smie--highlight-matching-block-lastpos)) | 1036 | (btok (funcall smie-forward-token-function)) |
| 1034 | (unless (overlayp smie--highlight-matching-block-overlay) | 1037 | (bend (point))) |
| 1035 | (setq smie--highlight-matching-block-overlay | 1038 | (cond |
| 1036 | (make-overlay (point) (point)))) | 1039 | ;; Token before point is a closer? |
| 1037 | (setq smie--highlight-matching-block-lastpos (point)) | 1040 | ((and (>= bend start) (rassoc btok smie-closer-alist)) |
| 1038 | (let ((beg-of-tok | 1041 | (funcall smie-backward-token-function) |
| 1039 | (lambda (&optional start) | 1042 | (when (< (point) start) |
| 1040 | "Move to the beginning of current token at START." | 1043 | (prog1 (list nil btok (point) bend) |
| 1041 | (let* ((token) | 1044 | (goto-char bend)))) |
| 1042 | (start (or start (point))) | 1045 | ;; Token around point is an opener? |
| 1043 | (beg (progn | 1046 | ((and (> bend start) (assoc btok smie-closer-alist)) |
| 1047 | (funcall smie-backward-token-function) | ||
| 1048 | (when (<= (point) start) (list t btok (point) bend))) | ||
| 1049 | ((<= bend start) | ||
| 1050 | (let ((atok (funcall smie-forward-token-function)) | ||
| 1051 | (aend (point))) | ||
| 1052 | (cond | ||
| 1053 | ((< aend start) nil) ;Hopefully shouldn't happen. | ||
| 1054 | ;; Token after point is a closer? | ||
| 1055 | ((assoc atok smie-closer-alist) | ||
| 1056 | (funcall smie-backward-token-function) | ||
| 1057 | (when (<= (point) start) | ||
| 1058 | (list t atok (point) aend))))))))) | ||
| 1059 | |||
| 1060 | (defun smie--matching-block-data (orig &rest args) | ||
| 1061 | "A function suitable for `show-paren-data-function' (which see)." | ||
| 1062 | (if (or (null smie-closer-alist) | ||
| 1063 | (eq (point) (car smie--matching-block-data-cache))) | ||
| 1064 | (or (cdr smie--matching-block-data-cache) | ||
| 1065 | (apply orig args)) | ||
| 1066 | (setq smie--matching-block-data-cache (list (point))) | ||
| 1067 | (unless (nth 8 (syntax-ppss)) | ||
| 1068 | (condition-case nil | ||
| 1069 | (let ((here (smie--opener/closer-at-point))) | ||
| 1070 | (when (and here | ||
| 1071 | (or smie-blink-matching-inners | ||
| 1072 | (not (numberp | ||
| 1073 | (nth (if (nth 0 here) 1 2) | ||
| 1074 | (assoc (nth 1 here) smie-grammar)))))) | ||
| 1075 | (let ((there | ||
| 1076 | (cond | ||
| 1077 | ((car here) ; Opener. | ||
| 1078 | (let ((data (smie-forward-sexp 'halfsexp)) | ||
| 1079 | (tend (point))) | ||
| 1080 | (unless (car data) | ||
| 1044 | (funcall smie-backward-token-function) | 1081 | (funcall smie-backward-token-function) |
| 1045 | (forward-comment (point-max)) | 1082 | (list (member (cons (nth 1 here) (nth 2 data)) |
| 1046 | (point))) | 1083 | smie-closer-alist) |
| 1047 | (end (progn | 1084 | (point) tend)))) |
| 1048 | (setq token (funcall smie-forward-token-function)) | 1085 | (t ;Closer. |
| 1049 | (forward-comment (- (point))) | 1086 | (let ((data (smie-backward-sexp 'halfsexp)) |
| 1050 | (point)))) | 1087 | (htok (nth 1 here))) |
| 1051 | (if (and (<= beg start) (<= start end) | 1088 | (if (car data) |
| 1052 | (or (assoc token smie-closer-alist) | 1089 | (let* ((hprec (nth 2 (assoc htok smie-grammar))) |
| 1053 | (rassoc token smie-closer-alist))) | 1090 | (ttok (nth 2 data)) |
| 1054 | (progn (goto-char beg) token) | 1091 | (tprec (nth 1 (assoc ttok smie-grammar)))) |
| 1055 | (goto-char start) | 1092 | (when (and (numberp hprec) ;Here is an inner. |
| 1056 | nil)))) | 1093 | (eq hprec tprec)) |
| 1057 | (highlight | 1094 | (goto-char (nth 1 data)) |
| 1058 | (lambda (beg end) | 1095 | (let ((tbeg (point))) |
| 1059 | (move-overlay smie--highlight-matching-block-overlay | 1096 | (funcall smie-forward-token-function) |
| 1060 | beg end (current-buffer)) | 1097 | (list t tbeg (point))))) |
| 1061 | (overlay-put smie--highlight-matching-block-overlay | 1098 | (let ((tbeg (point))) |
| 1062 | 'face 'smie-matching-block-highlight)))) | 1099 | (funcall smie-forward-token-function) |
| 1063 | (overlay-put smie--highlight-matching-block-overlay 'face nil) | 1100 | (list (member (cons (nth 2 data) htok) |
| 1064 | (unless (nth 8 (syntax-ppss)) | 1101 | smie-closer-alist) |
| 1065 | (save-excursion | 1102 | tbeg (point))))))))) |
| 1066 | (condition-case nil | 1103 | ;; Update the cache. |
| 1067 | (let ((token | 1104 | (setcdr smie--matching-block-data-cache |
| 1068 | (or (funcall beg-of-tok) | 1105 | (list (nth 2 here) (nth 3 here) |
| 1069 | (funcall beg-of-tok | 1106 | (nth 1 there) (nth 2 there) |
| 1070 | (prog1 (point) | 1107 | (not (nth 0 there))))))) |
| 1071 | (funcall smie-forward-token-function)))))) | 1108 | (scan-error nil)) |
| 1072 | (cond | 1109 | (goto-char (car smie--matching-block-data-cache))) |
| 1073 | ((assoc token smie-closer-alist) ; opener | 1110 | (apply #'smie--matching-block-data orig args))) |
| 1074 | (forward-sexp 1) | ||
| 1075 | (let ((end (point)) | ||
| 1076 | (closer (funcall smie-backward-token-function))) | ||
| 1077 | (when (rassoc closer smie-closer-alist) | ||
| 1078 | (funcall highlight (point) end)))) | ||
| 1079 | ((rassoc token smie-closer-alist) ; closer | ||
| 1080 | (funcall smie-forward-token-function) | ||
| 1081 | (forward-sexp -1) | ||
| 1082 | (let ((beg (point)) | ||
| 1083 | (opener (funcall smie-forward-token-function))) | ||
| 1084 | (when (assoc opener smie-closer-alist) | ||
| 1085 | (funcall highlight beg (point))))))) | ||
| 1086 | (scan-error))))))) | ||
| 1087 | |||
| 1088 | (defvar smie--highlight-matching-block-timer nil) | ||
| 1089 | |||
| 1090 | ;;;###autoload | ||
| 1091 | (define-minor-mode smie-highlight-matching-block-mode nil | ||
| 1092 | :global t :group 'smie | ||
| 1093 | (when (timerp smie--highlight-matching-block-timer) | ||
| 1094 | (cancel-timer smie--highlight-matching-block-timer)) | ||
| 1095 | (setq smie--highlight-matching-block-timer nil) | ||
| 1096 | (if smie-highlight-matching-block-mode | ||
| 1097 | (progn | ||
| 1098 | (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local) | ||
| 1099 | (setq smie--highlight-matching-block-timer | ||
| 1100 | (run-with-idle-timer 0.2 t #'smie-highlight-matching-block))) | ||
| 1101 | (when smie--highlight-matching-block-overlay | ||
| 1102 | (delete-overlay smie--highlight-matching-block-overlay) | ||
| 1103 | (setq smie--highlight-matching-block-overlay nil)) | ||
| 1104 | (kill-local-variable 'smie--highlight-matching-block-lastpos))) | ||
| 1105 | 1111 | ||
| 1106 | ;;; The indentation engine. | 1112 | ;;; The indentation engine. |
| 1107 | 1113 | ||
| @@ -1799,9 +1805,10 @@ KEYWORDS are additional arguments, which can use the following keywords: | |||
| 1799 | (setq-local smie-closer-alist ca) | 1805 | (setq-local smie-closer-alist ca) |
| 1800 | ;; Only needed for interactive calls to blink-matching-open. | 1806 | ;; Only needed for interactive calls to blink-matching-open. |
| 1801 | (setq-local blink-matching-check-function #'smie-blink-matching-check) | 1807 | (setq-local blink-matching-check-function #'smie-blink-matching-check) |
| 1802 | (unless smie-highlight-matching-block-mode | 1808 | (add-hook 'post-self-insert-hook |
| 1803 | (add-hook 'post-self-insert-hook | 1809 | #'smie-blink-matching-open 'append 'local) |
| 1804 | #'smie-blink-matching-open 'append 'local)) | 1810 | (add-function :around (local 'show-paren-data-function) |
| 1811 | #'smie--matching-block-data) | ||
| 1805 | ;; Setup smie-blink-matching-triggers. Rather than wait for SPC to | 1812 | ;; Setup smie-blink-matching-triggers. Rather than wait for SPC to |
| 1806 | ;; blink, try to blink as soon as we type the last char of a block ender. | 1813 | ;; blink, try to blink as soon as we type the last char of a block ender. |
| 1807 | (let ((closers (sort (mapcar #'cdr smie-closer-alist) #'string-lessp)) | 1814 | (let ((closers (sort (mapcar #'cdr smie-closer-alist) #'string-lessp)) |
diff --git a/lisp/epa.el b/lisp/epa.el index b567df5f40b..14f8879c1c6 100644 --- a/lisp/epa.el +++ b/lisp/epa.el | |||
| @@ -620,21 +620,24 @@ If SECRET is non-nil, list secret keys instead of public keys." | |||
| 620 | (floor (* (/ current (float total)) 100)))) | 620 | (floor (* (/ current (float total)) 100)))) |
| 621 | (message "%s..." prompt)))) | 621 | (message "%s..." prompt)))) |
| 622 | 622 | ||
| 623 | (defun epa-read-file-name (input) | ||
| 624 | "Interactively read an output file name based on INPUT file name." | ||
| 625 | (setq input (file-name-sans-extension (expand-file-name input))) | ||
| 626 | (expand-file-name | ||
| 627 | (read-file-name | ||
| 628 | (concat "To file (default " (file-name-nondirectory input) ") ") | ||
| 629 | (file-name-directory input) | ||
| 630 | input))) | ||
| 631 | |||
| 623 | ;;;###autoload | 632 | ;;;###autoload |
| 624 | (defun epa-decrypt-file (decrypt-file plain-file) | 633 | (defun epa-decrypt-file (decrypt-file &optional plain-file) |
| 625 | "Decrypt DECRYPT-FILE into PLAIN-FILE." | 634 | "Decrypt DECRYPT-FILE into PLAIN-FILE. |
| 635 | If you do not specify PLAIN-FILE, this functions prompts for the value to use." | ||
| 626 | (interactive | 636 | (interactive |
| 627 | (let (file default-name plain) | 637 | (let* ((file (read-file-name "File to decrypt: ")) |
| 628 | (setq file (read-file-name "File to decrypt: ")) | 638 | (plain (epa-read-file-name file))) |
| 629 | (setq default-name (file-name-sans-extension (expand-file-name file))) | ||
| 630 | (setq plain (expand-file-name | ||
| 631 | (read-file-name | ||
| 632 | (concat "To file (default " | ||
| 633 | (file-name-nondirectory default-name) | ||
| 634 | ") ") | ||
| 635 | (file-name-directory default-name) | ||
| 636 | default-name))) | ||
| 637 | (list file plain))) | 639 | (list file plain))) |
| 640 | (or plain-file (setq plain-file (epa-read-file-name decrypt-file))) | ||
| 638 | (setq decrypt-file (expand-file-name decrypt-file)) | 641 | (setq decrypt-file (expand-file-name decrypt-file)) |
| 639 | (let ((context (epg-make-context epa-protocol))) | 642 | (let ((context (epg-make-context epa-protocol))) |
| 640 | (epg-context-set-passphrase-callback context | 643 | (epg-context-set-passphrase-callback context |
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 106ca152c90..e8fbe0518ac 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el | |||
| @@ -207,8 +207,8 @@ Thus, this does not include the current directory.") | |||
| 207 | (when eshell-cd-on-directory | 207 | (when eshell-cd-on-directory |
| 208 | (make-local-variable 'eshell-interpreter-alist) | 208 | (make-local-variable 'eshell-interpreter-alist) |
| 209 | (setq eshell-interpreter-alist | 209 | (setq eshell-interpreter-alist |
| 210 | (cons (cons (lambda (file args) | 210 | (cons (cons #'(lambda (file args) |
| 211 | (eshell-lone-directory-p file)) | 211 | (eshell-lone-directory-p file)) |
| 212 | 'eshell-dirs-substitute-cd) | 212 | 'eshell-dirs-substitute-cd) |
| 213 | eshell-interpreter-alist))) | 213 | eshell-interpreter-alist))) |
| 214 | 214 | ||
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index 13ae6941dde..b073928738f 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el | |||
| @@ -61,9 +61,10 @@ This includes when running `eshell-command'." | |||
| 61 | "Initialize the script parsing code." | 61 | "Initialize the script parsing code." |
| 62 | (make-local-variable 'eshell-interpreter-alist) | 62 | (make-local-variable 'eshell-interpreter-alist) |
| 63 | (setq eshell-interpreter-alist | 63 | (setq eshell-interpreter-alist |
| 64 | (cons '((lambda (file args) | 64 | (cons (cons #'(lambda (file args) |
| 65 | (string= (file-name-nondirectory file) | 65 | (string= (file-name-nondirectory file) |
| 66 | "eshell")) . eshell/source) | 66 | "eshell")) |
| 67 | 'eshell/source) | ||
| 67 | eshell-interpreter-alist)) | 68 | eshell-interpreter-alist)) |
| 68 | (make-local-variable 'eshell-complex-commands) | 69 | (make-local-variable 'eshell-complex-commands) |
| 69 | (setq eshell-complex-commands | 70 | (setq eshell-complex-commands |
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 0501544789d..2932f443e4f 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el | |||
| @@ -31,6 +31,7 @@ | |||
| 31 | 31 | ||
| 32 | ;;; Code: | 32 | ;;; Code: |
| 33 | 33 | ||
| 34 | (require 'cl-lib) | ||
| 34 | (require 'esh-util) | 35 | (require 'esh-util) |
| 35 | (require 'esh-ext) | 36 | (require 'esh-ext) |
| 36 | (eval-when-compile (require 'eshell)) | 37 | (eval-when-compile (require 'eshell)) |
| @@ -61,13 +62,19 @@ which commands are considered visual in nature." | |||
| 61 | "less" "more" ; M-x view-file | 62 | "less" "more" ; M-x view-file |
| 62 | "lynx" "ncftp" ; w3.el, ange-ftp | 63 | "lynx" "ncftp" ; w3.el, ange-ftp |
| 63 | "pine" "tin" "trn" "elm") ; GNUS!! | 64 | "pine" "tin" "trn" "elm") ; GNUS!! |
| 64 | "A list of commands that present their output in a visual fashion." | 65 | "A list of commands that present their output in a visual fashion. |
| 66 | |||
| 67 | Commands listed here are run in a term buffer. | ||
| 68 | |||
| 69 | See also `eshell-visual-subcommands' and `eshell-visual-options'." | ||
| 65 | :type '(repeat string) | 70 | :type '(repeat string) |
| 66 | :group 'eshell-term) | 71 | :group 'eshell-term) |
| 67 | 72 | ||
| 68 | (defcustom eshell-visual-subcommands | 73 | (defcustom eshell-visual-subcommands |
| 69 | nil | 74 | nil |
| 70 | "An alist of the form | 75 | "An alist of subcommands that present their output in a visual fashion. |
| 76 | |||
| 77 | An alist of the form | ||
| 71 | 78 | ||
| 72 | ((COMMAND1 SUBCOMMAND1 SUBCOMMAND2...) | 79 | ((COMMAND1 SUBCOMMAND1 SUBCOMMAND2...) |
| 73 | (COMMAND2 SUBCOMMAND1 ...)) | 80 | (COMMAND2 SUBCOMMAND1 ...)) |
| @@ -77,7 +84,9 @@ visual fashion. A likely entry is | |||
| 77 | 84 | ||
| 78 | (\"git\" \"log\" \"diff\" \"show\") | 85 | (\"git\" \"log\" \"diff\" \"show\") |
| 79 | 86 | ||
| 80 | because git shows logs and diffs using a pager by default." | 87 | because git shows logs and diffs using a pager by default. |
| 88 | |||
| 89 | See also `eshell-visual-commands' and `eshell-visual-options'." | ||
| 81 | :type '(repeat (cons (string :tag "Command") | 90 | :type '(repeat (cons (string :tag "Command") |
| 82 | (repeat (string :tag "Subcommand")))) | 91 | (repeat (string :tag "Subcommand")))) |
| 83 | :version "24.4" | 92 | :version "24.4" |
| @@ -96,7 +105,9 @@ fashion. For example, a sensible entry would be | |||
| 96 | (\"git\" \"--help\") | 105 | (\"git\" \"--help\") |
| 97 | 106 | ||
| 98 | because \"git <command> --help\" shows the command's | 107 | because \"git <command> --help\" shows the command's |
| 99 | documentation with a pager." | 108 | documentation with a pager. |
| 109 | |||
| 110 | See also `eshell-visual-commands' and `eshell-visual-subcommands'." | ||
| 100 | :type '(repeat (cons (string :tag "Command") | 111 | :type '(repeat (cons (string :tag "Command") |
| 101 | (repeat (string :tag "Option")))) | 112 | (repeat (string :tag "Option")))) |
| 102 | :version "24.4" | 113 | :version "24.4" |
| @@ -131,18 +142,23 @@ character to the invoked process." | |||
| 131 | "Initialize the `term' interface code." | 142 | "Initialize the `term' interface code." |
| 132 | (make-local-variable 'eshell-interpreter-alist) | 143 | (make-local-variable 'eshell-interpreter-alist) |
| 133 | (setq eshell-interpreter-alist | 144 | (setq eshell-interpreter-alist |
| 134 | (cons (cons (function | 145 | (cons (cons #'eshell-visual-command-p |
| 135 | (lambda (command args) | ||
| 136 | (let ((command (file-name-nondirectory command))) | ||
| 137 | (or (member command eshell-visual-commands) | ||
| 138 | (member (car args) | ||
| 139 | (cdr (assoc command eshell-visual-subcommands))) | ||
| 140 | (cl-intersection args | ||
| 141 | (cdr (assoc command eshell-visual-options)) | ||
| 142 | :test 'string=))))) | ||
| 143 | 'eshell-exec-visual) | 146 | 'eshell-exec-visual) |
| 144 | eshell-interpreter-alist))) | 147 | eshell-interpreter-alist))) |
| 145 | 148 | ||
| 149 | (defun eshell-visual-command-p (command args) | ||
| 150 | "Returns non-nil when given a visual command. | ||
| 151 | If either COMMAND or a subcommand in ARGS (e.g. git log) is a | ||
| 152 | visual command, returns non-nil." | ||
| 153 | (let ((command (file-name-nondirectory command))) | ||
| 154 | (and (eshell-interactive-output-p) | ||
| 155 | (or (member command eshell-visual-commands) | ||
| 156 | (member (car args) | ||
| 157 | (cdr (assoc command eshell-visual-subcommands))) | ||
| 158 | (cl-intersection args | ||
| 159 | (cdr (assoc command eshell-visual-options)) | ||
| 160 | :test 'string=))))) | ||
| 161 | |||
| 146 | (defun eshell-exec-visual (&rest args) | 162 | (defun eshell-exec-visual (&rest args) |
| 147 | "Run the specified PROGRAM in a terminal emulation buffer. | 163 | "Run the specified PROGRAM in a terminal emulation buffer. |
| 148 | ARGS are passed to the program. At the moment, no piping of input is | 164 | ARGS are passed to the program. At the moment, no piping of input is |
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index ee857cf20f3..5346bd16fd2 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el | |||
| @@ -326,11 +326,8 @@ and the hook `eshell-exit-hook'." | |||
| 326 | (if mode-line-elt | 326 | (if mode-line-elt |
| 327 | (setcar mode-line-elt 'eshell-command-running-string)))) | 327 | (setcar mode-line-elt 'eshell-command-running-string)))) |
| 328 | 328 | ||
| 329 | (define-key eshell-mode-map [return] 'eshell-send-input) | 329 | (define-key eshell-mode-map "\r" 'eshell-send-input) |
| 330 | (define-key eshell-mode-map [(control ?m)] 'eshell-send-input) | 330 | (define-key eshell-mode-map "\M-\r" 'eshell-queue-input) |
| 331 | (define-key eshell-mode-map [(control ?j)] 'eshell-send-input) | ||
| 332 | (define-key eshell-mode-map [(meta return)] 'eshell-queue-input) | ||
| 333 | (define-key eshell-mode-map [(meta control ?m)] 'eshell-queue-input) | ||
| 334 | (define-key eshell-mode-map [(meta control ?l)] 'eshell-show-output) | 331 | (define-key eshell-mode-map [(meta control ?l)] 'eshell-show-output) |
| 335 | (define-key eshell-mode-map [(control ?a)] 'eshell-bol) | 332 | (define-key eshell-mode-map [(control ?a)] 'eshell-bol) |
| 336 | 333 | ||
diff --git a/lisp/finder.el b/lisp/finder.el index 3d988b41bde..f6593c554eb 100644 --- a/lisp/finder.el +++ b/lisp/finder.el | |||
| @@ -206,7 +206,8 @@ from; the default is `load-path'." | |||
| 206 | (setq version (ignore-errors (version-to-list version))) | 206 | (setq version (ignore-errors (version-to-list version))) |
| 207 | (setq entry (assq package package--builtins)) | 207 | (setq entry (assq package package--builtins)) |
| 208 | (cond ((null entry) | 208 | (cond ((null entry) |
| 209 | (push (cons package (vector version nil summary)) | 209 | (push (cons package |
| 210 | (package-make-builtin version summary)) | ||
| 210 | package--builtins)) | 211 | package--builtins)) |
| 211 | ((eq base-name package) | 212 | ((eq base-name package) |
| 212 | (setq desc (cdr entry)) | 213 | (setq desc (cdr entry)) |
diff --git a/lisp/font-lock.el b/lisp/font-lock.el index d18aea61236..8f4363b0bdf 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el | |||
| @@ -2328,7 +2328,7 @@ in which C preprocessor directives are used. e.g. `asm-mode' and | |||
| 2328 | (1 font-lock-keyword-face) | 2328 | (1 font-lock-keyword-face) |
| 2329 | (2 font-lock-constant-face nil t)) | 2329 | (2 font-lock-constant-face nil t)) |
| 2330 | ;; Erroneous structures. | 2330 | ;; Erroneous structures. |
| 2331 | ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\_>" 1 font-lock-warning-face) | 2331 | ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|\\(?:user-\\)?error\\|signal\\)\\_>" 1 font-lock-warning-face) |
| 2332 | ;; Words inside \\[] tend to be for `substitute-command-keys'. | 2332 | ;; Words inside \\[] tend to be for `substitute-command-keys'. |
| 2333 | ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]" | 2333 | ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]" |
| 2334 | (1 font-lock-constant-face prepend)) | 2334 | (1 font-lock-constant-face prepend)) |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 59e3e398788..83831264f58 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,112 @@ | |||
| 1 | 2013-06-13 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * shr.el (shr-expand-url): Expansion should chop off the bits after the | ||
| 4 | last slash. | ||
| 5 | |||
| 6 | * eww.el (eww-tag-select): Use the first value as the default value. | ||
| 7 | |||
| 8 | 2013-06-13 Rüdiger Sonderfeld <ruediger@c-plusplus.de> | ||
| 9 | |||
| 10 | * eww.el (eww): Prepend urls with http:// if scheme is missing. | ||
| 11 | (eww-mode): Use `define-derived-mode'. | ||
| 12 | (eww-parse-headers): Parse headers from beginning of buffer so that | ||
| 13 | file:// links work. | ||
| 14 | |||
| 15 | 2013-06-13 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 16 | |||
| 17 | * eww.el (eww-detect-charset): Detect charset from the <meta> tag. | ||
| 18 | |||
| 19 | 2013-06-12 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 20 | |||
| 21 | * shr.el (shr-tag-svg): Ignore SVG elements, because we don't know how | ||
| 22 | to handle them at all. | ||
| 23 | |||
| 24 | 2013-06-11 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 25 | |||
| 26 | * eww.el (eww-convert-widgets): Make widgets from non-tabular layouts | ||
| 27 | work, too. | ||
| 28 | (eww-tag-select): Implement <select>. | ||
| 29 | |||
| 30 | 2013-06-10 Albert Krewinkel <krewinkel@moltkeplatz.de> | ||
| 31 | |||
| 32 | * sieve-manage.el (sieve-manage-open): work with STARTTLS: shorten | ||
| 33 | stream managing functions by using open-protocol-stream to do most of | ||
| 34 | the work. Has the nice benefit of enabling STARTTLS. | ||
| 35 | Wait for capabilities after STARTTLS: following RFC5804, the server | ||
| 36 | sends new capabilities after successfully establishing a TLS connection | ||
| 37 | with the client. The client should update the cached list of | ||
| 38 | capabilities, but we just ignore the answer for now. | ||
| 39 | (sieve-manage-network-p, sieve-manage-network-open) | ||
| 40 | (sieve-manage-starttls-p, sieve-manage-starttls-open) | ||
| 41 | (sieve-manage-forward, sieve-manage-streams) | ||
| 42 | (sieve-manage-stream-alist): Remove unneeded functions neither in the | ||
| 43 | API, nor called by any other function. | ||
| 44 | Enable Multibyte for SieveManage buffers: The parser won't properly | ||
| 45 | handle umlauts and line endings unless multibyte is turned on in the | ||
| 46 | process buffer. | ||
| 47 | |||
| 48 | 2013-06-11 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 49 | |||
| 50 | * eww.el (eww-tag-input): Support password fields. | ||
| 51 | (eww-submit): Support POST. | ||
| 52 | |||
| 53 | 2013-06-10 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 54 | |||
| 55 | * eww.el (eww-tag-form): Protect against degenerate forms. | ||
| 56 | |||
| 57 | * shr.el (shr-expand-url): Expand URLs that start with a slash | ||
| 58 | correctly. | ||
| 59 | |||
| 60 | * eww.el (eww-submit): Get submit button logic right. | ||
| 61 | |||
| 62 | * shr.el (shr-final-table-render): New variable to signal when we're | ||
| 63 | doing the final table rendering so that we can collect more data at | ||
| 64 | that point. | ||
| 65 | |||
| 66 | * eww.el (eww-submit): Make form submission work. | ||
| 67 | (eww-tag-input): Implement submit buttons. | ||
| 68 | (eww-click-radio): Implement radio and checkboxes. | ||
| 69 | (eww-submit): Handle hidden elements. | ||
| 70 | |||
| 71 | * shr.el (shr-descend): Allow other packages to override (or provide) | ||
| 72 | rendering of elements. | ||
| 73 | (shr-expand-url): Strip query strings from URLs before expanding them. | ||
| 74 | |||
| 75 | * eww.el: Don't require cl-lib. | ||
| 76 | (eww-tag-form): Start form support. | ||
| 77 | |||
| 78 | * eww.el: Start writing a new, tiny web browser. | ||
| 79 | (eww-previous-url): New command. | ||
| 80 | (eww-quit): New command. | ||
| 81 | |||
| 82 | 2013-06-10 Albert Krewinkel <krewinkel@moltkeplatz.de> | ||
| 83 | |||
| 84 | * sieve.el: Put point at beginning of buffer when viewing a script. | ||
| 85 | (sieve-open-server): respect the PORT parameter. Show the correct port | ||
| 86 | number in sieve-buffer's header. Fixed code to also work with a string | ||
| 87 | as port specifier. Properly close the connection on pressing 'q'. Make | ||
| 88 | sieve-manage-quit close the connection and process buffer. Also, remove | ||
| 89 | duplicate keybinding for 'q'. | ||
| 90 | |||
| 91 | 2013-06-10 Roy Hashimoto <roy.hashimoto@gmail.com> (tiny change) | ||
| 92 | |||
| 93 | * mm-view.el (mm-pkcs7-signed-magic): Allow newline in the regexp and | ||
| 94 | make it easier to read. | ||
| 95 | (mm-pkcs7-enveloped-magic): Ditto. | ||
| 96 | |||
| 97 | 2013-06-06 Teodor Zlatanov <tzz@lifelogs.com> | ||
| 98 | |||
| 99 | * gnus-ems.el (gnus-image-type-available-p): Test `display-images-p' | ||
| 100 | before `image-type-available-p' to avoid loading the image libraries | ||
| 101 | needlessly. | ||
| 102 | |||
| 103 | 2013-06-04 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 104 | |||
| 105 | * gnus-art.el (article-date-ut, article-update-date-lapsed): Don't | ||
| 106 | assume Date header begins with "Date", that may be customized into | ||
| 107 | something like "X-Sent" using gnus-article-time-format. | ||
| 108 | (article-transform-date): Allow multi-line Date header. | ||
| 109 | |||
| 1 | 2013-06-02 David Engster <deng@randomsample.de> | 110 | 2013-06-02 David Engster <deng@randomsample.de> |
| 2 | 111 | ||
| 3 | * registry.el (initialize-instance, registry-lookup) | 112 | * registry.el (initialize-instance, registry-lookup) |
diff --git a/lisp/gnus/eww.el b/lisp/gnus/eww.el new file mode 100644 index 00000000000..d4dd178fb70 --- /dev/null +++ b/lisp/gnus/eww.el | |||
| @@ -0,0 +1,367 @@ | |||
| 1 | ;;; eww.el --- Emacs Web Wowser | ||
| 2 | |||
| 3 | ;; Copyright (C) 2013 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 6 | ;; Keywords: html | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;;; Code: | ||
| 26 | |||
| 27 | (eval-when-compile (require 'cl)) | ||
| 28 | (require 'shr) | ||
| 29 | (require 'url) | ||
| 30 | (require 'mm-url) | ||
| 31 | |||
| 32 | (defvar eww-current-url nil) | ||
| 33 | (defvar eww-history nil) | ||
| 34 | |||
| 35 | ;;;###autoload | ||
| 36 | (defun eww (url) | ||
| 37 | "Fetch URL and render the page." | ||
| 38 | (interactive "sUrl: ") | ||
| 39 | (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url) | ||
| 40 | (setq url (concat "http://" url))) | ||
| 41 | (url-retrieve url 'eww-render (list url))) | ||
| 42 | |||
| 43 | (defun eww-detect-charset (html-p) | ||
| 44 | (let ((case-fold-search t) | ||
| 45 | (pt (point))) | ||
| 46 | (or (and html-p | ||
| 47 | (re-search-forward | ||
| 48 | "<meta[\t\n\r ]+[^>]*charset=\\([^\t\n\r \"/>]+\\)" nil t) | ||
| 49 | (goto-char pt) | ||
| 50 | (match-string 1)) | ||
| 51 | (and (looking-at | ||
| 52 | "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)") | ||
| 53 | (match-string 1))))) | ||
| 54 | |||
| 55 | (defun eww-render (status url &optional point) | ||
| 56 | (let* ((headers (eww-parse-headers)) | ||
| 57 | (content-type | ||
| 58 | (mail-header-parse-content-type | ||
| 59 | (or (cdr (assoc "content-type" headers)) | ||
| 60 | "text/plain"))) | ||
| 61 | (charset (intern | ||
| 62 | (downcase | ||
| 63 | (or (cdr (assq 'charset (cdr content-type))) | ||
| 64 | (eww-detect-charset (equal (car content-type) | ||
| 65 | "text/html")) | ||
| 66 | "utf8")))) | ||
| 67 | (data-buffer (current-buffer))) | ||
| 68 | (unwind-protect | ||
| 69 | (progn | ||
| 70 | (cond | ||
| 71 | ((equal (car content-type) "text/html") | ||
| 72 | (eww-display-html charset url)) | ||
| 73 | ((string-match "^image/" (car content-type)) | ||
| 74 | (eww-display-image)) | ||
| 75 | (t | ||
| 76 | (eww-display-raw charset))) | ||
| 77 | (when point | ||
| 78 | (goto-char point))) | ||
| 79 | (kill-buffer data-buffer)))) | ||
| 80 | |||
| 81 | (defun eww-parse-headers () | ||
| 82 | (let ((headers nil)) | ||
| 83 | (goto-char (point-min)) | ||
| 84 | (while (and (not (eobp)) | ||
| 85 | (not (eolp))) | ||
| 86 | (when (looking-at "\\([^:]+\\): *\\(.*\\)") | ||
| 87 | (push (cons (downcase (match-string 1)) | ||
| 88 | (match-string 2)) | ||
| 89 | headers)) | ||
| 90 | (forward-line 1)) | ||
| 91 | (unless (eobp) | ||
| 92 | (forward-line 1)) | ||
| 93 | headers)) | ||
| 94 | |||
| 95 | (defun eww-display-html (charset url) | ||
| 96 | (unless (eq charset 'utf8) | ||
| 97 | (decode-coding-region (point) (point-max) charset)) | ||
| 98 | (let ((document | ||
| 99 | (list | ||
| 100 | 'base (list (cons 'href url)) | ||
| 101 | (libxml-parse-html-region (point) (point-max))))) | ||
| 102 | (eww-setup-buffer) | ||
| 103 | (setq eww-current-url url) | ||
| 104 | (let ((inhibit-read-only t) | ||
| 105 | (shr-external-rendering-functions | ||
| 106 | '((form . eww-tag-form) | ||
| 107 | (input . eww-tag-input) | ||
| 108 | (select . eww-tag-select)))) | ||
| 109 | (shr-insert-document document) | ||
| 110 | (eww-convert-widgets)) | ||
| 111 | (goto-char (point-min)))) | ||
| 112 | |||
| 113 | (defun eww-display-raw (charset) | ||
| 114 | (let ((data (buffer-substring (point) (point-max)))) | ||
| 115 | (eww-setup-buffer) | ||
| 116 | (let ((inhibit-read-only t)) | ||
| 117 | (insert data)) | ||
| 118 | (goto-char (point-min)))) | ||
| 119 | |||
| 120 | (defun eww-display-image () | ||
| 121 | (let ((data (buffer-substring (point) (point-max)))) | ||
| 122 | (eww-setup-buffer) | ||
| 123 | (let ((inhibit-read-only t)) | ||
| 124 | (shr-put-image data nil)) | ||
| 125 | (goto-char (point-min)))) | ||
| 126 | |||
| 127 | (defun eww-setup-buffer () | ||
| 128 | (pop-to-buffer (get-buffer-create "*eww*")) | ||
| 129 | (remove-overlays) | ||
| 130 | (setq widget-field-list nil) | ||
| 131 | (let ((inhibit-read-only t)) | ||
| 132 | (erase-buffer)) | ||
| 133 | (eww-mode)) | ||
| 134 | |||
| 135 | (defvar eww-mode-map | ||
| 136 | (let ((map (make-sparse-keymap))) | ||
| 137 | (suppress-keymap map) | ||
| 138 | (define-key map "q" 'eww-quit) | ||
| 139 | (define-key map "g" 'eww-reload) | ||
| 140 | (define-key map [tab] 'widget-forward) | ||
| 141 | (define-key map [backtab] 'widget-backward) | ||
| 142 | (define-key map [delete] 'scroll-down-command) | ||
| 143 | (define-key map "\177" 'scroll-down-command) | ||
| 144 | (define-key map " " 'scroll-up-command) | ||
| 145 | (define-key map "p" 'eww-previous-url) | ||
| 146 | ;;(define-key map "n" 'eww-next-url) | ||
| 147 | map)) | ||
| 148 | |||
| 149 | (define-derived-mode eww-mode nil "eww" | ||
| 150 | "Mode for browsing the web. | ||
| 151 | |||
| 152 | \\{eww-mode-map}" | ||
| 153 | (set (make-local-variable 'eww-current-url) 'author) | ||
| 154 | (set (make-local-variable 'browse-url-browser-function) 'eww-browse-url)) | ||
| 155 | |||
| 156 | (defun eww-browse-url (url &optional new-window) | ||
| 157 | (let ((url-request-extra-headers | ||
| 158 | (append '(("User-Agent" . "eww/1.0")) | ||
| 159 | url-request-extra-headers))) | ||
| 160 | (push (list eww-current-url (point)) | ||
| 161 | eww-history) | ||
| 162 | (eww url))) | ||
| 163 | |||
| 164 | (defun eww-quit () | ||
| 165 | "Exit the Emacs Web Wowser." | ||
| 166 | (interactive) | ||
| 167 | (setq eww-history nil) | ||
| 168 | (kill-buffer (current-buffer))) | ||
| 169 | |||
| 170 | (defun eww-previous-url () | ||
| 171 | "Go to the previously displayed page." | ||
| 172 | (interactive) | ||
| 173 | (when (zerop (length eww-history)) | ||
| 174 | (error "No previous page")) | ||
| 175 | (let ((prev (pop eww-history))) | ||
| 176 | (url-retrieve (car prev) 'eww-render (list (car prev) (cadr prev))))) | ||
| 177 | |||
| 178 | (defun eww-reload () | ||
| 179 | "Reload the current page." | ||
| 180 | (interactive) | ||
| 181 | (url-retrieve eww-current-url 'eww-render | ||
| 182 | (list eww-current-url (point)))) | ||
| 183 | |||
| 184 | ;; Form support. | ||
| 185 | |||
| 186 | (defvar eww-form nil) | ||
| 187 | |||
| 188 | (defun eww-tag-form (cont) | ||
| 189 | (let ((eww-form | ||
| 190 | (list (assq :method cont) | ||
| 191 | (assq :action cont))) | ||
| 192 | (start (point))) | ||
| 193 | (shr-ensure-paragraph) | ||
| 194 | (shr-generic cont) | ||
| 195 | (shr-ensure-paragraph) | ||
| 196 | (when (> (point) start) | ||
| 197 | (put-text-property start (1+ start) | ||
| 198 | 'eww-form eww-form)))) | ||
| 199 | |||
| 200 | (defun eww-tag-input (cont) | ||
| 201 | (let* ((start (point)) | ||
| 202 | (type (downcase (or (cdr (assq :type cont)) | ||
| 203 | "text"))) | ||
| 204 | (widget | ||
| 205 | (cond | ||
| 206 | ((equal type "submit") | ||
| 207 | (list | ||
| 208 | 'push-button | ||
| 209 | :notify 'eww-submit | ||
| 210 | :name (cdr (assq :name cont)) | ||
| 211 | :eww-form eww-form | ||
| 212 | (or (cdr (assq :value cont)) "Submit"))) | ||
| 213 | ((or (equal type "radio") | ||
| 214 | (equal type "checkbox")) | ||
| 215 | (list 'checkbox | ||
| 216 | :notify 'eww-click-radio | ||
| 217 | :name (cdr (assq :name cont)) | ||
| 218 | :checkbox-value (cdr (assq :value cont)) | ||
| 219 | :checkbox-type type | ||
| 220 | :eww-form eww-form | ||
| 221 | (cdr (assq :checked cont)))) | ||
| 222 | ((equal type "hidden") | ||
| 223 | (list 'hidden | ||
| 224 | :name (cdr (assq :name cont)) | ||
| 225 | :value (cdr (assq :value cont)))) | ||
| 226 | (t | ||
| 227 | (list | ||
| 228 | 'editable-field | ||
| 229 | :size (string-to-number | ||
| 230 | (or (cdr (assq :size cont)) | ||
| 231 | "40")) | ||
| 232 | :value (or (cdr (assq :value cont)) "") | ||
| 233 | :secret (and (equal type "password") ?*) | ||
| 234 | :action 'eww-submit | ||
| 235 | :name (cdr (assq :name cont)) | ||
| 236 | :eww-form eww-form))))) | ||
| 237 | (if (eq (car widget) 'hidden) | ||
| 238 | (when shr-final-table-render | ||
| 239 | (nconc eww-form (list widget))) | ||
| 240 | (apply 'widget-create widget)) | ||
| 241 | (put-text-property start (point) 'eww-widget widget) | ||
| 242 | (insert " "))) | ||
| 243 | |||
| 244 | (defun eww-tag-select (cont) | ||
| 245 | (shr-ensure-paragraph) | ||
| 246 | (let ((menu (list 'menu-choice | ||
| 247 | :name (cdr (assq :name cont)) | ||
| 248 | :eww-form eww-form)) | ||
| 249 | (options nil) | ||
| 250 | (start (point))) | ||
| 251 | (dolist (elem cont) | ||
| 252 | (when (eq (car elem) 'option) | ||
| 253 | (when (cdr (assq :selected (cdr elem))) | ||
| 254 | (nconc menu (list :value | ||
| 255 | (cdr (assq :value (cdr elem)))))) | ||
| 256 | (push (list 'item | ||
| 257 | :value (cdr (assq :value (cdr elem))) | ||
| 258 | :tag (cdr (assq 'text (cdr elem)))) | ||
| 259 | options))) | ||
| 260 | ;; If we have no selected values, default to the first value. | ||
| 261 | (unless (plist-get (cdr menu) :value) | ||
| 262 | (nconc menu (list :value (nth 2 (car options))))) | ||
| 263 | (nconc menu options) | ||
| 264 | (apply 'widget-create menu) | ||
| 265 | (put-text-property start (point) 'eww-widget menu) | ||
| 266 | (shr-ensure-paragraph))) | ||
| 267 | |||
| 268 | (defun eww-click-radio (widget &rest ignore) | ||
| 269 | (let ((form (plist-get (cdr widget) :eww-form)) | ||
| 270 | (name (plist-get (cdr widget) :name))) | ||
| 271 | (when (equal (plist-get (cdr widget) :type) "radio") | ||
| 272 | (if (widget-value widget) | ||
| 273 | ;; Switch all the other radio buttons off. | ||
| 274 | (dolist (overlay (overlays-in (point-min) (point-max))) | ||
| 275 | (let ((field (plist-get (overlay-properties overlay) 'button))) | ||
| 276 | (when (and (eq (plist-get (cdr field) :eww-form) form) | ||
| 277 | (equal name (plist-get (cdr field) :name))) | ||
| 278 | (unless (eq field widget) | ||
| 279 | (widget-value-set field nil))))) | ||
| 280 | (widget-value-set widget t))) | ||
| 281 | (eww-fix-widget-keymap))) | ||
| 282 | |||
| 283 | (defun eww-submit (widget &rest ignore) | ||
| 284 | (let ((form (plist-get (cdr widget) :eww-form)) | ||
| 285 | (first-button t) | ||
| 286 | values) | ||
| 287 | (dolist (overlay (sort (overlays-in (point-min) (point-max)) | ||
| 288 | (lambda (o1 o2) | ||
| 289 | (< (overlay-start o1) (overlay-start o2))))) | ||
| 290 | (let ((field (or (plist-get (overlay-properties overlay) 'field) | ||
| 291 | (plist-get (overlay-properties overlay) 'button) | ||
| 292 | (plist-get (overlay-properties overlay) 'eww-hidden)))) | ||
| 293 | (when (eq (plist-get (cdr field) :eww-form) form) | ||
| 294 | (let ((name (plist-get (cdr field) :name))) | ||
| 295 | (when name | ||
| 296 | (cond | ||
| 297 | ((eq (car field) 'checkbox) | ||
| 298 | (when (widget-value field) | ||
| 299 | (push (cons name (plist-get (cdr field) :checkbox-value)) | ||
| 300 | values))) | ||
| 301 | ((eq (car field) 'eww-hidden) | ||
| 302 | (push (cons name (plist-get (cdr field) :value)) | ||
| 303 | values)) | ||
| 304 | ((eq (car field) 'push-button) | ||
| 305 | ;; We want the values from buttons if we hit a button, | ||
| 306 | ;; or we're submitting something and this is the first | ||
| 307 | ;; button displayed. | ||
| 308 | (when (or (and (eq (car widget) 'push-button) | ||
| 309 | (eq widget field)) | ||
| 310 | (and (not (eq (car widget) 'push-button)) | ||
| 311 | (eq (car field) 'push-button) | ||
| 312 | first-button)) | ||
| 313 | (setq first-button nil) | ||
| 314 | (push (cons name (widget-value field)) | ||
| 315 | values))) | ||
| 316 | (t | ||
| 317 | (push (cons name (widget-value field)) | ||
| 318 | values)))))))) | ||
| 319 | (dolist (elem form) | ||
| 320 | (when (and (consp elem) | ||
| 321 | (eq (car elem) 'hidden)) | ||
| 322 | (push (cons (plist-get (cdr elem) :name) | ||
| 323 | (plist-get (cdr elem) :value)) | ||
| 324 | values))) | ||
| 325 | (let ((shr-base eww-current-url)) | ||
| 326 | (if (and (stringp (cdr (assq :method form))) | ||
| 327 | (equal (downcase (cdr (assq :method form))) "post")) | ||
| 328 | (let ((url-request-method "POST") | ||
| 329 | (url-request-extra-headers | ||
| 330 | '(("Content-Type" . "application/x-www-form-urlencoded"))) | ||
| 331 | (url-request-data (mm-url-encode-www-form-urlencoded values))) | ||
| 332 | (eww-browse-url (shr-expand-url (cdr (assq :action form))))) | ||
| 333 | (eww-browse-url | ||
| 334 | (shr-expand-url | ||
| 335 | (concat | ||
| 336 | (cdr (assq :action form)) | ||
| 337 | "?" | ||
| 338 | (mm-url-encode-www-form-urlencoded values)))))))) | ||
| 339 | |||
| 340 | (defun eww-convert-widgets () | ||
| 341 | (let ((start (point-min)) | ||
| 342 | widget) | ||
| 343 | ;; Some widgets come from different buffers (rendered for tables), | ||
| 344 | ;; so we need to nix out the list of widgets and recreate them. | ||
| 345 | (setq widget-field-list nil | ||
| 346 | widget-field-new nil) | ||
| 347 | (while (setq start (next-single-property-change start 'eww-widget)) | ||
| 348 | (setq widget (get-text-property start 'eww-widget)) | ||
| 349 | (goto-char start) | ||
| 350 | (let ((end (next-single-property-change start 'eww-widget))) | ||
| 351 | (dolist (overlay (overlays-in start end)) | ||
| 352 | (when (or (plist-get (overlay-properties overlay) 'button) | ||
| 353 | (plist-get (overlay-properties overlay) 'field)) | ||
| 354 | (delete-overlay overlay))) | ||
| 355 | (delete-region start end)) | ||
| 356 | (apply 'widget-create widget)) | ||
| 357 | (widget-setup) | ||
| 358 | (eww-fix-widget-keymap))) | ||
| 359 | |||
| 360 | (defun eww-fix-widget-keymap () | ||
| 361 | (dolist (overlay (overlays-in (point-min) (point-max))) | ||
| 362 | (when (plist-get (overlay-properties overlay) 'button) | ||
| 363 | (overlay-put overlay 'local-map widget-keymap)))) | ||
| 364 | |||
| 365 | (provide 'eww) | ||
| 366 | |||
| 367 | ;;; eww.el ends here | ||
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 23603bc7722..65f4b76ad19 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -3430,15 +3430,13 @@ possible values." | |||
| 3430 | (visible-date (mail-fetch-field "Date")) | 3430 | (visible-date (mail-fetch-field "Date")) |
| 3431 | pos date bface eface) | 3431 | pos date bface eface) |
| 3432 | (save-excursion | 3432 | (save-excursion |
| 3433 | (goto-char (point-min)) | ||
| 3434 | (when (re-search-forward "^Date:" nil t) | ||
| 3435 | (setq bface (get-text-property (point-at-bol) 'face) | ||
| 3436 | eface (get-text-property (1- (point-at-eol)) 'face))) | ||
| 3437 | ;; Delete any old Date headers. | ||
| 3438 | (if date-position | 3433 | (if date-position |
| 3439 | (progn | 3434 | (progn |
| 3440 | (goto-char date-position) | 3435 | (goto-char date-position) |
| 3441 | (setq date (get-text-property (point) 'original-date)) | 3436 | (setq date (get-text-property (point) 'original-date)) |
| 3437 | (when (looking-at "[^:]+:[\t ]*") | ||
| 3438 | (setq bface (get-text-property (match-beginning 0) 'face) | ||
| 3439 | eface (get-text-property (match-end 0) 'face))) | ||
| 3442 | (delete-region (point) | 3440 | (delete-region (point) |
| 3443 | (progn | 3441 | (progn |
| 3444 | (gnus-article-forward-header) | 3442 | (gnus-article-forward-header) |
| @@ -3454,12 +3452,26 @@ possible values." | |||
| 3454 | (narrow-to-region pos (if (search-forward "\n\n" nil t) | 3452 | (narrow-to-region pos (if (search-forward "\n\n" nil t) |
| 3455 | (1+ (match-beginning 0)) | 3453 | (1+ (match-beginning 0)) |
| 3456 | (point-max))) | 3454 | (point-max))) |
| 3457 | (goto-char (point-min)) | 3455 | (while (setq pos (text-property-not-all pos (point-max) |
| 3458 | (while (re-search-forward "^Date:" nil t) | 3456 | 'gnus-date-type nil)) |
| 3459 | (setq date (get-text-property (match-beginning 0) 'original-date)) | 3457 | (setq date (get-text-property pos 'original-date)) |
| 3460 | (delete-region (point-at-bol) (progn | 3458 | (goto-char pos) |
| 3461 | (gnus-article-forward-header) | 3459 | (when (looking-at "[^:]+:[\t ]*") |
| 3462 | (point)))) | 3460 | (setq bface (get-text-property (match-beginning 0) 'face) |
| 3461 | eface (get-text-property (match-end 0) 'face))) | ||
| 3462 | (delete-region pos (or (text-property-any pos (point-max) | ||
| 3463 | 'gnus-date-type nil) | ||
| 3464 | (point-max)))) | ||
| 3465 | (unless date ;; the 1st time | ||
| 3466 | (goto-char (point-min)) | ||
| 3467 | (while (re-search-forward "^Date:[\t ]*" nil t) | ||
| 3468 | (setq date (get-text-property (match-beginning 0) | ||
| 3469 | 'original-date) | ||
| 3470 | bface (get-text-property (match-beginning 0) 'face) | ||
| 3471 | eface (get-text-property (match-end 0) 'face)) | ||
| 3472 | (delete-region (point-at-bol) (progn | ||
| 3473 | (gnus-article-forward-header) | ||
| 3474 | (point))))) | ||
| 3463 | (when (and (not date) | 3475 | (when (and (not date) |
| 3464 | visible-date) | 3476 | visible-date) |
| 3465 | (setq date visible-date)) | 3477 | (setq date visible-date)) |
| @@ -3476,20 +3488,25 @@ possible values." | |||
| 3476 | (list type)) | 3488 | (list type)) |
| 3477 | (t | 3489 | (t |
| 3478 | type))) | 3490 | type))) |
| 3479 | (insert (article-make-date-line date (or this-type 'ut)) "\n") | 3491 | (goto-char |
| 3480 | (forward-line -1) | 3492 | (prog1 |
| 3481 | (beginning-of-line) | 3493 | (point) |
| 3482 | (put-text-property (point) (1+ (point)) | 3494 | (add-text-properties |
| 3483 | 'original-date date) | 3495 | (point) |
| 3484 | (put-text-property (point) (1+ (point)) | 3496 | (progn |
| 3485 | 'gnus-date-type this-type) | 3497 | (insert (article-make-date-line date (or this-type 'ut)) "\n") |
| 3498 | (point)) | ||
| 3499 | (list 'original-date date 'gnus-date-type this-type)))) | ||
| 3486 | ;; Do highlighting. | 3500 | ;; Do highlighting. |
| 3487 | (when (looking-at "\\([^:]+\\): *\\(.*\\)$") | 3501 | (when (looking-at |
| 3488 | (put-text-property (match-beginning 1) (1+ (match-end 1)) | 3502 | "\\([^:]+:\\)[\t ]*\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?") |
| 3489 | 'face bface) | 3503 | (put-text-property (match-beginning 1) (match-end 1) 'face bface) |
| 3490 | (put-text-property (match-beginning 2) (match-end 2) | 3504 | (when (match-beginning 2) |
| 3491 | 'face eface)) | 3505 | (put-text-property (match-beginning 2) (match-end 2) 'face eface)) |
| 3492 | (forward-line 1))) | 3506 | (while (and (zerop (forward-line 1)) |
| 3507 | (looking-at "[\t ]+\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?")) | ||
| 3508 | (when (match-beginning 1) | ||
| 3509 | (put-text-property (match-beginning 1) (match-end 1) 'face eface)))))) | ||
| 3493 | 3510 | ||
| 3494 | (defun article-make-date-line (date type) | 3511 | (defun article-make-date-line (date type) |
| 3495 | "Return a DATE line of TYPE." | 3512 | "Return a DATE line of TYPE." |
| @@ -3669,25 +3686,26 @@ function and want to see what the date was before converting." | |||
| 3669 | (when (eq major-mode 'gnus-article-mode) | 3686 | (when (eq major-mode 'gnus-article-mode) |
| 3670 | (let ((old-line (count-lines (point-min) (point))) | 3687 | (let ((old-line (count-lines (point-min) (point))) |
| 3671 | (old-column (- (point) (line-beginning-position))) | 3688 | (old-column (- (point) (line-beginning-position))) |
| 3672 | (window-start | 3689 | (window-start (window-start w)) |
| 3673 | (window-start (get-buffer-window (current-buffer))))) | 3690 | (pos (point-min)) |
| 3674 | (goto-char (point-min)) | 3691 | type next end) |
| 3675 | (while (re-search-forward "^Date:" nil t) | 3692 | (while (setq pos (text-property-not-all pos (point-max) |
| 3676 | (let ((type (get-text-property (match-beginning 0) | 3693 | 'gnus-date-type nil)) |
| 3677 | 'gnus-date-type))) | 3694 | (setq next (or (next-single-property-change pos |
| 3678 | (when (memq type '(lapsed combined-lapsed user-format)) | 3695 | 'gnus-date-type) |
| 3679 | (when (and window-start | 3696 | (point-max))) |
| 3680 | (not (= window-start | 3697 | (setq type (get-text-property pos 'gnus-date-type)) |
| 3681 | (save-excursion | 3698 | (when (memq type '(lapsed combined-lapsed user-defined)) |
| 3682 | (forward-line 1) | 3699 | (article-date-ut type t pos) |
| 3683 | (point))))) | 3700 | (setq end (or (next-single-property-change pos |
| 3684 | (setq window-start nil)) | 3701 | 'gnus-date-type) |
| 3685 | (save-excursion | 3702 | (point-max))) |
| 3686 | (article-date-ut type t (match-beginning 0))) | 3703 | (when window-start |
| 3687 | (forward-line 1) | 3704 | (if (/= window-start next) |
| 3688 | (when window-start | 3705 | (setq window-start nil) |
| 3689 | (set-window-start (get-buffer-window (current-buffer)) | 3706 | (set-window-start w end))) |
| 3690 | (point)))))) | 3707 | (setq next end)) |
| 3708 | (setq pos next)) | ||
| 3691 | (goto-char (point-min)) | 3709 | (goto-char (point-min)) |
| 3692 | (when (> old-column 0) | 3710 | (when (> old-column 0) |
| 3693 | (setq old-line (1- old-line))) | 3711 | (setq old-line (1- old-line))) |
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el index 4d9b5798247..f9ef70f9580 100644 --- a/lisp/gnus/gnus-ems.el +++ b/lisp/gnus/gnus-ems.el | |||
| @@ -165,10 +165,10 @@ | |||
| 165 | 165 | ||
| 166 | (defun gnus-image-type-available-p (type) | 166 | (defun gnus-image-type-available-p (type) |
| 167 | (and (fboundp 'image-type-available-p) | 167 | (and (fboundp 'image-type-available-p) |
| 168 | (image-type-available-p type) | ||
| 169 | (if (fboundp 'display-images-p) | 168 | (if (fboundp 'display-images-p) |
| 170 | (display-images-p) | 169 | (display-images-p) |
| 171 | t))) | 170 | t) |
| 171 | (image-type-available-p type))) | ||
| 172 | 172 | ||
| 173 | (defun gnus-create-image (file &optional type data-p &rest props) | 173 | (defun gnus-create-image (file &optional type data-p &rest props) |
| 174 | (let ((face (plist-get props :face))) | 174 | (let ((face (plist-get props :face))) |
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index ac6170a3cdf..b1cba27c335 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el | |||
| @@ -660,14 +660,26 @@ If MODE is not set, try to find mode automatically." | |||
| 660 | ;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) | 660 | ;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) |
| 661 | ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 } | 661 | ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 } |
| 662 | (defvar mm-pkcs7-signed-magic | 662 | (defvar mm-pkcs7-signed-magic |
| 663 | "\x30\x5c\x28\x80\x5c\x7c\x81\x2e\x5c\x7c\x82\x2e\x2e\x5c\x7c\x83\x2e\x2e\ | 663 | (concat |
| 664 | \x2e\x5c\x29\x06\x09\x5c\x2a\x86\x48\x86\xf7\x0d\x01\x07\x02") | 664 | "0" |
| 665 | "\\(\\(\x80\\)" | ||
| 666 | "\\|\\(\x81\\(.\\|\n\\)\\{1\\}\\)" | ||
| 667 | "\\|\\(\x82\\(.\\|\n\\)\\{2\\}\\)" | ||
| 668 | "\\|\\(\x83\\(.\\|\n\\)\\{3\\}\\)" | ||
| 669 | "\\)" | ||
| 670 | "\x06\x09\\*\x86H\x86\xf7\x0d\x01\x07\x02")) | ||
| 665 | 671 | ||
| 666 | ;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) | 672 | ;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) |
| 667 | ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 } | 673 | ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 } |
| 668 | (defvar mm-pkcs7-enveloped-magic | 674 | (defvar mm-pkcs7-enveloped-magic |
| 669 | "\x30\x5c\x28\x80\x5c\x7c\x81\x2e\x5c\x7c\x82\x2e\x2e\x5c\x7c\x83\x2e\x2e\ | 675 | (concat |
| 670 | \x2e\x5c\x29\x06\x09\x5c\x2a\x86\x48\x86\xf7\x0d\x01\x07\x03") | 676 | "0" |
| 677 | "\\(\\(\x80\\)" | ||
| 678 | "\\|\\(\x81\\(.\\|\n\\)\\{1\\}\\)" | ||
| 679 | "\\|\\(\x82\\(.\\|\n\\)\\{2\\}\\)" | ||
| 680 | "\\|\\(\x83\\(.\\|\n\\)\\{3\\}\\)" | ||
| 681 | "\\)" | ||
| 682 | "\x06\x09\\*\x86H\x86\xf7\x0d\x01\x07\x03")) | ||
| 671 | 683 | ||
| 672 | (defun mm-view-pkcs7-get-type (handle) | 684 | (defun mm-view-pkcs7-get-type (handle) |
| 673 | (mm-with-unibyte-buffer | 685 | (mm-with-unibyte-buffer |
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 9284da4c4b3..8cb16634e2b 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el | |||
| @@ -114,6 +114,8 @@ cid: URL as the argument.") | |||
| 114 | (defvar shr-stylesheet nil) | 114 | (defvar shr-stylesheet nil) |
| 115 | (defvar shr-base nil) | 115 | (defvar shr-base nil) |
| 116 | (defvar shr-ignore-cache nil) | 116 | (defvar shr-ignore-cache nil) |
| 117 | (defvar shr-external-rendering-functions nil) | ||
| 118 | (defvar shr-final-table-render nil) | ||
| 117 | 119 | ||
| 118 | (defvar shr-map | 120 | (defvar shr-map |
| 119 | (let ((map (make-sparse-keymap))) | 121 | (let ((map (make-sparse-keymap))) |
| @@ -291,7 +293,12 @@ size, and full-buffer size." | |||
| 291 | (nreverse result))) | 293 | (nreverse result))) |
| 292 | 294 | ||
| 293 | (defun shr-descend (dom) | 295 | (defun shr-descend (dom) |
| 294 | (let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) obarray)) | 296 | (let ((function |
| 297 | (or | ||
| 298 | ;; Allow other packages to override (or provide) rendering | ||
| 299 | ;; of elements. | ||
| 300 | (cdr (assq (car dom) shr-external-rendering-functions)) | ||
| 301 | (intern (concat "shr-tag-" (symbol-name (car dom))) obarray))) | ||
| 295 | (style (cdr (assq :style (cdr dom)))) | 302 | (style (cdr (assq :style (cdr dom)))) |
| 296 | (shr-stylesheet shr-stylesheet) | 303 | (shr-stylesheet shr-stylesheet) |
| 297 | (start (point))) | 304 | (start (point))) |
| @@ -478,20 +485,30 @@ size, and full-buffer size." | |||
| 478 | (not failed))) | 485 | (not failed))) |
| 479 | 486 | ||
| 480 | (defun shr-expand-url (url) | 487 | (defun shr-expand-url (url) |
| 481 | (cond | 488 | (if (or (not url) |
| 482 | ;; Absolute URL. | 489 | (string-match "\\`[a-z]*:" url) |
| 483 | ((or (not url) | 490 | (not shr-base)) |
| 484 | (string-match "\\`[a-z]*:" url) | 491 | ;; Absolute URL. |
| 485 | (not shr-base)) | 492 | url |
| 486 | url) | 493 | (let ((base shr-base)) |
| 487 | ((and (string-match "\\`//" url) | 494 | ;; Chop off query string. |
| 488 | (string-match "\\`[a-z]*:" shr-base)) | 495 | (when (string-match "\\`\\([^?]+\\)[?]" base) |
| 489 | (concat (match-string 0 shr-base) url)) | 496 | (setq base (match-string 1 base))) |
| 490 | ((and (not (string-match "/\\'" shr-base)) | 497 | ;; Chop off the bit after the last slash. |
| 491 | (not (string-match "\\`/" url))) | 498 | (when (string-match "\\`\\(.*\\)[/][^/]+" base) |
| 492 | (concat shr-base "/" url)) | 499 | (setq base (match-string 1 base))) |
| 493 | (t | 500 | (cond |
| 494 | (concat shr-base url)))) | 501 | ((and (string-match "\\`//" url) |
| 502 | (string-match "\\`[a-z]*:" base)) | ||
| 503 | (concat (match-string 0 base) url)) | ||
| 504 | ((and (not (string-match "/\\'" base)) | ||
| 505 | (not (string-match "\\`/" url))) | ||
| 506 | (concat base "/" url)) | ||
| 507 | ((and (string-match "\\`/" url) | ||
| 508 | (string-match "\\(\\`[^:]*://[^/]+\\)/" base)) | ||
| 509 | (concat (match-string 1 base) url)) | ||
| 510 | (t | ||
| 511 | (concat base url)))))) | ||
| 495 | 512 | ||
| 496 | (defun shr-ensure-newline () | 513 | (defun shr-ensure-newline () |
| 497 | (unless (zerop (current-column)) | 514 | (unless (zerop (current-column)) |
| @@ -877,6 +894,9 @@ ones, in case fg and bg are nil." | |||
| 877 | (defun shr-tag-comment (cont) | 894 | (defun shr-tag-comment (cont) |
| 878 | ) | 895 | ) |
| 879 | 896 | ||
| 897 | (defun shr-tag-svg (cont) | ||
| 898 | ) | ||
| 899 | |||
| 880 | (defun shr-tag-sup (cont) | 900 | (defun shr-tag-sup (cont) |
| 881 | (let ((start (point))) | 901 | (let ((start (point))) |
| 882 | (shr-generic cont) | 902 | (shr-generic cont) |
| @@ -945,7 +965,8 @@ ones, in case fg and bg are nil." | |||
| 945 | plist))) | 965 | plist))) |
| 946 | 966 | ||
| 947 | (defun shr-tag-base (cont) | 967 | (defun shr-tag-base (cont) |
| 948 | (setq shr-base (cdr (assq :href cont)))) | 968 | (setq shr-base (cdr (assq :href cont))) |
| 969 | (shr-generic cont)) | ||
| 949 | 970 | ||
| 950 | (defun shr-tag-a (cont) | 971 | (defun shr-tag-a (cont) |
| 951 | (let ((url (cdr (assq :href cont))) | 972 | (let ((url (cdr (assq :href cont))) |
| @@ -1167,7 +1188,8 @@ ones, in case fg and bg are nil." | |||
| 1167 | (frame-width)) | 1188 | (frame-width)) |
| 1168 | (setq truncate-lines t)) | 1189 | (setq truncate-lines t)) |
| 1169 | ;; Then render the table again with these new "hard" widths. | 1190 | ;; Then render the table again with these new "hard" widths. |
| 1170 | (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)) | 1191 | (let ((shr-final-table-render t)) |
| 1192 | (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths))) | ||
| 1171 | ;; Finally, insert all the images after the table. The Emacs buffer | 1193 | ;; Finally, insert all the images after the table. The Emacs buffer |
| 1172 | ;; model isn't strong enough to allow us to put the images actually | 1194 | ;; model isn't strong enough to allow us to put the images actually |
| 1173 | ;; into the tables. | 1195 | ;; into the tables. |
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index b96261764e5..23ab24152d9 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el | |||
| @@ -3,6 +3,7 @@ | |||
| 3 | ;; Copyright (C) 2001-2013 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001-2013 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Simon Josefsson <simon@josefsson.org> | 5 | ;; Author: Simon Josefsson <simon@josefsson.org> |
| 6 | ;; Albert Krewinkel <tarleb@moltkeplatz.de> | ||
| 6 | 7 | ||
| 7 | ;; This file is part of GNU Emacs. | 8 | ;; This file is part of GNU Emacs. |
| 8 | 9 | ||
| @@ -66,6 +67,7 @@ | |||
| 66 | ;; 2001-10-31 Committed to Oort Gnus. | 67 | ;; 2001-10-31 Committed to Oort Gnus. |
| 67 | ;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd. | 68 | ;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd. |
| 68 | ;; 2002-08-03 Use SASL library. | 69 | ;; 2002-08-03 Use SASL library. |
| 70 | ;; 2013-06-05 Enabled STARTTLS support, fixed bit rot. | ||
| 69 | 71 | ||
| 70 | ;;; Code: | 72 | ;;; Code: |
| 71 | 73 | ||
| @@ -82,7 +84,6 @@ | |||
| 82 | (require 'sasl) | 84 | (require 'sasl) |
| 83 | (require 'starttls)) | 85 | (require 'starttls)) |
| 84 | (autoload 'sasl-find-mechanism "sasl") | 86 | (autoload 'sasl-find-mechanism "sasl") |
| 85 | (autoload 'starttls-open-stream "starttls") | ||
| 86 | (autoload 'auth-source-search "auth-source") | 87 | (autoload 'auth-source-search "auth-source") |
| 87 | 88 | ||
| 88 | ;; User customizable variables: | 89 | ;; User customizable variables: |
| @@ -107,23 +108,6 @@ | |||
| 107 | :type 'string | 108 | :type 'string |
| 108 | :group 'sieve-manage) | 109 | :group 'sieve-manage) |
| 109 | 110 | ||
| 110 | (defcustom sieve-manage-streams '(network starttls shell) | ||
| 111 | "Priority of streams to consider when opening connection to server." | ||
| 112 | :group 'sieve-manage) | ||
| 113 | |||
| 114 | (defcustom sieve-manage-stream-alist | ||
| 115 | '((network sieve-manage-network-p sieve-manage-network-open) | ||
| 116 | (shell sieve-manage-shell-p sieve-manage-shell-open) | ||
| 117 | (starttls sieve-manage-starttls-p sieve-manage-starttls-open)) | ||
| 118 | "Definition of network streams. | ||
| 119 | |||
| 120 | \(NAME CHECK OPEN) | ||
| 121 | |||
| 122 | NAME names the stream, CHECK is a function returning non-nil if the | ||
| 123 | server support the stream and OPEN is a function for opening the | ||
| 124 | stream." | ||
| 125 | :group 'sieve-manage) | ||
| 126 | |||
| 127 | (defcustom sieve-manage-authenticators '(digest-md5 | 111 | (defcustom sieve-manage-authenticators '(digest-md5 |
| 128 | cram-md5 | 112 | cram-md5 |
| 129 | scram-md5 | 113 | scram-md5 |
| @@ -156,8 +140,7 @@ for doing the actual authentication." | |||
| 156 | :group 'sieve-manage) | 140 | :group 'sieve-manage) |
| 157 | 141 | ||
| 158 | (defcustom sieve-manage-default-stream 'network | 142 | (defcustom sieve-manage-default-stream 'network |
| 159 | "Default stream type to use for `sieve-manage'. | 143 | "Default stream type to use for `sieve-manage'." |
| 160 | Must be a name of a stream in `sieve-manage-stream-alist'." | ||
| 161 | :version "24.1" | 144 | :version "24.1" |
| 162 | :type 'symbol | 145 | :type 'symbol |
| 163 | :group 'sieve-manage) | 146 | :group 'sieve-manage) |
| @@ -185,17 +168,21 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") | |||
| 185 | (defvar sieve-manage-capability nil) | 168 | (defvar sieve-manage-capability nil) |
| 186 | 169 | ||
| 187 | ;; Internal utility functions | 170 | ;; Internal utility functions |
| 188 | 171 | (defun sieve-manage-make-process-buffer () | |
| 189 | (defmacro sieve-manage-disable-multibyte () | 172 | (with-current-buffer |
| 190 | "Enable multibyte in the current buffer." | 173 | (generate-new-buffer (format " *sieve %s:%s*" |
| 191 | (unless (featurep 'xemacs) | 174 | sieve-manage-server |
| 192 | '(set-buffer-multibyte nil))) | 175 | sieve-manage-port)) |
| 176 | (mapc 'make-local-variable sieve-manage-local-variables) | ||
| 177 | (mm-enable-multibyte) | ||
| 178 | (buffer-disable-undo) | ||
| 179 | (current-buffer))) | ||
| 193 | 180 | ||
| 194 | (defun sieve-manage-erase (&optional p buffer) | 181 | (defun sieve-manage-erase (&optional p buffer) |
| 195 | (let ((buffer (or buffer (current-buffer)))) | 182 | (let ((buffer (or buffer (current-buffer)))) |
| 196 | (and sieve-manage-log | 183 | (and sieve-manage-log |
| 197 | (with-current-buffer (get-buffer-create sieve-manage-log) | 184 | (with-current-buffer (get-buffer-create sieve-manage-log) |
| 198 | (sieve-manage-disable-multibyte) | 185 | (mm-enable-multibyte) |
| 199 | (buffer-disable-undo) | 186 | (buffer-disable-undo) |
| 200 | (goto-char (point-max)) | 187 | (goto-char (point-max)) |
| 201 | (insert-buffer-substring buffer (with-current-buffer buffer | 188 | (insert-buffer-substring buffer (with-current-buffer buffer |
| @@ -204,71 +191,32 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") | |||
| 204 | (point-max))))))) | 191 | (point-max))))))) |
| 205 | (delete-region (point-min) (or p (point-max)))) | 192 | (delete-region (point-min) (or p (point-max)))) |
| 206 | 193 | ||
| 207 | (defun sieve-manage-open-1 (buffer) | 194 | (defun sieve-manage-open-server (server port &optional stream buffer) |
| 195 | "Open network connection to SERVER on PORT. | ||
| 196 | Return the buffer associated with the connection." | ||
| 208 | (with-current-buffer buffer | 197 | (with-current-buffer buffer |
| 209 | (sieve-manage-erase) | 198 | (sieve-manage-erase) |
| 210 | (setq sieve-manage-state 'initial | 199 | (setq sieve-manage-state 'initial) |
| 211 | sieve-manage-process | 200 | (destructuring-bind (proc . props) |
| 212 | (condition-case () | 201 | (open-protocol-stream |
| 213 | (funcall (nth 2 (assq sieve-manage-stream | 202 | "SIEVE" buffer server port |
| 214 | sieve-manage-stream-alist)) | 203 | :type stream |
| 215 | "sieve" buffer sieve-manage-server sieve-manage-port) | 204 | :capability-command "CAPABILITY\r\n" |
| 216 | ((error quit) nil))) | 205 | :end-of-command "^\\(OK\\|NO\\).*\n" |
| 217 | (when sieve-manage-process | 206 | :success "^OK.*\n" |
| 218 | (while (and (eq sieve-manage-state 'initial) | 207 | :return-list t |
| 219 | (memq (process-status sieve-manage-process) '(open run))) | 208 | :starttls-function |
| 220 | (message "Waiting for response from %s..." sieve-manage-server) | 209 | '(lambda (capabilities) |
| 221 | (accept-process-output sieve-manage-process 1)) | 210 | (when (string-match "\\bSTARTTLS\\b" capabilities) |
| 222 | (message "Waiting for response from %s...done" sieve-manage-server) | 211 | "STARTTLS\r\n"))) |
| 223 | (and (memq (process-status sieve-manage-process) '(open run)) | 212 | (setq sieve-manage-process proc) |
| 224 | sieve-manage-process)))) | 213 | (setq sieve-manage-capability |
| 225 | 214 | (sieve-manage-parse-capability (getf props :capabilities))) | |
| 226 | ;; Streams | 215 | ;; Ignore new capabilities issues after successful STARTTLS |
| 227 | 216 | (when (and (memq stream '(nil network starttls)) | |
| 228 | (defun sieve-manage-network-p (buffer) | 217 | (eq (getf props :type) 'tls)) |
| 229 | t) | 218 | (sieve-manage-drop-next-answer)) |
| 230 | 219 | (current-buffer)))) | |
| 231 | (defun sieve-manage-network-open (name buffer server port) | ||
| 232 | (let* ((port (or port sieve-manage-default-port)) | ||
| 233 | (coding-system-for-read sieve-manage-coding-system-for-read) | ||
| 234 | (coding-system-for-write sieve-manage-coding-system-for-write) | ||
| 235 | (process (open-network-stream name buffer server port))) | ||
| 236 | (when process | ||
| 237 | (while (and (memq (process-status process) '(open run)) | ||
| 238 | (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | ||
| 239 | (goto-char (point-min)) | ||
| 240 | (not (sieve-manage-parse-greeting-1))) | ||
| 241 | (accept-process-output process 1) | ||
| 242 | (sit-for 1)) | ||
| 243 | (sieve-manage-erase nil buffer) | ||
| 244 | (when (memq (process-status process) '(open run)) | ||
| 245 | process)))) | ||
| 246 | |||
| 247 | (defun sieve-manage-starttls-p (buffer) | ||
| 248 | (condition-case () | ||
| 249 | (progn | ||
| 250 | (require 'starttls) | ||
| 251 | (call-process "starttls")) | ||
| 252 | (error nil))) | ||
| 253 | |||
| 254 | (defun sieve-manage-starttls-open (name buffer server port) | ||
| 255 | (let* ((port (or port sieve-manage-default-port)) | ||
| 256 | (coding-system-for-read sieve-manage-coding-system-for-read) | ||
| 257 | (coding-system-for-write sieve-manage-coding-system-for-write) | ||
| 258 | (process (starttls-open-stream name buffer server port)) | ||
| 259 | done) | ||
| 260 | (when process | ||
| 261 | (while (and (memq (process-status process) '(open run)) | ||
| 262 | (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | ||
| 263 | (goto-char (point-min)) | ||
| 264 | (not (sieve-manage-parse-greeting-1))) | ||
| 265 | (accept-process-output process 1) | ||
| 266 | (sit-for 1)) | ||
| 267 | (sieve-manage-erase nil buffer) | ||
| 268 | (sieve-manage-send "STARTTLS") | ||
| 269 | (starttls-negotiate process)) | ||
| 270 | (when (memq (process-status process) '(open run)) | ||
| 271 | process))) | ||
| 272 | 220 | ||
| 273 | ;; Authenticators | 221 | ;; Authenticators |
| 274 | (defun sieve-sasl-auth (buffer mech) | 222 | (defun sieve-sasl-auth (buffer mech) |
| @@ -396,63 +344,33 @@ Optional argument AUTH indicates authenticator to use, see | |||
| 396 | If nil, chooses the best stream the server is capable of. | 344 | If nil, chooses the best stream the server is capable of. |
| 397 | Optional argument BUFFER is buffer (buffer, or string naming buffer) | 345 | Optional argument BUFFER is buffer (buffer, or string naming buffer) |
| 398 | to work in." | 346 | to work in." |
| 399 | (or port (setq port sieve-manage-default-port)) | 347 | (setq sieve-manage-port (or port sieve-manage-default-port)) |
| 400 | (setq buffer (or buffer (format " *sieve* %s:%s" server port))) | 348 | (with-current-buffer (or buffer (sieve-manage-make-process-buffer)) |
| 401 | (with-current-buffer (get-buffer-create buffer) | 349 | (setq sieve-manage-server (or server |
| 402 | (mapc 'make-local-variable sieve-manage-local-variables) | 350 | sieve-manage-server) |
| 403 | (sieve-manage-disable-multibyte) | 351 | sieve-manage-stream (or stream |
| 404 | (buffer-disable-undo) | 352 | sieve-manage-stream |
| 405 | (setq sieve-manage-server (or server sieve-manage-server)) | 353 | sieve-manage-default-stream) |
| 406 | (setq sieve-manage-port port) | 354 | sieve-manage-auth (or auth |
| 407 | (setq sieve-manage-stream (or stream sieve-manage-stream)) | 355 | sieve-manage-auth)) |
| 408 | (message "sieve: Connecting to %s..." sieve-manage-server) | 356 | (message "sieve: Connecting to %s..." sieve-manage-server) |
| 409 | (if (let ((sieve-manage-stream | 357 | (sieve-manage-open-server sieve-manage-server |
| 410 | (or sieve-manage-stream sieve-manage-default-stream))) | 358 | sieve-manage-port |
| 411 | (sieve-manage-open-1 buffer)) | 359 | sieve-manage-stream |
| 412 | ;; Choose stream. | 360 | (current-buffer)) |
| 413 | (let (stream-changed) | 361 | (when (sieve-manage-opened (current-buffer)) |
| 414 | (message "sieve: Connecting to %s...done" sieve-manage-server) | 362 | ;; Choose authenticator |
| 415 | (when (null sieve-manage-stream) | 363 | (when (and (null sieve-manage-auth) |
| 416 | (let ((streams sieve-manage-streams)) | 364 | (not (eq sieve-manage-state 'auth))) |
| 417 | (while (setq stream (pop streams)) | 365 | (dolist (auth sieve-manage-authenticators) |
| 418 | (if (funcall (nth 1 (assq stream | 366 | (when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist)) |
| 419 | sieve-manage-stream-alist)) buffer) | 367 | buffer) |
| 420 | (setq stream-changed | 368 | (setq sieve-manage-auth auth) |
| 421 | (not (eq (or sieve-manage-stream | 369 | (return))) |
| 422 | sieve-manage-default-stream) | 370 | (unless sieve-manage-auth |
| 423 | stream)) | 371 | (error "Couldn't figure out authenticator for server"))) |
| 424 | sieve-manage-stream stream | ||
| 425 | streams nil))) | ||
| 426 | (unless sieve-manage-stream | ||
| 427 | (error "Couldn't figure out a stream for server")))) | ||
| 428 | (when stream-changed | ||
| 429 | (message "sieve: Reconnecting with stream `%s'..." | ||
| 430 | sieve-manage-stream) | ||
| 431 | (sieve-manage-close buffer) | ||
| 432 | (if (sieve-manage-open-1 buffer) | ||
| 433 | (message "sieve: Reconnecting with stream `%s'...done" | ||
| 434 | sieve-manage-stream) | ||
| 435 | (message "sieve: Reconnecting with stream `%s'...failed" | ||
| 436 | sieve-manage-stream)) | ||
| 437 | (setq sieve-manage-capability nil)) | ||
| 438 | (if (sieve-manage-opened buffer) | ||
| 439 | ;; Choose authenticator | ||
| 440 | (when (and (null sieve-manage-auth) | ||
| 441 | (not (eq sieve-manage-state 'auth))) | ||
| 442 | (let ((auths sieve-manage-authenticators)) | ||
| 443 | (while (setq auth (pop auths)) | ||
| 444 | (if (funcall (nth 1 (assq | ||
| 445 | auth | ||
| 446 | sieve-manage-authenticator-alist)) | ||
| 447 | buffer) | ||
| 448 | (setq sieve-manage-auth auth | ||
| 449 | auths nil))) | ||
| 450 | (unless sieve-manage-auth | ||
| 451 | (error "Couldn't figure out authenticator for server")))))) | ||
| 452 | (message "sieve: Connecting to %s...failed" sieve-manage-server)) | ||
| 453 | (when (sieve-manage-opened buffer) | ||
| 454 | (sieve-manage-erase) | 372 | (sieve-manage-erase) |
| 455 | buffer))) | 373 | (current-buffer)))) |
| 456 | 374 | ||
| 457 | (defun sieve-manage-authenticate (&optional buffer) | 375 | (defun sieve-manage-authenticate (&optional buffer) |
| 458 | "Authenticate on server in BUFFER. | 376 | "Authenticate on server in BUFFER. |
| @@ -544,12 +462,22 @@ If NAME is nil, return the full server list of capabilities." | |||
| 544 | 462 | ||
| 545 | ;; Protocol parsing routines | 463 | ;; Protocol parsing routines |
| 546 | 464 | ||
| 465 | (defun sieve-manage-wait-for-answer () | ||
| 466 | (let ((pattern "^\\(OK\\|NO\\).*\n") | ||
| 467 | pos) | ||
| 468 | (while (not pos) | ||
| 469 | (setq pos (search-forward-regexp pattern nil t)) | ||
| 470 | (goto-char (point-min)) | ||
| 471 | (sleep-for 0 50)) | ||
| 472 | pos)) | ||
| 473 | |||
| 474 | (defun sieve-manage-drop-next-answer () | ||
| 475 | (sieve-manage-wait-for-answer) | ||
| 476 | (sieve-manage-erase)) | ||
| 477 | |||
| 547 | (defun sieve-manage-ok-p (rsp) | 478 | (defun sieve-manage-ok-p (rsp) |
| 548 | (string= (downcase (or (car-safe rsp) "")) "ok")) | 479 | (string= (downcase (or (car-safe rsp) "")) "ok")) |
| 549 | 480 | ||
| 550 | (defsubst sieve-manage-forward () | ||
| 551 | (or (eobp) (forward-char))) | ||
| 552 | |||
| 553 | (defun sieve-manage-is-okno () | 481 | (defun sieve-manage-is-okno () |
| 554 | (when (looking-at (concat | 482 | (when (looking-at (concat |
| 555 | "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" | 483 | "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" |
| @@ -571,21 +499,15 @@ If NAME is nil, return the full server list of capabilities." | |||
| 571 | (sieve-manage-erase) | 499 | (sieve-manage-erase) |
| 572 | rsp)) | 500 | rsp)) |
| 573 | 501 | ||
| 574 | (defun sieve-manage-parse-capability-1 () | 502 | (defun sieve-manage-parse-capability (str) |
| 575 | "Accept a managesieve greeting." | 503 | "Parse managesieve capability string `STR'. |
| 576 | (let (str) | 504 | Set variable `sieve-manage-capability' to " |
| 577 | (while (setq str (sieve-manage-is-string)) | 505 | (let ((capas (remove-if #'null |
| 578 | (if (eq (char-after) ? ) | 506 | (mapcar #'split-string-and-unquote |
| 579 | (progn | 507 | (split-string str "\n"))))) |
| 580 | (sieve-manage-forward) | 508 | (when (string= "OK" (caar (last capas))) |
| 581 | (push (list str (sieve-manage-is-string)) | 509 | (setq sieve-manage-state 'nonauth)) |
| 582 | sieve-manage-capability)) | 510 | capas)) |
| 583 | (push (list str) sieve-manage-capability)) | ||
| 584 | (forward-line))) | ||
| 585 | (when (re-search-forward (concat "^OK.*" sieve-manage-server-eol) nil t) | ||
| 586 | (setq sieve-manage-state 'nonauth))) | ||
| 587 | |||
| 588 | (defalias 'sieve-manage-parse-greeting-1 'sieve-manage-parse-capability-1) | ||
| 589 | 511 | ||
| 590 | (defun sieve-manage-is-string () | 512 | (defun sieve-manage-is-string () |
| 591 | (cond ((looking-at "\"\\([^\"]+\\)\"") | 513 | (cond ((looking-at "\"\\([^\"]+\\)\"") |
| @@ -639,7 +561,7 @@ If NAME is nil, return the full server list of capabilities." | |||
| 639 | (setq cmdstr (concat cmdstr sieve-manage-client-eol)) | 561 | (setq cmdstr (concat cmdstr sieve-manage-client-eol)) |
| 640 | (and sieve-manage-log | 562 | (and sieve-manage-log |
| 641 | (with-current-buffer (get-buffer-create sieve-manage-log) | 563 | (with-current-buffer (get-buffer-create sieve-manage-log) |
| 642 | (sieve-manage-disable-multibyte) | 564 | (mm-enable-multibyte) |
| 643 | (buffer-disable-undo) | 565 | (buffer-disable-undo) |
| 644 | (goto-char (point-max)) | 566 | (goto-char (point-max)) |
| 645 | (insert cmdstr))) | 567 | (insert cmdstr))) |
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el index 0e46cb66361..2c11c039d56 100644 --- a/lisp/gnus/sieve.el +++ b/lisp/gnus/sieve.el | |||
| @@ -109,7 +109,6 @@ require \"fileinto\"; | |||
| 109 | ;; various | 109 | ;; various |
| 110 | (define-key map "?" 'sieve-help) | 110 | (define-key map "?" 'sieve-help) |
| 111 | (define-key map "h" 'sieve-help) | 111 | (define-key map "h" 'sieve-help) |
| 112 | (define-key map "q" 'kill-buffer) | ||
| 113 | ;; activating | 112 | ;; activating |
| 114 | (define-key map "m" 'sieve-activate) | 113 | (define-key map "m" 'sieve-activate) |
| 115 | (define-key map "u" 'sieve-deactivate) | 114 | (define-key map "u" 'sieve-deactivate) |
| @@ -152,6 +151,8 @@ require \"fileinto\"; | |||
| 152 | (defun sieve-manage-quit () | 151 | (defun sieve-manage-quit () |
| 153 | "Quit." | 152 | "Quit." |
| 154 | (interactive) | 153 | (interactive) |
| 154 | (sieve-manage-close sieve-manage-buffer) | ||
| 155 | (kill-buffer sieve-manage-buffer) | ||
| 155 | (kill-buffer (current-buffer))) | 156 | (kill-buffer (current-buffer))) |
| 156 | 157 | ||
| 157 | (defun sieve-activate (&optional pos) | 158 | (defun sieve-activate (&optional pos) |
| @@ -206,6 +207,7 @@ require \"fileinto\"; | |||
| 206 | (insert sieve-template)) | 207 | (insert sieve-template)) |
| 207 | (sieve-mode) | 208 | (sieve-mode) |
| 208 | (setq sieve-buffer-script-name name) | 209 | (setq sieve-buffer-script-name name) |
| 210 | (beginning-of-buffer) | ||
| 209 | (message | 211 | (message |
| 210 | (substitute-command-keys | 212 | (substitute-command-keys |
| 211 | "Press \\[sieve-upload] to upload script to server.")))) | 213 | "Press \\[sieve-upload] to upload script to server.")))) |
| @@ -256,10 +258,9 @@ Used to bracket operations which move point in the sieve-buffer." | |||
| 256 | (setq buffer-read-only nil) | 258 | (setq buffer-read-only nil) |
| 257 | (erase-buffer) | 259 | (erase-buffer) |
| 258 | (buffer-disable-undo) | 260 | (buffer-disable-undo) |
| 259 | (insert "\ | 261 | (let* ((port (or port sieve-manage-default-port)) |
| 260 | Server : " server ":" (or port sieve-manage-default-port) " | 262 | (header (format "Server : %s:%s\n\n" server port))) |
| 261 | 263 | (insert header)) | |
| 262 | ") | ||
| 263 | (set (make-local-variable 'sieve-buffer-header-end) | 264 | (set (make-local-variable 'sieve-buffer-header-end) |
| 264 | (point-max))) | 265 | (point-max))) |
| 265 | 266 | ||
| @@ -305,7 +306,7 @@ Server : " server ":" (or port sieve-manage-default-port) " | |||
| 305 | (with-current-buffer | 306 | (with-current-buffer |
| 306 | (or ;; open server | 307 | (or ;; open server |
| 307 | (set (make-local-variable 'sieve-manage-buffer) | 308 | (set (make-local-variable 'sieve-manage-buffer) |
| 308 | (sieve-manage-open server)) | 309 | (sieve-manage-open server port)) |
| 309 | (error "Error opening server %s" server)) | 310 | (error "Error opening server %s" server)) |
| 310 | (sieve-manage-authenticate))) | 311 | (sieve-manage-authenticate))) |
| 311 | 312 | ||
diff --git a/lisp/help-fns.el b/lisp/help-fns.el index bdf86016844..86bb67e87c2 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el | |||
| @@ -435,14 +435,19 @@ suitable file is found, return nil." | |||
| 435 | (let ((handler (function-get function 'compiler-macro))) | 435 | (let ((handler (function-get function 'compiler-macro))) |
| 436 | (when handler | 436 | (when handler |
| 437 | (insert "\nThis function has a compiler macro") | 437 | (insert "\nThis function has a compiler macro") |
| 438 | (let ((lib (get function 'compiler-macro-file))) | 438 | (if (symbolp handler) |
| 439 | ;; FIXME: rather than look at the compiler-macro-file property, | 439 | (progn |
| 440 | ;; just look at `handler' itself. | 440 | (insert (format " `%s'" handler)) |
| 441 | (when (stringp lib) | 441 | (save-excursion |
| 442 | (insert (format " in `%s'" lib)) | 442 | (re-search-backward "`\\([^`']+\\)'" nil t) |
| 443 | (save-excursion | 443 | (help-xref-button 1 'help-function handler))) |
| 444 | (re-search-backward "`\\([^`']+\\)'" nil t) | 444 | ;; FIXME: Obsolete since 24.4. |
| 445 | (help-xref-button 1 'help-function-cmacro function lib)))) | 445 | (let ((lib (get function 'compiler-macro-file))) |
| 446 | (when (stringp lib) | ||
| 447 | (insert (format " in `%s'" lib)) | ||
| 448 | (save-excursion | ||
| 449 | (re-search-backward "`\\([^`']+\\)'" nil t) | ||
| 450 | (help-xref-button 1 'help-function-cmacro function lib))))) | ||
| 446 | (insert ".\n")))) | 451 | (insert ".\n")))) |
| 447 | 452 | ||
| 448 | (defun help-fns--signature (function doc real-def real-function) | 453 | (defun help-fns--signature (function doc real-def real-function) |
diff --git a/lisp/help-mode.el b/lisp/help-mode.el index b5aca1a4445..b56adc2a4a9 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el | |||
| @@ -204,7 +204,7 @@ The format is (FUNCTION ARGS...).") | |||
| 204 | (message "Unable to find location in file")))) | 204 | (message "Unable to find location in file")))) |
| 205 | 'help-echo (purecopy "mouse-2, RET: find function's definition")) | 205 | 'help-echo (purecopy "mouse-2, RET: find function's definition")) |
| 206 | 206 | ||
| 207 | (define-button-type 'help-function-cmacro | 207 | (define-button-type 'help-function-cmacro ; FIXME: Obsolete since 24.4. |
| 208 | :supertype 'help-xref | 208 | :supertype 'help-xref |
| 209 | 'help-function (lambda (fun file) | 209 | 'help-function (lambda (fun file) |
| 210 | (setq file (locate-library file t)) | 210 | (setq file (locate-library file t)) |
| @@ -213,7 +213,7 @@ The format is (FUNCTION ARGS...).") | |||
| 213 | (pop-to-buffer (find-file-noselect file)) | 213 | (pop-to-buffer (find-file-noselect file)) |
| 214 | (goto-char (point-min)) | 214 | (goto-char (point-min)) |
| 215 | (if (re-search-forward | 215 | (if (re-search-forward |
| 216 | (format "^[ \t]*(define-compiler-macro[ \t]+%s" | 216 | (format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ \t]+%s" |
| 217 | (regexp-quote (symbol-name fun))) nil t) | 217 | (regexp-quote (symbol-name fun))) nil t) |
| 218 | (forward-line 0) | 218 | (forward-line 0) |
| 219 | (message "Unable to find location in file"))) | 219 | (message "Unable to find location in file"))) |
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 146ba61a517..de36c6c86ce 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el | |||
| @@ -1523,7 +1523,7 @@ You can then feed the file name(s) to other commands with \\[yank]." | |||
| 1523 | 1523 | ||
| 1524 | ;;;###autoload | 1524 | ;;;###autoload |
| 1525 | (defun ibuffer-mark-help-buffers () | 1525 | (defun ibuffer-mark-help-buffers () |
| 1526 | "Mark buffers like *Help*, *Apropos*, *Info*." | 1526 | "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'." |
| 1527 | (interactive) | 1527 | (interactive) |
| 1528 | (ibuffer-mark-on-buffer | 1528 | (ibuffer-mark-on-buffer |
| 1529 | #'(lambda (buf) | 1529 | #'(lambda (buf) |
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 586c8306a36..8f7d584d00b 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el | |||
| @@ -2652,7 +2652,7 @@ will be inserted before the group at point." | |||
| 2652 | ;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group | 2652 | ;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group |
| 2653 | ;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group | 2653 | ;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group |
| 2654 | ;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode | 2654 | ;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode |
| 2655 | ;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "9950bdf995e4b5e962a17d754a35f2c6") | 2655 | ;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "2c628e6cde385119c5f7b43cc1efe1a1") |
| 2656 | ;;; Generated autoloads from ibuf-ext.el | 2656 | ;;; Generated autoloads from ibuf-ext.el |
| 2657 | 2657 | ||
| 2658 | (autoload 'ibuffer-auto-mode "ibuf-ext" "\ | 2658 | (autoload 'ibuffer-auto-mode "ibuf-ext" "\ |
| @@ -2984,7 +2984,7 @@ Mark all buffers whose associated file does not exist. | |||
| 2984 | \(fn)" t nil) | 2984 | \(fn)" t nil) |
| 2985 | 2985 | ||
| 2986 | (autoload 'ibuffer-mark-help-buffers "ibuf-ext" "\ | 2986 | (autoload 'ibuffer-mark-help-buffers "ibuf-ext" "\ |
| 2987 | Mark buffers like *Help*, *Apropos*, *Info*. | 2987 | Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'. |
| 2988 | 2988 | ||
| 2989 | \(fn)" t nil) | 2989 | \(fn)" t nil) |
| 2990 | 2990 | ||
diff --git a/lisp/ido.el b/lisp/ido.el index 8087124765c..47c05b080f7 100644 --- a/lisp/ido.el +++ b/lisp/ido.el | |||
| @@ -3276,14 +3276,18 @@ for first matching file." | |||
| 3276 | (defun ido-wide-find-dirs-or-files (dir file &optional prefix finddir) | 3276 | (defun ido-wide-find-dirs-or-files (dir file &optional prefix finddir) |
| 3277 | ;; As ido-run-find-command, but returns a list of cons pairs ("file" . "dir") | 3277 | ;; As ido-run-find-command, but returns a list of cons pairs ("file" . "dir") |
| 3278 | (let ((filenames | 3278 | (let ((filenames |
| 3279 | (split-string | 3279 | (delq nil |
| 3280 | (shell-command-to-string | 3280 | (mapcar (lambda (name) |
| 3281 | (concat "find " | 3281 | (unless (ido-ignore-item-p name ido-ignore-files t) |
| 3282 | (shell-quote-argument dir) | 3282 | name)) |
| 3283 | " -name " | 3283 | (split-string |
| 3284 | (shell-quote-argument | 3284 | (shell-command-to-string |
| 3285 | (concat (if prefix "" "*") file "*")) | 3285 | (concat "find " |
| 3286 | " -type " (if finddir "d" "f") " -print")))) | 3286 | (shell-quote-argument dir) |
| 3287 | (if ido-case-fold " -iname " " -name ") | ||
| 3288 | (shell-quote-argument | ||
| 3289 | (concat (if prefix "" "*") file "*")) | ||
| 3290 | " -type " (if finddir "d" "f") " -print")))))) | ||
| 3287 | filename d f | 3291 | filename d f |
| 3288 | res) | 3292 | res) |
| 3289 | (while filenames | 3293 | (while filenames |
| @@ -3297,7 +3301,7 @@ for first matching file." | |||
| 3297 | res)) | 3301 | res)) |
| 3298 | 3302 | ||
| 3299 | (defun ido-flatten-merged-list (items) | 3303 | (defun ido-flatten-merged-list (items) |
| 3300 | ;; Create a list of directory names based on a merged directory list. | 3304 | "Create a list of directory names based on a merged directory list." |
| 3301 | (let (res) | 3305 | (let (res) |
| 3302 | (while items | 3306 | (while items |
| 3303 | (let* ((item (car items)) | 3307 | (let* ((item (car items)) |
| @@ -3400,7 +3404,7 @@ for first matching file." | |||
| 3400 | res)) | 3404 | res)) |
| 3401 | 3405 | ||
| 3402 | (defun ido-make-buffer-list-1 (&optional frame visible) | 3406 | (defun ido-make-buffer-list-1 (&optional frame visible) |
| 3403 | ;; Return list of non-ignored buffer names | 3407 | "Return list of non-ignored buffer names." |
| 3404 | (delq nil | 3408 | (delq nil |
| 3405 | (mapcar | 3409 | (mapcar |
| 3406 | (lambda (x) | 3410 | (lambda (x) |
| @@ -3410,12 +3414,12 @@ for first matching file." | |||
| 3410 | (buffer-list frame)))) | 3414 | (buffer-list frame)))) |
| 3411 | 3415 | ||
| 3412 | (defun ido-make-buffer-list (default) | 3416 | (defun ido-make-buffer-list (default) |
| 3413 | ;; Return the current list of buffers. | 3417 | "Return the current list of buffers. |
| 3414 | ;; Currently visible buffers are put at the end of the list. | 3418 | Currently visible buffers are put at the end of the list. |
| 3415 | ;; The hook `ido-make-buffer-list-hook' is run after the list has been | 3419 | The hook `ido-make-buffer-list-hook' is run after the list has been |
| 3416 | ;; created to allow the user to further modify the order of the buffer names | 3420 | created to allow the user to further modify the order of the buffer names |
| 3417 | ;; in this list. If DEFAULT is non-nil, and corresponds to an existing buffer, | 3421 | in this list. If DEFAULT is non-nil, and corresponds to an existing buffer, |
| 3418 | ;; it is put to the start of the list. | 3422 | it is put to the start of the list." |
| 3419 | (let* ((ido-current-buffers (ido-get-buffers-in-frames 'current)) | 3423 | (let* ((ido-current-buffers (ido-get-buffers-in-frames 'current)) |
| 3420 | (ido-temp-list (ido-make-buffer-list-1 (selected-frame) ido-current-buffers))) | 3424 | (ido-temp-list (ido-make-buffer-list-1 (selected-frame) ido-current-buffers))) |
| 3421 | (if ido-temp-list | 3425 | (if ido-temp-list |
| @@ -3457,9 +3461,9 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3457 | (nreverse (mapcar #'car ido-virtual-buffers)))))) | 3461 | (nreverse (mapcar #'car ido-virtual-buffers)))))) |
| 3458 | 3462 | ||
| 3459 | (defun ido-make-choice-list (default) | 3463 | (defun ido-make-choice-list (default) |
| 3460 | ;; Return the current list of choices. | 3464 | "Return the current list of choices. |
| 3461 | ;; If DEFAULT is non-nil, and corresponds to an element of choices, | 3465 | If DEFAULT is non-nil, and corresponds to an element of choices, |
| 3462 | ;; it is put to the start of the list. | 3466 | it is put to the start of the list." |
| 3463 | (let ((ido-temp-list ido-choice-list)) | 3467 | (let ((ido-temp-list ido-choice-list)) |
| 3464 | (if default | 3468 | (if default |
| 3465 | (progn | 3469 | (progn |
| @@ -3471,7 +3475,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3471 | ido-temp-list)) | 3475 | ido-temp-list)) |
| 3472 | 3476 | ||
| 3473 | (defun ido-to-end (items) | 3477 | (defun ido-to-end (items) |
| 3474 | ;; Move the elements from ITEMS to the end of `ido-temp-list' | 3478 | "Move the elements from ITEMS to the end of `ido-temp-list'." |
| 3475 | (mapc | 3479 | (mapc |
| 3476 | (lambda (elem) | 3480 | (lambda (elem) |
| 3477 | (setq ido-temp-list (delq elem ido-temp-list))) | 3481 | (setq ido-temp-list (delq elem ido-temp-list))) |
| @@ -3515,8 +3519,8 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3515 | (file-name-all-completions "" dir)))) | 3519 | (file-name-all-completions "" dir)))) |
| 3516 | 3520 | ||
| 3517 | (defun ido-file-name-all-completions (dir) | 3521 | (defun ido-file-name-all-completions (dir) |
| 3518 | ;; Return name of all files in DIR | 3522 | "Return name of all files in DIR. |
| 3519 | ;; Uses and updates ido-dir-file-cache | 3523 | Uses and updates `ido-dir-file-cache'." |
| 3520 | (cond | 3524 | (cond |
| 3521 | ((ido-is-unc-root dir) | 3525 | ((ido-is-unc-root dir) |
| 3522 | (mapcar | 3526 | (mapcar |
| @@ -3565,7 +3569,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3565 | (ido-file-name-all-completions-1 dir)))) | 3569 | (ido-file-name-all-completions-1 dir)))) |
| 3566 | 3570 | ||
| 3567 | (defun ido-remove-cached-dir (dir) | 3571 | (defun ido-remove-cached-dir (dir) |
| 3568 | ;; Remove dir from ido-dir-file-cache | 3572 | "Remove DIR from `ido-dir-file-cache'." |
| 3569 | (if (and ido-dir-file-cache | 3573 | (if (and ido-dir-file-cache |
| 3570 | (stringp dir) (> (length dir) 0)) | 3574 | (stringp dir) (> (length dir) 0)) |
| 3571 | (let ((cached (assoc dir ido-dir-file-cache))) | 3575 | (let ((cached (assoc dir ido-dir-file-cache))) |
| @@ -3574,8 +3578,8 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3574 | 3578 | ||
| 3575 | 3579 | ||
| 3576 | (defun ido-make-file-list-1 (dir &optional merged) | 3580 | (defun ido-make-file-list-1 (dir &optional merged) |
| 3577 | ;; Return list of non-ignored files in DIR | 3581 | "Return list of non-ignored files in DIR |
| 3578 | ;; If MERGED is non-nil, each file is cons'ed with DIR | 3582 | If MERGED is non-nil, each file is cons'ed with DIR." |
| 3579 | (and (or (ido-is-tramp-root dir) (ido-is-unc-root dir) | 3583 | (and (or (ido-is-tramp-root dir) (ido-is-unc-root dir) |
| 3580 | (file-directory-p dir)) | 3584 | (file-directory-p dir)) |
| 3581 | (delq nil | 3585 | (delq nil |
| @@ -3586,11 +3590,11 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3586 | (ido-file-name-all-completions dir))))) | 3590 | (ido-file-name-all-completions dir))))) |
| 3587 | 3591 | ||
| 3588 | (defun ido-make-file-list (default) | 3592 | (defun ido-make-file-list (default) |
| 3589 | ;; Return the current list of files. | 3593 | "Return the current list of files. |
| 3590 | ;; Currently visible files are put at the end of the list. | 3594 | Currently visible files are put at the end of the list. |
| 3591 | ;; The hook `ido-make-file-list-hook' is run after the list has been | 3595 | The hook `ido-make-file-list-hook' is run after the list has been |
| 3592 | ;; created to allow the user to further modify the order of the file names | 3596 | created to allow the user to further modify the order of the file names |
| 3593 | ;; in this list. | 3597 | in this list." |
| 3594 | (let ((ido-temp-list (ido-make-file-list-1 ido-current-directory))) | 3598 | (let ((ido-temp-list (ido-make-file-list-1 ido-current-directory))) |
| 3595 | (setq ido-temp-list (sort ido-temp-list | 3599 | (setq ido-temp-list (sort ido-temp-list |
| 3596 | (if ido-file-extensions-order | 3600 | (if ido-file-extensions-order |
| @@ -3631,8 +3635,8 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3631 | ido-temp-list)) | 3635 | ido-temp-list)) |
| 3632 | 3636 | ||
| 3633 | (defun ido-make-dir-list-1 (dir &optional merged) | 3637 | (defun ido-make-dir-list-1 (dir &optional merged) |
| 3634 | ;; Return list of non-ignored subdirs in DIR | 3638 | "Return list of non-ignored subdirs in DIR. |
| 3635 | ;; If MERGED is non-nil, each subdir is cons'ed with DIR | 3639 | If MERGED is non-nil, each subdir is cons'ed with DIR." |
| 3636 | (and (or (ido-is-tramp-root dir) (file-directory-p dir)) | 3640 | (and (or (ido-is-tramp-root dir) (file-directory-p dir)) |
| 3637 | (delq nil | 3641 | (delq nil |
| 3638 | (mapcar | 3642 | (mapcar |
| @@ -3642,10 +3646,10 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3642 | (ido-file-name-all-completions dir))))) | 3646 | (ido-file-name-all-completions dir))))) |
| 3643 | 3647 | ||
| 3644 | (defun ido-make-dir-list (default) | 3648 | (defun ido-make-dir-list (default) |
| 3645 | ;; Return the current list of directories. | 3649 | "Return the current list of directories. |
| 3646 | ;; The hook `ido-make-dir-list-hook' is run after the list has been | 3650 | The hook `ido-make-dir-list-hook' is run after the list has been |
| 3647 | ;; created to allow the user to further modify the order of the | 3651 | created to allow the user to further modify the order of the |
| 3648 | ;; directory names in this list. | 3652 | directory names in this list." |
| 3649 | (let ((ido-temp-list (ido-make-dir-list-1 ido-current-directory))) | 3653 | (let ((ido-temp-list (ido-make-dir-list-1 ido-current-directory))) |
| 3650 | (setq ido-temp-list (sort ido-temp-list #'ido-file-lessp)) | 3654 | (setq ido-temp-list (sort ido-temp-list #'ido-file-lessp)) |
| 3651 | (ido-to-end ;; move . files to end | 3655 | (ido-to-end ;; move . files to end |
| @@ -3676,10 +3680,9 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3676 | (defvar ido-bufs-in-frame) | 3680 | (defvar ido-bufs-in-frame) |
| 3677 | 3681 | ||
| 3678 | (defun ido-get-buffers-in-frames (&optional current) | 3682 | (defun ido-get-buffers-in-frames (&optional current) |
| 3679 | ;; Return the list of buffers that are visible in the current frame. | 3683 | "Return the list of buffers that are visible in the current frame. |
| 3680 | ;; If optional argument `current' is given, restrict searching to the | 3684 | If optional argument CURRENT is given, restrict searching to the current |
| 3681 | ;; current frame, rather than all frames, regardless of value of | 3685 | frame, rather than all frames, regardless of value of `ido-all-frames'." |
| 3682 | ;; `ido-all-frames'. | ||
| 3683 | (let ((ido-bufs-in-frame nil)) | 3686 | (let ((ido-bufs-in-frame nil)) |
| 3684 | (walk-windows 'ido-get-bufname nil | 3687 | (walk-windows 'ido-get-bufname nil |
| 3685 | (if current | 3688 | (if current |
| @@ -3688,7 +3691,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3688 | ido-bufs-in-frame)) | 3691 | ido-bufs-in-frame)) |
| 3689 | 3692 | ||
| 3690 | (defun ido-get-bufname (win) | 3693 | (defun ido-get-bufname (win) |
| 3691 | ;; Used by `ido-get-buffers-in-frames' to walk through all windows | 3694 | "Used by `ido-get-buffers-in-frames' to walk through all windows." |
| 3692 | (let ((buf (buffer-name (window-buffer win)))) | 3695 | (let ((buf (buffer-name (window-buffer win)))) |
| 3693 | (unless (or (member buf ido-bufs-in-frame) | 3696 | (unless (or (member buf ido-bufs-in-frame) |
| 3694 | (member buf ido-ignore-item-temp-list)) | 3697 | (member buf ido-ignore-item-temp-list)) |
| @@ -3701,7 +3704,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3701 | ;;; FIND MATCHING ITEMS | 3704 | ;;; FIND MATCHING ITEMS |
| 3702 | 3705 | ||
| 3703 | (defun ido-set-matches-1 (items &optional do-full) | 3706 | (defun ido-set-matches-1 (items &optional do-full) |
| 3704 | ;; Return list of matches in items | 3707 | "Return list of matches in ITEMS." |
| 3705 | (let* ((case-fold-search ido-case-fold) | 3708 | (let* ((case-fold-search ido-case-fold) |
| 3706 | (slash (and (not ido-enable-prefix) (ido-final-slash ido-text))) | 3709 | (slash (and (not ido-enable-prefix) (ido-final-slash ido-text))) |
| 3707 | (text (if slash (substring ido-text 0 -1) ido-text)) | 3710 | (text (if slash (substring ido-text 0 -1) ido-text)) |
| @@ -3789,13 +3792,13 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3789 | 3792 | ||
| 3790 | 3793 | ||
| 3791 | (defun ido-set-matches () | 3794 | (defun ido-set-matches () |
| 3792 | ;; Set `ido-matches' to the list of items matching prompt | 3795 | "Set `ido-matches' to the list of items matching prompt." |
| 3793 | (when ido-rescan | 3796 | (when ido-rescan |
| 3794 | (setq ido-matches (ido-set-matches-1 (reverse ido-cur-list) (not ido-rotate)) | 3797 | (setq ido-matches (ido-set-matches-1 (reverse ido-cur-list) (not ido-rotate)) |
| 3795 | ido-rotate nil))) | 3798 | ido-rotate nil))) |
| 3796 | 3799 | ||
| 3797 | (defun ido-ignore-item-p (name re-list &optional ignore-ext) | 3800 | (defun ido-ignore-item-p (name re-list &optional ignore-ext) |
| 3798 | ;; Return t if the buffer or file NAME should be ignored. | 3801 | "Return t if the buffer or file NAME should be ignored." |
| 3799 | (or (member name ido-ignore-item-temp-list) | 3802 | (or (member name ido-ignore-item-temp-list) |
| 3800 | (and | 3803 | (and |
| 3801 | ido-process-ignore-lists re-list | 3804 | ido-process-ignore-lists re-list |
| @@ -3835,7 +3838,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3835 | (defvar ido-change-word-sub) | 3838 | (defvar ido-change-word-sub) |
| 3836 | 3839 | ||
| 3837 | (defun ido-find-common-substring (items subs) | 3840 | (defun ido-find-common-substring (items subs) |
| 3838 | ;; Return common string following SUBS in each element of ITEMS. | 3841 | "Return common string following SUBS in each element of ITEMS." |
| 3839 | (let (res | 3842 | (let (res |
| 3840 | alist | 3843 | alist |
| 3841 | ido-change-word-sub) | 3844 | ido-change-word-sub) |
| @@ -3855,8 +3858,8 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3855 | comp)))) | 3858 | comp)))) |
| 3856 | 3859 | ||
| 3857 | (defun ido-word-matching-substring (word) | 3860 | (defun ido-word-matching-substring (word) |
| 3858 | ;; Return part of WORD before 1st match to `ido-change-word-sub'. | 3861 | "Return part of WORD before first match to `ido-change-word-sub'. |
| 3859 | ;; If `ido-change-word-sub' cannot be found in WORD, return nil. | 3862 | If `ido-change-word-sub' cannot be found in WORD, return nil." |
| 3860 | (let ((case-fold-search ido-case-fold)) | 3863 | (let ((case-fold-search ido-case-fold)) |
| 3861 | (let ((m (string-match ido-change-word-sub (ido-name word)))) | 3864 | (let ((m (string-match ido-change-word-sub (ido-name word)))) |
| 3862 | (if m | 3865 | (if m |
| @@ -3865,7 +3868,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3865 | nil)))) | 3868 | nil)))) |
| 3866 | 3869 | ||
| 3867 | (defun ido-makealist (res) | 3870 | (defun ido-makealist (res) |
| 3868 | ;; Return dotted pair (RES . 1). | 3871 | "Return dotted pair (RES . 1)." |
| 3869 | (cons res 1)) | 3872 | (cons res 1)) |
| 3870 | 3873 | ||
| 3871 | (defun ido-choose-completion-string (choice &rest ignored) | 3874 | (defun ido-choose-completion-string (choice &rest ignored) |
| @@ -4048,8 +4051,8 @@ Record command in `command-history' if optional RECORD is non-nil." | |||
| 4048 | 4051 | ||
| 4049 | 4052 | ||
| 4050 | (defun ido-buffer-window-other-frame (buffer) | 4053 | (defun ido-buffer-window-other-frame (buffer) |
| 4051 | ;; Return window pointer if BUFFER is visible in another frame. | 4054 | "Return window pointer if BUFFER is visible in another frame. |
| 4052 | ;; If BUFFER is visible in the current frame, return nil. | 4055 | If BUFFER is visible in the current frame, return nil." |
| 4053 | (let ((blist (ido-get-buffers-in-frames 'current))) | 4056 | (let ((blist (ido-get-buffers-in-frames 'current))) |
| 4054 | ;;If the buffer is visible in current frame, return nil | 4057 | ;;If the buffer is visible in current frame, return nil |
| 4055 | (if (member buffer blist) | 4058 | (if (member buffer blist) |
| @@ -4533,9 +4536,8 @@ For details of keybindings, see `ido-find-file'." | |||
| 4533 | )))) | 4536 | )))) |
| 4534 | 4537 | ||
| 4535 | (defun ido-completions (name) | 4538 | (defun ido-completions (name) |
| 4536 | ;; Return the string that is displayed after the user's text. | 4539 | "Return the string that is displayed after the user's text. |
| 4537 | ;; Modified from `icomplete-completions'. | 4540 | Modified from `icomplete-completions'." |
| 4538 | |||
| 4539 | (let* ((comps ido-matches) | 4541 | (let* ((comps ido-matches) |
| 4540 | (ind (and (consp (car comps)) (> (length (cdr (car comps))) 1) | 4542 | (ind (and (consp (car comps)) (> (length (cdr (car comps))) 1) |
| 4541 | ido-merged-indicator)) | 4543 | ido-merged-indicator)) |
diff --git a/lisp/image-dired.el b/lisp/image-dired.el index bbb41d49a1d..afb940fe337 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el | |||
| @@ -156,8 +156,9 @@ | |||
| 156 | (require 'format-spec) | 156 | (require 'format-spec) |
| 157 | (require 'widget) | 157 | (require 'widget) |
| 158 | 158 | ||
| 159 | (require 'cl-lib) | ||
| 160 | |||
| 159 | (eval-when-compile | 161 | (eval-when-compile |
| 160 | (require 'cl-lib) | ||
| 161 | (require 'wid-edit)) | 162 | (require 'wid-edit)) |
| 162 | 163 | ||
| 163 | (defgroup image-dired nil | 164 | (defgroup image-dired nil |
| @@ -657,9 +658,12 @@ previous -ARG, if ARG<0) files." | |||
| 657 | (string-match-p (image-file-name-regexp) image-file)) | 658 | (string-match-p (image-file-name-regexp) image-file)) |
| 658 | (setq thumb-file (image-dired-get-thumbnail-image image-file)) | 659 | (setq thumb-file (image-dired-get-thumbnail-image image-file)) |
| 659 | ;; If image is not already added, then add it. | 660 | ;; If image is not already added, then add it. |
| 660 | (let ((cur-ov (overlays-in (point) (1+ (point))))) | 661 | (let* ((cur-ovs (overlays-in (point) (1+ (point)))) |
| 661 | (if cur-ov | 662 | (thumb-ov (car (cl-remove-if-not |
| 662 | (delete-overlay (car cur-ov)) | 663 | (lambda (ov) (overlay-get ov 'thumb-file)) |
| 664 | cur-ovs)))) | ||
| 665 | (if thumb-ov | ||
| 666 | (delete-overlay thumb-ov) | ||
| 663 | (put-image thumb-file image-pos) | 667 | (put-image thumb-file image-pos) |
| 664 | (setq overlay | 668 | (setq overlay |
| 665 | (cl-loop for o in (overlays-in (point) (1+ (point))) | 669 | (cl-loop for o in (overlays-in (point) (1+ (point))) |
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index a31a90d9cfb..48487b850df 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el | |||
| @@ -1508,6 +1508,7 @@ for decoding and encoding files, process I/O, etc." | |||
| 1508 | (setq file-coding-system-alist | 1508 | (setq file-coding-system-alist |
| 1509 | (mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg))) | 1509 | (mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg))) |
| 1510 | '(("\\.elc\\'" . utf-8-emacs) | 1510 | '(("\\.elc\\'" . utf-8-emacs) |
| 1511 | ("\\.el\\'" . utf-8) | ||
| 1511 | ("\\.utf\\(-8\\)?\\'" . utf-8) | 1512 | ("\\.utf\\(-8\\)?\\'" . utf-8) |
| 1512 | ("\\.xml\\'" . xml-find-file-coding-system) | 1513 | ("\\.xml\\'" . xml-find-file-coding-system) |
| 1513 | ;; We use raw-text for reading loaddefs.el so that if it | 1514 | ;; We use raw-text for reading loaddefs.el so that if it |
diff --git a/lisp/international/mule.el b/lisp/international/mule.el index dd0f3821728..4ce1a28c438 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el | |||
| @@ -1691,7 +1691,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" | |||
| 1691 | ("\\.\\(gz\\|Z\\|bz\\|bz2\\|xz\\|gpg\\)\\'" . no-conversion) | 1691 | ("\\.\\(gz\\|Z\\|bz\\|bz2\\|xz\\|gpg\\)\\'" . no-conversion) |
| 1692 | ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion) | 1692 | ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion) |
| 1693 | ("\\.pdf\\'" . no-conversion) | 1693 | ("\\.pdf\\'" . no-conversion) |
| 1694 | ("/#[^/]+#\\'" . emacs-mule))) | 1694 | ("/#[^/]+#\\'" . utf-8-emacs-unix))) |
| 1695 | "Alist of filename patterns vs corresponding coding systems. | 1695 | "Alist of filename patterns vs corresponding coding systems. |
| 1696 | Each element looks like (REGEXP . CODING-SYSTEM). | 1696 | Each element looks like (REGEXP . CODING-SYSTEM). |
| 1697 | A file whose name matches REGEXP is decoded by CODING-SYSTEM on reading. | 1697 | A file whose name matches REGEXP is decoded by CODING-SYSTEM on reading. |
diff --git a/lisp/isearch.el b/lisp/isearch.el index c49b0d7fc59..d9f8b0891e4 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el | |||
| @@ -2152,6 +2152,15 @@ If nil, scrolling commands will first cancel Isearch mode." | |||
| 2152 | :type 'boolean | 2152 | :type 'boolean |
| 2153 | :group 'isearch) | 2153 | :group 'isearch) |
| 2154 | 2154 | ||
| 2155 | (defcustom isearch-allow-prefix t | ||
| 2156 | "Whether prefix arguments are allowed during incremental search. | ||
| 2157 | If non-nil, entering a prefix argument will not terminate the | ||
| 2158 | search. This option is ignored \(presumed t) when | ||
| 2159 | `isearch-allow-scroll' is set." | ||
| 2160 | :version "24.4" | ||
| 2161 | :type 'boolean | ||
| 2162 | :group 'isearch) | ||
| 2163 | |||
| 2155 | (defun isearch-string-out-of-window (isearch-point) | 2164 | (defun isearch-string-out-of-window (isearch-point) |
| 2156 | "Test whether the search string is currently outside of the window. | 2165 | "Test whether the search string is currently outside of the window. |
| 2157 | Return nil if it's completely visible, or if point is visible, | 2166 | Return nil if it's completely visible, or if point is visible, |
| @@ -2304,12 +2313,19 @@ Isearch mode." | |||
| 2304 | (setq prefix-arg arg) | 2313 | (setq prefix-arg arg) |
| 2305 | (apply 'isearch-unread keylist) | 2314 | (apply 'isearch-unread keylist) |
| 2306 | (isearch-edit-string)) | 2315 | (isearch-edit-string)) |
| 2307 | ;; Handle a scrolling function. | 2316 | ;; Handle a scrolling function or prefix argument. |
| 2308 | ((and isearch-allow-scroll | 2317 | ((progn |
| 2309 | (progn (setq key (isearch-reread-key-sequence-naturally keylist)) | 2318 | (setq key (isearch-reread-key-sequence-naturally keylist) |
| 2310 | (setq keylist (listify-key-sequence key)) | 2319 | keylist (listify-key-sequence key) |
| 2311 | (setq main-event (aref key 0)) | 2320 | main-event (aref key 0)) |
| 2312 | (setq scroll-command (isearch-lookup-scroll-key key)))) | 2321 | (or (and isearch-allow-scroll |
| 2322 | (setq scroll-command (isearch-lookup-scroll-key key))) | ||
| 2323 | (and isearch-allow-prefix | ||
| 2324 | (let (overriding-terminal-local-map) | ||
| 2325 | (setq scroll-command (key-binding key)) | ||
| 2326 | (memq scroll-command | ||
| 2327 | '(universal-argument | ||
| 2328 | negative-argument digit-argument)))))) | ||
| 2313 | ;; From this point onwards, KEY, KEYLIST and MAIN-EVENT hold a | 2329 | ;; From this point onwards, KEY, KEYLIST and MAIN-EVENT hold a |
| 2314 | ;; complete key sequence, possibly as modified by function-key-map, | 2330 | ;; complete key sequence, possibly as modified by function-key-map, |
| 2315 | ;; not merely the one or two event fragment which invoked | 2331 | ;; not merely the one or two event fragment which invoked |
diff --git a/lisp/loadup.el b/lisp/loadup.el index 5764cdec7eb..7fb9526b360 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el | |||
| @@ -210,6 +210,7 @@ | |||
| 210 | (load "textmodes/page") | 210 | (load "textmodes/page") |
| 211 | (load "register") | 211 | (load "register") |
| 212 | (load "textmodes/paragraphs") | 212 | (load "textmodes/paragraphs") |
| 213 | (load "progmodes/prog-mode") | ||
| 213 | (load "emacs-lisp/lisp-mode") | 214 | (load "emacs-lisp/lisp-mode") |
| 214 | (load "textmodes/text-mode") | 215 | (load "textmodes/text-mode") |
| 215 | (load "textmodes/fill") | 216 | (load "textmodes/fill") |
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el index cc20c5c06ea..8f6715018c4 100644 --- a/lisp/mail/reporter.el +++ b/lisp/mail/reporter.el | |||
| @@ -341,10 +341,10 @@ mail-sending package is used for editing and sending the message." | |||
| 341 | (mail-position-on-field "to") | 341 | (mail-position-on-field "to") |
| 342 | (insert address) | 342 | (insert address) |
| 343 | ;; insert problem summary if available | 343 | ;; insert problem summary if available |
| 344 | (if (and reporter-prompt-for-summary-p problem pkgname) | 344 | (when (and reporter-prompt-for-summary-p problem) |
| 345 | (progn | 345 | (mail-position-on-field "subject") |
| 346 | (mail-position-on-field "subject") | 346 | (if pkgname (insert pkgname "; ")) |
| 347 | (insert pkgname "; " problem))) | 347 | (insert problem)) |
| 348 | ;; move point to the body of the message | 348 | ;; move point to the body of the message |
| 349 | (mail-text) | 349 | (mail-text) |
| 350 | (forward-line 1) | 350 | (forward-line 1) |
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index 9555cb41cfe..1951b195886 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el | |||
| @@ -208,9 +208,9 @@ It returns t if not." | |||
| 208 | ;; <arg name="Prompt" type="o" direction="out"/> | 208 | ;; <arg name="Prompt" type="o" direction="out"/> |
| 209 | ;; </method> | 209 | ;; </method> |
| 210 | ;; <method name="GetSecrets"> | 210 | ;; <method name="GetSecrets"> |
| 211 | ;; <arg name="items" type="ao" direction="in"/> | 211 | ;; <arg name="items" type="ao" direction="in"/> |
| 212 | ;; <arg name="session" type="o" direction="in"/> | 212 | ;; <arg name="session" type="o" direction="in"/> |
| 213 | ;; <arg name="secrets" type="a{o(oayay)}" direction="out"/> | 213 | ;; <arg name="secrets" type="a{o(oayays)}" direction="out"/> |
| 214 | ;; </method> | 214 | ;; </method> |
| 215 | ;; <method name="ReadAlias"> | 215 | ;; <method name="ReadAlias"> |
| 216 | ;; <arg name="name" type="s" direction="in"/> | 216 | ;; <arg name="name" type="s" direction="in"/> |
| @@ -234,7 +234,7 @@ It returns t if not." | |||
| 234 | ;; <interface name="org.freedesktop.Secret.Collection"> | 234 | ;; <interface name="org.freedesktop.Secret.Collection"> |
| 235 | ;; <property name="Items" type="ao" access="read"/> | 235 | ;; <property name="Items" type="ao" access="read"/> |
| 236 | ;; <property name="Label" type="s" access="readwrite"/> | 236 | ;; <property name="Label" type="s" access="readwrite"/> |
| 237 | ;; <property name="Locked" type="s" access="read"/> | 237 | ;; <property name="Locked" type="b" access="read"/> |
| 238 | ;; <property name="Created" type="t" access="read"/> | 238 | ;; <property name="Created" type="t" access="read"/> |
| 239 | ;; <property name="Modified" type="t" access="read"/> | 239 | ;; <property name="Modified" type="t" access="read"/> |
| 240 | ;; <method name="Delete"> | 240 | ;; <method name="Delete"> |
| @@ -245,11 +245,11 @@ It returns t if not." | |||
| 245 | ;; <arg name="results" type="ao" direction="out"/> | 245 | ;; <arg name="results" type="ao" direction="out"/> |
| 246 | ;; </method> | 246 | ;; </method> |
| 247 | ;; <method name="CreateItem"> | 247 | ;; <method name="CreateItem"> |
| 248 | ;; <arg name="props" type="a{sv}" direction="in"/> | 248 | ;; <arg name="props" type="a{sv}" direction="in"/> |
| 249 | ;; <arg name="secret" type="(oayay)" direction="in"/> | 249 | ;; <arg name="secret" type="(oayays)" direction="in"/> |
| 250 | ;; <arg name="replace" type="b" direction="in"/> | 250 | ;; <arg name="replace" type="b" direction="in"/> |
| 251 | ;; <arg name="item" type="o" direction="out"/> | 251 | ;; <arg name="item" type="o" direction="out"/> |
| 252 | ;; <arg name="prompt" type="o" direction="out"/> | 252 | ;; <arg name="prompt" type="o" direction="out"/> |
| 253 | ;; </method> | 253 | ;; </method> |
| 254 | ;; <signal name="ItemCreated"> | 254 | ;; <signal name="ItemCreated"> |
| 255 | ;; <arg name="item" type="o"/> | 255 | ;; <arg name="item" type="o"/> |
| @@ -293,11 +293,11 @@ It returns t if not." | |||
| 293 | ;; <arg name="prompt" type="o" direction="out"/> | 293 | ;; <arg name="prompt" type="o" direction="out"/> |
| 294 | ;; </method> | 294 | ;; </method> |
| 295 | ;; <method name="GetSecret"> | 295 | ;; <method name="GetSecret"> |
| 296 | ;; <arg name="session" type="o" direction="in"/> | 296 | ;; <arg name="session" type="o" direction="in"/> |
| 297 | ;; <arg name="secret" type="(oayay)" direction="out"/> | 297 | ;; <arg name="secret" type="(oayays)" direction="out"/> |
| 298 | ;; </method> | 298 | ;; </method> |
| 299 | ;; <method name="SetSecret"> | 299 | ;; <method name="SetSecret"> |
| 300 | ;; <arg name="secret" type="(oayay)" direction="in"/> | 300 | ;; <arg name="secret" type="(oayays)" direction="in"/> |
| 301 | ;; </method> | 301 | ;; </method> |
| 302 | ;; </interface> | 302 | ;; </interface> |
| 303 | ;; | 303 | ;; |
| @@ -305,10 +305,22 @@ It returns t if not." | |||
| 305 | ;; OBJECT PATH session | 305 | ;; OBJECT PATH session |
| 306 | ;; ARRAY BYTE parameters | 306 | ;; ARRAY BYTE parameters |
| 307 | ;; ARRAY BYTE value | 307 | ;; ARRAY BYTE value |
| 308 | ;; STRING content_type ;; Added 2011/2/9 | ||
| 308 | 309 | ||
| 309 | (defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic" | 310 | (defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic" |
| 310 | "The default item type we are using.") | 311 | "The default item type we are using.") |
| 311 | 312 | ||
| 313 | (defconst secrets-struct-secret-content-type | ||
| 314 | (when (string-equal | ||
| 315 | (dbus-introspect-get-signature | ||
| 316 | :session secrets-service secrets-path secrets-interface-service | ||
| 317 | "GetSecrets" "out") | ||
| 318 | "a{o(oayays)}") | ||
| 319 | '("text/plain")) | ||
| 320 | "The content_type of a secret struct. | ||
| 321 | It must be wrapped as list, because we add it via `append'. This | ||
| 322 | is an interface introduced in 2011.") | ||
| 323 | |||
| 312 | (defconst secrets-interface-session "org.freedesktop.Secret.Session" | 324 | (defconst secrets-interface-session "org.freedesktop.Secret.Session" |
| 313 | "A session tracks state between the service and a client application.") | 325 | "A session tracks state between the service and a client application.") |
| 314 | 326 | ||
| @@ -616,16 +628,21 @@ The object path of the created item is returned." | |||
| 616 | ;; Properties. | 628 | ;; Properties. |
| 617 | (append | 629 | (append |
| 618 | `(:array | 630 | `(:array |
| 619 | (:dict-entry "Label" (:variant ,item)) | 631 | (:dict-entry ,(concat secrets-interface-item ".Label") |
| 620 | (:dict-entry | 632 | (:variant ,item)) |
| 621 | "Type" (:variant ,secrets-interface-item-type-generic))) | 633 | (:dict-entry ,(concat secrets-interface-item ".Type") |
| 634 | (:variant ,secrets-interface-item-type-generic))) | ||
| 622 | (when props | 635 | (when props |
| 623 | `((:dict-entry | 636 | `((:dict-entry ,(concat secrets-interface-item ".Attributes") |
| 624 | "Attributes" (:variant ,(append '(:array) props)))))) | 637 | (:variant ,(append '(:array) props)))))) |
| 625 | ;; Secret. | 638 | ;; Secret. |
| 626 | `(:struct :object-path ,secrets-session-path | 639 | (append |
| 627 | (:array :signature "y") ;; no parameters. | 640 | `(:struct :object-path ,secrets-session-path |
| 628 | ,(dbus-string-to-byte-array password)) | 641 | (:array :signature "y") ;; No parameters. |
| 642 | ,(dbus-string-to-byte-array password)) | ||
| 643 | ;; We add the content_type. In backward compatibility | ||
| 644 | ;; mode, nil is appended, which means nothing. | ||
| 645 | secrets-struct-secret-content-type) | ||
| 629 | ;; Do not replace. Replace does not seem to work. | 646 | ;; Do not replace. Replace does not seem to work. |
| 630 | nil)) | 647 | nil)) |
| 631 | (secrets-prompt (cadr result)) | 648 | (secrets-prompt (cadr result)) |
diff --git a/lisp/net/tls.el b/lisp/net/tls.el index 7fc314ef088..3d8d8decf47 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el | |||
| @@ -286,7 +286,10 @@ NOT trusted. Accept anyway? " host))))) | |||
| 286 | (format "Host name in certificate doesn't \ | 286 | (format "Host name in certificate doesn't \ |
| 287 | match `%s'. Connect anyway? " host)))))) | 287 | match `%s'. Connect anyway? " host)))))) |
| 288 | (setq done nil) | 288 | (setq done nil) |
| 289 | (delete-process process))) | 289 | (delete-process process)) |
| 290 | ;; Delete all the informational messages that could confuse | ||
| 291 | ;; future uses of `buffer'. | ||
| 292 | (delete-region (point-min) (point))) | ||
| 290 | (message "Opening TLS connection to `%s'...%s" | 293 | (message "Opening TLS connection to `%s'...%s" |
| 291 | host (if done "done" "failed")) | 294 | host (if done "done" "failed")) |
| 292 | (when use-temp-buffer | 295 | (when use-temp-buffer |
diff --git a/lisp/newcomment.el b/lisp/newcomment.el index e10b96f97f9..bcb5f721ae8 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el | |||
| @@ -485,29 +485,27 @@ and raises an error or returns nil if NOERROR is non-nil." | |||
| 485 | Moves point to inside the comment and returns the position of the | 485 | Moves point to inside the comment and returns the position of the |
| 486 | comment-starter. If no comment is found, moves point to LIMIT | 486 | comment-starter. If no comment is found, moves point to LIMIT |
| 487 | and raises an error or returns nil if NOERROR is non-nil." | 487 | and raises an error or returns nil if NOERROR is non-nil." |
| 488 | (let (found end) | 488 | ;; FIXME: If a comment-start appears inside a comment, we may erroneously |
| 489 | (while (and (not found) | 489 | ;; stop there. This can be rather bad in general, but since |
| 490 | (re-search-backward comment-start-skip limit t)) | 490 | ;; comment-search-backward is only used to find the comment-column (in |
| 491 | (setq end (match-end 0)) | 491 | ;; comment-set-column) and to find the comment-start string (via |
| 492 | (unless (and comment-use-syntax | 492 | ;; comment-beginning) in indent-new-comment-line, it should be harmless. |
| 493 | (nth 8 (syntax-ppss (or (match-end 1) | 493 | (if (not (re-search-backward comment-start-skip limit t)) |
| 494 | (match-beginning 0))))) | 494 | (unless noerror (error "No comment")) |
| 495 | (setq found t))) | 495 | (beginning-of-line) |
| 496 | (if (not found) | 496 | (let* ((end (match-end 0)) |
| 497 | (unless noerror (error "No comment")) | 497 | (cs (comment-search-forward end t)) |
| 498 | (beginning-of-line) | 498 | (pt (point))) |
| 499 | (let ((cs (comment-search-forward end t)) | 499 | (if (not cs) |
| 500 | (pt (point))) | 500 | (progn (beginning-of-line) |
| 501 | (if (not cs) | 501 | (comment-search-backward limit noerror)) |
| 502 | (progn (beginning-of-line) | 502 | (while (progn (goto-char cs) |
| 503 | (comment-search-backward limit noerror)) | 503 | (comment-forward) |
| 504 | (while (progn (goto-char cs) | 504 | (and (< (point) end) |
| 505 | (comment-forward) | 505 | (setq cs (comment-search-forward end t)))) |
| 506 | (and (< (point) end) | 506 | (setq pt (point))) |
| 507 | (setq cs (comment-search-forward end t)))) | 507 | (goto-char pt) |
| 508 | (setq pt (point))) | 508 | cs)))) |
| 509 | (goto-char pt) | ||
| 510 | cs))))) | ||
| 511 | 509 | ||
| 512 | (defun comment-beginning () | 510 | (defun comment-beginning () |
| 513 | "Find the beginning of the enclosing comment. | 511 | "Find the beginning of the enclosing comment. |
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index b0c0bfd7bde..9077bdbb513 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el | |||
| @@ -9355,10 +9355,6 @@ comment at the start of cc-engine.el for more info." | |||
| 9355 | containing-sexp nil))) | 9355 | containing-sexp nil))) |
| 9356 | (setq lim (1+ containing-sexp)))) | 9356 | (setq lim (1+ containing-sexp)))) |
| 9357 | (setq lim (point-min))) | 9357 | (setq lim (point-min))) |
| 9358 | (when (c-beginning-of-macro) | ||
| 9359 | (goto-char indent-point) | ||
| 9360 | (let ((lim1 (c-determine-limit 2000))) | ||
| 9361 | (setq lim (max lim lim1)))) | ||
| 9362 | 9358 | ||
| 9363 | ;; If we're in a parenthesis list then ',' delimits the | 9359 | ;; If we're in a parenthesis list then ',' delimits the |
| 9364 | ;; "statements" rather than being an operator (with the | 9360 | ;; "statements" rather than being an operator (with the |
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 11eb0eeaf49..01b5faef5b3 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el | |||
| @@ -527,6 +527,11 @@ Intended as the value of `indent-line-function'." | |||
| 527 | ;; Doze path separators. | 527 | ;; Doze path separators. |
| 528 | (modify-syntax-entry ?\\ "." table)) | 528 | (modify-syntax-entry ?\\ "." table)) |
| 529 | 529 | ||
| 530 | (defconst cfengine3--prettify-symbols-alist | ||
| 531 | '(("->" . ?→) | ||
| 532 | ("=>" . ?⇒) | ||
| 533 | ("::" . ?∷))) | ||
| 534 | |||
| 530 | ;;;###autoload | 535 | ;;;###autoload |
| 531 | (define-derived-mode cfengine3-mode prog-mode "CFE3" | 536 | (define-derived-mode cfengine3-mode prog-mode "CFE3" |
| 532 | "Major mode for editing CFEngine3 input. | 537 | "Major mode for editing CFEngine3 input. |
| @@ -538,8 +543,11 @@ to the action header." | |||
| 538 | (cfengine-common-syntax cfengine3-mode-syntax-table) | 543 | (cfengine-common-syntax cfengine3-mode-syntax-table) |
| 539 | 544 | ||
| 540 | (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line) | 545 | (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line) |
| 546 | |||
| 541 | (setq font-lock-defaults | 547 | (setq font-lock-defaults |
| 542 | '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun)) | 548 | '(cfengine3-font-lock-keywords |
| 549 | nil nil nil beginning-of-defun)) | ||
| 550 | (prog-prettify-install cfengine3--prettify-symbols-alist) | ||
| 543 | 551 | ||
| 544 | ;; Use defuns as the essential syntax block. | 552 | ;; Use defuns as the essential syntax block. |
| 545 | (set (make-local-variable 'beginning-of-defun-function) | 553 | (set (make-local-variable 'beginning-of-defun-function) |
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index d6f136ec92d..d9c482330cc 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el | |||
| @@ -1002,7 +1002,7 @@ POS and RES.") | |||
| 1002 | (let ((win (get-buffer-window buffer 0))) | 1002 | (let ((win (get-buffer-window buffer 0))) |
| 1003 | (if win (set-window-point win pos))) | 1003 | (if win (set-window-point win pos))) |
| 1004 | (if compilation-auto-jump-to-first-error | 1004 | (if compilation-auto-jump-to-first-error |
| 1005 | (compile-goto-error)))) | 1005 | (compile-goto-error nil t)))) |
| 1006 | 1006 | ||
| 1007 | ;; This function is the central driver, called when font-locking to gather | 1007 | ;; This function is the central driver, called when font-locking to gather |
| 1008 | ;; all information needed to later jump to corresponding source code. | 1008 | ;; all information needed to later jump to corresponding source code. |
| @@ -2317,7 +2317,7 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)." | |||
| 2317 | 2317 | ||
| 2318 | (defalias 'compile-mouse-goto-error 'compile-goto-error) | 2318 | (defalias 'compile-mouse-goto-error 'compile-goto-error) |
| 2319 | 2319 | ||
| 2320 | (defun compile-goto-error (&optional event) | 2320 | (defun compile-goto-error (&optional event nomsg) |
| 2321 | "Visit the source for the error message at point. | 2321 | "Visit the source for the error message at point. |
| 2322 | Use this command in a compilation log buffer. Sets the mark at point there." | 2322 | Use this command in a compilation log buffer. Sets the mark at point there." |
| 2323 | (interactive (list last-input-event)) | 2323 | (interactive (list last-input-event)) |
| @@ -2328,7 +2328,7 @@ Use this command in a compilation log buffer. Sets the mark at point there." | |||
| 2328 | (if (get-text-property (point) 'compilation-directory) | 2328 | (if (get-text-property (point) 'compilation-directory) |
| 2329 | (dired-other-window | 2329 | (dired-other-window |
| 2330 | (car (get-text-property (point) 'compilation-directory))) | 2330 | (car (get-text-property (point) 'compilation-directory))) |
| 2331 | (push-mark) | 2331 | (push-mark nil nomsg) |
| 2332 | (setq compilation-current-error (point)) | 2332 | (setq compilation-current-error (point)) |
| 2333 | (next-error-internal))) | 2333 | (next-error-internal))) |
| 2334 | 2334 | ||
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index c6e19fe3a15..b1936467274 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el | |||
| @@ -89,7 +89,7 @@ Used in `octave-mode' and `inferior-octave-mode' buffers.") | |||
| 89 | 89 | ||
| 90 | (defvar octave-function-header-regexp | 90 | (defvar octave-function-header-regexp |
| 91 | (concat "^\\s-*\\_<\\(function\\)\\_>" | 91 | (concat "^\\s-*\\_<\\(function\\)\\_>" |
| 92 | "\\([^=;\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>") | 92 | "\\([^=;(\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>") |
| 93 | "Regexp to match an Octave function header. | 93 | "Regexp to match an Octave function header. |
| 94 | The string `function' and its name are given by the first and third | 94 | The string `function' and its name are given by the first and third |
| 95 | parenthetical grouping.") | 95 | parenthetical grouping.") |
| @@ -153,10 +153,10 @@ parenthetical grouping.") | |||
| 153 | 'eldoc-mode)) | 153 | 'eldoc-mode)) |
| 154 | :style toggle :selected (or eldoc-post-insert-mode eldoc-mode) | 154 | :style toggle :selected (or eldoc-post-insert-mode eldoc-mode) |
| 155 | :help "Display function signatures after typing `SPC' or `('"] | 155 | :help "Display function signatures after typing `SPC' or `('"] |
| 156 | ["Delimiter Matching" smie-highlight-matching-block-mode | 156 | ["Delimiter Matching" show-paren-mode |
| 157 | :style toggle :selected smie-highlight-matching-block-mode | 157 | :style toggle :selected show-paren-mode |
| 158 | :help "Highlight matched pairs such as `if ... end'" | 158 | :help "Highlight matched pairs such as `if ... end'" |
| 159 | :visible (fboundp 'smie-highlight-matching-block-mode)] | 159 | :visible (fboundp 'smie--matching-block-data)] |
| 160 | ["Auto Fill" auto-fill-mode | 160 | ["Auto Fill" auto-fill-mode |
| 161 | :style toggle :selected auto-fill-function | 161 | :style toggle :selected auto-fill-function |
| 162 | :help "Automatic line breaking"] | 162 | :help "Automatic line breaking"] |
| @@ -540,6 +540,7 @@ definitions can also be stored in files and used in batch mode." | |||
| 540 | ;; a ";" at those places where it's correct (i.e. outside of parens). | 540 | ;; a ";" at those places where it's correct (i.e. outside of parens). |
| 541 | (setq-local electric-layout-rules '((?\; . after))) | 541 | (setq-local electric-layout-rules '((?\; . after))) |
| 542 | 542 | ||
| 543 | (setq-local comment-use-global-state t) | ||
| 543 | (setq-local comment-start octave-comment-start) | 544 | (setq-local comment-start octave-comment-start) |
| 544 | (setq-local comment-end "") | 545 | (setq-local comment-end "") |
| 545 | (setq-local comment-start-skip octave-comment-start-skip) | 546 | (setq-local comment-start-skip octave-comment-start-skip) |
| @@ -563,6 +564,8 @@ definitions can also be stored in files and used in batch mode." | |||
| 563 | (setq-local imenu-generic-expression octave-mode-imenu-generic-expression) | 564 | (setq-local imenu-generic-expression octave-mode-imenu-generic-expression) |
| 564 | (setq-local imenu-case-fold-search nil) | 565 | (setq-local imenu-case-fold-search nil) |
| 565 | 566 | ||
| 567 | (setq-local add-log-current-defun-function #'octave-add-log-current-defun) | ||
| 568 | |||
| 566 | (add-hook 'completion-at-point-functions 'octave-completion-at-point nil t) | 569 | (add-hook 'completion-at-point-functions 'octave-completion-at-point nil t) |
| 567 | (add-hook 'before-save-hook 'octave-sync-function-file-names nil t) | 570 | (add-hook 'before-save-hook 'octave-sync-function-file-names nil t) |
| 568 | (setq-local beginning-of-defun-function 'octave-beginning-of-defun) | 571 | (setq-local beginning-of-defun-function 'octave-beginning-of-defun) |
| @@ -605,12 +608,13 @@ startup." | |||
| 605 | :group 'octave | 608 | :group 'octave |
| 606 | :version "24.4") | 609 | :version "24.4") |
| 607 | 610 | ||
| 608 | (defcustom inferior-octave-startup-args nil | 611 | (defcustom inferior-octave-startup-args '("-i" "--no-line-editing") |
| 609 | "List of command line arguments for the inferior Octave process. | 612 | "List of command line arguments for the inferior Octave process. |
| 610 | For example, for suppressing the startup message and using `traditional' | 613 | For example, for suppressing the startup message and using `traditional' |
| 611 | mode, set this to (\"-q\" \"--traditional\")." | 614 | mode, include \"-q\" and \"--traditional\"." |
| 612 | :type '(repeat string) | 615 | :type '(repeat string) |
| 613 | :group 'octave) | 616 | :group 'octave |
| 617 | :version "24.4") | ||
| 614 | 618 | ||
| 615 | (defcustom inferior-octave-mode-hook nil | 619 | (defcustom inferior-octave-mode-hook nil |
| 616 | "Hook to be run when Inferior Octave mode is started." | 620 | "Hook to be run when Inferior Octave mode is started." |
| @@ -664,6 +668,7 @@ in the Inferior Octave buffer.") | |||
| 664 | :abbrev-table octave-abbrev-table | 668 | :abbrev-table octave-abbrev-table |
| 665 | (setq comint-prompt-regexp inferior-octave-prompt) | 669 | (setq comint-prompt-regexp inferior-octave-prompt) |
| 666 | 670 | ||
| 671 | (setq-local comment-use-global-state t) | ||
| 667 | (setq-local comment-start octave-comment-start) | 672 | (setq-local comment-start octave-comment-start) |
| 668 | (setq-local comment-end "") | 673 | (setq-local comment-end "") |
| 669 | (setq comment-column 32) | 674 | (setq comment-column 32) |
| @@ -719,13 +724,13 @@ startup file, `~/.emacs-octave'." | |||
| 719 | (substring inferior-octave-buffer 1 -1) | 724 | (substring inferior-octave-buffer 1 -1) |
| 720 | inferior-octave-buffer | 725 | inferior-octave-buffer |
| 721 | inferior-octave-program | 726 | inferior-octave-program |
| 722 | (append (list "-i" "--no-line-editing") | 727 | (append |
| 723 | ;; --no-gui is introduced in Octave > 3.7 | 728 | inferior-octave-startup-args |
| 724 | (when (zerop (process-file inferior-octave-program | 729 | ;; --no-gui is introduced in Octave > 3.7 |
| 725 | nil nil nil | 730 | (and (not (member "--no-gui" inferior-octave-startup-args)) |
| 726 | "--no-gui" "--help")) | 731 | (zerop (process-file inferior-octave-program |
| 727 | (list "--no-gui")) | 732 | nil nil nil "--no-gui" "--help")) |
| 728 | inferior-octave-startup-args)))) | 733 | '("--no-gui")))))) |
| 729 | (set-process-filter proc 'inferior-octave-output-digest) | 734 | (set-process-filter proc 'inferior-octave-output-digest) |
| 730 | (setq inferior-octave-process proc | 735 | (setq inferior-octave-process proc |
| 731 | inferior-octave-output-list nil | 736 | inferior-octave-output-list nil |
| @@ -755,10 +760,10 @@ startup file, `~/.emacs-octave'." | |||
| 755 | (inferior-octave-send-list-and-digest (list "PS2\n")) | 760 | (inferior-octave-send-list-and-digest (list "PS2\n")) |
| 756 | (when (string-match "\\(PS2\\|ans\\) = *$" | 761 | (when (string-match "\\(PS2\\|ans\\) = *$" |
| 757 | (car inferior-octave-output-list)) | 762 | (car inferior-octave-output-list)) |
| 758 | (inferior-octave-send-list-and-digest (list "PS2 (\"> \");\n"))) | 763 | (inferior-octave-send-list-and-digest (list "PS2 ('> ');\n"))) |
| 759 | 764 | ||
| 760 | (inferior-octave-send-list-and-digest | 765 | (inferior-octave-send-list-and-digest |
| 761 | (list "disp(getenv(\"OCTAVE_SRCDIR\"))\n")) | 766 | (list "disp (getenv ('OCTAVE_SRCDIR'))\n")) |
| 762 | (process-put proc 'octave-srcdir | 767 | (process-put proc 'octave-srcdir |
| 763 | (unless (equal (car inferior-octave-output-list) "") | 768 | (unless (equal (car inferior-octave-output-list) "") |
| 764 | (car inferior-octave-output-list))) | 769 | (car inferior-octave-output-list))) |
| @@ -767,19 +772,19 @@ startup file, `~/.emacs-octave'." | |||
| 767 | (inferior-octave-send-list-and-digest | 772 | (inferior-octave-send-list-and-digest |
| 768 | (list "more off;\n" | 773 | (list "more off;\n" |
| 769 | (unless (equal inferior-octave-output-string ">> ") | 774 | (unless (equal inferior-octave-output-string ">> ") |
| 770 | "PS1 (\"\\\\s> \");\n") | 775 | "PS1 ('\\s> ');\n") |
| 771 | (when (and inferior-octave-startup-file | 776 | (when (and inferior-octave-startup-file |
| 772 | (file-exists-p inferior-octave-startup-file)) | 777 | (file-exists-p inferior-octave-startup-file)) |
| 773 | (format "source (\"%s\");\n" inferior-octave-startup-file)))) | 778 | (format "source ('%s');\n" inferior-octave-startup-file)))) |
| 774 | (when inferior-octave-output-list | 779 | (when inferior-octave-output-list |
| 775 | (insert-before-markers | 780 | (insert-before-markers |
| 776 | (mapconcat 'identity inferior-octave-output-list "\n"))) | 781 | (mapconcat 'identity inferior-octave-output-list "\n"))) |
| 777 | 782 | ||
| 778 | ;; And finally, everything is back to normal. | 783 | ;; And finally, everything is back to normal. |
| 779 | (set-process-filter proc 'comint-output-filter) | 784 | (set-process-filter proc 'comint-output-filter) |
| 780 | ;; Just in case, to be sure a cd in the startup file | 785 | ;; Just in case, to be sure a cd in the startup file won't have |
| 781 | ;; won't have detrimental effects. | 786 | ;; detrimental effects. |
| 782 | (inferior-octave-resync-dirs) | 787 | (with-demoted-errors (inferior-octave-resync-dirs)) |
| 783 | ;; Generate a proper prompt, which is critical to | 788 | ;; Generate a proper prompt, which is critical to |
| 784 | ;; `comint-history-isearch-backward-regexp'. Bug#14433. | 789 | ;; `comint-history-isearch-backward-regexp'. Bug#14433. |
| 785 | (comint-send-string proc "\n"))) | 790 | (comint-send-string proc "\n"))) |
| @@ -795,7 +800,7 @@ startup file, `~/.emacs-octave'." | |||
| 795 | (unless (and (equal (car cache) command) | 800 | (unless (and (equal (car cache) command) |
| 796 | (< (float-time) (+ 5 (cadr cache)))) | 801 | (< (float-time) (+ 5 (cadr cache)))) |
| 797 | (inferior-octave-send-list-and-digest | 802 | (inferior-octave-send-list-and-digest |
| 798 | (list (concat "completion_matches (\"" command "\");\n"))) | 803 | (list (format "completion_matches ('%s');\n" command))) |
| 799 | (setq cache (list command (float-time) | 804 | (setq cache (list command (float-time) |
| 800 | (delete-consecutive-dups | 805 | (delete-consecutive-dups |
| 801 | (sort inferior-octave-output-list 'string-lessp))))) | 806 | (sort inferior-octave-output-list 'string-lessp))))) |
| @@ -894,8 +899,8 @@ output is passed to the filter `inferior-octave-output-digest'." | |||
| 894 | "Tracks `cd' commands issued to the inferior Octave process. | 899 | "Tracks `cd' commands issued to the inferior Octave process. |
| 895 | Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." | 900 | Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." |
| 896 | (when inferior-octave-directory-tracker-resync | 901 | (when inferior-octave-directory-tracker-resync |
| 897 | (setq inferior-octave-directory-tracker-resync nil) | 902 | (or (inferior-octave-resync-dirs 'noerror) |
| 898 | (inferior-octave-resync-dirs)) | 903 | (setq inferior-octave-directory-tracker-resync nil))) |
| 899 | (cond | 904 | (cond |
| 900 | ((string-match "^[ \t]*cd[ \t;]*$" string) | 905 | ((string-match "^[ \t]*cd[ \t;]*$" string) |
| 901 | (cd "~")) | 906 | (cd "~")) |
| @@ -907,13 +912,17 @@ Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." | |||
| 907 | (error-message-string err) | 912 | (error-message-string err) |
| 908 | (match-string 1 string))))))) | 913 | (match-string 1 string))))))) |
| 909 | 914 | ||
| 910 | (defun inferior-octave-resync-dirs () | 915 | (defun inferior-octave-resync-dirs (&optional noerror) |
| 911 | "Resync the buffer's idea of the current directory. | 916 | "Resync the buffer's idea of the current directory. |
| 912 | This command queries the inferior Octave process about its current | 917 | This command queries the inferior Octave process about its current |
| 913 | directory and makes this the current buffer's default directory." | 918 | directory and makes this the current buffer's default directory." |
| 914 | (interactive) | 919 | (interactive) |
| 915 | (inferior-octave-send-list-and-digest '("disp (pwd ())\n")) | 920 | (inferior-octave-send-list-and-digest '("disp (pwd ())\n")) |
| 916 | (cd (car inferior-octave-output-list))) | 921 | (condition-case err |
| 922 | (progn | ||
| 923 | (cd (car inferior-octave-output-list)) | ||
| 924 | t) | ||
| 925 | (error (unless noerror (signal (car err) (cdr err)))))) | ||
| 917 | 926 | ||
| 918 | (defcustom inferior-octave-minimal-columns 80 | 927 | (defcustom inferior-octave-minimal-columns 80 |
| 919 | "The minimal column width for the inferior Octave process." | 928 | "The minimal column width for the inferior Octave process." |
| @@ -931,7 +940,7 @@ directory and makes this the current buffer's default directory." | |||
| 931 | (when (and inferior-octave-process | 940 | (when (and inferior-octave-process |
| 932 | (process-live-p inferior-octave-process)) | 941 | (process-live-p inferior-octave-process)) |
| 933 | (inferior-octave-send-list-and-digest | 942 | (inferior-octave-send-list-and-digest |
| 934 | (list (format "putenv(\"COLUMNS\", \"%s\");\n" width))))))) | 943 | (list (format "putenv ('COLUMNS', '%s');\n" width))))))) |
| 935 | 944 | ||
| 936 | 945 | ||
| 937 | ;;; Miscellaneous useful functions | 946 | ;;; Miscellaneous useful functions |
| @@ -975,16 +984,17 @@ directory and makes this the current buffer's default directory." | |||
| 975 | 984 | ||
| 976 | (defun octave-goto-function-definition (fn) | 985 | (defun octave-goto-function-definition (fn) |
| 977 | "Go to the function definition of FN in current buffer." | 986 | "Go to the function definition of FN in current buffer." |
| 978 | (goto-char (point-min)) | ||
| 979 | (let ((search | 987 | (let ((search |
| 980 | (lambda (re sub) | 988 | (lambda (re sub) |
| 981 | (let (done) | 989 | (let ((orig (point)) found) |
| 982 | (while (and (not done) (re-search-forward re nil t)) | 990 | (goto-char (point-min)) |
| 991 | (while (and (not found) (re-search-forward re nil t)) | ||
| 983 | (when (and (equal (match-string sub) fn) | 992 | (when (and (equal (match-string sub) fn) |
| 984 | (not (nth 8 (syntax-ppss)))) | 993 | (not (nth 8 (syntax-ppss)))) |
| 985 | (setq done t))) | 994 | (setq found t))) |
| 986 | (or done (goto-char (point-min))))))) | 995 | (unless found (goto-char orig)) |
| 987 | (pcase (file-name-extension (buffer-file-name)) | 996 | found)))) |
| 997 | (pcase (and buffer-file-name (file-name-extension buffer-file-name)) | ||
| 988 | (`"cc" (funcall search | 998 | (`"cc" (funcall search |
| 989 | "\\_<DEFUN\\(?:_DLD\\)?\\s-*(\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)" 1)) | 999 | "\\_<DEFUN\\(?:_DLD\\)?\\s-*(\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)" 1)) |
| 990 | (t (funcall search octave-function-header-regexp 3))))) | 1000 | (t (funcall search octave-function-header-regexp 3))))) |
| @@ -1345,8 +1355,6 @@ The block marked is the one that contains point or follows point." | |||
| 1345 | (forward-line 1)))) | 1355 | (forward-line 1)))) |
| 1346 | t))) | 1356 | t))) |
| 1347 | 1357 | ||
| 1348 | ;;; Completions | ||
| 1349 | |||
| 1350 | (defun octave-completion-at-point () | 1358 | (defun octave-completion-at-point () |
| 1351 | "Find the text to complete and the corresponding table." | 1359 | "Find the text to complete and the corresponding table." |
| 1352 | (let* ((beg (save-excursion (skip-syntax-backward "w_") (point))) | 1360 | (let* ((beg (save-excursion (skip-syntax-backward "w_") (point))) |
| @@ -1363,6 +1371,16 @@ The block marked is the one that contains point or follows point." | |||
| 1363 | 1371 | ||
| 1364 | (define-obsolete-function-alias 'octave-complete-symbol | 1372 | (define-obsolete-function-alias 'octave-complete-symbol |
| 1365 | 'completion-at-point "24.1") | 1373 | 'completion-at-point "24.1") |
| 1374 | |||
| 1375 | (defun octave-add-log-current-defun () | ||
| 1376 | "A function for `add-log-current-defun-function' (which see)." | ||
| 1377 | (save-excursion | ||
| 1378 | (end-of-line) | ||
| 1379 | (and (beginning-of-defun) | ||
| 1380 | (re-search-forward octave-function-header-regexp | ||
| 1381 | (line-end-position) t) | ||
| 1382 | (match-string 3)))) | ||
| 1383 | |||
| 1366 | 1384 | ||
| 1367 | ;;; Electric characters && friends | 1385 | ;;; Electric characters && friends |
| 1368 | (define-skeleton octave-insert-defun | 1386 | (define-skeleton octave-insert-defun |
| @@ -1387,7 +1405,7 @@ entered without parens)." | |||
| 1387 | "function " > str \n | 1405 | "function " > str \n |
| 1388 | _ \n | 1406 | _ \n |
| 1389 | "endfunction" > \n) | 1407 | "endfunction" > \n) |
| 1390 | 1408 | ||
| 1391 | ;;; Communication with the inferior Octave process | 1409 | ;;; Communication with the inferior Octave process |
| 1392 | (defun octave-kill-process () | 1410 | (defun octave-kill-process () |
| 1393 | "Kill inferior Octave process and its buffer." | 1411 | "Kill inferior Octave process and its buffer." |
| @@ -1506,9 +1524,7 @@ code line." | |||
| 1506 | (defun octave-eldoc-function-signatures (fn) | 1524 | (defun octave-eldoc-function-signatures (fn) |
| 1507 | (unless (equal fn (car octave-eldoc-cache)) | 1525 | (unless (equal fn (car octave-eldoc-cache)) |
| 1508 | (inferior-octave-send-list-and-digest | 1526 | (inferior-octave-send-list-and-digest |
| 1509 | (list (format "\ | 1527 | (list (format "print_usage ('%s');\n" fn))) |
| 1510 | if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n" | ||
| 1511 | fn fn))) | ||
| 1512 | (let (result) | 1528 | (let (result) |
| 1513 | (dolist (line inferior-octave-output-list) | 1529 | (dolist (line inferior-octave-output-list) |
| 1514 | (when (string-match | 1530 | (when (string-match |
| @@ -1605,20 +1621,11 @@ if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n" | |||
| 1605 | (when (or help-xref-stack help-xref-forward-stack) | 1621 | (when (or help-xref-stack help-xref-forward-stack) |
| 1606 | (insert "\n")))) | 1622 | (insert "\n")))) |
| 1607 | 1623 | ||
| 1608 | (defvar octave-help-mode-finish-hook nil | ||
| 1609 | "Octave specific hook for `temp-buffer-show-hook'.") | ||
| 1610 | |||
| 1611 | (defun octave-help-mode-finish () | ||
| 1612 | (when (eq major-mode 'octave-help-mode) | ||
| 1613 | (run-hooks 'octave-help-mode-finish-hook))) | ||
| 1614 | |||
| 1615 | (add-hook 'temp-buffer-show-hook 'octave-help-mode-finish) | ||
| 1616 | |||
| 1617 | (defun octave-help (fn) | 1624 | (defun octave-help (fn) |
| 1618 | "Display the documentation of FN." | 1625 | "Display the documentation of FN." |
| 1619 | (interactive (list (octave-completing-read))) | 1626 | (interactive (list (octave-completing-read))) |
| 1620 | (inferior-octave-send-list-and-digest | 1627 | (inferior-octave-send-list-and-digest |
| 1621 | (list (format "help \"%s\"\n" fn))) | 1628 | (list (format "help ('%s');\n" fn))) |
| 1622 | (let ((lines inferior-octave-output-list) | 1629 | (let ((lines inferior-octave-output-list) |
| 1623 | (inhibit-read-only t)) | 1630 | (inhibit-read-only t)) |
| 1624 | (when (string-match "error: \\(.*\\)$" (car lines)) | 1631 | (when (string-match "error: \\(.*\\)$" (car lines)) |
| @@ -1654,12 +1661,15 @@ if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n" | |||
| 1654 | (help-insert-xref-button (file-relative-name file dir) | 1661 | (help-insert-xref-button (file-relative-name file dir) |
| 1655 | 'octave-help-file fn) | 1662 | 'octave-help-file fn) |
| 1656 | (insert "'"))) | 1663 | (insert "'"))) |
| 1657 | ;; Make 'See also' clickable | 1664 | ;; Make 'See also' clickable. |
| 1658 | (with-syntax-table octave-mode-syntax-table | 1665 | (with-syntax-table octave-mode-syntax-table |
| 1659 | (when (re-search-forward "^\\s-*See also:" nil t) | 1666 | (when (re-search-forward "^\\s-*See also:" nil t) |
| 1660 | (let ((end (save-excursion (re-search-forward "^\\s-*$" nil t)))) | 1667 | (let ((end (save-excursion (re-search-forward "^\\s-*$" nil t)))) |
| 1661 | (while (re-search-forward "\\_<\\(?:\\sw\\|\\s_\\)+\\_>" end t) | 1668 | (while (re-search-forward |
| 1662 | (make-text-button (match-beginning 0) (match-end 0) | 1669 | ;; Match operators and symbols. |
| 1670 | "\\(?1:\\s.+?\\)\\(?:$\\|[,;]\\|\\s-\\)\\|\\_<\\(?1:\\(?:\\sw\\|\\s_\\)+\\)\\_>" | ||
| 1671 | end t) | ||
| 1672 | (make-text-button (match-beginning 1) (match-end 1) | ||
| 1663 | :type 'octave-help-function))))) | 1673 | :type 'octave-help-function))))) |
| 1664 | (octave-help-mode))))) | 1674 | (octave-help-mode))))) |
| 1665 | 1675 | ||
| @@ -1710,23 +1720,30 @@ If the environment variable OCTAVE_SRCDIR is set, it is searched first." | |||
| 1710 | Functions implemented in C++ can be found if | 1720 | Functions implemented in C++ can be found if |
| 1711 | `octave-source-directories' is set correctly." | 1721 | `octave-source-directories' is set correctly." |
| 1712 | (interactive (list (octave-completing-read))) | 1722 | (interactive (list (octave-completing-read))) |
| 1713 | (inferior-octave-send-list-and-digest | 1723 | (require 'etags) |
| 1714 | ;; help NAME is more verbose | 1724 | (let ((orig (point))) |
| 1715 | (list (format "\ | 1725 | (if (and (derived-mode-p 'octave-mode) |
| 1716 | if iskeyword(\"%s\") disp(\"`%s' is a keyword\") else which(\"%s\") endif\n" | 1726 | (octave-goto-function-definition fn)) |
| 1717 | fn fn fn))) | 1727 | (ring-insert find-tag-marker-ring (copy-marker orig)) |
| 1718 | (let* ((line (car inferior-octave-output-list)) | 1728 | (inferior-octave-send-list-and-digest |
| 1719 | (file (when (and line (string-match "from the file \\(.*\\)$" line)) | 1729 | ;; help NAME is more verbose |
| 1720 | (match-string 1 line)))) | 1730 | (list (format "\ |
| 1721 | (if (not file) | 1731 | if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n" |
| 1722 | (user-error "%s" (or line (format "`%s' not found" fn))) | 1732 | fn fn fn))) |
| 1723 | (require 'etags) | 1733 | (let (line file) |
| 1724 | (ring-insert find-tag-marker-ring (point-marker)) | 1734 | ;; Skip garbage lines such as |
| 1725 | (setq file (funcall octave-find-definition-filename-function file)) | 1735 | ;; warning: fmincg.m: possible Matlab-style .... |
| 1726 | (when file | 1736 | (while (and (not file) (consp inferior-octave-output-list)) |
| 1727 | (find-file file) | 1737 | (setq line (pop inferior-octave-output-list)) |
| 1728 | (octave-goto-function-definition fn))))) | 1738 | (when (string-match "from the file \\(.*\\)$" line) |
| 1729 | 1739 | (setq file (match-string 1 line)))) | |
| 1740 | (if (not file) | ||
| 1741 | (user-error "%s" (or line (format "`%s' not found" fn))) | ||
| 1742 | (ring-insert find-tag-marker-ring (point-marker)) | ||
| 1743 | (setq file (funcall octave-find-definition-filename-function file)) | ||
| 1744 | (when file | ||
| 1745 | (find-file file) | ||
| 1746 | (octave-goto-function-definition fn))))))) | ||
| 1730 | 1747 | ||
| 1731 | (provide 'octave) | 1748 | (provide 'octave) |
| 1732 | ;;; octave.el ends here | 1749 | ;;; octave.el ends here |
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 01ac8584e19..1d5052bede4 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el | |||
| @@ -158,44 +158,10 @@ | |||
| 158 | ;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and | 158 | ;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and |
| 159 | ;; Jim Campbell <jec@murzim.ca.boeing.com>. | 159 | ;; Jim Campbell <jec@murzim.ca.boeing.com>. |
| 160 | 160 | ||
| 161 | (defcustom perl-prettify-symbols t | ||
| 162 | "If non-nil, some symbols will be displayed using Unicode chars." | ||
| 163 | :version "24.4" | ||
| 164 | :type 'boolean) | ||
| 165 | |||
| 166 | (defconst perl--prettify-symbols-alist | 161 | (defconst perl--prettify-symbols-alist |
| 167 | '(;;("andalso" . ?∧) ("orelse" . ?∨) ("as" . ?≡)("not" . ?¬) | 162 | '(("->" . ?→) |
| 168 | ;;("div" . ?÷) ("*" . ?×) ("o" . ?○) | ||
| 169 | ("->" . ?→) | ||
| 170 | ("=>" . ?⇒) | 163 | ("=>" . ?⇒) |
| 171 | ;;("<-" . ?←) ("<>" . ?≠) (">=" . ?≥) ("<=" . ?≤) ("..." . ?⋯) | 164 | ("::" . ?∷))) |
| 172 | ("::" . ?∷) | ||
| 173 | )) | ||
| 174 | |||
| 175 | (defun perl--font-lock-compose-symbol () | ||
| 176 | "Compose a sequence of ascii chars into a symbol. | ||
| 177 | Regexp match data 0 points to the chars." | ||
| 178 | ;; Check that the chars should really be composed into a symbol. | ||
| 179 | (let* ((start (match-beginning 0)) | ||
| 180 | (end (match-end 0)) | ||
| 181 | (syntaxes (if (eq (char-syntax (char-after start)) ?w) | ||
| 182 | '(?w) '(?. ?\\)))) | ||
| 183 | (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) | ||
| 184 | (memq (char-syntax (or (char-after end) ?\ )) syntaxes) | ||
| 185 | (nth 8 (syntax-ppss))) | ||
| 186 | ;; No composition for you. Let's actually remove any composition | ||
| 187 | ;; we may have added earlier and which is now incorrect. | ||
| 188 | (remove-text-properties start end '(composition)) | ||
| 189 | ;; That's a symbol alright, so add the composition. | ||
| 190 | (compose-region start end (cdr (assoc (match-string 0) | ||
| 191 | perl--prettify-symbols-alist))))) | ||
| 192 | ;; Return nil because we're not adding any face property. | ||
| 193 | nil) | ||
| 194 | |||
| 195 | (defun perl--font-lock-symbols-keywords () | ||
| 196 | (when perl-prettify-symbols | ||
| 197 | `((,(regexp-opt (mapcar 'car perl--prettify-symbols-alist) t) | ||
| 198 | (0 (perl--font-lock-compose-symbol)))))) | ||
| 199 | 165 | ||
| 200 | (defconst perl-font-lock-keywords-1 | 166 | (defconst perl-font-lock-keywords-1 |
| 201 | '(;; What is this for? | 167 | '(;; What is this for? |
| @@ -243,8 +209,7 @@ Regexp match data 0 points to the chars." | |||
| 243 | ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. | 209 | ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. |
| 244 | ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" | 210 | ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" |
| 245 | (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) | 211 | (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) |
| 246 | ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face) | 212 | ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face))) |
| 247 | ,@(perl--font-lock-symbols-keywords))) | ||
| 248 | "Gaudy level highlighting for Perl mode.") | 213 | "Gaudy level highlighting for Perl mode.") |
| 249 | 214 | ||
| 250 | (defvar perl-font-lock-keywords perl-font-lock-keywords-1 | 215 | (defvar perl-font-lock-keywords perl-font-lock-keywords-1 |
| @@ -685,13 +650,15 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." | |||
| 685 | (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *") | 650 | (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *") |
| 686 | (setq-local comment-indent-function #'perl-comment-indent) | 651 | (setq-local comment-indent-function #'perl-comment-indent) |
| 687 | (setq-local parse-sexp-ignore-comments t) | 652 | (setq-local parse-sexp-ignore-comments t) |
| 653 | |||
| 688 | ;; Tell font-lock.el how to handle Perl. | 654 | ;; Tell font-lock.el how to handle Perl. |
| 689 | (setq font-lock-defaults '((perl-font-lock-keywords | 655 | (setq font-lock-defaults '((perl-font-lock-keywords |
| 690 | perl-font-lock-keywords-1 | 656 | perl-font-lock-keywords-1 |
| 691 | perl-font-lock-keywords-2) | 657 | perl-font-lock-keywords-2) |
| 692 | nil nil ((?\_ . "w")) nil | 658 | nil nil ((?\_ . "w")) nil |
| 693 | (font-lock-syntactic-face-function | 659 | (font-lock-syntactic-face-function |
| 694 | . perl-font-lock-syntactic-face-function))) | 660 | . perl-font-lock-syntactic-face-function))) |
| 661 | (prog-prettify-install perl--prettify-symbols-alist) | ||
| 695 | (setq-local syntax-propertize-function #'perl-syntax-propertize-function) | 662 | (setq-local syntax-propertize-function #'perl-syntax-propertize-function) |
| 696 | (add-hook 'syntax-propertize-extend-region-functions | 663 | (add-hook 'syntax-propertize-extend-region-functions |
| 697 | #'syntax-propertize-multiline 'append 'local) | 664 | #'syntax-propertize-multiline 'append 'local) |
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el new file mode 100644 index 00000000000..e2700414636 --- /dev/null +++ b/lisp/progmodes/prog-mode.el | |||
| @@ -0,0 +1,119 @@ | |||
| 1 | ;;; prog-mode.el --- Generic major mode for programming -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2013 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Maintainer: FSF | ||
| 6 | ;; Keywords: internal | ||
| 7 | ;; Package: emacs | ||
| 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 | ;; This major mode is mostly intended as a parent of other programming | ||
| 27 | ;; modes. All major modes for programming languages should derive from this | ||
| 28 | ;; mode so that users can put generic customization on prog-mode-hook. | ||
| 29 | |||
| 30 | ;;; Code: | ||
| 31 | |||
| 32 | (eval-when-compile (require 'cl-lib)) | ||
| 33 | |||
| 34 | (defgroup prog-mode nil | ||
| 35 | "Generic programming mode, from which others derive." | ||
| 36 | :group 'languages) | ||
| 37 | |||
| 38 | (defvar prog-mode-map | ||
| 39 | (let ((map (make-sparse-keymap))) | ||
| 40 | (define-key map [?\C-\M-q] 'prog-indent-sexp) | ||
| 41 | map) | ||
| 42 | "Keymap used for programming modes.") | ||
| 43 | |||
| 44 | (defun prog-indent-sexp (&optional defun) | ||
| 45 | "Indent the expression after point. | ||
| 46 | When interactively called with prefix, indent the enclosing defun | ||
| 47 | instead." | ||
| 48 | (interactive "P") | ||
| 49 | (save-excursion | ||
| 50 | (when defun | ||
| 51 | (end-of-line) | ||
| 52 | (beginning-of-defun)) | ||
| 53 | (let ((start (point)) | ||
| 54 | (end (progn (forward-sexp 1) (point)))) | ||
| 55 | (indent-region start end nil)))) | ||
| 56 | |||
| 57 | (defvar prog-prettify-symbols-alist nil) | ||
| 58 | |||
| 59 | (defcustom prog-prettify-symbols nil | ||
| 60 | "Whether symbols should be prettified. | ||
| 61 | When set to an alist in the form `((STRING . CHARACTER)...)' it | ||
| 62 | will augment the mode's native prettify alist." | ||
| 63 | :type '(choice | ||
| 64 | (const :tag "No thanks" nil) | ||
| 65 | (const :tag "Mode defaults" t) | ||
| 66 | (alist :tag "Mode defaults augmented with your own list" | ||
| 67 | :key-type string :value-type character)) | ||
| 68 | :version "24.4") | ||
| 69 | |||
| 70 | (defun prog--prettify-font-lock-compose-symbol (alist) | ||
| 71 | "Compose a sequence of ascii chars into a symbol. | ||
| 72 | Regexp match data 0 points to the chars." | ||
| 73 | ;; Check that the chars should really be composed into a symbol. | ||
| 74 | (let* ((start (match-beginning 0)) | ||
| 75 | (end (match-end 0)) | ||
| 76 | (syntaxes (if (eq (char-syntax (char-after start)) ?w) | ||
| 77 | '(?w) '(?. ?\\)))) | ||
| 78 | (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) | ||
| 79 | (memq (char-syntax (or (char-after end) ?\ )) syntaxes) | ||
| 80 | (nth 8 (syntax-ppss))) | ||
| 81 | ;; No composition for you. Let's actually remove any composition | ||
| 82 | ;; we may have added earlier and which is now incorrect. | ||
| 83 | (remove-text-properties start end '(composition)) | ||
| 84 | ;; That's a symbol alright, so add the composition. | ||
| 85 | (compose-region start end (cdr (assoc (match-string 0) alist))))) | ||
| 86 | ;; Return nil because we're not adding any face property. | ||
| 87 | nil) | ||
| 88 | |||
| 89 | (defun prog-prettify-font-lock-symbols-keywords () | ||
| 90 | (when prog-prettify-symbols | ||
| 91 | (let ((alist (append prog-prettify-symbols-alist | ||
| 92 | (if (listp prog-prettify-symbols) | ||
| 93 | prog-prettify-symbols | ||
| 94 | nil)))) | ||
| 95 | `((,(regexp-opt (mapcar 'car alist) t) | ||
| 96 | (0 (prog--prettify-font-lock-compose-symbol ',alist))))))) | ||
| 97 | |||
| 98 | (defun prog-prettify-install (alist) | ||
| 99 | "Install prog-mode support to prettify symbols according to ALIST. | ||
| 100 | |||
| 101 | ALIST is in the format `((STRING . CHARACTER)...)' like | ||
| 102 | `prog-prettify-symbols'. | ||
| 103 | |||
| 104 | Internally, `font-lock-add-keywords' is called." | ||
| 105 | (setq-local prog-prettify-symbols-alist alist) | ||
| 106 | (let ((keywords (prog-prettify-font-lock-symbols-keywords))) | ||
| 107 | (if keywords (font-lock-add-keywords nil keywords)))) | ||
| 108 | |||
| 109 | ;;;###autoload | ||
| 110 | (define-derived-mode prog-mode fundamental-mode "Prog" | ||
| 111 | "Major mode for editing programming language source code." | ||
| 112 | (set (make-local-variable 'require-final-newline) mode-require-final-newline) | ||
| 113 | (set (make-local-variable 'parse-sexp-ignore-comments) t) | ||
| 114 | ;; Any programming language is always written left to right. | ||
| 115 | (setq bidi-paragraph-direction 'left-to-right)) | ||
| 116 | |||
| 117 | (provide 'prog-mode) | ||
| 118 | |||
| 119 | ;;; prog-mode.el ends here | ||
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 63bd9258d69..0f3c1504ee9 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el | |||
| @@ -1149,11 +1149,7 @@ VERSION is of the format (Major . Minor)" | |||
| 1149 | (set (make-local-variable 'comment-start) "%") | 1149 | (set (make-local-variable 'comment-start) "%") |
| 1150 | (set (make-local-variable 'comment-end) "") | 1150 | (set (make-local-variable 'comment-end) "") |
| 1151 | (set (make-local-variable 'comment-add) 1) | 1151 | (set (make-local-variable 'comment-add) 1) |
| 1152 | (set (make-local-variable 'comment-start-skip) | 1152 | (set (make-local-variable 'comment-start-skip) "\\(?:/\\*+ *\\|%%+ *\\)") |
| 1153 | ;; This complex regexp makes sure that comments cannot start | ||
| 1154 | ;; inside quoted atoms or strings | ||
| 1155 | (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)" | ||
| 1156 | prolog-quoted-atom-regexp prolog-string-regexp)) | ||
| 1157 | (set (make-local-variable 'parens-require-spaces) nil) | 1153 | (set (make-local-variable 'parens-require-spaces) nil) |
| 1158 | ;; Initialize Prolog system specific variables | 1154 | ;; Initialize Prolog system specific variables |
| 1159 | (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators | 1155 | (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators |
| @@ -1739,8 +1735,7 @@ This function must be called from the source code buffer." | |||
| 1739 | (real-file buffer-file-name) | 1735 | (real-file buffer-file-name) |
| 1740 | (command-string (prolog-build-prolog-command compilep file | 1736 | (command-string (prolog-build-prolog-command compilep file |
| 1741 | real-file first-line)) | 1737 | real-file first-line)) |
| 1742 | (process (get-process "prolog")) | 1738 | (process (get-process "prolog"))) |
| 1743 | (old-filter (process-filter process))) | ||
| 1744 | (with-current-buffer buffer | 1739 | (with-current-buffer buffer |
| 1745 | (delete-region (point-min) (point-max)) | 1740 | (delete-region (point-min) (point-max)) |
| 1746 | ;; FIXME: Wasn't this supposed to use prolog-inferior-mode? | 1741 | ;; FIXME: Wasn't this supposed to use prolog-inferior-mode? |
| @@ -1759,8 +1754,7 @@ This function must be called from the source code buffer." | |||
| 1759 | 'prolog-parse-sicstus-compilation-errors)) | 1754 | 'prolog-parse-sicstus-compilation-errors)) |
| 1760 | (setq buffer-read-only nil) | 1755 | (setq buffer-read-only nil) |
| 1761 | (insert command-string "\n")) | 1756 | (insert command-string "\n")) |
| 1762 | (save-selected-window | 1757 | (display-buffer buffer) |
| 1763 | (pop-to-buffer buffer)) | ||
| 1764 | (setq prolog-process-flag t | 1758 | (setq prolog-process-flag t |
| 1765 | prolog-consult-compile-output "" | 1759 | prolog-consult-compile-output "" |
| 1766 | prolog-consult-compile-first-line (if first-line (1- first-line) 0) | 1760 | prolog-consult-compile-first-line (if first-line (1- first-line) 0) |
| @@ -1954,20 +1948,6 @@ If COMPILEP is non-nil, compile, otherwise consult." | |||
| 1954 | ;;------------------------------------------------------------------- | 1948 | ;;------------------------------------------------------------------- |
| 1955 | 1949 | ||
| 1956 | ;; Auxiliary functions | 1950 | ;; Auxiliary functions |
| 1957 | (defun prolog-make-keywords-regexp (keywords &optional protect) | ||
| 1958 | "Create regexp from the list of strings KEYWORDS. | ||
| 1959 | If PROTECT is non-nil, surround the result regexp by word breaks." | ||
| 1960 | (let ((regexp | ||
| 1961 | (if (fboundp 'regexp-opt) | ||
| 1962 | ;; Emacs 20 | ||
| 1963 | ;; Avoid compile warnings under earlier versions by using eval | ||
| 1964 | (eval '(regexp-opt keywords)) | ||
| 1965 | ;; Older Emacsen | ||
| 1966 | (concat (mapconcat 'regexp-quote keywords "\\|"))) | ||
| 1967 | )) | ||
| 1968 | (if protect | ||
| 1969 | (concat "\\<\\(" regexp "\\)\\>") | ||
| 1970 | regexp))) | ||
| 1971 | 1951 | ||
| 1972 | (defun prolog-font-lock-object-matcher (bound) | 1952 | (defun prolog-font-lock-object-matcher (bound) |
| 1973 | "Find SICStus objects method name for font lock. | 1953 | "Find SICStus objects method name for font lock. |
| @@ -2084,20 +2064,16 @@ Argument BOUND is a buffer position limiting searching." | |||
| 2084 | (if (eq prolog-system 'mercury) | 2064 | (if (eq prolog-system 'mercury) |
| 2085 | (concat | 2065 | (concat |
| 2086 | "\\<\\(" | 2066 | "\\<\\(" |
| 2087 | (prolog-make-keywords-regexp prolog-keywords-i) | 2067 | (regexp-opt prolog-keywords-i) |
| 2088 | "\\|" | 2068 | "\\|" |
| 2089 | (prolog-make-keywords-regexp | 2069 | (regexp-opt |
| 2090 | prolog-determinism-specificators-i) | 2070 | prolog-determinism-specificators-i) |
| 2091 | "\\)\\>") | 2071 | "\\)\\>") |
| 2092 | (concat | 2072 | (concat |
| 2093 | "^[?:]- *\\(" | 2073 | "^[?:]- *\\(" |
| 2094 | (prolog-make-keywords-regexp prolog-keywords-i) | 2074 | (regexp-opt prolog-keywords-i) |
| 2095 | "\\)\\>")) | 2075 | "\\)\\>")) |
| 2096 | 1 prolog-builtin-face)) | 2076 | 1 prolog-builtin-face)) |
| 2097 | (quoted_atom (list prolog-quoted-atom-regexp | ||
| 2098 | 2 'font-lock-string-face 'append)) | ||
| 2099 | (string (list prolog-string-regexp | ||
| 2100 | 1 'font-lock-string-face 'append)) | ||
| 2101 | ;; SICStus specific patterns | 2077 | ;; SICStus specific patterns |
| 2102 | (sicstus-object-methods | 2078 | (sicstus-object-methods |
| 2103 | (if (eq prolog-system 'sicstus) | 2079 | (if (eq prolog-system 'sicstus) |
| @@ -2107,17 +2083,17 @@ Argument BOUND is a buffer position limiting searching." | |||
| 2107 | (types | 2083 | (types |
| 2108 | (if (eq prolog-system 'mercury) | 2084 | (if (eq prolog-system 'mercury) |
| 2109 | (list | 2085 | (list |
| 2110 | (prolog-make-keywords-regexp prolog-types-i t) | 2086 | (regexp-opt prolog-types-i 'words) |
| 2111 | 0 'font-lock-type-face))) | 2087 | 0 'font-lock-type-face))) |
| 2112 | (modes | 2088 | (modes |
| 2113 | (if (eq prolog-system 'mercury) | 2089 | (if (eq prolog-system 'mercury) |
| 2114 | (list | 2090 | (list |
| 2115 | (prolog-make-keywords-regexp prolog-mode-specificators-i t) | 2091 | (regexp-opt prolog-mode-specificators-i 'words) |
| 2116 | 0 'font-lock-constant-face))) | 2092 | 0 'font-lock-constant-face))) |
| 2117 | (directives | 2093 | (directives |
| 2118 | (if (eq prolog-system 'mercury) | 2094 | (if (eq prolog-system 'mercury) |
| 2119 | (list | 2095 | (list |
| 2120 | (prolog-make-keywords-regexp prolog-directives-i t) | 2096 | (regexp-opt prolog-directives-i 'words) |
| 2121 | 0 'prolog-warning-face))) | 2097 | 0 'prolog-warning-face))) |
| 2122 | ;; Inferior mode specific patterns | 2098 | ;; Inferior mode specific patterns |
| 2123 | (prompt | 2099 | (prompt |
| @@ -2211,8 +2187,6 @@ Argument BOUND is a buffer position limiting searching." | |||
| 2211 | (list | 2187 | (list |
| 2212 | head-predicates | 2188 | head-predicates |
| 2213 | head-predicates-1 | 2189 | head-predicates-1 |
| 2214 | quoted_atom | ||
| 2215 | string | ||
| 2216 | variables | 2190 | variables |
| 2217 | important-elements | 2191 | important-elements |
| 2218 | important-elements-1 | 2192 | important-elements-1 |
diff --git a/lisp/replace.el b/lisp/replace.el index af05bd11fb2..24cfccf60fd 100644 --- a/lisp/replace.el +++ b/lisp/replace.el | |||
| @@ -246,7 +246,7 @@ Matching is independent of case if `case-fold-search' is non-nil and | |||
| 246 | FROM-STRING has no uppercase letters. Replacement transfers the case | 246 | FROM-STRING has no uppercase letters. Replacement transfers the case |
| 247 | pattern of the old text to the new text, if `case-replace' and | 247 | pattern of the old text to the new text, if `case-replace' and |
| 248 | `case-fold-search' are non-nil and FROM-STRING has no uppercase | 248 | `case-fold-search' are non-nil and FROM-STRING has no uppercase |
| 249 | letters. \(Transferring the case pattern means that if the old text | 249 | letters. (Transferring the case pattern means that if the old text |
| 250 | matched is all caps, or capitalized, then its replacement is upcased | 250 | matched is all caps, or capitalized, then its replacement is upcased |
| 251 | or capitalized.) | 251 | or capitalized.) |
| 252 | 252 | ||
| @@ -1175,8 +1175,8 @@ is called only during interactive use. | |||
| 1175 | 1175 | ||
| 1176 | For example, to check for occurrence of symbol at point use | 1176 | For example, to check for occurrence of symbol at point use |
| 1177 | 1177 | ||
| 1178 | \(setq occur-read-regexp-defaults-function | 1178 | (setq occur-read-regexp-defaults-function |
| 1179 | 'find-tag-default-as-regexp\).") | 1179 | 'find-tag-default-as-regexp).") |
| 1180 | 1180 | ||
| 1181 | (defun occur-read-regexp-defaults () | 1181 | (defun occur-read-regexp-defaults () |
| 1182 | "Return the latest regexp from `regexp-history'. | 1182 | "Return the latest regexp from `regexp-history'. |
| @@ -1874,7 +1874,7 @@ It is called with three arguments, as if it were | |||
| 1874 | 1874 | ||
| 1875 | (defun replace-search (search-string limit regexp-flag delimited-flag | 1875 | (defun replace-search (search-string limit regexp-flag delimited-flag |
| 1876 | case-fold-search) | 1876 | case-fold-search) |
| 1877 | "Search for the next occurence of SEARCH-STRING to replace." | 1877 | "Search for the next occurrence of SEARCH-STRING to replace." |
| 1878 | ;; Let-bind global isearch-* variables to values used | 1878 | ;; Let-bind global isearch-* variables to values used |
| 1879 | ;; to search the next replacement. These let-bindings | 1879 | ;; to search the next replacement. These let-bindings |
| 1880 | ;; should be effective both at the time of calling | 1880 | ;; should be effective both at the time of calling |
diff --git a/lisp/simple.el b/lisp/simple.el index 18a360faa61..15bf8779f56 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -372,34 +372,6 @@ Other major modes are defined by comparison with this one." | |||
| 372 | "Parent major mode from which special major modes should inherit." | 372 | "Parent major mode from which special major modes should inherit." |
| 373 | (setq buffer-read-only t)) | 373 | (setq buffer-read-only t)) |
| 374 | 374 | ||
| 375 | ;; Major mode meant to be the parent of programming modes. | ||
| 376 | |||
| 377 | (defvar prog-mode-map | ||
| 378 | (let ((map (make-sparse-keymap))) | ||
| 379 | (define-key map [?\C-\M-q] 'prog-indent-sexp) | ||
| 380 | map) | ||
| 381 | "Keymap used for programming modes.") | ||
| 382 | |||
| 383 | (defun prog-indent-sexp (&optional defun) | ||
| 384 | "Indent the expression after point. | ||
| 385 | When interactively called with prefix, indent the enclosing defun | ||
| 386 | instead." | ||
| 387 | (interactive "P") | ||
| 388 | (save-excursion | ||
| 389 | (when defun | ||
| 390 | (end-of-line) | ||
| 391 | (beginning-of-defun)) | ||
| 392 | (let ((start (point)) | ||
| 393 | (end (progn (forward-sexp 1) (point)))) | ||
| 394 | (indent-region start end nil)))) | ||
| 395 | |||
| 396 | (define-derived-mode prog-mode fundamental-mode "Prog" | ||
| 397 | "Major mode for editing programming language source code." | ||
| 398 | (set (make-local-variable 'require-final-newline) mode-require-final-newline) | ||
| 399 | (set (make-local-variable 'parse-sexp-ignore-comments) t) | ||
| 400 | ;; Any programming language is always written left to right. | ||
| 401 | (setq bidi-paragraph-direction 'left-to-right)) | ||
| 402 | |||
| 403 | ;; Making and deleting lines. | 375 | ;; Making and deleting lines. |
| 404 | 376 | ||
| 405 | (defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)) | 377 | (defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)) |
diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 01288b89132..a7eae7464e2 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el | |||
| @@ -31,6 +31,8 @@ | |||
| 31 | 31 | ||
| 32 | ;;; Code: | 32 | ;;; Code: |
| 33 | 33 | ||
| 34 | (eval-when-compile (require 'cl-lib)) | ||
| 35 | |||
| 34 | ;; page 1: statement skeleton language definition & interpreter | 36 | ;; page 1: statement skeleton language definition & interpreter |
| 35 | ;; page 2: paired insertion | 37 | ;; page 2: paired insertion |
| 36 | ;; page 3: mirror-mode, an example for setting up paired insertion | 38 | ;; page 3: mirror-mode, an example for setting up paired insertion |
| @@ -84,13 +86,11 @@ The variables `v1' and `v2' are still set when calling this.") | |||
| 84 | "When non-nil, indent rigidly under current line for element `\\n'. | 86 | "When non-nil, indent rigidly under current line for element `\\n'. |
| 85 | Else use mode's `indent-line-function'.") | 87 | Else use mode's `indent-line-function'.") |
| 86 | 88 | ||
| 87 | (defvar skeleton-further-elements () | 89 | (defvar-local skeleton-further-elements () |
| 88 | "A buffer-local varlist (see `let') of mode specific skeleton elements. | 90 | "A buffer-local varlist (see `let') of mode specific skeleton elements. |
| 89 | These variables are bound while interpreting a skeleton. Their value may | 91 | These variables are bound while interpreting a skeleton. Their value may |
| 90 | in turn be any valid skeleton element if they are themselves to be used as | 92 | in turn be any valid skeleton element if they are themselves to be used as |
| 91 | skeleton elements.") | 93 | skeleton elements.") |
| 92 | (make-variable-buffer-local 'skeleton-further-elements) | ||
| 93 | |||
| 94 | 94 | ||
| 95 | (defvar skeleton-subprompt | 95 | (defvar skeleton-subprompt |
| 96 | (substitute-command-keys | 96 | (substitute-command-keys |
| @@ -260,8 +260,10 @@ When done with skeleton, but before going back to `_'-point call | |||
| 260 | skeleton-modified skeleton-point resume: help input v1 v2) | 260 | skeleton-modified skeleton-point resume: help input v1 v2) |
| 261 | (setq skeleton-positions nil) | 261 | (setq skeleton-positions nil) |
| 262 | (unwind-protect | 262 | (unwind-protect |
| 263 | (eval `(let ,skeleton-further-elements | 263 | (cl-progv |
| 264 | (skeleton-internal-list skeleton str))) | 264 | (mapcar #'car skeleton-further-elements) |
| 265 | (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements) | ||
| 266 | (skeleton-internal-list skeleton str)) | ||
| 265 | (run-hooks 'skeleton-end-hook) | 267 | (run-hooks 'skeleton-end-hook) |
| 266 | (sit-for 0) | 268 | (sit-for 0) |
| 267 | (or (pos-visible-in-window-p beg) | 269 | (or (pos-visible-in-window-p beg) |
diff --git a/lisp/subr.el b/lisp/subr.el index f8fbe98b141..6f46e1189cf 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8 -*- | 1 | ;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8; lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2013 Free Software | 3 | ;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2013 Free Software |
| 4 | ;; Foundation, Inc. | 4 | ;; Foundation, Inc. |
| @@ -39,13 +39,13 @@ Each element of this list holds the arguments to one call to `defcustom'.") | |||
| 39 | (setq custom-declare-variable-list | 39 | (setq custom-declare-variable-list |
| 40 | (cons arguments custom-declare-variable-list))) | 40 | (cons arguments custom-declare-variable-list))) |
| 41 | 41 | ||
| 42 | (defmacro declare-function (fn file &optional arglist fileonly) | 42 | (defmacro declare-function (_fn _file &optional _arglist _fileonly) |
| 43 | "Tell the byte-compiler that function FN is defined, in FILE. | 43 | "Tell the byte-compiler that function FN is defined, in FILE. |
| 44 | Optional ARGLIST is the argument list used by the function. The | 44 | Optional ARGLIST is the argument list used by the function. |
| 45 | FILE argument is not used by the byte-compiler, but by the | 45 | The FILE argument is not used by the byte-compiler, but by the |
| 46 | `check-declare' package, which checks that FILE contains a | 46 | `check-declare' package, which checks that FILE contains a |
| 47 | definition for FN. ARGLIST is used by both the byte-compiler and | 47 | definition for FN. ARGLIST is used by both the byte-compiler |
| 48 | `check-declare' to check for consistency. | 48 | and `check-declare' to check for consistency. |
| 49 | 49 | ||
| 50 | FILE can be either a Lisp file (in which case the \".el\" | 50 | FILE can be either a Lisp file (in which case the \".el\" |
| 51 | extension is optional), or a C file. C files are expanded | 51 | extension is optional), or a C file. C files are expanded |
| @@ -396,9 +396,9 @@ non-nil." | |||
| 396 | (defun number-sequence (from &optional to inc) | 396 | (defun number-sequence (from &optional to inc) |
| 397 | "Return a sequence of numbers from FROM to TO (both inclusive) as a list. | 397 | "Return a sequence of numbers from FROM to TO (both inclusive) as a list. |
| 398 | INC is the increment used between numbers in the sequence and defaults to 1. | 398 | INC is the increment used between numbers in the sequence and defaults to 1. |
| 399 | So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from | 399 | So, the Nth element of the list is (+ FROM (* N INC)) where N counts from |
| 400 | zero. TO is only included if there is an N for which TO = FROM + N * INC. | 400 | zero. TO is only included if there is an N for which TO = FROM + N * INC. |
| 401 | If TO is nil or numerically equal to FROM, return \(FROM). | 401 | If TO is nil or numerically equal to FROM, return (FROM). |
| 402 | If INC is positive and TO is less than FROM, or INC is negative | 402 | If INC is positive and TO is less than FROM, or INC is negative |
| 403 | and TO is larger than FROM, return nil. | 403 | and TO is larger than FROM, return nil. |
| 404 | If INC is zero and TO is neither nil nor numerically equal to | 404 | If INC is zero and TO is neither nil nor numerically equal to |
| @@ -408,11 +408,11 @@ This function is primarily designed for integer arguments. | |||
| 408 | Nevertheless, FROM, TO and INC can be integer or float. However, | 408 | Nevertheless, FROM, TO and INC can be integer or float. However, |
| 409 | floating point arithmetic is inexact. For instance, depending on | 409 | floating point arithmetic is inexact. For instance, depending on |
| 410 | the machine, it may quite well happen that | 410 | the machine, it may quite well happen that |
| 411 | \(number-sequence 0.4 0.6 0.2) returns the one element list \(0.4), | 411 | \(number-sequence 0.4 0.6 0.2) returns the one element list (0.4), |
| 412 | whereas \(number-sequence 0.4 0.8 0.2) returns a list with three | 412 | whereas (number-sequence 0.4 0.8 0.2) returns a list with three |
| 413 | elements. Thus, if some of the arguments are floats and one wants | 413 | elements. Thus, if some of the arguments are floats and one wants |
| 414 | to make sure that TO is included, one may have to explicitly write | 414 | to make sure that TO is included, one may have to explicitly write |
| 415 | TO as \(+ FROM \(* N INC)) or use a variable whose value was | 415 | TO as (+ FROM (* N INC)) or use a variable whose value was |
| 416 | computed with this exact expression. Alternatively, you can, | 416 | computed with this exact expression. Alternatively, you can, |
| 417 | of course, also replace TO with a slightly larger value | 417 | of course, also replace TO with a slightly larger value |
| 418 | \(or a slightly more negative value if INC is negative)." | 418 | \(or a slightly more negative value if INC is negative)." |
| @@ -784,8 +784,8 @@ KEY is a key sequence; noninteractively, it is a string or vector | |||
| 784 | of characters or event types, and non-ASCII characters with codes | 784 | of characters or event types, and non-ASCII characters with codes |
| 785 | above 127 (such as ISO Latin-1) can be included if you use a vector. | 785 | above 127 (such as ISO Latin-1) can be included if you use a vector. |
| 786 | 786 | ||
| 787 | The binding goes in the current buffer's local map, | 787 | The binding goes in the current buffer's local map, which in most |
| 788 | which in most cases is shared with all other buffers in the same major mode." | 788 | cases is shared with all other buffers in the same major mode." |
| 789 | (interactive "KSet key locally: \nCSet key %s locally to command: ") | 789 | (interactive "KSet key locally: \nCSet key %s locally to command: ") |
| 790 | (let ((map (current-local-map))) | 790 | (let ((map (current-local-map))) |
| 791 | (or map | 791 | (or map |
| @@ -821,7 +821,7 @@ in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP. | |||
| 821 | 821 | ||
| 822 | If you don't specify OLDMAP, you can usually get the same results | 822 | If you don't specify OLDMAP, you can usually get the same results |
| 823 | in a cleaner way with command remapping, like this: | 823 | in a cleaner way with command remapping, like this: |
| 824 | \(define-key KEYMAP [remap OLDDEF] NEWDEF) | 824 | (define-key KEYMAP [remap OLDDEF] NEWDEF) |
| 825 | \n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)" | 825 | \n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)" |
| 826 | ;; Don't document PREFIX in the doc string because we don't want to | 826 | ;; Don't document PREFIX in the doc string because we don't want to |
| 827 | ;; advertise it. It's meant for recursive calls only. Here's its | 827 | ;; advertise it. It's meant for recursive calls only. Here's its |
| @@ -1478,11 +1478,48 @@ ELEMENT is added at the end. | |||
| 1478 | 1478 | ||
| 1479 | The return value is the new value of LIST-VAR. | 1479 | The return value is the new value of LIST-VAR. |
| 1480 | 1480 | ||
| 1481 | This is handy to add some elements to configuration variables, | ||
| 1482 | but please do not abuse it in Elisp code, where you are usually better off | ||
| 1483 | using `push' or `cl-pushnew'. | ||
| 1484 | |||
| 1481 | If you want to use `add-to-list' on a variable that is not defined | 1485 | If you want to use `add-to-list' on a variable that is not defined |
| 1482 | until a certain package is loaded, you should put the call to `add-to-list' | 1486 | until a certain package is loaded, you should put the call to `add-to-list' |
| 1483 | into a hook function that will be run only after loading the package. | 1487 | into a hook function that will be run only after loading the package. |
| 1484 | `eval-after-load' provides one way to do this. In some cases | 1488 | `eval-after-load' provides one way to do this. In some cases |
| 1485 | other hooks, such as major mode hooks, can do the job." | 1489 | other hooks, such as major mode hooks, can do the job." |
| 1490 | (declare | ||
| 1491 | (compiler-macro | ||
| 1492 | (lambda (exp) | ||
| 1493 | ;; FIXME: Something like this could be used for `set' as well. | ||
| 1494 | (if (or (not (eq 'quote (car-safe list-var))) | ||
| 1495 | (special-variable-p (cadr list-var)) | ||
| 1496 | (and append compare-fn)) | ||
| 1497 | exp | ||
| 1498 | (let* ((sym (cadr list-var)) | ||
| 1499 | (msg (format "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'" | ||
| 1500 | sym)) | ||
| 1501 | ;; Big ugly hack so we only output a warning during | ||
| 1502 | ;; byte-compilation, and so we can use | ||
| 1503 | ;; byte-compile-not-lexical-var-p to silence the warning | ||
| 1504 | ;; when a defvar has been seen but not yet executed. | ||
| 1505 | (warnfun (lambda () | ||
| 1506 | ;; FIXME: We should also emit a warning for let-bound | ||
| 1507 | ;; variables with dynamic binding. | ||
| 1508 | (when (assq sym byte-compile--lexical-environment) | ||
| 1509 | (byte-compile-log-warning msg t :error)))) | ||
| 1510 | (code | ||
| 1511 | (if append | ||
| 1512 | (macroexp-let2 macroexp-copyable-p x element | ||
| 1513 | `(unless (member ,x ,sym) | ||
| 1514 | (setq ,sym (append ,sym (list ,x))))) | ||
| 1515 | (require 'cl-lib) | ||
| 1516 | `(cl-pushnew ,element ,sym | ||
| 1517 | :test ,(or compare-fn '#'equal))))) | ||
| 1518 | (if (not (macroexp--compiling-p)) | ||
| 1519 | code | ||
| 1520 | `(progn | ||
| 1521 | (macroexp--funcall-if-compiled ',warnfun) | ||
| 1522 | ,code))))))) | ||
| 1486 | (if (cond | 1523 | (if (cond |
| 1487 | ((null compare-fn) | 1524 | ((null compare-fn) |
| 1488 | (member element (symbol-value list-var))) | 1525 | (member element (symbol-value list-var))) |
| @@ -1710,7 +1747,7 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label." | |||
| 1710 | (nconc found (list (cons toggle keymap)) rest)) | 1747 | (nconc found (list (cons toggle keymap)) rest)) |
| 1711 | (push (cons toggle keymap) minor-mode-map-alist))))))) | 1748 | (push (cons toggle keymap) minor-mode-map-alist))))))) |
| 1712 | 1749 | ||
| 1713 | ;;; Load history | 1750 | ;;;; Load history |
| 1714 | 1751 | ||
| 1715 | (defsubst autoloadp (object) | 1752 | (defsubst autoloadp (object) |
| 1716 | "Non-nil if OBJECT is an autoload." | 1753 | "Non-nil if OBJECT is an autoload." |
| @@ -1793,173 +1830,6 @@ and the file name is displayed in the echo area." | |||
| 1793 | file)) | 1830 | file)) |
| 1794 | 1831 | ||
| 1795 | 1832 | ||
| 1796 | ;;;; Specifying things to do later. | ||
| 1797 | |||
| 1798 | (defun load-history-regexp (file) | ||
| 1799 | "Form a regexp to find FILE in `load-history'. | ||
| 1800 | FILE, a string, is described in the function `eval-after-load'." | ||
| 1801 | (if (file-name-absolute-p file) | ||
| 1802 | (setq file (file-truename file))) | ||
| 1803 | (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)") | ||
| 1804 | (regexp-quote file) | ||
| 1805 | (if (file-name-extension file) | ||
| 1806 | "" | ||
| 1807 | ;; Note: regexp-opt can't be used here, since we need to call | ||
| 1808 | ;; this before Emacs has been fully started. 2006-05-21 | ||
| 1809 | (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?")) | ||
| 1810 | "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|") | ||
| 1811 | "\\)?\\'")) | ||
| 1812 | |||
| 1813 | (defun load-history-filename-element (file-regexp) | ||
| 1814 | "Get the first elt of `load-history' whose car matches FILE-REGEXP. | ||
| 1815 | Return nil if there isn't one." | ||
| 1816 | (let* ((loads load-history) | ||
| 1817 | (load-elt (and loads (car loads)))) | ||
| 1818 | (save-match-data | ||
| 1819 | (while (and loads | ||
| 1820 | (or (null (car load-elt)) | ||
| 1821 | (not (string-match file-regexp (car load-elt))))) | ||
| 1822 | (setq loads (cdr loads) | ||
| 1823 | load-elt (and loads (car loads))))) | ||
| 1824 | load-elt)) | ||
| 1825 | |||
| 1826 | (put 'eval-after-load 'lisp-indent-function 1) | ||
| 1827 | (defun eval-after-load (file form) | ||
| 1828 | "Arrange that if FILE is loaded, FORM will be run immediately afterwards. | ||
| 1829 | If FILE is already loaded, evaluate FORM right now. | ||
| 1830 | |||
| 1831 | If a matching file is loaded again, FORM will be evaluated again. | ||
| 1832 | |||
| 1833 | If FILE is a string, it may be either an absolute or a relative file | ||
| 1834 | name, and may have an extension \(e.g. \".el\") or may lack one, and | ||
| 1835 | additionally may or may not have an extension denoting a compressed | ||
| 1836 | format \(e.g. \".gz\"). | ||
| 1837 | |||
| 1838 | When FILE is absolute, this first converts it to a true name by chasing | ||
| 1839 | symbolic links. Only a file of this name \(see next paragraph regarding | ||
| 1840 | extensions) will trigger the evaluation of FORM. When FILE is relative, | ||
| 1841 | a file whose absolute true name ends in FILE will trigger evaluation. | ||
| 1842 | |||
| 1843 | When FILE lacks an extension, a file name with any extension will trigger | ||
| 1844 | evaluation. Otherwise, its extension must match FILE's. A further | ||
| 1845 | extension for a compressed format \(e.g. \".gz\") on FILE will not affect | ||
| 1846 | this name matching. | ||
| 1847 | |||
| 1848 | Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM | ||
| 1849 | is evaluated at the end of any file that `provide's this feature. | ||
| 1850 | If the feature is provided when evaluating code not associated with a | ||
| 1851 | file, FORM is evaluated immediately after the provide statement. | ||
| 1852 | |||
| 1853 | Usually FILE is just a library name like \"font-lock\" or a feature name | ||
| 1854 | like 'font-lock. | ||
| 1855 | |||
| 1856 | This function makes or adds to an entry on `after-load-alist'." | ||
| 1857 | ;; Add this FORM into after-load-alist (regardless of whether we'll be | ||
| 1858 | ;; evaluating it now). | ||
| 1859 | (let* ((regexp-or-feature | ||
| 1860 | (if (stringp file) | ||
| 1861 | (setq file (purecopy (load-history-regexp file))) | ||
| 1862 | file)) | ||
| 1863 | (elt (assoc regexp-or-feature after-load-alist))) | ||
| 1864 | (unless elt | ||
| 1865 | (setq elt (list regexp-or-feature)) | ||
| 1866 | (push elt after-load-alist)) | ||
| 1867 | ;; Make sure `form' is evalled in the current lexical/dynamic code. | ||
| 1868 | (setq form `(funcall ',(eval `(lambda () ,form) lexical-binding))) | ||
| 1869 | ;; Is there an already loaded file whose name (or `provide' name) | ||
| 1870 | ;; matches FILE? | ||
| 1871 | (prog1 (if (if (stringp file) | ||
| 1872 | (load-history-filename-element regexp-or-feature) | ||
| 1873 | (featurep file)) | ||
| 1874 | (eval form)) | ||
| 1875 | (when (symbolp regexp-or-feature) | ||
| 1876 | ;; For features, the after-load-alist elements get run when `provide' is | ||
| 1877 | ;; called rather than at the end of the file. So add an indirection to | ||
| 1878 | ;; make sure that `form' is really run "after-load" in case the provide | ||
| 1879 | ;; call happens early. | ||
| 1880 | (setq form | ||
| 1881 | `(if load-file-name | ||
| 1882 | (let ((fun (make-symbol "eval-after-load-helper"))) | ||
| 1883 | (fset fun `(lambda (file) | ||
| 1884 | (if (not (equal file ',load-file-name)) | ||
| 1885 | nil | ||
| 1886 | (remove-hook 'after-load-functions ',fun) | ||
| 1887 | ,',form))) | ||
| 1888 | (add-hook 'after-load-functions fun)) | ||
| 1889 | ;; Not being provided from a file, run form right now. | ||
| 1890 | ,form))) | ||
| 1891 | ;; Add FORM to the element unless it's already there. | ||
| 1892 | (unless (member form (cdr elt)) | ||
| 1893 | (nconc elt (list form)))))) | ||
| 1894 | |||
| 1895 | (defvar after-load-functions nil | ||
| 1896 | "Special hook run after loading a file. | ||
| 1897 | Each function there is called with a single argument, the absolute | ||
| 1898 | name of the file just loaded.") | ||
| 1899 | |||
| 1900 | (defun do-after-load-evaluation (abs-file) | ||
| 1901 | "Evaluate all `eval-after-load' forms, if any, for ABS-FILE. | ||
| 1902 | ABS-FILE, a string, should be the absolute true name of a file just loaded. | ||
| 1903 | This function is called directly from the C code." | ||
| 1904 | ;; Run the relevant eval-after-load forms. | ||
| 1905 | (mapc #'(lambda (a-l-element) | ||
| 1906 | (when (and (stringp (car a-l-element)) | ||
| 1907 | (string-match-p (car a-l-element) abs-file)) | ||
| 1908 | ;; discard the file name regexp | ||
| 1909 | (mapc #'eval (cdr a-l-element)))) | ||
| 1910 | after-load-alist) | ||
| 1911 | ;; Complain when the user uses obsolete files. | ||
| 1912 | (when (string-match-p "/obsolete/[^/]*\\'" abs-file) | ||
| 1913 | (run-with-timer 0 nil | ||
| 1914 | (lambda (file) | ||
| 1915 | (message "Package %s is obsolete!" | ||
| 1916 | (substring file 0 | ||
| 1917 | (string-match "\\.elc?\\>" file)))) | ||
| 1918 | (file-name-nondirectory abs-file))) | ||
| 1919 | ;; Finally, run any other hook. | ||
| 1920 | (run-hook-with-args 'after-load-functions abs-file)) | ||
| 1921 | |||
| 1922 | (defun eval-next-after-load (file) | ||
| 1923 | "Read the following input sexp, and run it whenever FILE is loaded. | ||
| 1924 | This makes or adds to an entry on `after-load-alist'. | ||
| 1925 | FILE should be the name of a library, with no directory name." | ||
| 1926 | (declare (obsolete eval-after-load "23.2")) | ||
| 1927 | (eval-after-load file (read))) | ||
| 1928 | |||
| 1929 | (defun display-delayed-warnings () | ||
| 1930 | "Display delayed warnings from `delayed-warnings-list'. | ||
| 1931 | Used from `delayed-warnings-hook' (which see)." | ||
| 1932 | (dolist (warning (nreverse delayed-warnings-list)) | ||
| 1933 | (apply 'display-warning warning)) | ||
| 1934 | (setq delayed-warnings-list nil)) | ||
| 1935 | |||
| 1936 | (defun collapse-delayed-warnings () | ||
| 1937 | "Remove duplicates from `delayed-warnings-list'. | ||
| 1938 | Collapse identical adjacent warnings into one (plus count). | ||
| 1939 | Used from `delayed-warnings-hook' (which see)." | ||
| 1940 | (let ((count 1) | ||
| 1941 | collapsed warning) | ||
| 1942 | (while delayed-warnings-list | ||
| 1943 | (setq warning (pop delayed-warnings-list)) | ||
| 1944 | (if (equal warning (car delayed-warnings-list)) | ||
| 1945 | (setq count (1+ count)) | ||
| 1946 | (when (> count 1) | ||
| 1947 | (setcdr warning (cons (format "%s [%d times]" (cadr warning) count) | ||
| 1948 | (cddr warning))) | ||
| 1949 | (setq count 1)) | ||
| 1950 | (push warning collapsed))) | ||
| 1951 | (setq delayed-warnings-list (nreverse collapsed)))) | ||
| 1952 | |||
| 1953 | ;; At present this is only used for Emacs internals. | ||
| 1954 | ;; Ref http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00085.html | ||
| 1955 | (defvar delayed-warnings-hook '(collapse-delayed-warnings | ||
| 1956 | display-delayed-warnings) | ||
| 1957 | "Normal hook run to process and display delayed warnings. | ||
| 1958 | By default, this hook contains functions to consolidate the | ||
| 1959 | warnings listed in `delayed-warnings-list', display them, and set | ||
| 1960 | `delayed-warnings-list' back to nil.") | ||
| 1961 | |||
| 1962 | |||
| 1963 | ;;;; Process stuff. | 1833 | ;;;; Process stuff. |
| 1964 | 1834 | ||
| 1965 | (defun process-lines (program &rest args) | 1835 | (defun process-lines (program &rest args) |
| @@ -2054,8 +1924,8 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." | |||
| 2054 | ;; disable quail's input methods, so although read-key-sequence | 1924 | ;; disable quail's input methods, so although read-key-sequence |
| 2055 | ;; always inherits the input method, in practice read-key does not | 1925 | ;; always inherits the input method, in practice read-key does not |
| 2056 | ;; inherit the input method (at least not if it's based on quail). | 1926 | ;; inherit the input method (at least not if it's based on quail). |
| 2057 | (let ((overriding-terminal-local-map read-key-empty-map) | 1927 | (let ((overriding-terminal-local-map nil) |
| 2058 | (overriding-local-map nil) | 1928 | (overriding-local-map read-key-empty-map) |
| 2059 | (echo-keystrokes 0) | 1929 | (echo-keystrokes 0) |
| 2060 | (old-global-map (current-global-map)) | 1930 | (old-global-map (current-global-map)) |
| 2061 | (timer (run-with-idle-timer | 1931 | (timer (run-with-idle-timer |
| @@ -2670,7 +2540,7 @@ Set this to nil at your own risk..." | |||
| 2670 | (defun locate-user-emacs-file (new-name &optional old-name) | 2540 | (defun locate-user-emacs-file (new-name &optional old-name) |
| 2671 | "Return an absolute per-user Emacs-specific file name. | 2541 | "Return an absolute per-user Emacs-specific file name. |
| 2672 | If NEW-NAME exists in `user-emacs-directory', return it. | 2542 | If NEW-NAME exists in `user-emacs-directory', return it. |
| 2673 | Else If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. | 2543 | Else if OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. |
| 2674 | Else return NEW-NAME in `user-emacs-directory', creating the | 2544 | Else return NEW-NAME in `user-emacs-directory', creating the |
| 2675 | directory if it does not exist." | 2545 | directory if it does not exist." |
| 2676 | (convert-standard-filename | 2546 | (convert-standard-filename |
| @@ -3361,7 +3231,7 @@ than cosmetic ones, undo data may become corrupted. | |||
| 3361 | 3231 | ||
| 3362 | This macro will run BODY normally, but doesn't count its buffer | 3232 | This macro will run BODY normally, but doesn't count its buffer |
| 3363 | modifications as being buffer modifications. This affects things | 3233 | modifications as being buffer modifications. This affects things |
| 3364 | like buffer-modified-p, checking whether the file is locked by | 3234 | like `buffer-modified-p', checking whether the file is locked by |
| 3365 | someone else, running buffer modification hooks, and other things | 3235 | someone else, running buffer modification hooks, and other things |
| 3366 | of that nature. | 3236 | of that nature. |
| 3367 | 3237 | ||
| @@ -3666,7 +3536,7 @@ which separates, but is not part of, the substrings. If nil it defaults to | |||
| 3666 | `split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and | 3536 | `split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and |
| 3667 | OMIT-NULLS is forced to t. | 3537 | OMIT-NULLS is forced to t. |
| 3668 | 3538 | ||
| 3669 | If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so | 3539 | If OMIT-NULLS is t, zero-length substrings are omitted from the list (so |
| 3670 | that for the default value of SEPARATORS leading and trailing whitespace | 3540 | that for the default value of SEPARATORS leading and trailing whitespace |
| 3671 | are effectively trimmed). If nil, all zero-length substrings are retained, | 3541 | are effectively trimmed). If nil, all zero-length substrings are retained, |
| 3672 | which correctly parses CSV format, for example. | 3542 | which correctly parses CSV format, for example. |
| @@ -3825,6 +3695,173 @@ consisting of STR followed by an invisible left-to-right mark | |||
| 3825 | (concat str (propertize (string ?\x200e) 'invisible t)) | 3695 | (concat str (propertize (string ?\x200e) 'invisible t)) |
| 3826 | str)) | 3696 | str)) |
| 3827 | 3697 | ||
| 3698 | ;;;; Specifying things to do later. | ||
| 3699 | |||
| 3700 | (defun load-history-regexp (file) | ||
| 3701 | "Form a regexp to find FILE in `load-history'. | ||
| 3702 | FILE, a string, is described in the function `eval-after-load'." | ||
| 3703 | (if (file-name-absolute-p file) | ||
| 3704 | (setq file (file-truename file))) | ||
| 3705 | (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)") | ||
| 3706 | (regexp-quote file) | ||
| 3707 | (if (file-name-extension file) | ||
| 3708 | "" | ||
| 3709 | ;; Note: regexp-opt can't be used here, since we need to call | ||
| 3710 | ;; this before Emacs has been fully started. 2006-05-21 | ||
| 3711 | (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?")) | ||
| 3712 | "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|") | ||
| 3713 | "\\)?\\'")) | ||
| 3714 | |||
| 3715 | (defun load-history-filename-element (file-regexp) | ||
| 3716 | "Get the first elt of `load-history' whose car matches FILE-REGEXP. | ||
| 3717 | Return nil if there isn't one." | ||
| 3718 | (let* ((loads load-history) | ||
| 3719 | (load-elt (and loads (car loads)))) | ||
| 3720 | (save-match-data | ||
| 3721 | (while (and loads | ||
| 3722 | (or (null (car load-elt)) | ||
| 3723 | (not (string-match file-regexp (car load-elt))))) | ||
| 3724 | (setq loads (cdr loads) | ||
| 3725 | load-elt (and loads (car loads))))) | ||
| 3726 | load-elt)) | ||
| 3727 | |||
| 3728 | (put 'eval-after-load 'lisp-indent-function 1) | ||
| 3729 | (defun eval-after-load (file form) | ||
| 3730 | "Arrange that if FILE is loaded, FORM will be run immediately afterwards. | ||
| 3731 | If FILE is already loaded, evaluate FORM right now. | ||
| 3732 | |||
| 3733 | If a matching file is loaded again, FORM will be evaluated again. | ||
| 3734 | |||
| 3735 | If FILE is a string, it may be either an absolute or a relative file | ||
| 3736 | name, and may have an extension (e.g. \".el\") or may lack one, and | ||
| 3737 | additionally may or may not have an extension denoting a compressed | ||
| 3738 | format (e.g. \".gz\"). | ||
| 3739 | |||
| 3740 | When FILE is absolute, this first converts it to a true name by chasing | ||
| 3741 | symbolic links. Only a file of this name (see next paragraph regarding | ||
| 3742 | extensions) will trigger the evaluation of FORM. When FILE is relative, | ||
| 3743 | a file whose absolute true name ends in FILE will trigger evaluation. | ||
| 3744 | |||
| 3745 | When FILE lacks an extension, a file name with any extension will trigger | ||
| 3746 | evaluation. Otherwise, its extension must match FILE's. A further | ||
| 3747 | extension for a compressed format (e.g. \".gz\") on FILE will not affect | ||
| 3748 | this name matching. | ||
| 3749 | |||
| 3750 | Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM | ||
| 3751 | is evaluated at the end of any file that `provide's this feature. | ||
| 3752 | If the feature is provided when evaluating code not associated with a | ||
| 3753 | file, FORM is evaluated immediately after the provide statement. | ||
| 3754 | |||
| 3755 | Usually FILE is just a library name like \"font-lock\" or a feature name | ||
| 3756 | like 'font-lock. | ||
| 3757 | |||
| 3758 | This function makes or adds to an entry on `after-load-alist'." | ||
| 3759 | ;; Add this FORM into after-load-alist (regardless of whether we'll be | ||
| 3760 | ;; evaluating it now). | ||
| 3761 | (let* ((regexp-or-feature | ||
| 3762 | (if (stringp file) | ||
| 3763 | (setq file (purecopy (load-history-regexp file))) | ||
| 3764 | file)) | ||
| 3765 | (elt (assoc regexp-or-feature after-load-alist))) | ||
| 3766 | (unless elt | ||
| 3767 | (setq elt (list regexp-or-feature)) | ||
| 3768 | (push elt after-load-alist)) | ||
| 3769 | ;; Make sure `form' is evalled in the current lexical/dynamic code. | ||
| 3770 | (setq form `(funcall ',(eval `(lambda () ,form) lexical-binding))) | ||
| 3771 | ;; Is there an already loaded file whose name (or `provide' name) | ||
| 3772 | ;; matches FILE? | ||
| 3773 | (prog1 (if (if (stringp file) | ||
| 3774 | (load-history-filename-element regexp-or-feature) | ||
| 3775 | (featurep file)) | ||
| 3776 | (eval form)) | ||
| 3777 | (when (symbolp regexp-or-feature) | ||
| 3778 | ;; For features, the after-load-alist elements get run when `provide' is | ||
| 3779 | ;; called rather than at the end of the file. So add an indirection to | ||
| 3780 | ;; make sure that `form' is really run "after-load" in case the provide | ||
| 3781 | ;; call happens early. | ||
| 3782 | (setq form | ||
| 3783 | `(if load-file-name | ||
| 3784 | (let ((fun (make-symbol "eval-after-load-helper"))) | ||
| 3785 | (fset fun `(lambda (file) | ||
| 3786 | (if (not (equal file ',load-file-name)) | ||
| 3787 | nil | ||
| 3788 | (remove-hook 'after-load-functions ',fun) | ||
| 3789 | ,',form))) | ||
| 3790 | (add-hook 'after-load-functions fun)) | ||
| 3791 | ;; Not being provided from a file, run form right now. | ||
| 3792 | ,form))) | ||
| 3793 | ;; Add FORM to the element unless it's already there. | ||
| 3794 | (unless (member form (cdr elt)) | ||
| 3795 | (nconc elt (list form)))))) | ||
| 3796 | |||
| 3797 | (defvar after-load-functions nil | ||
| 3798 | "Special hook run after loading a file. | ||
| 3799 | Each function there is called with a single argument, the absolute | ||
| 3800 | name of the file just loaded.") | ||
| 3801 | |||
| 3802 | (defun do-after-load-evaluation (abs-file) | ||
| 3803 | "Evaluate all `eval-after-load' forms, if any, for ABS-FILE. | ||
| 3804 | ABS-FILE, a string, should be the absolute true name of a file just loaded. | ||
| 3805 | This function is called directly from the C code." | ||
| 3806 | ;; Run the relevant eval-after-load forms. | ||
| 3807 | (mapc #'(lambda (a-l-element) | ||
| 3808 | (when (and (stringp (car a-l-element)) | ||
| 3809 | (string-match-p (car a-l-element) abs-file)) | ||
| 3810 | ;; discard the file name regexp | ||
| 3811 | (mapc #'eval (cdr a-l-element)))) | ||
| 3812 | after-load-alist) | ||
| 3813 | ;; Complain when the user uses obsolete files. | ||
| 3814 | (when (string-match-p "/obsolete/[^/]*\\'" abs-file) | ||
| 3815 | (run-with-timer 0 nil | ||
| 3816 | (lambda (file) | ||
| 3817 | (message "Package %s is obsolete!" | ||
| 3818 | (substring file 0 | ||
| 3819 | (string-match "\\.elc?\\>" file)))) | ||
| 3820 | (file-name-nondirectory abs-file))) | ||
| 3821 | ;; Finally, run any other hook. | ||
| 3822 | (run-hook-with-args 'after-load-functions abs-file)) | ||
| 3823 | |||
| 3824 | (defun eval-next-after-load (file) | ||
| 3825 | "Read the following input sexp, and run it whenever FILE is loaded. | ||
| 3826 | This makes or adds to an entry on `after-load-alist'. | ||
| 3827 | FILE should be the name of a library, with no directory name." | ||
| 3828 | (declare (obsolete eval-after-load "23.2")) | ||
| 3829 | (eval-after-load file (read))) | ||
| 3830 | |||
| 3831 | (defun display-delayed-warnings () | ||
| 3832 | "Display delayed warnings from `delayed-warnings-list'. | ||
| 3833 | Used from `delayed-warnings-hook' (which see)." | ||
| 3834 | (dolist (warning (nreverse delayed-warnings-list)) | ||
| 3835 | (apply 'display-warning warning)) | ||
| 3836 | (setq delayed-warnings-list nil)) | ||
| 3837 | |||
| 3838 | (defun collapse-delayed-warnings () | ||
| 3839 | "Remove duplicates from `delayed-warnings-list'. | ||
| 3840 | Collapse identical adjacent warnings into one (plus count). | ||
| 3841 | Used from `delayed-warnings-hook' (which see)." | ||
| 3842 | (let ((count 1) | ||
| 3843 | collapsed warning) | ||
| 3844 | (while delayed-warnings-list | ||
| 3845 | (setq warning (pop delayed-warnings-list)) | ||
| 3846 | (if (equal warning (car delayed-warnings-list)) | ||
| 3847 | (setq count (1+ count)) | ||
| 3848 | (when (> count 1) | ||
| 3849 | (setcdr warning (cons (format "%s [%d times]" (cadr warning) count) | ||
| 3850 | (cddr warning))) | ||
| 3851 | (setq count 1)) | ||
| 3852 | (push warning collapsed))) | ||
| 3853 | (setq delayed-warnings-list (nreverse collapsed)))) | ||
| 3854 | |||
| 3855 | ;; At present this is only used for Emacs internals. | ||
| 3856 | ;; Ref http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00085.html | ||
| 3857 | (defvar delayed-warnings-hook '(collapse-delayed-warnings | ||
| 3858 | display-delayed-warnings) | ||
| 3859 | "Normal hook run to process and display delayed warnings. | ||
| 3860 | By default, this hook contains functions to consolidate the | ||
| 3861 | warnings listed in `delayed-warnings-list', display them, and set | ||
| 3862 | `delayed-warnings-list' back to nil.") | ||
| 3863 | |||
| 3864 | |||
| 3828 | ;;;; invisibility specs | 3865 | ;;;; invisibility specs |
| 3829 | 3866 | ||
| 3830 | (defun add-to-invisibility-spec (element) | 3867 | (defun add-to-invisibility-spec (element) |
| @@ -4197,32 +4234,6 @@ use `called-interactively-p'." | |||
| 4197 | (declare (obsolete called-interactively-p "23.2")) | 4234 | (declare (obsolete called-interactively-p "23.2")) |
| 4198 | (called-interactively-p 'interactive)) | 4235 | (called-interactively-p 'interactive)) |
| 4199 | 4236 | ||
| 4200 | (defun function-arity (f &optional num) | ||
| 4201 | "Return the (MIN . MAX) arity of F. | ||
| 4202 | If the maximum arity is infinite, MAX is `many'. | ||
| 4203 | F can be a function or a macro. | ||
| 4204 | If NUM is non-nil, return non-nil iff F can be called with NUM args." | ||
| 4205 | (if (symbolp f) (setq f (indirect-function f))) | ||
| 4206 | (if (eq (car-safe f) 'macro) (setq f (cdr f))) | ||
| 4207 | (let ((res | ||
| 4208 | (if (subrp f) | ||
| 4209 | (let ((x (subr-arity f))) | ||
| 4210 | (if (eq (cdr x) 'unevalled) (cons (car x) 'many))) | ||
| 4211 | (let* ((args (if (consp f) (cadr f) (aref f 0))) | ||
| 4212 | (max (length args)) | ||
| 4213 | (opt (memq '&optional args)) | ||
| 4214 | (rest (memq '&rest args)) | ||
| 4215 | (min (- max (length opt)))) | ||
| 4216 | (if opt | ||
| 4217 | (cons min (if rest 'many (1- max))) | ||
| 4218 | (if rest | ||
| 4219 | (cons (- max (length rest)) 'many) | ||
| 4220 | (cons min max))))))) | ||
| 4221 | (if (not num) | ||
| 4222 | res | ||
| 4223 | (and (>= num (car res)) | ||
| 4224 | (or (eq 'many (cdr res)) (<= num (cdr res))))))) | ||
| 4225 | |||
| 4226 | (defun set-temporary-overlay-map (map &optional keep-pred) | 4237 | (defun set-temporary-overlay-map (map &optional keep-pred) |
| 4227 | "Set MAP as a temporary keymap taking precedence over most other keymaps. | 4238 | "Set MAP as a temporary keymap taking precedence over most other keymaps. |
| 4228 | Note that this does NOT take precedence over the \"overriding\" maps | 4239 | Note that this does NOT take precedence over the \"overriding\" maps |
diff --git a/lisp/term.el b/lisp/term.el index 1c67057d3a7..31889a78273 100644 --- a/lisp/term.el +++ b/lisp/term.el | |||
| @@ -560,6 +560,13 @@ This variable is buffer-local." | |||
| 560 | :type 'boolean | 560 | :type 'boolean |
| 561 | :group 'term) | 561 | :group 'term) |
| 562 | 562 | ||
| 563 | (defcustom term-suppress-hard-newline nil | ||
| 564 | "Non-nil means interpreter should not break long lines with newlines. | ||
| 565 | This means text can automatically reflow if the window is resized." | ||
| 566 | :version "24.4" | ||
| 567 | :type 'boolean | ||
| 568 | :group 'term) | ||
| 569 | |||
| 563 | ;; Where gud-display-frame should put the debugging arrow. This is | 570 | ;; Where gud-display-frame should put the debugging arrow. This is |
| 564 | ;; set by the marker-filter, which scans the debugger's output for | 571 | ;; set by the marker-filter, which scans the debugger's output for |
| 565 | ;; indications of the current pc. | 572 | ;; indications of the current pc. |
| @@ -2828,8 +2835,9 @@ See `term-prompt-regexp'." | |||
| 2828 | (setq count (length decoded-substring)) | 2835 | (setq count (length decoded-substring)) |
| 2829 | (setq temp (- (+ (term-horizontal-column) count) | 2836 | (setq temp (- (+ (term-horizontal-column) count) |
| 2830 | term-width)) | 2837 | term-width)) |
| 2831 | (cond ((<= temp 0)) ;; All count chars fit in line. | 2838 | (cond ((or term-suppress-hard-newline (<= temp 0))) |
| 2832 | ((> count temp) ;; Some chars fit. | 2839 | ;; All count chars fit in line. |
| 2840 | ((> count temp) ;; Some chars fit. | ||
| 2833 | ;; This iteration, handle only what fits. | 2841 | ;; This iteration, handle only what fits. |
| 2834 | (setq count (- count temp)) | 2842 | (setq count (- count temp)) |
| 2835 | (setq count-bytes | 2843 | (setq count-bytes |
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index ca29709de2e..6c103294a06 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el | |||
| @@ -25,18 +25,16 @@ | |||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | (eval-when-compile (require 'cl)) | 27 | (eval-when-compile (require 'cl)) |
| 28 | (provide 'reftex-cite) | ||
| 29 | (require 'reftex) | ||
| 30 | ;;; | ||
| 31 | 28 | ||
| 32 | ;; Variables and constants | 29 | (require 'reftex) |
| 33 | 30 | ||
| 34 | ;; The history list of regular expressions used for citations | 31 | ;;; Variables and constants |
| 35 | (defvar reftex-cite-regexp-hist nil) | 32 | (defvar reftex-cite-regexp-hist nil |
| 33 | "The history list of regular expressions used for citations") | ||
| 36 | 34 | ||
| 37 | ;; Prompt and help string for citation selection | ||
| 38 | (defconst reftex-citation-prompt | 35 | (defconst reftex-citation-prompt |
| 39 | "Select: [n]ext [p]revious [r]estrict [ ]full_entry [q]uit RET [?]Help+more") | 36 | "Select: [n]ext [p]revious [r]estrict [ ]full_entry [q]uit RET [?]Help+more" |
| 37 | "Prompt and help string for citation selection") | ||
| 40 | 38 | ||
| 41 | (defconst reftex-citation-help | 39 | (defconst reftex-citation-help |
| 42 | " n / p Go to next/previous entry (Cursor motion works as well). | 40 | " n / p Go to next/previous entry (Cursor motion works as well). |
| @@ -51,8 +49,7 @@ | |||
| 51 | e / E Create BibTeX file with all (marked/unmarked) entries | 49 | e / E Create BibTeX file with all (marked/unmarked) entries |
| 52 | a / A Put all (marked) entries into one/many \\cite commands.") | 50 | a / A Put all (marked) entries into one/many \\cite commands.") |
| 53 | 51 | ||
| 54 | ;; Find bibtex files | 52 | ;;; Find bibtex files |
| 55 | |||
| 56 | (defmacro reftex-with-special-syntax-for-bib (&rest body) | 53 | (defmacro reftex-with-special-syntax-for-bib (&rest body) |
| 57 | `(let ((saved-syntax (syntax-table))) | 54 | `(let ((saved-syntax (syntax-table))) |
| 58 | (unwind-protect | 55 | (unwind-protect |
| @@ -62,8 +59,8 @@ | |||
| 62 | (set-syntax-table saved-syntax)))) | 59 | (set-syntax-table saved-syntax)))) |
| 63 | 60 | ||
| 64 | (defun reftex-default-bibliography () | 61 | (defun reftex-default-bibliography () |
| 65 | ;; Return the expanded value of `reftex-default-bibliography'. | 62 | "Return the expanded value of variable `reftex-default-bibliography'. |
| 66 | ;; The expanded value is cached. | 63 | The expanded value is cached." |
| 67 | (unless (eq (get 'reftex-default-bibliography :reftex-raw) | 64 | (unless (eq (get 'reftex-default-bibliography :reftex-raw) |
| 68 | reftex-default-bibliography) | 65 | reftex-default-bibliography) |
| 69 | (put 'reftex-default-bibliography :reftex-expanded | 66 | (put 'reftex-default-bibliography :reftex-expanded |
| @@ -74,9 +71,8 @@ | |||
| 74 | (get 'reftex-default-bibliography :reftex-expanded)) | 71 | (get 'reftex-default-bibliography :reftex-expanded)) |
| 75 | 72 | ||
| 76 | (defun reftex-bib-or-thebib () | 73 | (defun reftex-bib-or-thebib () |
| 77 | ;; Tests if BibTeX or \begin{thebibliography} should be used for the | 74 | "Test if BibTeX or \begin{thebibliography} should be used for the citation. |
| 78 | ;; citation | 75 | Find the bof of the current file" |
| 79 | ;; Find the bof of the current file | ||
| 80 | (let* ((docstruct (symbol-value reftex-docstruct-symbol)) | 76 | (let* ((docstruct (symbol-value reftex-docstruct-symbol)) |
| 81 | (rest (or (member (list 'bof (buffer-file-name)) docstruct) | 77 | (rest (or (member (list 'bof (buffer-file-name)) docstruct) |
| 82 | docstruct)) | 78 | docstruct)) |
| @@ -94,11 +90,11 @@ | |||
| 94 | (if thebib 'thebib nil)))) | 90 | (if thebib 'thebib nil)))) |
| 95 | 91 | ||
| 96 | (defun reftex-get-bibfile-list () | 92 | (defun reftex-get-bibfile-list () |
| 97 | ;; Return list of bibfiles for current document. | 93 | "Return list of bibfiles for current document. |
| 98 | ;; When using the chapterbib or bibunits package you should either | 94 | When using the chapterbib or bibunits package you should either |
| 99 | ;; use the same database files everywhere, or separate parts using | 95 | use the same database files everywhere, or separate parts using |
| 100 | ;; different databases into different files (included into the mater file). | 96 | different databases into different files (included into the mater file). |
| 101 | ;; Then this function will return the applicable database files. | 97 | Then this function will return the applicable database files." |
| 102 | 98 | ||
| 103 | ;; Ensure access to scanning info | 99 | ;; Ensure access to scanning info |
| 104 | (reftex-access-scan-info) | 100 | (reftex-access-scan-info) |
| @@ -115,16 +111,14 @@ | |||
| 115 | (cdr (assq 'bib (symbol-value reftex-docstruct-symbol))) | 111 | (cdr (assq 'bib (symbol-value reftex-docstruct-symbol))) |
| 116 | (error "\\bibliography statement missing or .bib files not found"))) | 112 | (error "\\bibliography statement missing or .bib files not found"))) |
| 117 | 113 | ||
| 118 | ;; Find a certain reference in any of the BibTeX files. | 114 | ;;; Find a certain reference in any of the BibTeX files. |
| 119 | |||
| 120 | (defun reftex-pop-to-bibtex-entry (key file-list &optional mark-to-kill | 115 | (defun reftex-pop-to-bibtex-entry (key file-list &optional mark-to-kill |
| 121 | highlight item return) | 116 | highlight item return) |
| 122 | ;; Find BibTeX KEY in any file in FILE-LIST in another window. | 117 | "Find BibTeX KEY in any file in FILE-LIST in another window. |
| 123 | ;; If MARK-TO-KILL is non-nil, mark new buffer to kill. | 118 | If MARK-TO-KILL is non-nil, mark new buffer to kill. |
| 124 | ;; If HIGHLIGHT is non-nil, highlight the match. | 119 | If HIGHLIGHT is non-nil, highlight the match. |
| 125 | ;; If ITEM in non-nil, search for bibitem instead of database entry. | 120 | If ITEM in non-nil, search for bibitem instead of database entry. |
| 126 | ;; If RETURN is non-nil, just return the entry and restore point. | 121 | If RETURN is non-nil, just return the entry and restore point." |
| 127 | |||
| 128 | (let* ((re | 122 | (let* ((re |
| 129 | (if item | 123 | (if item |
| 130 | (concat "\\\\bibitem[ \t]*\\(\\[[^]]*\\]\\)?[ \t]*{" | 124 | (concat "\\\\bibitem[ \t]*\\(\\[[^]]*\\]\\)?[ \t]*{" |
| @@ -178,12 +172,11 @@ | |||
| 178 | (progn (forward-list 1) (point))) | 172 | (progn (forward-list 1) (point))) |
| 179 | (error (min (point-max) (+ 300 (point))))))) | 173 | (error (min (point-max) (+ 300 (point))))))) |
| 180 | 174 | ||
| 181 | ;; Parse bibtex buffers | 175 | ;;; Parse bibtex buffers |
| 182 | |||
| 183 | (defun reftex-extract-bib-entries (buffers) | 176 | (defun reftex-extract-bib-entries (buffers) |
| 184 | ;; Extract bib entries which match regexps from BUFFERS. | 177 | "Extract bib entries which match regexps from BUFFERS. |
| 185 | ;; BUFFERS is a list of buffers or file names. | 178 | BUFFERS is a list of buffers or file names. |
| 186 | ;; Return list with entries." | 179 | Return list with entries." |
| 187 | (let* (re-list first-re rest-re | 180 | (let* (re-list first-re rest-re |
| 188 | (buffer-list (if (listp buffers) buffers (list buffers))) | 181 | (buffer-list (if (listp buffers) buffers (list buffers))) |
| 189 | found-list entry buffer1 buffer alist | 182 | found-list entry buffer1 buffer alist |
| @@ -309,6 +302,8 @@ | |||
| 309 | (t found-list)))) | 302 | (t found-list)))) |
| 310 | 303 | ||
| 311 | (defun reftex-bib-sort-author (e1 e2) | 304 | (defun reftex-bib-sort-author (e1 e2) |
| 305 | "Compare bib entries E1 and E2 by author. | ||
| 306 | The name of the first different author/editor is used." | ||
| 312 | (let ((al1 (reftex-get-bib-names "author" e1)) | 307 | (let ((al1 (reftex-get-bib-names "author" e1)) |
| 313 | (al2 (reftex-get-bib-names "author" e2))) | 308 | (al2 (reftex-get-bib-names "author" e2))) |
| 314 | (while (and al1 al2 (string= (car al1) (car al2))) | 309 | (while (and al1 al2 (string= (car al1) (car al2))) |
| @@ -320,15 +315,17 @@ | |||
| 320 | (not (stringp (car al1)))))) | 315 | (not (stringp (car al1)))))) |
| 321 | 316 | ||
| 322 | (defun reftex-bib-sort-year (e1 e2) | 317 | (defun reftex-bib-sort-year (e1 e2) |
| 318 | "Compare bib entries E1 and E2 by year in ascending order." | ||
| 323 | (< (string-to-number (or (cdr (assoc "year" e1)) "0")) | 319 | (< (string-to-number (or (cdr (assoc "year" e1)) "0")) |
| 324 | (string-to-number (or (cdr (assoc "year" e2)) "0")))) | 320 | (string-to-number (or (cdr (assoc "year" e2)) "0")))) |
| 325 | 321 | ||
| 326 | (defun reftex-bib-sort-year-reverse (e1 e2) | 322 | (defun reftex-bib-sort-year-reverse (e1 e2) |
| 323 | "Compare bib entries E1 and E2 by year in descending order." | ||
| 327 | (> (string-to-number (or (cdr (assoc "year" e1)) "0")) | 324 | (> (string-to-number (or (cdr (assoc "year" e1)) "0")) |
| 328 | (string-to-number (or (cdr (assoc "year" e2)) "0")))) | 325 | (string-to-number (or (cdr (assoc "year" e2)) "0")))) |
| 329 | 326 | ||
| 330 | (defun reftex-get-crossref-alist (entry) | 327 | (defun reftex-get-crossref-alist (entry) |
| 331 | ;; return the alist from a crossref entry | 328 | "Return the alist from a crossref ENTRY." |
| 332 | (let ((crkey (cdr (assoc "crossref" entry))) | 329 | (let ((crkey (cdr (assoc "crossref" entry))) |
| 333 | start) | 330 | start) |
| 334 | (save-excursion | 331 | (save-excursion |
| @@ -347,10 +344,9 @@ | |||
| 347 | 344 | ||
| 348 | ;; Parse the bibliography environment | 345 | ;; Parse the bibliography environment |
| 349 | (defun reftex-extract-bib-entries-from-thebibliography (files) | 346 | (defun reftex-extract-bib-entries-from-thebibliography (files) |
| 350 | ;; Extract bib-entries from the \begin{thebibliography} environment. | 347 | "Extract bib-entries from the \begin{thebibliography} environment. |
| 351 | ;; Parsing is not as good as for the BibTeX database stuff. | 348 | Parsing is not as good as for the BibTeX database stuff. |
| 352 | ;; The environment should be located in file FILE. | 349 | The environment should be located in FILES." |
| 353 | |||
| 354 | (let* (start end buf entries re re-list file default) | 350 | (let* (start end buf entries re re-list file default) |
| 355 | (unless files | 351 | (unless files |
| 356 | (error "Need file name to find thebibliography environment")) | 352 | (error "Need file name to find thebibliography environment")) |
| @@ -430,8 +426,8 @@ | |||
| 430 | entries)) | 426 | entries)) |
| 431 | 427 | ||
| 432 | (defun reftex-get-bibkey-default () | 428 | (defun reftex-get-bibkey-default () |
| 433 | ;; Return the word before the cursor. If the cursor is in a | 429 | "Return the word before the cursor. |
| 434 | ;; citation macro, return the word before the macro. | 430 | If the cursor is in a citation macro, return the word before the macro." |
| 435 | (let* ((macro (reftex-what-macro 1))) | 431 | (let* ((macro (reftex-what-macro 1))) |
| 436 | (save-excursion | 432 | (save-excursion |
| 437 | (if (and macro (string-match "cite" (car macro))) | 433 | (if (and macro (string-match "cite" (car macro))) |
| @@ -439,10 +435,10 @@ | |||
| 439 | (skip-chars-backward "^a-zA-Z0-9") | 435 | (skip-chars-backward "^a-zA-Z0-9") |
| 440 | (reftex-this-word)))) | 436 | (reftex-this-word)))) |
| 441 | 437 | ||
| 442 | ;; Parse and format individual entries | 438 | ;;; Parse and format individual entries |
| 443 | |||
| 444 | (defun reftex-get-bib-names (field entry) | 439 | (defun reftex-get-bib-names (field entry) |
| 445 | ;; Return a list with the author or editor names in ENTRY | 440 | "Return a list with the author or editor names in ENTRY. |
| 441 | If FIELD is empty try \"editor\" field." | ||
| 446 | (let ((names (reftex-get-bib-field field entry))) | 442 | (let ((names (reftex-get-bib-field field entry))) |
| 447 | (if (equal "" names) | 443 | (if (equal "" names) |
| 448 | (setq names (reftex-get-bib-field "editor" entry))) | 444 | (setq names (reftex-get-bib-field "editor" entry))) |
| @@ -457,7 +453,9 @@ | |||
| 457 | (split-string names "\n"))) | 453 | (split-string names "\n"))) |
| 458 | 454 | ||
| 459 | (defun reftex-parse-bibtex-entry (entry &optional from to raw) | 455 | (defun reftex-parse-bibtex-entry (entry &optional from to raw) |
| 460 | ; if RAW is non-nil, keep double quotes/curly braces delimiting fields | 456 | "Parse BibTeX ENTRY. |
| 457 | If ENTRY is nil then parse the entry in current buffer between FROM and TO. | ||
| 458 | If RAW is non-nil, keep double quotes/curly braces delimiting fields." | ||
| 461 | (let (alist key start field) | 459 | (let (alist key start field) |
| 462 | (save-excursion | 460 | (save-excursion |
| 463 | (save-restriction | 461 | (save-restriction |
| @@ -518,7 +516,8 @@ | |||
| 518 | alist)) | 516 | alist)) |
| 519 | 517 | ||
| 520 | (defun reftex-get-bib-field (fieldname entry &optional format) | 518 | (defun reftex-get-bib-field (fieldname entry &optional format) |
| 521 | ;; Extract the field FIELDNAME from an ENTRY | 519 | "Extract the field FIELDNAME from ENTRY. |
| 520 | If FORMAT is non-nil `format' entry accordingly." | ||
| 522 | (let ((cell (assoc fieldname entry))) | 521 | (let ((cell (assoc fieldname entry))) |
| 523 | (if cell | 522 | (if cell |
| 524 | (if format | 523 | (if format |
| @@ -527,7 +526,7 @@ | |||
| 527 | ""))) | 526 | ""))) |
| 528 | 527 | ||
| 529 | (defun reftex-format-bib-entry (entry) | 528 | (defun reftex-format-bib-entry (entry) |
| 530 | ;; Format a BibTeX ENTRY so that it is nice to look at | 529 | "Format a BibTeX ENTRY so that it is nice to look at." |
| 531 | (let* | 530 | (let* |
| 532 | ((auth-list (reftex-get-bib-names "author" entry)) | 531 | ((auth-list (reftex-get-bib-names "author" entry)) |
| 533 | (authors (mapconcat 'identity auth-list ", ")) | 532 | (authors (mapconcat 'identity auth-list ", ")) |
| @@ -570,7 +569,7 @@ | |||
| 570 | (concat key "\n " authors " " year " " extra "\n " title "\n\n"))) | 569 | (concat key "\n " authors " " year " " extra "\n " title "\n\n"))) |
| 571 | 570 | ||
| 572 | (defun reftex-parse-bibitem (item) | 571 | (defun reftex-parse-bibitem (item) |
| 573 | ;; Parse a \bibitem entry | 572 | "Parse a \bibitem entry in ITEM." |
| 574 | (let ((key "") (text "")) | 573 | (let ((key "") (text "")) |
| 575 | (when (string-match "\\`{\\([^}]+\\)}\\([^\000]*\\)" item) | 574 | (when (string-match "\\`{\\([^}]+\\)}\\([^\000]*\\)" item) |
| 576 | (setq key (match-string 1 item) | 575 | (setq key (match-string 1 item) |
| @@ -586,7 +585,7 @@ | |||
| 586 | (cons "&entry" (concat key " " text))))) | 585 | (cons "&entry" (concat key " " text))))) |
| 587 | 586 | ||
| 588 | (defun reftex-format-bibitem (item) | 587 | (defun reftex-format-bibitem (item) |
| 589 | ;; Format a \bibitem entry so that it is (relatively) nice to look at. | 588 | "Format a \bibitem entry in ITEM so that it is (relatively) nice to look at." |
| 590 | (let ((text (reftex-get-bib-field "&text" item)) | 589 | (let ((text (reftex-get-bib-field "&text" item)) |
| 591 | (key (reftex-get-bib-field "&key" item)) | 590 | (key (reftex-get-bib-field "&key" item)) |
| 592 | (lines nil)) | 591 | (lines nil)) |
| @@ -603,7 +602,7 @@ | |||
| 603 | (put-text-property 0 (length text) 'face reftex-bib-author-face text)) | 602 | (put-text-property 0 (length text) 'face reftex-bib-author-face text)) |
| 604 | (concat key "\n " text "\n\n"))) | 603 | (concat key "\n " text "\n\n"))) |
| 605 | 604 | ||
| 606 | ;; Make a citation | 605 | ;;; Make a citation |
| 607 | 606 | ||
| 608 | ;;;###autoload | 607 | ;;;###autoload |
| 609 | (defun reftex-citation (&optional no-insert format-key) | 608 | (defun reftex-citation (&optional no-insert format-key) |
| @@ -627,7 +626,6 @@ The regular expression uses an expanded syntax: && is interpreted as `and'. | |||
| 627 | Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. | 626 | Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. |
| 628 | While entering the regexp, completion on knows citation keys is possible. | 627 | While entering the regexp, completion on knows citation keys is possible. |
| 629 | `=' is a good regular expression to match all entries in all files." | 628 | `=' is a good regular expression to match all entries in all files." |
| 630 | |||
| 631 | (interactive) | 629 | (interactive) |
| 632 | 630 | ||
| 633 | ;; check for recursive edit | 631 | ;; check for recursive edit |
| @@ -645,8 +643,7 @@ While entering the regexp, completion on knows citation keys is possible. | |||
| 645 | (reftex-kill-temporary-buffers))) | 643 | (reftex-kill-temporary-buffers))) |
| 646 | 644 | ||
| 647 | (defun reftex-do-citation (&optional arg no-insert format-key) | 645 | (defun reftex-do-citation (&optional arg no-insert format-key) |
| 648 | ;; This really does the work of reftex-citation. | 646 | "This really does the work of `reftex-citation'." |
| 649 | |||
| 650 | (let* ((format (reftex-figure-out-cite-format arg no-insert format-key)) | 647 | (let* ((format (reftex-figure-out-cite-format arg no-insert format-key)) |
| 651 | (docstruct-symbol reftex-docstruct-symbol) | 648 | (docstruct-symbol reftex-docstruct-symbol) |
| 652 | (selected-entries (reftex-offer-bib-menu)) | 649 | (selected-entries (reftex-offer-bib-menu)) |
| @@ -743,8 +740,8 @@ While entering the regexp, completion on knows citation keys is possible. | |||
| 743 | (mapcar 'car selected-entries))) | 740 | (mapcar 'car selected-entries))) |
| 744 | 741 | ||
| 745 | (defun reftex-figure-out-cite-format (arg &optional no-insert format-key) | 742 | (defun reftex-figure-out-cite-format (arg &optional no-insert format-key) |
| 746 | ;; Check if there is already a cite command at point and change cite format | 743 | "Check if there is already a cite command at point and change cite format |
| 747 | ;; in order to only add another reference in the same cite command. | 744 | in order to only add another reference in the same cite command." |
| 748 | (let ((macro (car (reftex-what-macro 1))) | 745 | (let ((macro (car (reftex-what-macro 1))) |
| 749 | (cite-format-value (reftex-get-cite-format)) | 746 | (cite-format-value (reftex-get-cite-format)) |
| 750 | key format) | 747 | key format) |
| @@ -802,8 +799,7 @@ While entering the regexp, completion on knows citation keys is possible. | |||
| 802 | 799 | ||
| 803 | (defvar reftex-select-bib-map) | 800 | (defvar reftex-select-bib-map) |
| 804 | (defun reftex-offer-bib-menu () | 801 | (defun reftex-offer-bib-menu () |
| 805 | ;; Offer bib menu and return list of selected items | 802 | "Offer bib menu and return list of selected items." |
| 806 | |||
| 807 | (let ((bibtype (reftex-bib-or-thebib)) | 803 | (let ((bibtype (reftex-bib-or-thebib)) |
| 808 | found-list rtn key data selected-entries) | 804 | found-list rtn key data selected-entries) |
| 809 | (while | 805 | (while |
| @@ -917,7 +913,7 @@ While entering the regexp, completion on knows citation keys is possible. | |||
| 917 | selected-entries)) | 913 | selected-entries)) |
| 918 | 914 | ||
| 919 | (defun reftex-restrict-bib-matches (found-list) | 915 | (defun reftex-restrict-bib-matches (found-list) |
| 920 | ;; Limit FOUND-LIST with more regular expressions | 916 | "Limit FOUND-LIST with more regular expressions." |
| 921 | (let ((re-list (split-string (read-string | 917 | (let ((re-list (split-string (read-string |
| 922 | "RegExp [ && RegExp...]: " | 918 | "RegExp [ && RegExp...]: " |
| 923 | nil 'reftex-cite-regexp-hist) | 919 | nil 'reftex-cite-regexp-hist) |
| @@ -940,7 +936,7 @@ While entering the regexp, completion on knows citation keys is possible. | |||
| 940 | found-list))) | 936 | found-list))) |
| 941 | 937 | ||
| 942 | (defun reftex-extract-bib-file (all &optional marked complement) | 938 | (defun reftex-extract-bib-file (all &optional marked complement) |
| 943 | ;; Limit FOUND-LIST with more regular expressions | 939 | "Limit FOUND-LIST with more regular expressions." |
| 944 | (let ((file (read-file-name "File to create: "))) | 940 | (let ((file (read-file-name "File to create: "))) |
| 945 | (find-file-other-window file) | 941 | (find-file-other-window file) |
| 946 | (if (> (buffer-size) 0) | 942 | (if (> (buffer-size) 0) |
| @@ -963,7 +959,7 @@ While entering the regexp, completion on knows citation keys is possible. | |||
| 963 | (goto-char (point-min)))) | 959 | (goto-char (point-min)))) |
| 964 | 960 | ||
| 965 | (defun reftex-insert-bib-matches (list) | 961 | (defun reftex-insert-bib-matches (list) |
| 966 | ;; Insert the bib matches and number them correctly | 962 | "Insert the bib matches and number them correctly." |
| 967 | (let ((mouse-face | 963 | (let ((mouse-face |
| 968 | (if (memq reftex-highlight-selection '(mouse both)) | 964 | (if (memq reftex-highlight-selection '(mouse both)) |
| 969 | reftex-mouse-selected-face | 965 | reftex-mouse-selected-face |
| @@ -996,8 +992,7 @@ While entering the regexp, completion on knows citation keys is possible. | |||
| 996 | last))))) | 992 | last))))) |
| 997 | 993 | ||
| 998 | (defun reftex-format-citation (entry format) | 994 | (defun reftex-format-citation (entry format) |
| 999 | ;; Format a citation from the info in the BibTeX ENTRY | 995 | "Format a citation from the info in the BibTeX ENTRY according to FORMAT." |
| 1000 | |||
| 1001 | (unless (stringp format) (setq format "\\cite{%l}")) | 996 | (unless (stringp format) (setq format "\\cite{%l}")) |
| 1002 | 997 | ||
| 1003 | (if (and reftex-comment-citations | 998 | (if (and reftex-comment-citations |
| @@ -1064,7 +1059,7 @@ While entering the regexp, completion on knows citation keys is possible. | |||
| 1064 | format) | 1059 | format) |
| 1065 | 1060 | ||
| 1066 | (defun reftex-make-cite-echo-string (entry docstruct-symbol) | 1061 | (defun reftex-make-cite-echo-string (entry docstruct-symbol) |
| 1067 | ;; Format a bibtex entry for the echo area and cache the result. | 1062 | "Format a bibtex ENTRY for the echo area and cache the result." |
| 1068 | (let* ((key (reftex-get-bib-field "&key" entry)) | 1063 | (let* ((key (reftex-get-bib-field "&key" entry)) |
| 1069 | (string | 1064 | (string |
| 1070 | (let* ((reftex-cite-punctuation '(" " " & " " etal."))) | 1065 | (let* ((reftex-cite-punctuation '(" " " & " " etal."))) |
| @@ -1088,9 +1083,9 @@ While entering the regexp, completion on knows citation keys is possible. | |||
| 1088 | string)) | 1083 | string)) |
| 1089 | 1084 | ||
| 1090 | (defun reftex-bibtex-selection-callback (data ignore no-revisit) | 1085 | (defun reftex-bibtex-selection-callback (data ignore no-revisit) |
| 1091 | ;; Callback function to be called from the BibTeX selection, in | 1086 | "Callback function to be called from the BibTeX selection, in |
| 1092 | ;; order to display context. This function is relatively slow and not | 1087 | order to display context. This function is relatively slow and not |
| 1093 | ;; recommended for follow mode. It works OK for individual lookups. | 1088 | recommended for follow mode. It works OK for individual lookups." |
| 1094 | (let ((win (selected-window)) | 1089 | (let ((win (selected-window)) |
| 1095 | (key (reftex-get-bib-field "&key" data)) | 1090 | (key (reftex-get-bib-field "&key" data)) |
| 1096 | bibfile-list item bibtype) | 1091 | bibfile-list item bibtype) |
| @@ -1157,7 +1152,7 @@ While entering the regexp, completion on knows citation keys is possible. | |||
| 1157 | alist)))) | 1152 | alist)))) |
| 1158 | 1153 | ||
| 1159 | (defun reftex-create-bibtex-file (bibfile) | 1154 | (defun reftex-create-bibtex-file (bibfile) |
| 1160 | "Create a new BibTeX database file with all entries referenced in document. | 1155 | "Create a new BibTeX database BIBFILE with all entries referenced in document. |
| 1161 | The command prompts for a filename and writes the collected | 1156 | The command prompts for a filename and writes the collected |
| 1162 | entries to that file. Only entries referenced in the current | 1157 | entries to that file. Only entries referenced in the current |
| 1163 | document with any \\cite-like macros are used. The sequence in | 1158 | document with any \\cite-like macros are used. The sequence in |
| @@ -1247,5 +1242,5 @@ created files in the variables `reftex-create-bibtex-header' or | |||
| 1247 | (message "%d entries extracted and copied to new database" | 1242 | (message "%d entries extracted and copied to new database" |
| 1248 | (length entries)))) | 1243 | (length entries)))) |
| 1249 | 1244 | ||
| 1250 | 1245 | (provide 'reftex-cite) | |
| 1251 | ;;; reftex-cite.el ends here | 1246 | ;;; reftex-cite.el ends here |
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 3a64aad6a06..a99791e5427 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el | |||
| @@ -49,7 +49,8 @@ | |||
| 49 | (reftex-access-scan-info '(16))) | 49 | (reftex-access-scan-info '(16))) |
| 50 | 50 | ||
| 51 | (defun reftex-do-parse (rescan &optional file) | 51 | (defun reftex-do-parse (rescan &optional file) |
| 52 | "Do a document rescan. When allowed, do only a partial scan from FILE." | 52 | "Do a document rescan. |
| 53 | When allowed, do only a partial scan from FILE." | ||
| 53 | 54 | ||
| 54 | ;; Normalize the rescan argument | 55 | ;; Normalize the rescan argument |
| 55 | (setq rescan (cond ((eq rescan t) t) | 56 | (setq rescan (cond ((eq rescan t) t) |
| @@ -191,7 +192,7 @@ of master file." | |||
| 191 | (defvar index-tags) | 192 | (defvar index-tags) |
| 192 | 193 | ||
| 193 | (defun reftex-parse-from-file (file docstruct master-dir) | 194 | (defun reftex-parse-from-file (file docstruct master-dir) |
| 194 | ;; Scan the buffer for labels and save them in a list. | 195 | "Scan the buffer for labels and save them in a list." |
| 195 | (let ((regexp (reftex-everything-regexp)) | 196 | (let ((regexp (reftex-everything-regexp)) |
| 196 | (bound 0) | 197 | (bound 0) |
| 197 | file-found tmp include-file | 198 | file-found tmp include-file |
| @@ -350,8 +351,7 @@ of master file." | |||
| 350 | docstruct)) | 351 | docstruct)) |
| 351 | 352 | ||
| 352 | (defun reftex-locate-bibliography-files (master-dir &optional files) | 353 | (defun reftex-locate-bibliography-files (master-dir &optional files) |
| 353 | ;; Scan buffer for bibliography macro and return file list. | 354 | "Scan buffer for bibliography macro and return file list." |
| 354 | |||
| 355 | (unless files | 355 | (unless files |
| 356 | (save-excursion | 356 | (save-excursion |
| 357 | (goto-char (point-min)) | 357 | (goto-char (point-min)) |
| @@ -379,10 +379,10 @@ of master file." | |||
| 379 | (delq nil files))) | 379 | (delq nil files))) |
| 380 | 380 | ||
| 381 | (defun reftex-replace-label-list-segment (old insert &optional entirely) | 381 | (defun reftex-replace-label-list-segment (old insert &optional entirely) |
| 382 | ;; Replace the segment in OLD which corresponds to INSERT. | 382 | "Replace the segment in OLD which corresponds to INSERT. |
| 383 | ;; Works with side effects, directly changes old. | 383 | Works with side effects, directly changes old. |
| 384 | ;; If entirely is t, just return INSERT. | 384 | If ENTIRELY is t, just return INSERT. |
| 385 | ;; This function also makes sure the old toc markers do not point anywhere. | 385 | This function also makes sure the old toc markers do not point anywhere." |
| 386 | 386 | ||
| 387 | (cond | 387 | (cond |
| 388 | (entirely | 388 | (entirely |
| @@ -404,8 +404,8 @@ of master file." | |||
| 404 | new)))) | 404 | new)))) |
| 405 | 405 | ||
| 406 | (defun reftex-section-info (file) | 406 | (defun reftex-section-info (file) |
| 407 | ;; Return a section entry for the current match. | 407 | "Return a section entry for the current match. |
| 408 | ;; Careful: This function expects the match-data to be still in place! | 408 | Careful: This function expects the match-data to be still in place!" |
| 409 | (let* ((marker (set-marker (make-marker) (1- (match-beginning 3)))) | 409 | (let* ((marker (set-marker (make-marker) (1- (match-beginning 3)))) |
| 410 | (macro (reftex-match-string 3)) | 410 | (macro (reftex-match-string 3)) |
| 411 | (prefix (save-match-data | 411 | (prefix (save-match-data |
| @@ -440,9 +440,9 @@ of master file." | |||
| 440 | literal (marker-position marker)))) | 440 | literal (marker-position marker)))) |
| 441 | 441 | ||
| 442 | (defun reftex-ensure-index-support (&optional abort) | 442 | (defun reftex-ensure-index-support (&optional abort) |
| 443 | ;; When index support is turned off, ask to turn it on and | 443 | "When index support is turned off, ask to turn it on and |
| 444 | ;; set the current prefix argument so that `reftex-access-scan-info' | 444 | set the current prefix argument so that `reftex-access-scan-info' |
| 445 | ;; will rescan the entire document. | 445 | will rescan the entire document." |
| 446 | (cond | 446 | (cond |
| 447 | (reftex-support-index t) | 447 | (reftex-support-index t) |
| 448 | ((y-or-n-p "Turn on index support and rescan entire document? ") | 448 | ((y-or-n-p "Turn on index support and rescan entire document? ") |
| @@ -460,8 +460,8 @@ of master file." | |||
| 460 | 460 | ||
| 461 | (defvar test-dummy) | 461 | (defvar test-dummy) |
| 462 | (defun reftex-index-info (file) | 462 | (defun reftex-index-info (file) |
| 463 | ;; Return an index entry for the current match. | 463 | "Return an index entry for the current match. |
| 464 | ;; Careful: This function expects the match-data to be still in place! | 464 | Careful: This function expects the match-data to be still in place!" |
| 465 | (catch 'exit | 465 | (catch 'exit |
| 466 | (let* ((macro (reftex-match-string 10)) | 466 | (let* ((macro (reftex-match-string 10)) |
| 467 | (bom (match-beginning 10)) | 467 | (bom (match-beginning 10)) |
| @@ -508,7 +508,7 @@ of master file." | |||
| 508 | (list 'index index-tag context file bom arg key showkey sortkey key-end)))) | 508 | (list 'index index-tag context file bom arg key showkey sortkey key-end)))) |
| 509 | 509 | ||
| 510 | (defun reftex-short-context (env parse &optional bound derive) | 510 | (defun reftex-short-context (env parse &optional bound derive) |
| 511 | ;; Get about one line of useful context for the label definition at point. | 511 | "Get about one line of useful context for the label definition at point." |
| 512 | 512 | ||
| 513 | (if (consp parse) | 513 | (if (consp parse) |
| 514 | (setq parse (if derive (cdr parse) (car parse)))) | 514 | (setq parse (if derive (cdr parse) (car parse)))) |
| @@ -568,9 +568,9 @@ of master file." | |||
| 568 | "INVALID VALUE OF PARSE")))) | 568 | "INVALID VALUE OF PARSE")))) |
| 569 | 569 | ||
| 570 | (defun reftex-where-am-I () | 570 | (defun reftex-where-am-I () |
| 571 | ;; Return the docstruct entry above point. Actually returns a cons | 571 | "Return the docstruct entry above point. |
| 572 | ;; cell in which the cdr is a flag indicating if the information is | 572 | Actually returns a cons cell in which the cdr is a flag indicating |
| 573 | ;; exact (t) or approximate (nil). | 573 | if the information is exact (t) or approximate (nil)." |
| 574 | 574 | ||
| 575 | (let ((docstruct (symbol-value reftex-docstruct-symbol)) | 575 | (let ((docstruct (symbol-value reftex-docstruct-symbol)) |
| 576 | (cnt 0) rtn rtn-if-no-other | 576 | (cnt 0) rtn rtn-if-no-other |
| @@ -748,10 +748,10 @@ of master file." | |||
| 748 | ) | 748 | ) |
| 749 | 749 | ||
| 750 | (defsubst reftex-move-to-previous-arg (&optional bound) | 750 | (defsubst reftex-move-to-previous-arg (&optional bound) |
| 751 | ;; Assuming that we are in front of a macro argument, | 751 | "Assuming that we are in front of a macro argument, |
| 752 | ;; move backward to the closing parenthesis of the previous argument. | 752 | move backward to the closing parenthesis of the previous argument. |
| 753 | ;; This function understands the splitting of macros over several lines | 753 | This function understands the splitting of macros over several lines |
| 754 | ;; in TeX. | 754 | in TeX." |
| 755 | (cond | 755 | (cond |
| 756 | ;; Just to be quick: | 756 | ;; Just to be quick: |
| 757 | ((memq (preceding-char) '(?\] ?\}))) | 757 | ((memq (preceding-char) '(?\] ?\}))) |
| @@ -764,28 +764,27 @@ of master file." | |||
| 764 | (t nil))) | 764 | (t nil))) |
| 765 | 765 | ||
| 766 | (defun reftex-what-macro-safe (which &optional bound) | 766 | (defun reftex-what-macro-safe (which &optional bound) |
| 767 | ;; reftex-what-macro with special syntax table. | 767 | "Call `reftex-what-macro' with special syntax table." |
| 768 | (reftex-with-special-syntax | 768 | (reftex-with-special-syntax |
| 769 | (reftex-what-macro which bound))) | 769 | (reftex-what-macro which bound))) |
| 770 | 770 | ||
| 771 | (defun reftex-what-macro (which &optional bound) | 771 | (defun reftex-what-macro (which &optional bound) |
| 772 | ;; Find out if point is within the arguments of any TeX-macro. | 772 | "Find out if point is within the arguments of any TeX-macro. |
| 773 | ;; The return value is either ("\\macro" . (point)) or a list of them. | 773 | The return value is either (\"\\macro\" . (point)) or a list of them. |
| 774 | 774 | ||
| 775 | ;; If WHICH is nil, immediately return nil. | 775 | If WHICH is nil, immediately return nil. |
| 776 | ;; If WHICH is 1, return innermost enclosing macro. | 776 | If WHICH is 1, return innermost enclosing macro. |
| 777 | ;; If WHICH is t, return list of all macros enclosing point. | 777 | If WHICH is t, return list of all macros enclosing point. |
| 778 | ;; If WHICH is a list of macros, look only for those macros and return the | 778 | If WHICH is a list of macros, look only for those macros and return the |
| 779 | ;; name of the first macro in this list found to enclose point. | 779 | name of the first macro in this list found to enclose point. |
| 780 | ;; If the optional BOUND is an integer, bound backwards directed | 780 | If the optional BOUND is an integer, bound backwards directed |
| 781 | ;; searches to this point. If it is nil, limit to nearest \section - | 781 | searches to this point. If it is nil, limit to nearest \\section - |
| 782 | ;; like statement. | 782 | like statement. |
| 783 | 783 | ||
| 784 | ;; This function is pretty stable, but can be fooled if the text contains | 784 | This function is pretty stable, but can be fooled if the text contains |
| 785 | ;; things like \macro{aa}{bb} where \macro is defined to take only one | 785 | things like \\macro{aa}{bb} where \\macro is defined to take only one |
| 786 | ;; argument. As RefTeX cannot know this, the string "bb" would still be | 786 | argument. As RefTeX cannot know this, the string \"bb\" would still be |
| 787 | ;; considered an argument of macro \macro. | 787 | considered an argument of macro \\macro." |
| 788 | |||
| 789 | (unless reftex-section-regexp (reftex-compile-variables)) | 788 | (unless reftex-section-regexp (reftex-compile-variables)) |
| 790 | (catch 'exit | 789 | (catch 'exit |
| 791 | (if (null which) (throw 'exit nil)) | 790 | (if (null which) (throw 'exit nil)) |
| @@ -832,20 +831,19 @@ of master file." | |||
| 832 | (nreverse cmd-list))))) | 831 | (nreverse cmd-list))))) |
| 833 | 832 | ||
| 834 | (defun reftex-what-environment (which &optional bound) | 833 | (defun reftex-what-environment (which &optional bound) |
| 835 | ;; Find out if point is inside a LaTeX environment. | 834 | "Find out if point is inside a LaTeX environment. |
| 836 | ;; The return value is (e.g.) either ("equation" . (point)) or a list of | 835 | The return value is (e.g.) either (\"equation\" . (point)) or a list of |
| 837 | ;; them. | 836 | them. |
| 838 | 837 | ||
| 839 | ;; If WHICH is nil, immediately return nil. | 838 | If WHICH is nil, immediately return nil. |
| 840 | ;; If WHICH is 1, return innermost enclosing environment. | 839 | If WHICH is 1, return innermost enclosing environment. |
| 841 | ;; If WHICH is t, return list of all environments enclosing point. | 840 | If WHICH is t, return list of all environments enclosing point. |
| 842 | ;; If WHICH is a list of environments, look only for those environments and | 841 | If WHICH is a list of environments, look only for those environments and |
| 843 | ;; return the name of the first environment in this list found to enclose | 842 | return the name of the first environment in this list found to enclose |
| 844 | ;; point. | 843 | point. |
| 845 | 844 | ||
| 846 | ;; If the optional BOUND is an integer, bound backwards directed searches to | 845 | If the optional BOUND is an integer, bound backwards directed searches to |
| 847 | ;; this point. If it is nil, limit to nearest \section - like statement. | 846 | this point. If it is nil, limit to nearest \\section - like statement." |
| 848 | |||
| 849 | (unless reftex-section-regexp (reftex-compile-variables)) | 847 | (unless reftex-section-regexp (reftex-compile-variables)) |
| 850 | (catch 'exit | 848 | (catch 'exit |
| 851 | (save-excursion | 849 | (save-excursion |
| @@ -870,18 +868,17 @@ of master file." | |||
| 870 | (nreverse env-list))))) | 868 | (nreverse env-list))))) |
| 871 | 869 | ||
| 872 | (defun reftex-what-special-env (which &optional bound) | 870 | (defun reftex-what-special-env (which &optional bound) |
| 873 | ;; Run the special environment parsers and return the matches. | 871 | "Run the special environment parsers and return the matches. |
| 874 | ;; | 872 | |
| 875 | ;; The return value is (e.g.) either ("my-parser-function" . (point)) | 873 | The return value is (e.g.) either (\"my-parser-function\" . (point)) |
| 876 | ;; or a list of them. | 874 | or a list of them. |
| 877 | |||
| 878 | ;; If WHICH is nil, immediately return nil. | ||
| 879 | ;; If WHICH is 1, return innermost enclosing environment. | ||
| 880 | ;; If WHICH is t, return list of all environments enclosing point. | ||
| 881 | ;; If WHICH is a list of environments, look only for those environments and | ||
| 882 | ;; return the name of the first environment in this list found to enclose | ||
| 883 | ;; point. | ||
| 884 | 875 | ||
| 876 | If WHICH is nil, immediately return nil. | ||
| 877 | If WHICH is 1, return innermost enclosing environment. | ||
| 878 | If WHICH is t, return list of all environments enclosing point. | ||
| 879 | If WHICH is a list of environments, look only for those environments and | ||
| 880 | return the name of the first environment in this list found to enclose | ||
| 881 | point." | ||
| 885 | (unless reftex-section-regexp (reftex-compile-variables)) | 882 | (unless reftex-section-regexp (reftex-compile-variables)) |
| 886 | (catch 'exit | 883 | (catch 'exit |
| 887 | (save-excursion | 884 | (save-excursion |
| @@ -911,10 +908,10 @@ of master file." | |||
| 911 | (car specials)))))) | 908 | (car specials)))))) |
| 912 | 909 | ||
| 913 | (defsubst reftex-move-to-next-arg (&optional ignore) | 910 | (defsubst reftex-move-to-next-arg (&optional ignore) |
| 914 | ;; Assuming that we are at the end of a macro name or a macro argument, | 911 | "Assuming that we are at the end of a macro name or a macro argument, |
| 915 | ;; move forward to the opening parenthesis of the next argument. | 912 | move forward to the opening parenthesis of the next argument. |
| 916 | ;; This function understands the splitting of macros over several lines | 913 | This function understands the splitting of macros over several lines |
| 917 | ;; in TeX. | 914 | in TeX." |
| 918 | (cond | 915 | (cond |
| 919 | ;; Just to be quick: | 916 | ;; Just to be quick: |
| 920 | ((memq (following-char) '(?\[ ?\{))) | 917 | ((memq (following-char) '(?\[ ?\{))) |
| @@ -930,8 +927,8 @@ of master file." | |||
| 930 | (reftex-nth-arg (nth 5 entry) (nth 6 entry)))) | 927 | (reftex-nth-arg (nth 5 entry) (nth 6 entry)))) |
| 931 | 928 | ||
| 932 | (defun reftex-nth-arg (n &optional opt-args) | 929 | (defun reftex-nth-arg (n &optional opt-args) |
| 933 | ;; Return the nth following {} or [] parentheses content. | 930 | "Return the Nth following {} or [] parentheses content. |
| 934 | ;; OPT-ARGS is a list of argument numbers which are optional. | 931 | OPT-ARGS is a list of argument numbers which are optional." |
| 935 | 932 | ||
| 936 | ;; If we are sitting at a macro start, skip to end of macro name. | 933 | ;; If we are sitting at a macro start, skip to end of macro name. |
| 937 | (and (eq (following-char) ?\\) (skip-chars-forward "a-zA-Z*\\\\")) | 934 | (and (eq (following-char) ?\\) (skip-chars-forward "a-zA-Z*\\\\")) |
| @@ -974,8 +971,8 @@ of master file." | |||
| 974 | (error nil))) | 971 | (error nil))) |
| 975 | 972 | ||
| 976 | (defun reftex-context-substring (&optional to-end) | 973 | (defun reftex-context-substring (&optional to-end) |
| 977 | ;; Return up to 150 chars from point | 974 | "Return up to 150 chars from point. |
| 978 | ;; When point is just after a { or [, limit string to matching parenthesis | 975 | When point is just after a { or [, limit string to matching parenthesis" |
| 979 | (cond | 976 | (cond |
| 980 | (to-end | 977 | (to-end |
| 981 | ;; Environment - find next \end | 978 | ;; Environment - find next \end |
| @@ -1007,8 +1004,7 @@ of master file." | |||
| 1007 | (defvar reftex-section-numbers (make-vector reftex-max-section-depth 0)) | 1004 | (defvar reftex-section-numbers (make-vector reftex-max-section-depth 0)) |
| 1008 | 1005 | ||
| 1009 | (defun reftex-init-section-numbers (&optional toc-entry appendix) | 1006 | (defun reftex-init-section-numbers (&optional toc-entry appendix) |
| 1010 | ;; Initialize the section numbers with zeros or with what is found | 1007 | "Initialize the section numbers with zeros or with what is found in the TOC-ENTRY." |
| 1011 | ;; in the toc entry. | ||
| 1012 | (let* ((level (or (nth 5 toc-entry) -1)) | 1008 | (let* ((level (or (nth 5 toc-entry) -1)) |
| 1013 | (numbers (nreverse (split-string (or (nth 6 toc-entry) "") "\\."))) | 1009 | (numbers (nreverse (split-string (or (nth 6 toc-entry) "") "\\."))) |
| 1014 | (depth (1- (length reftex-section-numbers))) | 1010 | (depth (1- (length reftex-section-numbers))) |
| @@ -1026,8 +1022,8 @@ of master file." | |||
| 1026 | (put 'reftex-section-numbers 'appendix appendix)) | 1022 | (put 'reftex-section-numbers 'appendix appendix)) |
| 1027 | 1023 | ||
| 1028 | (defun reftex-section-number (&optional level star) | 1024 | (defun reftex-section-number (&optional level star) |
| 1029 | ;; Return a string with the current section number. | 1025 | "Return a string with the current section number. |
| 1030 | ;; When LEVEL is non-nil, increase section numbers on that level. | 1026 | When LEVEL is non-nil, increase section numbers on that level." |
| 1031 | (let* ((depth (1- (length reftex-section-numbers))) idx n (string "") | 1027 | (let* ((depth (1- (length reftex-section-numbers))) idx n (string "") |
| 1032 | (appendix (get 'reftex-section-numbers 'appendix)) | 1028 | (appendix (get 'reftex-section-numbers 'appendix)) |
| 1033 | (partspecial (and (not reftex-part-resets-chapter) | 1029 | (partspecial (and (not reftex-part-resets-chapter) |
| @@ -1073,7 +1069,7 @@ of master file." | |||
| 1073 | string)))) | 1069 | string)))) |
| 1074 | 1070 | ||
| 1075 | (defun reftex-roman-number (n) | 1071 | (defun reftex-roman-number (n) |
| 1076 | ;; Return as a string the roman number equal to N. | 1072 | "Return as a string the roman number equal to N." |
| 1077 | (let ((nrest n) | 1073 | (let ((nrest n) |
| 1078 | (string "") | 1074 | (string "") |
| 1079 | (list '((1000 . "M") ( 900 . "CM") ( 500 . "D") ( 400 . "CD") | 1075 | (list '((1000 . "M") ( 900 . "CM") ( 500 . "D") ( 400 . "CD") |
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index b633b7be403..de103c0cdb6 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el | |||
| @@ -1,9 +1,9 @@ | |||
| 1 | ;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output -*- lexical-binding: t -*- | 1 | ;;; log-view.el --- Major mode for browsing revision log histories -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1999-2013 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1999-2013 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | 5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> |
| 6 | ;; Keywords: rcs, sccs, cvs, log, vc, tools | 6 | ;; Keywords: tools, vc |
| 7 | 7 | ||
| 8 | ;; This file is part of GNU Emacs. | 8 | ;; This file is part of GNU Emacs. |
| 9 | 9 | ||
| @@ -24,10 +24,12 @@ | |||
| 24 | 24 | ||
| 25 | ;; Major mode to browse revision log histories. | 25 | ;; Major mode to browse revision log histories. |
| 26 | ;; Currently supports the format output by: | 26 | ;; Currently supports the format output by: |
| 27 | ;; RCS, SCCS, CVS, Subversion, and DaRCS. | 27 | ;; SCCS, RCS, CVS, Subversion, DaRCS, and Mercurial. |
| 28 | 28 | ||
| 29 | ;; Examples of log output: | 29 | ;; Examples of log output: |
| 30 | 30 | ||
| 31 | ;;;; SCCS: | ||
| 32 | |||
| 31 | ;;;; RCS/CVS: | 33 | ;;;; RCS/CVS: |
| 32 | 34 | ||
| 33 | ;; ---------------------------- | 35 | ;; ---------------------------- |
| @@ -43,8 +45,6 @@ | |||
| 43 | ;; Change release version from 21.4 to 22.1 throughout. | 45 | ;; Change release version from 21.4 to 22.1 throughout. |
| 44 | ;; Change development version from 21.3.50 to 22.0.50. | 46 | ;; Change development version from 21.3.50 to 22.0.50. |
| 45 | 47 | ||
| 46 | ;;;; SCCS: | ||
| 47 | |||
| 48 | ;;;; Subversion: | 48 | ;;;; Subversion: |
| 49 | 49 | ||
| 50 | ;; ------------------------------------------------------------------------ | 50 | ;; ------------------------------------------------------------------------ |
| @@ -117,18 +117,25 @@ | |||
| 117 | (defvar cvs-force-command) | 117 | (defvar cvs-force-command) |
| 118 | 118 | ||
| 119 | (defgroup log-view nil | 119 | (defgroup log-view nil |
| 120 | "Major mode for browsing log output of RCS/CVS/SCCS." | 120 | "Major mode for browsing log output of revision log histories." |
| 121 | :group 'pcl-cvs | 121 | :group 'pcl-cvs |
| 122 | :prefix "log-view-") | 122 | :prefix "log-view-") |
| 123 | 123 | ||
| 124 | (easy-mmode-defmap log-view-mode-map | 124 | (easy-mmode-defmap log-view-mode-map |
| 125 | '( | 125 | '( |
| 126 | ;; FIXME: (copy-keymap special-mode-map) instead | 126 | ("-" . negative-argument) |
| 127 | ("z" . kill-this-buffer) | 127 | ("0" . digit-argument) |
| 128 | ("q" . quit-window) | 128 | ("1" . digit-argument) |
| 129 | ("g" . revert-buffer) | 129 | ("2" . digit-argument) |
| 130 | ("\C-m" . log-view-toggle-entry-display) | 130 | ("3" . digit-argument) |
| 131 | ("4" . digit-argument) | ||
| 132 | ("5" . digit-argument) | ||
| 133 | ("6" . digit-argument) | ||
| 134 | ("7" . digit-argument) | ||
| 135 | ("8" . digit-argument) | ||
| 136 | ("9" . digit-argument) | ||
| 131 | 137 | ||
| 138 | ("\C-m" . log-view-toggle-entry-display) | ||
| 132 | ("m" . log-view-toggle-mark-entry) | 139 | ("m" . log-view-toggle-mark-entry) |
| 133 | ("e" . log-view-modify-change-comment) | 140 | ("e" . log-view-modify-change-comment) |
| 134 | ("d" . log-view-diff) | 141 | ("d" . log-view-diff) |
| @@ -145,6 +152,7 @@ | |||
| 145 | ("\M-n" . log-view-file-next) | 152 | ("\M-n" . log-view-file-next) |
| 146 | ("\M-p" . log-view-file-prev)) | 153 | ("\M-p" . log-view-file-prev)) |
| 147 | "Log-View's keymap." | 154 | "Log-View's keymap." |
| 155 | :inherit special-mode-map | ||
| 148 | :group 'log-view) | 156 | :group 'log-view) |
| 149 | 157 | ||
| 150 | (easy-menu-define log-view-mode-menu log-view-mode-map | 158 | (easy-menu-define log-view-mode-menu log-view-mode-map |
| @@ -275,6 +283,7 @@ The match group number 1 should match the revision number itself.") | |||
| 275 | (easy-mmode-define-navigation log-view-file log-view-file-re "file") | 283 | (easy-mmode-define-navigation log-view-file log-view-file-re "file") |
| 276 | 284 | ||
| 277 | (defun log-view-goto-rev (rev) | 285 | (defun log-view-goto-rev (rev) |
| 286 | "Go to revision REV." | ||
| 278 | (goto-char (point-min)) | 287 | (goto-char (point-min)) |
| 279 | (ignore-errors | 288 | (ignore-errors |
| 280 | (while (not (equal rev (log-view-current-tag))) | 289 | (while (not (equal rev (log-view-current-tag))) |
| @@ -288,6 +297,7 @@ The match group number 1 should match the revision number itself.") | |||
| 288 | (defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$") | 297 | (defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$") |
| 289 | 298 | ||
| 290 | (defun log-view-current-file () | 299 | (defun log-view-current-file () |
| 300 | "Return the current file." | ||
| 291 | (save-excursion | 301 | (save-excursion |
| 292 | (forward-line 1) | 302 | (forward-line 1) |
| 293 | (or (re-search-backward log-view-file-re nil t) | 303 | (or (re-search-backward log-view-file-re nil t) |
| @@ -340,7 +350,7 @@ if POS is omitted or nil, it defaults to point." | |||
| 340 | 350 | ||
| 341 | (defun log-view-toggle-mark-entry () | 351 | (defun log-view-toggle-mark-entry () |
| 342 | "Toggle the marked state for the log entry at point. | 352 | "Toggle the marked state for the log entry at point. |
| 343 | Individual log entries can be marked and unmarked. The marked | 353 | Individual log entries can be marked and unmarked. The marked |
| 344 | entries are denoted by changing their background color. | 354 | entries are denoted by changing their background color. |
| 345 | `log-view-get-marked' returns the list of tags for the marked | 355 | `log-view-get-marked' returns the list of tags for the marked |
| 346 | log entries." | 356 | log entries." |
| @@ -479,7 +489,8 @@ It assumes that a log entry starts with a line matching | |||
| 479 | (funcall f)))) | 489 | (funcall f)))) |
| 480 | 490 | ||
| 481 | (defun log-view-find-revision (pos) | 491 | (defun log-view-find-revision (pos) |
| 482 | "Visit the version at point." | 492 | "Visit the version at POS. |
| 493 | If called interactively, visit the version at point." | ||
| 483 | (interactive "d") | 494 | (interactive "d") |
| 484 | (unless log-view-per-file-logs | 495 | (unless log-view-per-file-logs |
| 485 | (when (> (length log-view-vc-fileset) 1) | 496 | (when (> (length log-view-vc-fileset) 1) |
| @@ -521,7 +532,8 @@ It assumes that a log entry starts with a line matching | |||
| 521 | (log-view-extract-comment))) | 532 | (log-view-extract-comment))) |
| 522 | 533 | ||
| 523 | (defun log-view-annotate-version (pos) | 534 | (defun log-view-annotate-version (pos) |
| 524 | "Annotate the version at point." | 535 | "Annotate the version at POS. |
| 536 | If called interactively, annotate the version at point." | ||
| 525 | (interactive "d") | 537 | (interactive "d") |
| 526 | (unless log-view-per-file-logs | 538 | (unless log-view-per-file-logs |
| 527 | (when (> (length log-view-vc-fileset) 1) | 539 | (when (> (length log-view-vc-fileset) 1) |
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index eee896056c6..17b278d1ce4 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el | |||
| @@ -115,7 +115,7 @@ This is only meaningful if you don't use the implicit checkout model | |||
| 115 | This avoids slow queries over the network and instead uses heuristics | 115 | This avoids slow queries over the network and instead uses heuristics |
| 116 | and past information to determine the current status of a file. | 116 | and past information to determine the current status of a file. |
| 117 | 117 | ||
| 118 | If value is the symbol `only-file' `vc-dir' will connect to the | 118 | If value is the symbol `only-file', `vc-dir' will connect to the |
| 119 | server, but heuristics will be used to determine the status for | 119 | server, but heuristics will be used to determine the status for |
| 120 | all other VC operations. | 120 | all other VC operations. |
| 121 | 121 | ||
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 5c8a4515b7e..284481ee524 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el | |||
| @@ -128,7 +128,7 @@ See also variable `vc-consult-headers'." | |||
| 128 | This avoids slow queries over the network and instead uses heuristics | 128 | This avoids slow queries over the network and instead uses heuristics |
| 129 | and past information to determine the current status of a file. | 129 | and past information to determine the current status of a file. |
| 130 | 130 | ||
| 131 | If value is the symbol `only-file' `vc-dir' will connect to the | 131 | If value is the symbol `only-file', `vc-dir' will connect to the |
| 132 | server, but heuristics will be used to determine the status for | 132 | server, but heuristics will be used to determine the status for |
| 133 | all other VC operations. | 133 | all other VC operations. |
| 134 | 134 | ||
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 5e1d27c0ea3..0308dd1ebd4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el | |||
| @@ -115,10 +115,10 @@ | |||
| 115 | ;; Return non-nil if FILE is registered in this backend. Both this | 115 | ;; Return non-nil if FILE is registered in this backend. Both this |
| 116 | ;; function as well as `state' should be careful to fail gracefully | 116 | ;; function as well as `state' should be careful to fail gracefully |
| 117 | ;; in the event that the backend executable is absent. It is | 117 | ;; in the event that the backend executable is absent. It is |
| 118 | ;; preferable that this function's body is autoloaded, that way only | 118 | ;; preferable that this function's *body* is autoloaded, that way only |
| 119 | ;; calling vc-registered does not cause the backend to be loaded | 119 | ;; calling vc-registered does not cause the backend to be loaded |
| 120 | ;; (all the vc-FOO-registered functions are called to try to find | 120 | ;; (all the vc-FOO-registered functions are called to try to find |
| 121 | ;; the controlling backend for FILE. | 121 | ;; the controlling backend for FILE). |
| 122 | ;; | 122 | ;; |
| 123 | ;; * state (file) | 123 | ;; * state (file) |
| 124 | ;; | 124 | ;; |
| @@ -233,6 +233,7 @@ | |||
| 233 | ;; The implementation should pass the value of vc-register-switches | 233 | ;; The implementation should pass the value of vc-register-switches |
| 234 | ;; to the backend command. (Note: in older versions of VC, this | 234 | ;; to the backend command. (Note: in older versions of VC, this |
| 235 | ;; command took a single file argument and not a list.) | 235 | ;; command took a single file argument and not a list.) |
| 236 | ;; The REV argument is a historical leftover and is never used. | ||
| 236 | ;; | 237 | ;; |
| 237 | ;; - init-revision (file) | 238 | ;; - init-revision (file) |
| 238 | ;; | 239 | ;; |
| @@ -999,7 +1000,7 @@ current buffer." | |||
| 999 | nil) | 1000 | nil) |
| 1000 | (list (vc-backend-for-registration (buffer-file-name)) | 1001 | (list (vc-backend-for-registration (buffer-file-name)) |
| 1001 | (list buffer-file-name)))) | 1002 | (list buffer-file-name)))) |
| 1002 | (t (error "No fileset is available here"))))) | 1003 | (t (error "File is not under version control"))))) |
| 1003 | 1004 | ||
| 1004 | (defun vc-dired-deduce-fileset () | 1005 | (defun vc-dired-deduce-fileset () |
| 1005 | (let ((backend (vc-responsible-backend default-directory))) | 1006 | (let ((backend (vc-responsible-backend default-directory))) |
| @@ -1041,6 +1042,11 @@ current buffer." | |||
| 1041 | (eq p q) | 1042 | (eq p q) |
| 1042 | (and (member p '(edited added removed)) (member q '(edited added removed))))) | 1043 | (and (member p '(edited added removed)) (member q '(edited added removed))))) |
| 1043 | 1044 | ||
| 1045 | (defun vc-read-backend (prompt) | ||
| 1046 | (intern | ||
| 1047 | (completing-read prompt (mapcar 'symbol-name vc-handled-backends) | ||
| 1048 | nil 'require-match))) | ||
| 1049 | |||
| 1044 | ;; Here's the major entry point. | 1050 | ;; Here's the major entry point. |
| 1045 | 1051 | ||
| 1046 | ;;;###autoload | 1052 | ;;;###autoload |
| @@ -1099,8 +1105,9 @@ For old-style locking-based version control systems, like RCS: | |||
| 1099 | ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) | 1105 | ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) |
| 1100 | (cond | 1106 | (cond |
| 1101 | (verbose | 1107 | (verbose |
| 1102 | ;; go to a different revision | 1108 | ;; Go to a different revision. |
| 1103 | (let* ((revision | 1109 | (let* ((revision |
| 1110 | ;; FIXME: Provide completion. | ||
| 1104 | (read-string "Branch, revision, or backend to move to: ")) | 1111 | (read-string "Branch, revision, or backend to move to: ")) |
| 1105 | (revision-downcase (downcase revision))) | 1112 | (revision-downcase (downcase revision))) |
| 1106 | (if (member | 1113 | (if (member |
| @@ -1161,15 +1168,10 @@ For old-style locking-based version control systems, like RCS: | |||
| 1161 | (message "No files remain to be committed") | 1168 | (message "No files remain to be committed") |
| 1162 | (if (not verbose) | 1169 | (if (not verbose) |
| 1163 | (vc-checkin ready-for-commit backend) | 1170 | (vc-checkin ready-for-commit backend) |
| 1164 | (let* ((revision (read-string "New revision or backend: ")) | 1171 | (let ((new-backend (vc-read-backend "New backend: "))) |
| 1165 | (revision-downcase (downcase revision))) | 1172 | (if new-backend |
| 1166 | (if (member | 1173 | (dolist (file files) |
| 1167 | revision-downcase | 1174 | (vc-transfer-file file new-backend)))))))) |
| 1168 | (mapcar (lambda (arg) (downcase (symbol-name arg))) | ||
| 1169 | vc-handled-backends)) | ||
| 1170 | (let ((vsym (intern revision-downcase))) | ||
| 1171 | (dolist (file files) (vc-transfer-file file vsym))) | ||
| 1172 | (vc-checkin ready-for-commit backend revision))))))) | ||
| 1173 | ;; locked by somebody else (locking VCSes only) | 1175 | ;; locked by somebody else (locking VCSes only) |
| 1174 | ((stringp state) | 1176 | ((stringp state) |
| 1175 | ;; In the old days, we computed the revision once and used it on | 1177 | ;; In the old days, we computed the revision once and used it on |