diff options
author | Paul Eggert <eggert@cs.ucla.edu> | 2011-03-17 09:32:03 -0700 |
---|---|---|
committer | Paul Eggert <eggert@cs.ucla.edu> | 2011-03-17 09:32:03 -0700 |
commit | b1d876f1a19ae65c8a8dd61c4ce17055ca53f16c (patch) | |
tree | 5dd8a40d7e3e0b86749cecfee7443ad81bdbfe5e /lisp | |
parent | b766f86726fc2828a035cb8db149598a3a84de96 (diff) | |
parent | d6cd56f187a791983579bf5d4ce3702d2ddf2499 (diff) | |
download | emacs-b1d876f1a19ae65c8a8dd61c4ce17055ca53f16c.tar.gz emacs-b1d876f1a19ae65c8a8dd61c4ce17055ca53f16c.tar.bz2 emacs-b1d876f1a19ae65c8a8dd61c4ce17055ca53f16c.zip |
Merge from mainline.
Diffstat (limited to 'lisp')
44 files changed, 740 insertions, 362 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c74e7cbdb2d..5164207a5ce 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,119 @@ +2011-03-17 Juanma Barranquero <lekktu@gmail.com> + + * custom.el (custom-known-themes): Reflow docstring. + (custom-theme-load-path): Fix typo in docstring. + (load-theme): Fix typo in error message. + (custom-available-themes, custom-variable-theme-value): + Use `let', not `let*'. + +2011-03-17 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/README: Mention inclusion of musical notes. + + * calc/calc-units.el (calc-lu-quant): Rename from + `calc-logunits-quantity'. + (calcFunc-lupquant): Rename from `calcFunc-powerquant'. + (calcFunc-lufquant): Rename from `calcFunc-fieldquant'. + (calc-db): Rename from `calc-dblevel'. + (calcFunc-dbpower): Rename from `calcFunc-dbpowerlevel'. + (calcFunc-dbfield): Rename from `calcFunc-dbfieldlevel'. + (calc-np): Rename from `calc-nplevel'. + (calcFunc-nppower): Rename from `calcFunc-nppowerlevel'. + (calcFunc-npfield): Rename from `calcFunc-npfieldlevel'. + (calc-lu-plus): Rename from `calc-logunits-add'. + (calcFunc-lupadd): Rename from `calcFunc-lupoweradd'. + (calcFunc-lufadd): Rename from `calcFunc-lufieldadd'. + (calc-lu-minus): Rename from `calc-logunits-sub'. + (calcFunc-lupsub): Rename from `calcFunc-lupowersub'. + (calcFunc-lufsub): Rename from `calcFunc-lufieldsub'. + (calc-lu-times): Rename from `calc-logunits-mul'. + (calcFunc-lupmul): Rename from `calcFunc-lupowermul'. + (calcFunc-lufmul): Rename from `calcFunc-lufieldmul'. + (calc-lu-divide): Rename from `calc-logunits-div'. + (calcFunc-lupdiv): Rename from `calcFunc-lupowerdiv'. + (calcFunc-lufdiv): Rename from `calcFunc-lufielddiv'. + + * calc/calc-ext.el (calc-init-extensions): Update the names of the + functions being autoloaded. + + * calc/calc.el (calc-lu-power-reference): Rename from + `calc-logunits-power-reference'. + (calc-lu-field-reference): Rename from + `calc-logunits-field-reference'. + + * calc/calc-help (calc-l-prefix-help): Mention musical note functions. + +2011-03-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (completion-all-sorted-completions): + Use :completion-cycle-penalty text property if present. + +2011-03-16 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el (allout-yank-processing): Adjust for new rebulleting + regime so bullet being yanked is used without prompting the user + for a choice. + +2011-03-16 Juanma Barranquero <lekktu@gmail.com> + + * startup.el (command-line): Warn the user that _emacs is deprecated. + +2011-03-16 Juanma Barranquero <lekktu@gmail.com> + + * progmodes/delphi.el (delphi-search-path, delphi-indent-level) + (delphi-verbose, delphi-comment-face, delphi-string-face) + (delphi-keyword-face, delphi-ignore-changes, delphi-indent-line) + (delphi-mode-abbrev-table, delphi-debug-buffer, delphi-tab) + (delphi-find-unit, delphi-find-current-xdef, delphi-fill-comment) + (delphi-new-comment-line, delphi-font-lock-defaults) + (delphi-debug-mode-map, delphi-mode-syntax-table, delphi-mode): + Fix typos in docstrings. + +2011-03-15 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el (allout-make-topic-prefix, allout-rebullet-heading): + Invert the roles of character and string values for INSTEAD, so a + string is used for the more common case of a defaulting prompt. + +2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/ruby-mode.el (ruby-backward-sexp): + * progmodes/ebrowse.el (ebrowse-draw-file-member-info): + * play/gamegrid.el (gamegrid-make-face): + * play/bubbles.el (bubbles--grid-width, bubbles--grid-height) + (bubbles--colors, bubbles--shift-mode, bubbles--initialize-images): + * notifications.el (notifications-notify): + * net/xesam.el (xesam-search-engines): + * net/quickurl.el (quickurl-list-insert): + * vc/vc-hg.el (vc-hg-dir-printer): Fix use of case. + +2011-03-15 Chong Yidong <cyd@stupidchicken.com> + + * startup.el (command-line): Update package subdirectory regexp. + +2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * allout.el (allout-abbreviate-flattened-numbering) + (allout-mode-deactivate-hook): Fix up obsolescence "date". + + * subr.el (read-char-choice): Only show the cursor after the prompt, + not after the answer. + +2011-03-15 Kevin Ryde <user42@zip.com.au> + + * help-fns.el (variable-at-point): Skip leading quotes, if any + (bug#8253). + +2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/bytecomp.el (byte-compile-save-excursion): Change the + warning message. + +2011-03-14 Michael Albinus <michael.albinus@gmx.de> + + * shell.el (shell): When called interactively, offer to change the + shell file name on remote hosts. + 2011-03-13 Teodor Zlatanov <tzz@lifelogs.com> * net/ldap.el (ldap-search-internal): Add `auth-source-search' diff --git a/lisp/allout.el b/lisp/allout.el index 91eaa28fdaf..3fb8ed7ccd5 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -310,6 +310,7 @@ Auto-layout is not. With value nil, inhibit any automatic allout-mode activation." :set 'allout-auto-activation-helper + ;; FIXME: Using strings here is unusual and less efficient than symbols. :type '(choice (const :tag "On" t) (const :tag "Ask about layout" "ask") (const :tag "Mode only" "activate") @@ -752,7 +753,7 @@ Set this var to the bullet you want to use for file cross-references." ;;;_ = allout-flattened-numbering-abbreviation (define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering - 'allout-flattened-numbering-abbreviation "24.0") + 'allout-flattened-numbering-abbreviation "24.1") (defcustom allout-flattened-numbering-abbreviation nil "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic numbers to minimal amount with some context. Otherwise, entire @@ -1402,7 +1403,7 @@ their settings before allout-mode was started." (defvar allout-mode-deactivate-hook nil "*Hook that's run when allout mode ends.") (define-obsolete-variable-alias 'allout-mode-deactivate-hook - 'allout-mode-off-hook "future") + 'allout-mode-off-hook "24.1") ;;;_ = allout-exposure-category (defvar allout-exposure-category nil "Symbol for use as allout invisible-text overlay category.") @@ -3495,8 +3496,8 @@ the current topics' depth. If INSTEAD is: - nil, then the bullet char for the context is used, per distinction or depth -- a string, then the first character of the string will be used -- a character, then the user is solicited for bullet, with that char as default +- a \(numeric) character, then character's string representation is used +- a string, then the user is asked for bullet with the first char as default - anything else, the user is solicited with bullet char per context as default \(INSTEAD overrides other options, including, eg, a distinctive @@ -3553,10 +3554,12 @@ index for each successive sibling)." ((progn (setq body (make-string (- depth 2) ?\ )) ;; The actual condition: instead) - (let* ((got - (if (and (stringp instead)(> (length instead) 0)) - (substring instead 0 1) - (allout-solicit-alternate-bullet depth instead)))) + (let ((got (cond ((stringp instead) + (if (> (length instead) 0) + (allout-solicit-alternate-bullet + depth (substring instead 0 1)))) + ((characterp instead) (char-to-string instead)) + (t (allout-solicit-alternate-bullet depth))))) ;; Gotta check whether we're numbering and got a numbered bullet: (setq numbering (and allout-numbered-bullet (not (and number-control (not index))) @@ -3950,8 +3953,8 @@ All args are optional. If INSTEAD is: - nil, then the bullet char for the context is used, per distinction or depth -- a string, then the first character of the string will be used -- a character, then the user is solicited for bullet, with that char as default +- a \(numeric) character, then character's string representation is used +- a string, then the user is asked for bullet with the first char as default - anything else, the user is solicited with bullet char per context as default Second arg DEPTH forces the topic prefix to that depth, regardless @@ -4596,7 +4599,7 @@ however, are left exactly like normal, non-allout-specific yanks." (if (looking-at " ") (delete-char 1)))) ;; Assert new topic's bullet - minimal effort if unchanged: - (allout-rebullet-heading prefix-bullet)) + (allout-rebullet-heading (string-to-char prefix-bullet))) (exchange-point-and-mark)))) (if rectify-numbering (progn diff --git a/lisp/calc/README b/lisp/calc/README index 533b80baeb0..308b5115aa2 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -72,6 +72,8 @@ Summary of changes to "Calc" Emacs 24.1 +* Support for musical notes added. + * Support for logarithmic units added. * Calc no longer uses the tex prefix for TeX specific unit diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 11a26d6d125..9ea773fbb98 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -422,13 +422,13 @@ (define-key calc-mode-map "kT" 'calc-utpt) (define-key calc-mode-map "l" nil) - (define-key calc-mode-map "lq" 'calc-logunits-quantity) - (define-key calc-mode-map "ld" 'calc-dblevel) - (define-key calc-mode-map "ln" 'calc-nplevel) - (define-key calc-mode-map "l+" 'calc-logunits-add) - (define-key calc-mode-map "l-" 'calc-logunits-sub) - (define-key calc-mode-map "l*" 'calc-logunits-mul) - (define-key calc-mode-map "l/" 'calc-logunits-divide) + (define-key calc-mode-map "lq" 'calc-lu-quant) + (define-key calc-mode-map "ld" 'calc-db) + (define-key calc-mode-map "ln" 'calc-np) + (define-key calc-mode-map "l+" 'calc-lu-plus) + (define-key calc-mode-map "l-" 'calc-lu-minus) + (define-key calc-mode-map "l*" 'calc-lu-times) + (define-key calc-mode-map "l/" 'calc-lu-divide) (define-key calc-mode-map "ls" 'calc-spn) (define-key calc-mode-map "lm" 'calc-midi) (define-key calc-mode-map "lf" 'calc-freq) @@ -943,12 +943,11 @@ calc-store-value calc-var-name) ("calc-stuff" calc-explain-why calcFunc-clean calcFunc-pclean calcFunc-pfloat calcFunc-pfrac) - ("calc-units" calcFunc-usimplify calcFunc-lufieldadd -calcFunc-lupoweradd calcFunc-lufieldsub calcFunc-lupowersub -calcFunc-lufieldmul calcFunc-lupowermul calcFunc-lufielddiv -calcFunc-lupowerdiv calcFunc-fieldquant calcFunc-powerquant -calcFunc-dbfieldlevel calcFunc-dbpowerlevel calcFunc-npfieldlevel -calcFunc-nppowerlevel calcFunc-spn calcFunc-midi calcFunc-freq + ("calc-units" calcFunc-usimplify calcFunc-lufadd calcFunc-lupadd +calcFunc-lufsub calcFunc-lupsub calcFunc-lufmul calcFunc-lupmul +calcFunc-lufdiv calcFunc-lupdiv calcFunc-lufquant calcFunc-lupquant +calcFunc-dbfield calcFunc-dbpower calcFunc-npfield +calcFunc-nppower calcFunc-spn calcFunc-midi calcFunc-freq math-build-units-table math-build-units-table-buffer math-check-unit-name math-convert-temperature math-convert-units math-extract-units math-remove-units math-simplify-units @@ -1180,9 +1179,9 @@ calc-convert-temperature calc-convert-units calc-define-unit calc-enter-units-table calc-explain-units calc-extract-units calc-get-unit-definition calc-permanent-units calc-quick-units calc-remove-units calc-simplify-units calc-undefine-unit -calc-view-units-table calc-logunits-quantity calc-dblevel -calc-nplevel calc-logunits-add calc-logunits-sub -calc-logunits-mul calc-logunits-divide calc-spn calc-midi +calc-view-units-table calc-lu-quant calc-db +calc-np calc-lu-plus calc-lu-minus +calc-lu-times calc-lu-divide calc-spn calc-midi calc-freq) ("calc-vec" calc-arrange-vector calc-build-vector calc-cnorm diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index d688b31b3cb..427cf6ba233 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -673,7 +673,9 @@ C-w Describe how there is no warranty for Calc." (interactive) (calc-do-prefix-help '("Quantity, DB level, Np level" - "+, -, *, /") + "+, -, *, /" + "Scientific pitch notation, Midi number, Frequency" + ) "log units" ?l)) (defun calc-v-prefix-help () diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 7f0adc9fe7e..43cb5828e85 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -1623,39 +1623,39 @@ In symbolic mode, return the list (^ a b)." coef))) units))))))) -(defun calcFunc-lufieldplus (a b) +(defun calcFunc-lufadd (a b) (math-logunits-add a b nil nil)) -(defun calcFunc-lupowerplus (a b) +(defun calcFunc-lupadd (a b) (math-logunits-add a b nil t)) -(defun calcFunc-lufieldminus (a b) +(defun calcFunc-lufsub (a b) (math-logunits-add a b t nil)) -(defun calcFunc-lupowerminus (a b) +(defun calcFunc-lupsub (a b) (math-logunits-add a b t t)) -(defun calc-logunits-add (arg) +(defun calc-lu-plus (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-inverse) (if (calc-is-hyperbolic) - (calc-binary-op "lu-" 'calcFunc-lufieldminus arg) - (calc-binary-op "lu-" 'calcFunc-lupowerminus arg)) + (calc-binary-op "lu-" 'calcFunc-lufsub arg) + (calc-binary-op "lu-" 'calcFunc-lupsub arg)) (if (calc-is-hyperbolic) - (calc-binary-op "lu+" 'calcFunc-lufieldplus arg) - (calc-binary-op "lu+" 'calcFunc-lupowerplus arg))))) + (calc-binary-op "lu+" 'calcFunc-lufadd arg) + (calc-binary-op "lu+" 'calcFunc-lupadd arg))))) -(defun calc-logunits-sub (arg) +(defun calc-lu-minus (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-inverse) (if (calc-is-hyperbolic) - (calc-binary-op "lu+" 'calcFunc-lufieldplus arg) - (calc-binary-op "lu+" 'calcFunc-lupowerplus arg)) + (calc-binary-op "lu+" 'calcFunc-lufadd arg) + (calc-binary-op "lu+" 'calcFunc-lupadd arg)) (if (calc-is-hyperbolic) - (calc-binary-op "lu-" 'calcFunc-lufieldminus arg) - (calc-binary-op "lu-" 'calcFunc-lupowerminus arg))))) + (calc-binary-op "lu-" 'calcFunc-lufsub arg) + (calc-binary-op "lu-" 'calcFunc-lupsub arg))))) (defun math-logunits-mul (a b power) (let (logunit coef units number) @@ -1719,39 +1719,39 @@ In symbolic mode, return the list (^ a b)." (math-div (math-conditional-apply 'calcFunc-ln b) (if power 2 1))) units))))))))) -(defun calcFunc-lufieldtimes (a b) +(defun calcFunc-lufmul (a b) (math-logunits-mul a b nil)) -(defun calcFunc-lupowertimes (a b) +(defun calcFunc-lupmul (a b) (math-logunits-mul a b t)) -(defun calc-logunits-mul (arg) +(defun calc-lu-times (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-inverse) (if (calc-is-hyperbolic) - (calc-binary-op "lu/" 'calcFunc-lufielddiv arg) - (calc-binary-op "lu/" 'calcFunc-lupowerdiv arg)) + (calc-binary-op "lu/" 'calcFunc-lufdiv arg) + (calc-binary-op "lu/" 'calcFunc-lupdiv arg)) (if (calc-is-hyperbolic) - (calc-binary-op "lu*" 'calcFunc-lufieldtimes arg) - (calc-binary-op "lu*" 'calcFunc-lupowertimes arg))))) + (calc-binary-op "lu*" 'calcFunc-lufmul arg) + (calc-binary-op "lu*" 'calcFunc-lupmul arg))))) -(defun calcFunc-lufielddiv (a b) +(defun calcFunc-lufdiv (a b) (math-logunits-divide a b nil)) -(defun calcFunc-lupowerdiv (a b) +(defun calcFunc-lupdiv (a b) (math-logunits-divide a b t)) -(defun calc-logunits-divide (arg) +(defun calc-lu-divide (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-inverse) (if (calc-is-hyperbolic) - (calc-binary-op "lu*" 'calcFunc-lufieldtimes arg) - (calc-binary-op "lu*" 'calcFunc-lupowertimes arg)) + (calc-binary-op "lu*" 'calcFunc-lufmul arg) + (calc-binary-op "lu*" 'calcFunc-lupmul arg)) (if (calc-is-hyperbolic) - (calc-binary-op "lu/" 'calcFunc-lufielddiv arg) - (calc-binary-op "lu/" 'calcFunc-lupowerdiv arg))))) + (calc-binary-op "lu/" 'calcFunc-lufdiv arg) + (calc-binary-op "lu/" 'calcFunc-lupdiv arg))))) (defun math-logunits-quant (val ref power) (let* ((units (math-simplify (math-extract-units val))) @@ -1777,29 +1777,29 @@ In symbolic mode, return the list (^ a b)." coeff)))) runits))))) -(defvar calc-logunits-field-reference) -(defvar calc-logunits-power-reference) +(defvar calc-lu-field-reference) +(defvar calc-lu-power-reference) -(defun calcFunc-fieldquant (val &optional ref) +(defun calcFunc-lufquant (val &optional ref) (unless ref - (setq ref (math-read-expr calc-logunits-field-reference))) + (setq ref (math-read-expr calc-lu-field-reference))) (math-logunits-quant val ref nil)) -(defun calcFunc-powerquant (val &optional ref) +(defun calcFunc-lupquant (val &optional ref) (unless ref - (setq ref (math-read-expr calc-logunits-power-reference))) + (setq ref (math-read-expr calc-lu-power-reference))) (math-logunits-quant val ref t)) -(defun calc-logunits-quantity (arg) +(defun calc-lu-quant (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-hyperbolic) (if (calc-is-option) - (calc-binary-op "lupq" 'calcFunc-fieldquant arg) - (calc-unary-op "lupq" 'calcFunc-fieldquant arg)) + (calc-binary-op "lupq" 'calcFunc-lufquant arg) + (calc-unary-op "lupq" 'calcFunc-lufquant arg)) (if (calc-is-option) - (calc-binary-op "lufq" 'calcFunc-powerquant arg) - (calc-unary-op "lufq" 'calcFunc-powerquant arg))))) + (calc-binary-op "lufq" 'calcFunc-lupquant arg) + (calc-unary-op "lufq" 'calcFunc-lupquant arg))))) (defun math-logunits-level (val ref db power) "Compute the value of VAL in decibels or nepers." @@ -1817,47 +1817,47 @@ In symbolic mode, return the list (^ a b)." '(var Np var-Np))) units))) -(defun calcFunc-dbfieldlevel (val &optional ref) +(defun calcFunc-dbfield (val &optional ref) (unless ref - (setq ref (math-read-expr calc-logunits-field-reference))) + (setq ref (math-read-expr calc-lu-field-reference))) (math-logunits-level val ref t nil)) -(defun calcFunc-dbpowerlevel (val &optional ref) +(defun calcFunc-dbpower (val &optional ref) (unless ref - (setq ref (math-read-expr calc-logunits-power-reference))) + (setq ref (math-read-expr calc-lu-power-reference))) (math-logunits-level val ref t t)) -(defun calcFunc-npfieldlevel (val &optional ref) +(defun calcFunc-npfield (val &optional ref) (unless ref - (setq ref (math-read-expr calc-logunits-field-reference))) + (setq ref (math-read-expr calc-lu-field-reference))) (math-logunits-level val ref nil nil)) -(defun calcFunc-nppowerlevel (val &optional ref) +(defun calcFunc-nppower (val &optional ref) (unless ref - (setq ref (math-read-expr calc-logunits-power-reference))) + (setq ref (math-read-expr calc-lu-power-reference))) (math-logunits-level val ref nil t)) -(defun calc-dblevel (arg) +(defun calc-db (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-hyperbolic) (if (calc-is-option) - (calc-binary-op "ludb" 'calcFunc-dbfieldlevel arg) - (calc-unary-op "ludb" 'calcFunc-dbfieldlevel arg)) + (calc-binary-op "ludb" 'calcFunc-dbfield arg) + (calc-unary-op "ludb" 'calcFunc-dbfield arg)) (if (calc-is-option) - (calc-binary-op "ludb" 'calcFunc-dbpowerlevel arg) - (calc-unary-op "ludb" 'calcFunc-dbpowerlevel arg))))) + (calc-binary-op "ludb" 'calcFunc-dbpower arg) + (calc-unary-op "ludb" 'calcFunc-dbpower arg))))) -(defun calc-nplevel (arg) +(defun calc-np (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-hyperbolic) (if (calc-is-option) - (calc-binary-op "lunp" 'calcFunc-npfieldlevel arg) - (calc-unary-op "lunp" 'calcFunc-npfieldlevel arg)) + (calc-binary-op "lunp" 'calcFunc-npfield arg) + (calc-unary-op "lunp" 'calcFunc-npfield arg)) (if (calc-is-option) - (calc-binary-op "lunp" 'calcFunc-nppowerlevel arg) - (calc-unary-op "lunp" 'calcFunc-nppowerlevel arg))))) + (calc-binary-op "lunp" 'calcFunc-nppower arg) + (calc-unary-op "lunp" 'calcFunc-nppower arg))))) ;;; Musical notes diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 08ae7b10113..41f549cbe2c 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -434,13 +434,13 @@ by displaying the sub-formula in `calc-selected-face'." :group 'calc :type 'boolean) -(defcustom calc-logunits-field-reference +(defcustom calc-lu-field-reference "20 uPa" "The default reference level for logarithmic units (field)." :group 'calc :type '(string)) -(defcustom calc-logunits-power-reference +(defcustom calc-lu-power-reference "mW" "The default reference level for logarithmic units (power)." :group 'calc diff --git a/lisp/custom.el b/lisp/custom.el index 923321c03c9..cf06fe27f4d 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -789,10 +789,10 @@ E.g. dumped variables whose default depends on run-time information." (defvar custom-known-themes '(user changed) "Themes that have been defined with `deftheme'. The default value is the list (user changed). The theme `changed' -contains the settings before custom themes are applied. The -theme `user' contains all the settings the user customized and saved. -Additional themes declared with the `deftheme' macro will be added to -the front of this list.") +contains the settings before custom themes are applied. The theme +`user' contains all the settings the user customized and saved. +Additional themes declared with the `deftheme' macro will be added +to the front of this list.") (defsubst custom-theme-p (theme) "Non-nil when THEME has been defined." @@ -1071,7 +1071,7 @@ order. Each element in the list should be one of the following: named \"themes\" in `data-directory'). - a directory name (a string). -Each theme file is named NAME-theme.el, where THEME is the theme +Each theme file is named THEME-theme.el, where THEME is the theme name." :type '(repeat (choice (const :tag "custom-theme-directory" custom-theme-directory) @@ -1143,7 +1143,7 @@ Return t if THEME was successfully loaded, nil otherwise." '("" "c"))) hash) (unless fn - (error "Unable to find theme file for `%s'." theme)) + (error "Unable to find theme file for `%s'" theme)) (with-temp-buffer (insert-file-contents fn) (setq hash (sha1 (current-buffer))) @@ -1209,7 +1209,7 @@ NAME should be a symbol." (defun custom-available-themes () "Return a list of available Custom themes (symbols)." - (let* (sym themes) + (let (sym themes) (dolist (dir (custom-theme--load-path)) (when (file-directory-p dir) (dolist (file (file-expand-wildcards @@ -1335,7 +1335,7 @@ That is to say, it specifies what the value should be according to currently enabled custom themes. This function returns nil if no custom theme specifies a value for VARIABLE." - (let* ((theme-value (get variable 'theme-value))) + (let ((theme-value (get variable 'theme-value))) (if theme-value (cdr (car theme-value))))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5e24b80ac5a..5c845e59c85 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3776,7 +3776,8 @@ that suppresses all warnings during execution of BODY." (defun byte-compile-save-excursion (form) (if (and (eq 'set-buffer (car-safe (car-safe (cdr form)))) (byte-compile-warning-enabled-p 'suspicious)) - (byte-compile-warn "`save-excursion' defeated by `set-buffer'")) + (byte-compile-warn + "Use `with-current-buffer' rather than save-excursion+set-buffer")) (byte-compile-out 'byte-save-excursion 0) (byte-compile-body-do-effect (cdr form)) (byte-compile-out 'byte-unbind 1)) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index af0bd1519c7..b22ed7397af 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,82 @@ +2011-03-16 Julien Danjou <julien@danjou.info> + + * mm-uu.el (mm-uu-dissect-text-parts): Only dissect handle that are + inline. + + * gnus-art.el (article-hide-list-identifiers): Use + gnus-group-get-list-identifiers. + + * gnus-sum.el (gnus-group-get-list-identifiers): New function. + (gnus-summary-remove-list-identifiers): Use + gnus-group-get-list-identifiers to get regexp. + (gnus-select-newsgroup, gnus-summary-insert-subject) + (gnus-summary-insert-articles): Call + gnus-summary-remove-list-identifiers unconditionally. + +2011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-articles-to-read): Revert back to old behaviour if + we're selecting a group with unread articles. + + * nnimap.el (nnimap-open-connection-1): Allow `network-only', too. + + * gssapi.el: New file separated out from imap.el to provide a general + Kerberos 5 connection facility for Emacs. + + * message.el (message-elide-ellipsis): Document the format spec + ellipsis. + +2011-03-15 Reiner Steib <Reiner.Steib@gmx.de> + + * message.el (message-elide-region): Allow the ellipsis to say how many + lines were removed. + +2011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-win.el (gnus-configure-frame): Protect against trying to restore + window configurations containing buffers that are now dead. + + * nnimap.el (nnimap-parse-flags): Remove all MODSEQ entries before + parsing to avoid integer overflows. + (nnimap-parse-flags): Simplify the last change. + (nnimap-parse-flags): Store HIGHESTMODSEQ as a string, since it may be + too large for 32-bit Emacsen. + +2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * auth-source.el (auth-source-netrc-create): + * message.el (message-yank-original): Fix use of `case'. + +2011-03-15 Nelson Ferreira <nelson.ferreira@ieee.org> (tiny change) + + * gnus-art.el (gnus-article-treat-body-boundary): Fix boundary width on + XEmacs, which was one character too wide. + +2011-03-09 Antoine Levitt <antoine.levitt@gmail.com> + + * gnus-sum.el (gnus-articles-to-read): Use gnus-large-newsgroup as + default number of articles to display. + (gnus-articles-to-read): Use pretty names for prompt. + +2011-03-15 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-int.el (gnus-open-server): Ditto. + + * gnus-start.el (gnus-activate-group): Give a backtrace if + debug-on-quit is set and the user hits `C-g'. + (gnus-read-active-file): Ditto. + + * gnus-group.el (gnus-group-read-ephemeral-group): Ditto. + +2011-03-15 Teodor Zlatanov <tzz@lifelogs.com> + + * message.el (message-yank-original): Use cond instead of CL case. + +2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * auth-source.el (auth-source-netrc-create): Use usual format for the + default in prompts. + 2011-03-13 Teodor Zlatanov <tzz@lifelogs.com> * auth-source.el (auth-source-netrc-create): Show the default in the @@ -15,9 +94,9 @@ 2011-03-11 Teodor Zlatanov <tzz@lifelogs.com> - * gnus-sync.el (gnus-sync-install-hooks, gnus-sync-unload-hook): Don't - install `gnus-sync-read' to any hooks by default. It's buggy. The - user will have to run `gnus-sync-read' manually and wait for Cloudy + * gnus-sync.el (gnus-sync-install-hooks, gnus-sync-unload-hook): + Don't install `gnus-sync-read' to any hooks by default. It's buggy. + The user will have to run `gnus-sync-read' manually and wait for Cloudy Gnus. 2011-03-11 Julien Danjou <julien@danjou.info> @@ -101,8 +180,8 @@ 2011-03-05 Antoine Levitt <antoine.levitt@gmail.com> - * message.el (message-cite-reply-position, message-cite-style): New - variables. + * message.el (message-cite-reply-position, message-cite-style): + New variables. (message-yank-original): Use the new citation styles. 2011-03-04 Daiki Ueno <ueno@unixuser.org> @@ -216,14 +295,14 @@ 2011-02-23 Lars Ingebrigtsen <larsi@gnus.org> - * gnus-start.el (gnus-dribble-read-file): Set - buffer-save-without-query, since we always want to save the dribble + * gnus-start.el (gnus-dribble-read-file): + Set buffer-save-without-query, since we always want to save the dribble file, probably. * nnmail.el (nnmail-article-group): Allow a final "" split to work on nnimap. - * gnus-sum.el (gnus-user-date-format-alist): Renamed back again from + * gnus-sum.el (gnus-user-date-format-alist): Rename back again from -summary- since it's a user-visible variable. * nnimap.el (nnimap-retrieve-group-data-early): Don't do QRESYNC the @@ -469,8 +548,8 @@ 2011-02-14 Teodor Zlatanov <tzz@lifelogs.com> * auth-source.el (auth-source-backend-parse-parameters): Don't rely on - `plist-get' to accept non-list parameters (XEmacs issue). Fix - docstring. + `plist-get' to accept non-list parameters (XEmacs issue). + Fix docstring. (auth-source-secrets-search): Use `delete-dups', `append mapcar', and `butlast' instead of `remove-duplicates', `mapcan', and `subseq'. (auth-sources, auth-source-backend-parse, auth-source-secrets-search): @@ -510,8 +589,8 @@ 2011-02-13 Tassilo Horn <tassilo@member.fsf.org> (tiny change) - * nnimap.el (nnimap-request-accept-article, nnimap-process-quirk): Fix - Gcc processing on imap. + * nnimap.el (nnimap-request-accept-article, nnimap-process-quirk): + Fix Gcc processing on imap. 2011-02-10 Stefan Monnier <monnier@iro.umontreal.ca> @@ -599,8 +678,8 @@ 2011-02-06 Michael Albinus <michael.albinus@gmx.de> - * auth-source.el (top): Require 'eieio unconditionally. Autoload - `secrets-get-attributes' instead of `secrets-get-attribute'. + * auth-source.el (top): Require 'eieio unconditionally. + Autoload `secrets-get-attributes' instead of `secrets-get-attribute'. (auth-source-secrets-search): Limit search when `max' is greater than number of results. @@ -636,7 +715,7 @@ (auth-source-protocol-defaults, auth-source-user-or-password-imap) (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh) (auth-source-user-or-password-sftp) - (auth-source-user-or-password-smtp): Removed. + (auth-source-user-or-password-smtp): Remove. (auth-source-user-or-password): Deprecated and modified to be a wrapper around `auth-source-search'. Not tested thoroughly. @@ -802,16 +881,16 @@ * gnus-group.el (gnus-group-jump-to-group): Allow jumping to groups that Gnus doesn't know exists again. - * gnus-art.el (gnus-article-date-lapsed-new-header): Removed. + * gnus-art.el (gnus-article-date-lapsed-new-header): Remove. (gnus-treat-date-ut): Ditto. - (gnus-article-update-date-header): Renamed. - (gnus-treat-date-local): Removed. - (gnus-treat-date-english): Removed. - (gnus-treat-date-lapsed): Removed. - (gnus-treat-date-combined-lapsed): Removed. - (gnus-treat-date-original): Removed. - (gnus-treat-date-iso8601): Removed. - (gnus-treat-date-user-defined): Removed. + (gnus-article-update-date-header): Rename. + (gnus-treat-date-local): Remove. + (gnus-treat-date-english): Remove. + (gnus-treat-date-lapsed): Remove. + (gnus-treat-date-combined-lapsed): Remove. + (gnus-treat-date-original): Remove. + (gnus-treat-date-iso8601): Remove. + (gnus-treat-date-user-defined): Remove. (gnus-article-date-headers): New variable to control all the date header options. (article-date-ut): Rewrite to allow using the new way to format date diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 52f2b92e933..e0bea324a25 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -1093,17 +1093,19 @@ See `auth-source-search' for details on SPEC." (?h ,(aget printable-defaults 'host)) (?p ,(aget printable-defaults 'port)))))) - ;; store the data, prompting for the password if needed + ;; Store the data, prompting for the password if needed. (setq data (cond ((and (null data) (eq r 'secret)) - ;; special case prompt for passwords + ;; Special case prompt for passwords. (read-passwd prompt)) ((null data) (when default - (setq - prompt - (concat prompt (format "(default %s) " default)))) + (setq prompt + (if (string-match ": *\\'" prompt) + (concat (substring prompt 0 (match-beginning 0)) + " (default " default "): ") + (concat prompt "(default " default ") ")))) (read-string prompt nil nil default)) (t (or data default)))) @@ -1115,7 +1117,7 @@ See `auth-source-search' for details on SPEC." (lambda () data)) data)))) - ;; when r is not an empty string... + ;; When r is not an empty string... (when (and (stringp data) (< 0 (length data))) ;; this function is not strictly necessary but I think it @@ -1128,10 +1130,10 @@ See `auth-source-search' for details on SPEC." (if (zerop (length add)) "" " ") ;; remap auth-source tokens to netrc (case r - ('user "login") - ('host "machine") - ('secret "password") - ('port "port") ; redundant but clearer + (user "login") + (host "machine") + (secret "password") + (port "port") ; redundant but clearer (t (symbol-name r))) ;; the value will be printed in %S format data)))) @@ -1173,7 +1175,7 @@ Respects `auth-source-save-behavior'. Uses ;; we want the new data to be found first, so insert at beginning (goto-char (point-min)) - ;; ask AFTER we've successfully opened the file + ;; Ask AFTER we've successfully opened the file. (let ((prompt (format "Save auth info to file %s? " file)) (done (not (eq auth-source-save-behavior 'ask))) (bufname "*auth-source Help*") @@ -1190,6 +1192,8 @@ Respects `auth-source-save-behavior'. Uses "(N)o and don't ask to save again\n" "(e)dit the line\n" "(?) for help as you can see.\n")) + ;; Why? Doesn't with-output-to-temp-buffer already do + ;; the exact same thing anyway? --Stef (set-buffer standard-output) (help-mode)))) (?n (setq add "" @@ -1203,7 +1207,7 @@ Respects `auth-source-save-behavior'. Uses (when (get-buffer-window bufname) (delete-window (get-buffer-window bufname))) - ;; make sure the info is not saved + ;; Make sure the info is not saved. (when (null auth-source-save-behavior) (setq add "")) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index c64138b43d7..b994a2839bc 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2337,10 +2337,12 @@ long lines if and only if arg is positive." (let ((start (point))) (insert "X-Boundary: ") (gnus-add-text-properties start (point) '(invisible t intangible t)) - (insert (let (str) - (while (>= (window-width) (length str)) + (insert (let (str (max (window-width))) + (if (featurep 'xemacs) + (setq max (1- max))) + (while (>= max (length str)) (setq str (concat str gnus-body-boundary-delimiter))) - (substring str 0 (window-width))) + (substring str 0 max)) "\n") (gnus-put-text-property start (point) 'gnus-decoration 'header))))) @@ -3074,10 +3076,7 @@ images if any to the browser, and deletes them when exiting the group The `gnus-list-identifiers' variable specifies what to do." (interactive) (let ((inhibit-point-motion-hooks t) - (regexp (or (gnus-parameter-list-identifier gnus-newsgroup-name) - (if (consp gnus-list-identifiers) - (mapconcat 'identity gnus-list-identifiers " *\\|") - gnus-list-identifiers))) + (regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) (inhibit-read-only t)) (when regexp (save-excursion diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 9ed3cf02a49..e928811b558 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2313,9 +2313,10 @@ Return the name of the group if selection was successful." gnus-fetch-old-ephemeral-headers)) (gnus-group-read-group (or number t) t group select-articles)) group) - ;;(error nil) (quit - (message "Quit reading the ephemeral group") + (if debug-on-quit + (debug "Quit") + (message "Quit reading the ephemeral group")) nil))))) (defcustom gnus-gmane-group-download-format diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index a67063bb970..ef15a479892 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -270,7 +270,9 @@ If it is down, start it up (again)." server (error-message-string err)) nil) (quit - (gnus-message 1 "Quit trying to open server %s" server) + (if debug-on-quit + (debug "Quit") + (gnus-message 1 "Quit trying to open server %s" server)) nil))) open-offline) ;; If this hasn't been opened before, we add it to the list. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index c6ff6044b92..afded87fe37 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1462,9 +1462,10 @@ If SCAN, request a scan of that group as well." (inline (gnus-request-group group (or dont-sub-check dont-check) method (gnus-get-info group))) - ;;(error nil) (quit - (message "Quit activating %s" group) + (if debug-on-quit + (debug "Quit") + (message "Quit activating %s" group)) nil))) (unless dont-check (setq active (gnus-parse-active)) @@ -2004,7 +2005,9 @@ If SCAN, request a scan of that group as well." ;; We catch C-g so that we can continue past servers ;; that do not respond. (quit - (message "Quit reading the active file") + (if debug-on-quit + (debug "Quit") + (message "Quit reading the active file")) nil)))))))) (defun gnus-read-active-file-1 (method force) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index a8786e39c7b..29a98b7d11d 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -5510,12 +5510,17 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) +(defun gnus-group-get-list-identifiers (group) + "Get list identifier regexp for GROUP." + (or (gnus-parameter-list-identifier group) + (if (consp gnus-list-identifiers) + (mapconcat 'identity gnus-list-identifiers " *\\|") + gnus-list-identifiers))) + (defun gnus-summary-remove-list-identifiers () "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." - (let ((regexp (if (consp gnus-list-identifiers) - (mapconcat 'identity gnus-list-identifiers " *\\|") - gnus-list-identifiers)) - changed subject) + (let ((regexp (gnus-group-get-list-identifiers gnus-newsgroup-name)) + changed subject) (when regexp (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)")) (dolist (header gnus-newsgroup-headers) @@ -5707,8 +5712,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (when gnus-agent (gnus-agent-get-undownloaded-list)) ;; Remove list identifiers from subject - (when gnus-list-identifiers - (gnus-summary-remove-list-identifiers)) + (gnus-summary-remove-list-identifiers) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire (gnus-group-auto-expirable-p group)) @@ -5798,7 +5802,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (defun gnus-articles-to-read (group &optional read-all) "Find out what articles the user wants to read." - (let* ((articles + (let* ((only-read-p t) + (articles ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. (if (or read-all @@ -5822,6 +5827,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-uncompress-range (gnus-active group))) (gnus-cache-articles-in-group group)) ;; Select only the "normal" subset of articles. + (setq only-read-p nil) (gnus-sorted-nunion (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked) gnus-newsgroup-unreads))) @@ -5845,16 +5851,25 @@ If SELECT-ARTICLES, only select those articles from GROUP." (let* ((cursor-in-echo-area nil) (initial (gnus-parameter-large-newsgroup-initial gnus-newsgroup-name)) + (default (if only-read-p + (or initial gnus-large-newsgroup) + number)) (input (read-string - (format - "How many articles from %s (%s %d): " - (gnus-group-decoded-name gnus-newsgroup-name) - (if initial "max" "default") - number) - (if initial - (cons (number-to-string initial) - 0))))) + (if only-read-p + (format + "How many articles from %s (available %d, default %d): " + (gnus-group-decoded-name + (gnus-group-real-name gnus-newsgroup-name)) + number default) + (format + "How many articles from %s (%d available): " + (gnus-group-decoded-name + (gnus-group-real-name gnus-newsgroup-name)) + default)) + nil + nil + (number-to-string default)))) (if (string-match "^[ \t]*$" input) number input))) ((and (> scored marked) (< scored number) (> (- scored number) 20)) @@ -5862,7 +5877,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (read-string (format "%s %s (%d scored, %d total): " "How many articles from" - (gnus-group-decoded-name group) + (gnus-group-decoded-name + (gnus-group-real-name gnus-newsgroup-name)) scored number)))) (if (string-match "^[ \t]*$" input) number input))) @@ -6564,9 +6580,8 @@ the subject line on." (1+ (point-at-eol)) (gnus-delete-line)))))) ;; Remove list identifiers from subject. - (when gnus-list-identifiers - (let ((gnus-newsgroup-headers (list header))) - (gnus-summary-remove-list-identifiers))) + (let ((gnus-newsgroup-headers (list header))) + (gnus-summary-remove-list-identifiers)) (when old-header (mail-header-set-number header (mail-header-number old-header))) (setq gnus-newsgroup-sparse @@ -12670,8 +12685,7 @@ returned." (when gnus-agent (gnus-agent-get-undownloaded-list)) ;; Remove list identifiers from subject - (when gnus-list-identifiers - (gnus-summary-remove-list-identifiers)) + (gnus-summary-remove-list-identifiers) ;; First and last article in this newsgroup. (when gnus-newsgroup-headers (setq gnus-newsgroup-begin diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 156f9a020fd..c38f57d96cb 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -268,8 +268,10 @@ See the Gnus manual for an explanation of the syntax used.") (error "Invalid buffer type: %s" type)) (let ((buf (gnus-get-buffer-create (gnus-window-to-buffer-helper buffer)))) - (if (eq buf (window-buffer (selected-window))) (set-buffer buf) - (switch-to-buffer buf))) + (when (buffer-name buf) + (if (eq buf (window-buffer (selected-window))) + (set-buffer buf) + (switch-to-buffer buf)))) (when (memq 'frame-focus split) (setq gnus-window-frame-focus window)) ;; We return the window if it has the `point' spec. diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el new file mode 100644 index 00000000000..3765fb84ee8 --- /dev/null +++ b/lisp/gnus/gssapi.el @@ -0,0 +1,105 @@ +;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Simon Josefsson <simon@josefsson.org> +;; Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: network + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'format-spec) + +(defcustom gssapi-program (list + (concat "gsasl %s %p " + "--mechanism GSSAPI " + "--authentication-id %l") + "imtest -m gssapi -u %l -p %p %s") + "List of strings containing commands for GSSAPI (krb5) authentication. +%s is replaced with server hostname, %p with port to connect to, and +%l with the value of `imap-default-user'. The program should accept +IMAP commands on stdin and return responses to stdout. Each entry in +the list is tried until a successful connection is made." + :group 'network + :type '(repeat string)) + +(defun open-gssapi-stream (name buffer server port) + (let ((cmds gssapi-program) + cmd done) + (with-current-buffer buffer + (while (and (not done) + (setq cmd (pop cmds))) + (message "Opening GSSAPI connection with `%s'..." cmd) + (erase-buffer) + (let* ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (process (start-process + name buffer shell-file-name shell-command-switch + (format-spec + cmd + (format-spec-make + ?s server + ?p (number-to-string port) + ?l imap-default-user)))) + response) + (when process + (while (and (memq (process-status process) '(open run)) + (goto-char (point-min)) + ;; Athena IMTEST can output SSL verify errors + (or (while (looking-at "^verify error:num=") + (forward-line)) + t) + (or (while (looking-at "^TLS connection established") + (forward-line)) + t) + ;; cyrus 1.6.x (13? < x <= 22) queries capabilities + (or (while (looking-at "^C:") + (forward-line)) + t) + ;; cyrus 1.6 imtest print "S: " before server greeting + (or (not (looking-at "S: ")) + (forward-char 3) + t) + ;; GNU SASL may print 'Trying ...' first. + (or (not (looking-at "Trying ")) + (forward-line) + t) + (not (and (looking-at "\\* \\(OK\\|PREAUTH\\|BYE\\) ") + ;; success in imtest 1.6: + (re-search-forward + (concat "^\\(\\(Authenticat.*\\)\\|\\(" + "Client authentication " + "finished.*\\)\\)") + nil t) + (setq response (match-string 1))))) + (accept-process-output process 1) + (sit-for 1)) + (erase-buffer) + (message "GSSAPI IMAP connection: %s" (or response "failed")) + (if (and response (let ((case-fold-search nil)) + (not (string-match "failed" response)))) + (setq done process) + (delete-process process) + nil)))) + done))) + +(provide 'gssapi) + +;;; gssapi.el ends here diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 08c59b00bfc..bb9215aca7c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -49,6 +49,7 @@ (require 'mail-parse) (require 'mml) (require 'rfc822) +(require 'format-spec) (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ @@ -438,7 +439,10 @@ whitespace)." :group 'message-various) (defcustom message-elide-ellipsis "\n[...]\n\n" - "*The string which is inserted for elided text." + "*The string which is inserted for elided text. +This is a format-spec string, and you can use %l to say how many +lines were removed, and %c to say how many characters were +removed." :type 'string :link '(custom-manual "(message)Various Commands") :group 'message-various) @@ -3535,8 +3539,12 @@ Note that this should not be used in newsgroups." An ellipsis (from `message-elide-ellipsis') will be inserted where the text was killed." (interactive "r") - (kill-region b e) - (insert message-elide-ellipsis)) + (let ((lines (count-lines b e)) + (chars (- e b))) + (kill-region b e) + (insert (format-spec message-elide-ellipsis + `((?l . ,lines) + (?c . ,chars)))))) (defvar message-caesar-translation-table nil) @@ -3749,12 +3757,12 @@ prefix, and don't delete any headers." (insert-before-markers ?\n) (goto-char pt)))) (case message-cite-reply-position - ('above + (above (message-goto-body) (insert body-text) (insert (if (bolp) "\n" "\n\n")) (message-goto-body)) - ('below + (below (message-goto-signature))) ;; Add a `message-setup-very-last-hook' here? ;; Add `gnus-article-highlight-citation' here? diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 96dce48a774..4f7b5ed26b3 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -705,6 +705,8 @@ Assume text has been decoded if DECODED is non-nil." ;; Mutt still uses application/pgp even though ;; it has already been withdrawn. (string-match "\\`text/\\|\\`application/pgp\\'" type) + (equal (car (mm-handle-disposition handle)) + "inline") (setq children (with-current-buffer buffer diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index e76ead515c5..e0804f81e2e 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -340,6 +340,7 @@ textual parts.") (ports (cond ((or (eq nnimap-stream 'network) + (eq nnimap-stream 'network-only) (eq nnimap-stream 'starttls)) (nnheader-message 7 "Opening connection to %s..." nnimap-address) @@ -1452,6 +1453,11 @@ textual parts.") ;; Change \Delete etc to %Delete, so that the reader can read it. (subst-char-in-region (point-min) (point-max) ?\\ ?% t) + ;; Remove any MODSEQ entries in the buffer, because they may contain + ;; numbers that are too large for 32-bit Emacsen. + (while (re-search-forward " MODSEQ ([0-9]+)" nil t) + (replace-match "" t t)) + (goto-char (point-min)) (let (start end articles groups uidnext elems permanent-flags uidvalidity vanished highestmodseq) (dolist (elem sequences) @@ -1491,9 +1497,9 @@ textual parts.") (match-string 1))) (goto-char start) (setq highestmodseq - (and (search-forward "HIGHESTMODSEQ " + (and (re-search-forward "HIGHESTMODSEQ \\([0-9]+\\)" (or end (point-min)) t) - (read (current-buffer)))) + (match-string 1))) (goto-char end) (forward-line -1)) ;; The UID FETCH FLAGS was successful. @@ -1507,18 +1513,7 @@ textual parts.") (goto-char end)) (while (re-search-forward "^\\* [0-9]+ FETCH " start t) (let ((p (point))) - ;; FIXME: For FETCH lines like "* 2971 FETCH (FLAGS (%Recent) UID - ;; 12509 MODSEQ (13419098521433281274))" we get an - ;; overflow-error. The handler simply deletes that large number - ;; and reads again. But maybe there's a better fix... - (setq elems (condition-case nil (read (current-buffer)) - (overflow-error - ;; After an overflow-error, point is just after - ;; the too large number. So delete it and try - ;; again. - (delete-region (point) (progn (backward-word) (point))) - (goto-char p) - (read (current-buffer))))) + (setq elems (read (current-buffer))) (push (cons (cadr (memq 'UID elems)) (cadr (memq 'FLAGS elems))) articles))) @@ -1674,6 +1669,8 @@ textual parts.") (goto-char (point-max))) openp) (quit + (when debug-on-quit + (debug "Quit")) ;; The user hit C-g while we were waiting: kill the process, in case ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind ;; NAT routers). diff --git a/lisp/help-fns.el b/lisp/help-fns.el index e27a1e47b5c..ede80f858bf 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -534,6 +534,7 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound." (with-syntax-table emacs-lisp-mode-syntax-table (or (condition-case () (save-excursion + (skip-chars-forward "'") (or (not (zerop (skip-syntax-backward "_w"))) (eq (char-syntax (following-char)) ?w) (eq (char-syntax (following-char)) ?_) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 3c8628c9cfa..fa36da01cd9 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -704,7 +704,15 @@ scroll the window of possible completions." (when last (setcdr last nil) ;; Prefer shorter completions. - (setq all (sort all (lambda (c1 c2) (< (length c1) (length c2))))) + (setq all (sort all (lambda (c1 c2) + (let ((s1 (get-text-property + 0 :completion-cycle-penalty c1)) + (s2 (get-text-property + 0 :completion-cycle-penalty c2))) + (if (eq s1 s2) + (< (length c1) (length c2)) + (< (or s1 (length c1)) + (or s2 (length c2)))))))) ;; Prefer recently used completions. (let ((hist (symbol-value minibuffer-history-variable))) (setq all (sort all (lambda (c1 c2) diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index 4045a443640..c3da1707165 100644 --- a/lisp/net/quickurl.el +++ b/lisp/net/quickurl.el @@ -511,15 +511,15 @@ TYPE dictates what will be inserted, options are: (with-current-buffer quickurl-list-last-buffer (insert (case type - ('url (funcall quickurl-format-function url)) - ('naked-url (quickurl-url-url url)) - ('with-lookup (format "%s <URL:%s>" + (url (funcall quickurl-format-function url)) + (naked-url (quickurl-url-url url)) + (with-lookup (format "%s <URL:%s>" (quickurl-url-keyword url) (quickurl-url-url url))) - ('with-desc (format "%S <URL:%s>" + (with-desc (format "%S <URL:%s>" (quickurl-url-description url) (quickurl-url-url url))) - ('lookup (quickurl-url-keyword url))))) + (lookup (quickurl-url-keyword url))))) (error "No URL details on that line")) url)) diff --git a/lisp/net/xesam.el b/lisp/net/xesam.el index 21a22749408..64c26cfb2c9 100644 --- a/lisp/net/xesam.el +++ b/lisp/net/xesam.el @@ -414,18 +414,18 @@ If there is no registered search engine at all, the function returns `nil'." ;; Hopefully, this will change later. (setq hit-fields (case (intern vendor-id) - ('Beagle + (Beagle '("xesam:mimeType" "xesam:url")) - ('Strigi + (Strigi '("xesam:author" "xesam:cc" "xesam:charset" "xesam:contentType" "xesam:fileExtension" "xesam:id" "xesam:lineCount" "xesam:links" "xesam:mimeType" "xesam:name" "xesam:size" "xesam:sourceModified" "xesam:subject" "xesam:to" "xesam:url")) - ('TrackerXesamSession + (TrackerXesamSession '("xesam:relevancyRating" "xesam:url")) - ('Debbugs + (Debbugs '("xesam:keyword" "xesam:owner" "xesam:title" "xesam:url" "xesam:sourceModified" "xesam:mimeType" "debbugs:key")) diff --git a/lisp/notifications.el b/lisp/notifications.el index 893b9ed095f..adb9fdd641a 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -210,8 +210,8 @@ used to manipulate the notification item with (add-to-list 'hints `(:dict-entry "urgency" (:variant :byte ,(case urgency - ('low 0) - ('critical 2) + (low 0) + (critical 2) (t 1)))) t)) (when category (add-to-list 'hints `(:dict-entry diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index e75821b6860..44a2cb15b7e 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,13 @@ +2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * org-src.el (org-src-switch-to-buffer): + * org-plot.el (org-plot/gnuplot-script, org-plot/gnuplot): + * org-mouse.el (org-mouse-agenda-type): + * org-freemind.el (org-freemind-node-to-org): + * ob-sql.el (org-babel-execute:sql): + * ob-exp.el (org-babel-exp-do-export, org-babel-exp-code): + * ob-ref.el (org-babel-ref-resolve): Fix use of case. + 2011-03-06 Juanma Barranquero <lekktu@gmail.com> * org.el (org-blank-before-new-entry, org-context-in-file-links) diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 1be45198e0d..3215bcf4d8a 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -231,10 +231,10 @@ The function respects the value of the :exports header argument." (org-babel-exp-results info type 'silent)))) (clean () (org-babel-remove-result info))) (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) - ('none (silently) (clean) "") - ('code (silently) (clean) (org-babel-exp-code info type)) - ('results (org-babel-exp-results info type)) - ('both (concat (org-babel-exp-code info type) + (none (silently) (clean) "") + (code (silently) (clean) (org-babel-exp-code info type)) + (results (org-babel-exp-results info type)) + (both (concat (org-babel-exp-code info type) "\n\n" (org-babel-exp-results info type)))))) @@ -250,8 +250,8 @@ The code block is not evaluated." (name (nth 4 info)) (args (mapcar #'cdr (org-babel-get-header (nth 2 info) :var)))) (case type - ('inline (format "=%s=" body)) - ('block + (inline (format "=%s=" body)) + (block (let ((str (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body (if (and body (string-match "\n$" body)) @@ -265,7 +265,7 @@ The code block is not evaluated." (mapconcat #'identity args ", "))) str)) str)) - ('lob + (lob (let ((call-line (and (string-match "results=" (car args)) (substring (car args) (match-end 0))))) (cond diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 7b06e90f924..96819df8ea1 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -147,12 +147,12 @@ the variable." (let ((params (append args '((:results . "silent"))))) (setq result (case type - ('results-line (org-babel-read-result)) - ('table (org-babel-read-table)) - ('list (org-babel-read-list)) - ('file (org-babel-read-link)) - ('source-block (org-babel-execute-src-block nil nil params)) - ('lob (org-babel-execute-src-block nil lob-info params))))) + (results-line (org-babel-read-result)) + (table (org-babel-read-table)) + (list (org-babel-read-list)) + (file (org-babel-read-link)) + (source-block (org-babel-execute-src-block nil nil params)) + (lob (org-babel-execute-src-block nil lob-info params))))) (if (symbolp result) (format "%S" result) (if (and index (listp result)) diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 3bd10d6b2bd..49859d24a17 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -66,18 +66,18 @@ This function is called by `org-babel-execute-src-block'." (out-file (or (cdr (assoc :out-file params)) (org-babel-temp-file "sql-out-"))) (command (case (intern engine) - ('msosql (format "osql %s -s \"\t\" -i %s -o %s" - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - ('mysql (format "mysql %s -e \"source %s\" > %s" + (msosql (format "osql %s -s \"\t\" -i %s -o %s" (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - ('postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + (mysql (format "mysql %s -e \"source %s\" > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + (postgresql (format "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) (t (error "no support for the %s sql engine" engine))))) (with-temp-file in-file (insert (org-babel-expand-body:sql body params))) diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el index c85b4bac36a..dccdf449296 100644 --- a/lisp/org/org-freemind.el +++ b/lisp/org/org-freemind.el @@ -1172,8 +1172,8 @@ PATH should be a list of steps, where each step has the form (when (< 0 (- level skip-levels)) (dolist (attrib attributes) (case (car attrib) - ('TEXT (setq text (cdr attrib))) - ('text (setq text (cdr attrib))))) + (TEXT (setq text (cdr attrib))) + (text (setq text (cdr attrib))))) (unless text ;; There should be a richcontent node holding the text: (setq text (org-freemind-get-richcontent-node-text node))) @@ -1193,7 +1193,7 @@ PATH should be a list of steps, where each step has the form (setq text (replace-regexp-in-string "\n $" "" text)) (insert text)) (case qname - ('node + (node (insert (make-string (- level skip-levels) ?*) " " text "\n") (when note (insert ":COMMENT:\n" note "\n:END:\n")) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index d30f172f42f..cec19d89de1 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -476,11 +476,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (defun org-mouse-agenda-type (type) (case type - ('tags "Tags: ") - ('todo "TODO: ") - ('tags-tree "Tags tree: ") - ('todo-tree "TODO tree: ") - ('occur-tree "Occur tree: ") + (tags "Tags: ") + (todo "TODO: ") + (tags-tree "Tags tree: ") + (todo-tree "TODO tree: ") + (occur-tree "Occur tree: ") (t "Agenda command ???"))) diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index c5f4bff24fa..10722403f7e 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -206,18 +206,18 @@ manner suitable for prepending to a user-specified script." (y-labels (plist-get params :ylabels)) (plot-str "'%s' using %s%d%s with %s title '%s'") (plot-cmd (case type - ('2d "plot") - ('3d "splot") - ('grid "splot"))) + (2d "plot") + (3d "splot") + (grid "splot"))) (script "reset") plot-lines) (flet ((add-to-script (line) (setf script (format "%s\n%s" script line)))) (when file ;; output file (add-to-script (format "set term %s" (file-name-extension file))) (add-to-script (format "set output '%s'" file))) (case type ;; type - ('2d ()) - ('3d (if map (add-to-script "set map"))) - ('grid (if map + (2d ()) + (3d (if map (add-to-script "set map"))) + (grid (if map (add-to-script "set pm3d map") (add-to-script "set pm3d")))) (when title (add-to-script (format "set title '%s'" title))) ;; title @@ -243,7 +243,7 @@ manner suitable for prepending to a user-specified script." "%Y-%m-%d-%H:%M:%S") "\""))) (unless preface (case type ;; plot command - ('2d (dotimes (col num-cols) + (2d (dotimes (col num-cols) (unless (and (equal type '2d) (or (and ind (equal (+ 1 col) ind)) (and deps (not (member (+ 1 col) deps))))) @@ -258,10 +258,10 @@ manner suitable for prepending to a user-specified script." with (or (nth col col-labels) (format "%d" (+ 1 col)))) plot-lines))))) - ('3d + (3d (setq plot-lines (list (format "'%s' matrix with %s title ''" data-file with)))) - ('grid + (grid (setq plot-lines (list (format "'%s' with %s title ''" data-file with))))) (add-to-script @@ -305,9 +305,9 @@ line directly before or after the table." (setf params (org-plot/collect-options params)))) ;; dump table to datafile (very different for grid) (case (plist-get params :plot-type) - ('2d (org-plot/gnuplot-to-data table data-file params)) - ('3d (org-plot/gnuplot-to-data table data-file params)) - ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data + (2d (org-plot/gnuplot-to-data table data-file params)) + (3d (org-plot/gnuplot-to-data table data-file params)) + (grid (let ((y-labels (org-plot/gnuplot-to-grid-data table data-file params))) (when y-labels (plist-put params :ylabels y-labels))))) ;; check for timestamp ind column diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 98fdb75423d..bd1c3802044 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -335,26 +335,26 @@ buffer." (defun org-src-switch-to-buffer (buffer context) (case org-src-window-setup - ('current-window + (current-window (switch-to-buffer buffer)) - ('other-window + (other-window (switch-to-buffer-other-window buffer)) - ('other-frame + (other-frame (case context - ('exit + (exit (let ((frame (selected-frame))) (switch-to-buffer-other-frame buffer) (delete-frame frame))) - ('save + (save (kill-buffer (current-buffer)) (switch-to-buffer buffer)) (t (switch-to-buffer-other-frame buffer)))) - ('reorganize-frame + (reorganize-frame (if (eq context 'edit) (delete-other-windows)) (org-switch-to-buffer-other-window buffer) (if (eq context 'exit) (delete-other-windows))) - ('switch-invisibly + (switch-invisibly (set-buffer buffer)) (t (message "Invalid value %s for org-src-window-setup" diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index 8fea2cef6ad..0dc556007ba 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -719,57 +719,57 @@ static char * dot3d_xpm[] = { (defsubst bubbles--grid-width () "Return the grid width for the current game theme." (car (case bubbles-game-theme - ('easy + (easy bubbles--grid-small) - ('medium + (medium bubbles--grid-medium) - ('difficult + (difficult bubbles--grid-large) - ('hard + (hard bubbles--grid-huge) - ('user-defined + (user-defined bubbles-grid-size)))) (defsubst bubbles--grid-height () "Return the grid height for the current game theme." (cdr (case bubbles-game-theme - ('easy + (easy bubbles--grid-small) - ('medium + (medium bubbles--grid-medium) - ('difficult + (difficult bubbles--grid-large) - ('hard + (hard bubbles--grid-huge) - ('user-defined + (user-defined bubbles-grid-size)))) (defsubst bubbles--colors () "Return the color list for the current game theme." (case bubbles-game-theme - ('easy + (easy bubbles--colors-2) - ('medium + (medium bubbles--colors-3) - ('difficult + (difficult bubbles--colors-4) - ('hard + (hard bubbles--colors-5) - ('user-defined + (user-defined bubbles-colors))) (defsubst bubbles--shift-mode () "Return the shift mode for the current game theme." (case bubbles-game-theme - ('easy + (easy 'default) - ('medium + (medium 'default) - ('difficult + (difficult 'always) - ('hard + (hard 'always) - ('user-defined + (user-defined bubbles-shift-mode))) (defun bubbles-save-settings () @@ -1346,11 +1346,11 @@ Return t if new char is non-empty." (when (and (display-images-p) (not (eq bubbles-graphics-theme 'ascii))) (let ((template (case bubbles-graphics-theme - ('circles bubbles--image-template-circle) - ('balls bubbles--image-template-ball) - ('squares bubbles--image-template-square) - ('diamonds bubbles--image-template-diamond) - ('emacs bubbles--image-template-emacs)))) + (circles bubbles--image-template-circle) + (balls bubbles--image-template-ball) + (squares bubbles--image-template-square) + (diamonds bubbles--image-template-diamond) + (emacs bubbles--image-template-emacs)))) (setq bubbles--empty-image (create-image (replace-regexp-in-string "^\"\\(.*\\)\t.*c .*\",$" diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index d3d8350a43f..99e3b487437 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -213,19 +213,19 @@ static unsigned char gamegrid_bits[] = { (let ((data (gamegrid-match-spec-list data-spec-list)) (color (gamegrid-match-spec-list color-spec-list))) (case data - ('color-x + (color-x (gamegrid-make-color-x-face color)) - ('grid-x + (grid-x (unless gamegrid-grid-x-face (setq gamegrid-grid-x-face (gamegrid-make-grid-x-face))) gamegrid-grid-x-face) - ('mono-x + (mono-x (unless gamegrid-mono-x-face (setq gamegrid-mono-x-face (gamegrid-make-mono-x-face))) gamegrid-mono-x-face) - ('color-tty + (color-tty (gamegrid-make-color-tty-face color)) - ('mono-tty + (mono-tty (unless gamegrid-mono-tty-face (setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face))) gamegrid-mono-tty-face)))) diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el index c376b25fae0..0f823c806e0 100644 --- a/lisp/progmodes/delphi.el +++ b/lisp/progmodes/delphi.el @@ -26,14 +26,14 @@ ;; To enter Delphi mode when you find a Delphi source file, one must override ;; the auto-mode-alist to associate Delphi with .pas (and .dpr and .dpk) -;; files. Emacs, by default, will otherwise enter Pascal mode. E.g. +;; files. Emacs, by default, will otherwise enter Pascal mode. E.g. ;; ;; (autoload 'delphi-mode "delphi") ;; (setq auto-mode-alist ;; (cons '("\\.\\(pas\\|dpr\\|dpk\\)$" . delphi-mode) auto-mode-alist)) ;; To get keyword, comment, and string literal coloring, be sure that font-lock -;; is running. One can manually do M-x font-lock-mode in a Delphi buffer, or +;; is running. One can manually do M-x font-lock-mode in a Delphi buffer, or ;; one can put in .emacs: ;; ;; (add-hook 'delphi-mode-hook 'turn-on-font-lock) @@ -56,8 +56,8 @@ ;; When you have entered Delphi mode, you may get more info by pressing ;; C-h m. -;; This delphi mode implementation is fairly tolerant of syntax errors, relying -;; as much as possible on the indentation of the previous statement. This also +;; This Delphi mode implementation is fairly tolerant of syntax errors, relying +;; as much as possible on the indentation of the previous statement. This also ;; makes it faster and simpler, since there is less searching for properly ;; constructed beginnings. @@ -74,15 +74,16 @@ "True if in debug mode.") (defcustom delphi-search-path "." - "*Directories to search when finding external units. It is a list of -directory strings. If only a single directory, it can be a single -string instead of a list. If a directory ends in \"...\" then that -directory is recursively searched." + "*Directories to search when finding external units. +It is a list of directory strings. If only a single directory, +it can be a single string instead of a list. If a directory +ends in \"...\" then that directory is recursively searched." :type 'string :group 'delphi) (defcustom delphi-indent-level 3 - "*Indentation of Delphi statements with respect to containing block. E.g. + "*Indentation of Delphi statements with respect to containing block. +E.g. begin // This is an indent of 3. @@ -117,7 +118,7 @@ end; end;" :group 'delphi) (defcustom delphi-verbose t ; nil - "*If true then delphi token processing progress is reported to the user." + "*If true then Delphi token processing progress is reported to the user." :type 'boolean :group 'delphi) @@ -137,17 +138,17 @@ differs from the default." :group 'delphi) (defcustom delphi-comment-face 'font-lock-comment-face - "*Face used to color delphi comments." + "*Face used to color Delphi comments." :type 'face :group 'delphi) (defcustom delphi-string-face 'font-lock-string-face - "*Face used to color delphi strings." + "*Face used to color Delphi strings." :type 'face :group 'delphi) (defcustom delphi-keyword-face 'font-lock-keyword-face - "*Face used to color delphi keywords." + "*Face used to color Delphi keywords." :type 'face :group 'delphi) @@ -720,9 +721,9 @@ routine.") (delphi-progress-done))))) (defvar delphi-ignore-changes t - "Internal flag to control if the delphi-mode responds to buffer changes. -Defaults to t in case the delphi-after-change function is called on a -non-delphi buffer. Set to nil in a delphi buffer. To override, just do: + "Internal flag to control if the Delphi mode responds to buffer changes. +Defaults to t in case the `delphi-after-change' function is called on a +non-Delphi buffer. Set to nil in a Delphi buffer. To override, just do: (let ((delphi-ignore-changes t)) ...)") (defun delphi-after-change (change-start change-end old-length) @@ -1521,8 +1522,8 @@ non-delphi buffer. Set to nil in a delphi buffer. To override, just do: indent))) (defun delphi-indent-line () - "Indent the current line according to the current language construct. If -before the indent, the point is moved to the indent." + "Indent the current line according to the current language construct. +If before the indent, the point is moved to the indent." (interactive) (delphi-save-match-data (let ((marked-point (point-marker)) ; Maintain our position reliably. @@ -1547,7 +1548,7 @@ before the indent, the point is moved to the indent." (set-marker marked-point nil)))) (defvar delphi-mode-abbrev-table nil - "Abbrev table in use in delphi-mode buffers.") + "Abbrev table in use in Delphi mode buffers.") (define-abbrev-table 'delphi-mode-abbrev-table ()) (defmacro delphi-ensure-buffer (buffer-var buffer-name) @@ -1568,7 +1569,7 @@ before the indent, the point is moved to the indent." ;; Debugging helpers: (defvar delphi-debug-buffer nil - "Buffer to write delphi-mode debug messages to. Created on demand.") + "Buffer to write Delphi mode debug messages to. Created on demand.") (defun delphi-debug-log (format-string &rest args) ;; Writes a message to the log buffer. @@ -1679,7 +1680,7 @@ before the indent, the point is moved to the indent." (defun delphi-tab () "Indent the region, when Transient Mark mode is enabled and the region is -active. Otherwise, indent the current line or insert a TAB, depending on the +active. Otherwise, indent the current line or insert a TAB, depending on the value of `delphi-tab-always-indents' and the current line position." (interactive) (cond ((use-region-p) @@ -1768,8 +1769,8 @@ value of `delphi-tab-always-indents' and the current line position." nil)) (defun delphi-find-unit (unit) - "Finds the specified delphi source file according to `delphi-search-path'. -If no extension is specified, .pas is assumed. Creates a buffer for the unit." + "Find the specified Delphi source file according to `delphi-search-path'. +If no extension is specified, .pas is assumed. Creates a buffer for the unit." (interactive "sDelphi unit name: ") (let* ((unit-file (if (string-match "^\\(.*\\)\\.[a-z]+$" unit) unit @@ -1791,7 +1792,7 @@ If no extension is specified, .pas is assumed. Creates a buffer for the unit." "Find the definition of the identifier under the current point, searching in external units if necessary (as listed in the current unit's use clause). The set of directories to search for a unit is specified by the global variable -delphi-search-path." +`delphi-search-path'." (interactive) (error "delphi-find-current-xdef: not implemented yet")) @@ -1802,7 +1803,7 @@ it is a routine." (error "delphi-find-current-body: not implemented yet")) (defun delphi-fill-comment () - "Fills the text of the current comment, according to `fill-column'. + "Fill the text of the current comment, according to `fill-column'. An error is raised if not in a comment." (interactive) (save-excursion @@ -1888,8 +1889,8 @@ An error is raised if not in a comment." (delphi-progress-done))))))) (defun delphi-new-comment-line () - "If in a // comment, does a newline, indented such that one is still in the -comment block. If not in a // comment, just does a normal newline." + "If in a // comment, do a newline, indented such that one is still in the +comment block. If not in a // comment, just does a normal newline." (interactive) (let ((comment (delphi-current-token))) (if (not (eq 'comment-single-line (delphi-token-kind comment))) @@ -1923,7 +1924,7 @@ comment block. If not in a // comment, just does a normal newline." nil ; Syntax begin movement doesn't apply (font-lock-fontify-region-function . delphi-fontify-region) (font-lock-verbose . delphi-fontifying-progress-step)) - "Delphi mode font-lock defaults. Syntactic fontification is ignored.") + "Delphi mode font-lock defaults. Syntactic fontification is ignored.") (defvar delphi-debug-mode-map (let ((kmap (make-sparse-keymap))) @@ -1944,7 +1945,7 @@ comment block. If not in a // comment, just does a normal newline." ("x" delphi-debug-show-is-stable) )) kmap) - "Keystrokes for delphi-mode debug commands.") + "Keystrokes for Delphi mode debug commands.") (defvar delphi-mode-map (let ((kmap (make-sparse-keymap))) @@ -1964,7 +1965,7 @@ comment block. If not in a // comment, just does a normal newline." "Keymap used in Delphi mode.") (defconst delphi-mode-syntax-table (make-syntax-table) - "Delphi mode's syntax table. It is just a standard syntax table. + "Delphi mode's syntax table. It is just a standard syntax table. This is ok since we do our own keyword/comment/string face coloring.") ;;;###autoload @@ -1976,7 +1977,7 @@ This is ok since we do our own keyword/comment/string face coloring.") \\[delphi-fill-comment]\t- Fill the current comment. \\[delphi-new-comment-line]\t- If in a // comment, do a new comment line. -M-x indent-region also works for indenting a whole region. +\\[indent-region] also works for indenting a whole region. Customization: @@ -1996,21 +1997,21 @@ Customization: `delphi-search-path' (default .) Directories to search when finding external units. `delphi-verbose' (default nil) - If true then delphi token processing progress is reported to the user. + If true then Delphi token processing progress is reported to the user. Coloring: `delphi-comment-face' (default font-lock-comment-face) - Face used to color delphi comments. + Face used to color Delphi comments. `delphi-string-face' (default font-lock-string-face) - Face used to color delphi strings. + Face used to color Delphi strings. `delphi-keyword-face' (default font-lock-keyword-face) - Face used to color delphi keywords. + Face used to color Delphi keywords. `delphi-other-face' (default nil) Face used to color everything else. -Turning on Delphi mode calls the value of the variable delphi-mode-hook with -no args, if that value is non-nil." +Turning on Delphi mode calls the value of the variable `delphi-mode-hook' +with no args, if that value is non-nil." (interactive) (kill-all-local-variables) (use-local-map delphi-mode-map) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index d674484345a..87e5875c943 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -3566,12 +3566,12 @@ KIND is an additional string printed in the buffer." (insert kind) (indent-to 50) (insert (case (second info) - ('ebrowse-ts-member-functions "member function") - ('ebrowse-ts-member-variables "member variable") - ('ebrowse-ts-static-functions "static function") - ('ebrowse-ts-static-variables "static variable") - ('ebrowse-ts-friends (if globals-p "define" "friend")) - ('ebrowse-ts-types "type") + (ebrowse-ts-member-functions "member function") + (ebrowse-ts-member-variables "member variable") + (ebrowse-ts-static-functions "static function") + (ebrowse-ts-static-variables "static variable") + (ebrowse-ts-friends (if globals-p "define" "friend")) + (ebrowse-ts-types "type") (t "unknown")) "\n"))) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 9d40b4d8fd7..c8b156c5441 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -974,7 +974,7 @@ With ARG, do it many times. Negative ARG means move forward." (goto-char (scan-sexps (1+ (point)) -1)) (case (char-before) (?% (forward-char -1)) - ('(?q ?Q ?w ?W ?r ?x) + ((?q ?Q ?w ?W ?r ?x) (if (eq (char-before (1- (point))) ?%) (forward-char -2)))) nil) ((looking-at "\\s\"\\|\\\\\\S_") diff --git a/lisp/shell.el b/lisp/shell.el index bceea990baf..dde81c6cb95 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -583,6 +583,21 @@ Otherwise, one argument `-i' is passed to the shell. (get-buffer-create (or buffer "*shell*")) ;; If the current buffer is a dead shell buffer, use it. (current-buffer))) + + ;; On remote hosts, the local `shell-file-name' might be useless. + (if (and (interactive-p) + (file-remote-p default-directory) + (null explicit-shell-file-name) + (null (getenv "ESHELL"))) + (with-current-buffer buffer + (set (make-local-variable 'explicit-shell-file-name) + (file-remote-p + (expand-file-name + (read-file-name + "Remote shell path: " default-directory shell-file-name + t shell-file-name)) + 'localname)))) + ;; Pop to buffer, so that the buffer's window will be correctly set ;; when we call comint (so that comint sets the COLUMNS env var properly). (pop-to-buffer buffer) diff --git a/lisp/startup.el b/lisp/startup.el index 384d81391ab..65b1a013c21 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1006,19 +1006,23 @@ opening the first frame (e.g. open a connection to an X server).") (if init-file-user (let ((user-init-file-1 (cond - ((eq system-type 'ms-dos) - (concat "~" init-file-user "/_emacs")) - ((eq system-type 'windows-nt) - ;; Prefer .emacs on Windows. - (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$") - "~/.emacs" - ;; Also support _emacs for compatibility. - (if (directory-files "~" nil "^_emacs\\(\\.elc?\\)?$") - "~/_emacs" - ;; But default to .emacs if _emacs does not exist. - "~/.emacs"))) - (t - (concat "~" init-file-user "/.emacs"))))) + ((eq system-type 'ms-dos) + (concat "~" init-file-user "/_emacs")) + ((not (eq system-type 'windows-nt)) + (concat "~" init-file-user "/.emacs")) + ;; Else deal with the Windows situation + ((directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$") + ;; Prefer .emacs on Windows. + "~/.emacs") + ((directory-files "~" nil "^_emacs\\(\\.elc?\\)?$") + ;; Also support _emacs for compatibility, but warn about it. + (display-warning + 'initialization + "`_emacs' init file is deprecated, please use `.emacs'" + :warning) + "~/_emacs") + (t ;; But default to .emacs if _emacs does not exist. + "~/.emacs")))) ;; This tells `load' to store the file name found ;; into user-init-file. (setq user-init-file t) @@ -1191,7 +1195,7 @@ the `--debug-init' option to view a complete error backtrace." (dolist (subdir (directory-files dir)) (when (and (file-directory-p (expand-file-name subdir dir)) ;; package-subdirectory-regexp from package.el - (string-match "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" + (string-match "\\`\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)\\'" subdir)) (throw 'package-dir-found t))))))) (package-initialize)) diff --git a/lisp/subr.el b/lisp/subr.el index 3330fa20379..6f39a41709e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2003,24 +2003,24 @@ If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore keyboard-quit events while waiting for a valid input." (unless (consp chars) (error "Called `read-char-choice' without valid char choices")) - (let ((cursor-in-echo-area t) - (executing-kbd-macro executing-kbd-macro) - char done) - (while (not done) - (unless (get-text-property 0 'face prompt) - (setq prompt (propertize prompt 'face 'minibuffer-prompt))) - (setq char (let ((inhibit-quit inhibit-keyboard-quit)) - (read-key prompt))) - (cond - ((not (numberp char))) - ((memq char chars) - (setq done t)) - ((and executing-kbd-macro (= char -1)) - ;; read-event returns -1 if we are in a kbd macro and - ;; there are no more events in the macro. Attempt to - ;; get an event interactively. - (setq executing-kbd-macro nil)))) - ;; Display the question with the answer. + (let (char done) + (let ((cursor-in-echo-area t) + (executing-kbd-macro executing-kbd-macro)) + (while (not done) + (unless (get-text-property 0 'face prompt) + (setq prompt (propertize prompt 'face 'minibuffer-prompt))) + (setq char (let ((inhibit-quit inhibit-keyboard-quit)) + (read-key prompt))) + (cond + ((not (numberp char))) + ((memq char chars) + (setq done t)) + ((and executing-kbd-macro (= char -1)) + ;; read-event returns -1 if we are in a kbd macro and + ;; there are no more events in the macro. Attempt to + ;; get an event interactively. + (setq executing-kbd-macro nil))))) + ;; Display the question with the answer. But without cursor-in-echo-area. (message "%s%s" prompt (char-to-string char)) char)) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index d4970207b94..01b6f2fc26e 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -104,7 +104,7 @@ See `run-hooks'." ;; We pass a filename to create-file-buffer because it is what ;; the function expects, and also what uniquify needs (if active) (with-current-buffer (create-file-buffer (expand-file-name bname dir)) - (cd dir) + (setq default-directory dir) (vc-setup-buffer (current-buffer)) ;; Reset the vc-parent-buffer-name so that it does not appear ;; in the mode-line. @@ -1002,7 +1002,7 @@ specific headers." (generate-new-buffer (format " *VC-%s* tmp status" backend)))) (lexical-let ((buffer (current-buffer))) (with-current-buffer vc-dir-process-buffer - (cd def-dir) + (setq default-directory def-dir) (erase-buffer) (vc-call-backend backend 'dir-status-files def-dir files default-state @@ -1067,7 +1067,7 @@ Throw an error if another update process is in progress." (ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "") (lexical-let ((buffer (current-buffer))) (with-current-buffer vc-dir-process-buffer - (cd def-dir) + (setq default-directory def-dir) (erase-buffer) (vc-call-backend backend 'dir-status def-dir diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 4ac7ef15fc7..0516abbf024 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -529,9 +529,9 @@ REV is the revision to check out into WORKFILE." (insert (propertize (format " (%s %s)" (case (vc-hg-extra-fileinfo->rename-state extra) - ('copied "copied from") - ('renamed-from "renamed from") - ('renamed-to "renamed to")) + (copied "copied from") + (renamed-from "renamed from") + (renamed-to "renamed to")) (vc-hg-extra-fileinfo->extra-name extra)) 'face 'font-lock-comment-face))))) |