Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 103787. ------------------------------------------------------------ revno: 103787 committer: Glenn Morris branch nick: trunk timestamp: Wed 2011-03-30 19:11:34 -0700 message: * lisp/generic-x.el (etc-fstab-generic-mode): Add ext4, sysfs keywords. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-03-30 22:44:07 +0000 +++ lisp/ChangeLog 2011-03-31 02:11:34 +0000 @@ -1,3 +1,7 @@ +2011-03-31 Glenn Morris + + * generic-x.el (etc-fstab-generic-mode): Add ext4, sysfs keywords. + 2011-03-30 Christoph Scholtes * progmodes/python.el (python-default-interpreter) === modified file 'lisp/generic-x.el' --- lisp/generic-x.el 2011-03-06 02:59:21 +0000 +++ lisp/generic-x.el 2011-03-31 02:11:34 +0000 @@ -1705,6 +1705,7 @@ "efs" "ext2" "ext3" + "ext4" "hfs" "hpfs" "iso9660" @@ -1722,6 +1723,7 @@ "cifs" "usbdevfs" "sysv" + "sysfs" "tmpfs" "udf" "ufs" ------------------------------------------------------------ revno: 103786 committer: Juanma Barranquero branch nick: trunk timestamp: Thu 2011-03-31 03:37:51 +0200 message: src/xdisp.c: Remove unused parameters. * dispextern.h (move_it_by_lines): * xdisp.c (move_it_by_lines): Remove parameter `need_y_p', unused since revno:34925 (2000-12-29). All callers changed. (message_log_check_duplicate): Remove parameters `prev_bol' and `this_bol', unused since revno:20537 (1998-01-01). All callers changed. (redisplay_internal): Remove parameter `preserve_echo_area', unused since revno:25013 (1999-07-21). All callers changed. * indent.c (Fvertical_motion): * window.c (window_scroll_pixel_based, Frecenter): Don't pass `need_y_p' to `move_it_by_lines'. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-03-30 19:18:12 +0000 +++ src/ChangeLog 2011-03-31 01:37:51 +0000 @@ -1,3 +1,17 @@ +2011-03-31 Juanma Barranquero + + * dispextern.h (move_it_by_lines): + * xdisp.c (move_it_by_lines): Remove parameter `need_y_p', unused + since revno:34925 (2000-12-29). All callers changed. + (message_log_check_duplicate): Remove parameters `prev_bol' and + `this_bol', unused since revno:20537 (1998-01-01). All callers changed. + (redisplay_internal): Remove parameter `preserve_echo_area', + unused since revno:25013 (1999-07-21). All callers changed. + + * indent.c (Fvertical_motion): + * window.c (window_scroll_pixel_based, Frecenter): + Don't pass `need_y_p' to `move_it_by_lines'. + 2011-03-30 Stefan Monnier * eval.c (struct backtrace): Don't cheat with negative numbers, but do === modified file 'src/dispextern.h' --- src/dispextern.h 2011-03-28 03:29:18 +0000 +++ src/dispextern.h 2011-03-31 01:37:51 +0000 @@ -2988,7 +2988,7 @@ void move_it_to (struct it *, EMACS_INT, int, int, int, int); void move_it_vertically (struct it *, int); void move_it_vertically_backward (struct it *, int); -void move_it_by_lines (struct it *, int, int); +void move_it_by_lines (struct it *, int); void move_it_past_eol (struct it *); void move_it_in_display_line (struct it *it, EMACS_INT to_charpos, int to_x, === modified file 'src/indent.c' --- src/indent.c 2011-03-15 17:59:31 +0000 +++ src/indent.c 2011-03-31 01:37:51 +0000 @@ -2072,7 +2072,7 @@ /* Do this even if LINES is 0, so that we move back to the beginning of the current line as we ought. */ if (XINT (lines) == 0 || IT_CHARPOS (it) > 0) - move_it_by_lines (&it, XINT (lines), 0); + move_it_by_lines (&it, XINT (lines)); } else { @@ -2090,9 +2090,9 @@ || (it_overshoot_expected < 0 && it.method == GET_FROM_BUFFER && it.c == '\n')) - move_it_by_lines (&it, -1, 0); + move_it_by_lines (&it, -1); it.vpos = 0; - move_it_by_lines (&it, XINT (lines), 0); + move_it_by_lines (&it, XINT (lines)); } else { @@ -2105,15 +2105,15 @@ while (IT_CHARPOS (it) <= it_start) { it.vpos = 0; - move_it_by_lines (&it, 1, 0); + move_it_by_lines (&it, 1); } if (XINT (lines) > 1) - move_it_by_lines (&it, XINT (lines) - 1, 0); + move_it_by_lines (&it, XINT (lines) - 1); } else { it.vpos = 0; - move_it_by_lines (&it, XINT (lines), 0); + move_it_by_lines (&it, XINT (lines)); } } } === modified file 'src/window.c' --- src/window.c 2011-03-29 06:59:27 +0000 +++ src/window.c 2011-03-31 01:37:51 +0000 @@ -4858,7 +4858,7 @@ looking at an image that is taller that the window height. */ while (start_pos == IT_CHARPOS (it) && start_pos > BEGV) - move_it_by_lines (&it, -1, 1); + move_it_by_lines (&it, -1); } else if (dy > 0) { @@ -4868,11 +4868,11 @@ looking at an image that is taller that the window height. */ while (start_pos == IT_CHARPOS (it) && start_pos < ZV) - move_it_by_lines (&it, 1, 1); + move_it_by_lines (&it, 1); } } else - move_it_by_lines (&it, n, 1); + move_it_by_lines (&it, n); /* We failed if we find ZV is already on the screen (scrolling up, means there's nothing past the end), or if we can't start any @@ -4983,7 +4983,7 @@ while (it.current_y < this_scroll_margin) { int prev = it.current_y; - move_it_by_lines (&it, 1, 1); + move_it_by_lines (&it, 1); if (prev == it.current_y) break; } @@ -5017,7 +5017,7 @@ partial_p = it.current_y + it.ascent + it.descent > it.last_visible_y; else { - move_it_by_lines (&it, 1, 1); + move_it_by_lines (&it, 1); partial_p = it.current_y > it.last_visible_y; } @@ -5044,7 +5044,7 @@ /* The last line was only partially visible, so back up two lines to make sure we're on a fully visible line. */ { - move_it_by_lines (&it, -2, 0); + move_it_by_lines (&it, -2); SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it)); } else @@ -5587,14 +5587,14 @@ start_display (&it, w, pt); /* Be sure we have the exact height of the full line containing PT. */ - move_it_by_lines (&it, 0, 1); + move_it_by_lines (&it, 0); /* The amount of pixels we have to move back is the window height minus what's displayed in the line containing PT, and the lines below. */ it.current_y = 0; it.vpos = 0; - move_it_by_lines (&it, nlines, 1); + move_it_by_lines (&it, nlines); if (it.vpos == nlines) h -= it.current_y; @@ -5633,7 +5633,7 @@ */ h += extra_line_spacing; while (-it.current_y > h) - move_it_by_lines (&it, 1, 1); + move_it_by_lines (&it, 1); charpos = IT_CHARPOS (it); bytepos = IT_BYTEPOS (it); === modified file 'src/xdisp.c' --- src/xdisp.c 2011-03-29 23:35:49 +0000 +++ src/xdisp.c 2011-03-31 01:37:51 +0000 @@ -802,13 +802,12 @@ static int try_scrolling (Lisp_Object, int, EMACS_INT, EMACS_INT, int, int); static int try_cursor_movement (Lisp_Object, struct text_pos, int *); static int trailing_whitespace_p (EMACS_INT); -static unsigned long int message_log_check_duplicate (EMACS_INT, EMACS_INT, - EMACS_INT, EMACS_INT); +static unsigned long int message_log_check_duplicate (EMACS_INT, EMACS_INT); static void push_it (struct it *); static void pop_it (struct it *); static void sync_frame_with_window_matrix_rows (struct window *); static void select_frame_for_redisplay (Lisp_Object); -static void redisplay_internal (int); +static void redisplay_internal (); static int echo_area_display (int); static void redisplay_windows (Lisp_Object); static void redisplay_window (Lisp_Object, int); @@ -1146,7 +1145,7 @@ line_height = last_height; else if (IT_CHARPOS (*it) < ZV) { - move_it_by_lines (it, 1, 1); + move_it_by_lines (it, 1); line_height = (it->max_ascent || it->max_descent ? it->max_ascent + it->max_descent : last_height); @@ -1270,7 +1269,7 @@ it2 = it; if (IT_CHARPOS (it) < ZV && FETCH_BYTE (IT_BYTEPOS (it)) != '\n') - move_it_by_lines (&it, 1, 0); + move_it_by_lines (&it, 1); if (charpos < IT_CHARPOS (it) || (it.what == IT_EOB && charpos == IT_CHARPOS (it))) { @@ -7638,7 +7637,7 @@ /* DY == 0 means move to the start of the screen line. The value of nlines is > 0 if continuation lines were involved. */ if (nlines > 0) - move_it_by_lines (it, nlines, 1); + move_it_by_lines (it, nlines); } else { @@ -7682,7 +7681,7 @@ { do { - move_it_by_lines (it, 1, 1); + move_it_by_lines (it, 1); } while (target_y >= line_bottom_y (it) && IT_CHARPOS (*it) < ZV); } @@ -7712,7 +7711,7 @@ if (IT_CHARPOS (*it) == ZV && ZV > BEGV && FETCH_BYTE (IT_BYTEPOS (*it) - 1) != '\n') - move_it_by_lines (it, 0, 0); + move_it_by_lines (it, 0); } } @@ -7732,15 +7731,14 @@ /* Move IT by a specified number DVPOS of screen lines down. DVPOS negative means move up. DVPOS == 0 means move to the start of the - screen line. NEED_Y_P non-zero means calculate IT->current_y. If - NEED_Y_P is zero, IT->current_y will be left unchanged. + screen line. - Further optimization ideas: If we would know that IT->f doesn't use + Optimization idea: If we would know that IT->f doesn't use a face with proportional font, we could be faster for truncate-lines nil. */ void -move_it_by_lines (struct it *it, int dvpos, int need_y_p) +move_it_by_lines (struct it *it, int dvpos) { /* The commented-out optimization uses vmotion on terminals. This @@ -8003,8 +8001,8 @@ prev_bol = PT; prev_bol_byte = PT_BYTE; - dups = message_log_check_duplicate (prev_bol, prev_bol_byte, - this_bol, this_bol_byte); + dups = message_log_check_duplicate (prev_bol_byte, + this_bol_byte); if (dups) { del_range_both (prev_bol, prev_bol_byte, @@ -8079,8 +8077,7 @@ value N > 1 if we should also append " [N times]". */ static unsigned long int -message_log_check_duplicate (EMACS_INT prev_bol, EMACS_INT prev_bol_byte, - EMACS_INT this_bol, EMACS_INT this_bol_byte) +message_log_check_duplicate (EMACS_INT prev_bol_byte, EMACS_INT this_bol_byte) { EMACS_INT i; EMACS_INT len = Z_BYTE - 1 - this_bol_byte; @@ -8838,7 +8835,7 @@ { ++windows_or_buffers_changed; ++update_mode_lines; - redisplay_internal (0); + redisplay_internal (); } } } @@ -9379,7 +9376,7 @@ int count = SPECPDL_INDEX (); specbind (Qredisplay_dont_pause, Qt); windows_or_buffers_changed = 1; - redisplay_internal (0); + redisplay_internal (); unbind_to (count, Qnil); } else if (FRAME_WINDOW_P (f) && n == 0) @@ -11150,7 +11147,7 @@ void redisplay (void) { - redisplay_internal (0); + redisplay_internal (); } @@ -11414,14 +11411,11 @@ polling_stopped_here = 0; } while (0) -/* If PRESERVE_ECHO_AREA is nonzero, it means this redisplay is not in - response to any user action; therefore, we should preserve the echo - area. (Actually, our caller does that job.) Perhaps in the future - avoid recentering windows if it is not necessary; currently that - causes some problems. */ +/* Perhaps in the future avoid recentering windows if it + is not necessary; currently that causes some problems. */ static void -redisplay_internal (int preserve_echo_area) +redisplay_internal () { struct window *w = XWINDOW (selected_window); struct window *sw; @@ -12181,11 +12175,11 @@ /* We have a previously displayed message, but no current message. Redisplay the previous message. */ display_last_displayed_message_p = 1; - redisplay_internal (1); + redisplay_internal (); display_last_displayed_message_p = 0; } else - redisplay_internal (1); + redisplay_internal (); if (FRAME_RIF (SELECTED_FRAME ()) != NULL && FRAME_RIF (SELECTED_FRAME ())->flush_display_optional) @@ -13139,14 +13133,14 @@ int start_y = line_bottom_y (&it1); do { - move_it_by_lines (&it, 1, 1); + move_it_by_lines (&it, 1); it1 = it; } while (line_bottom_y (&it1) - start_y < amount_to_scroll); } /* If STARTP is unchanged, move it down another screen line. */ if (CHARPOS (it.current.pos) == CHARPOS (startp)) - move_it_by_lines (&it, 1, 1); + move_it_by_lines (&it, 1); startp = it.current.pos; } else @@ -13307,7 +13301,7 @@ { min_distance = distance; pos = it.current.pos; - move_it_by_lines (&it, 1, 0); + move_it_by_lines (&it, 1); } /* Set the window start there. */ @@ -14269,13 +14263,13 @@ && PT >= Z - XFASTINT (w->window_end_pos)) { clear_glyph_matrix (w->desired_matrix); - move_it_by_lines (&it, 1, 0); + move_it_by_lines (&it, 1); try_window (window, it.current.pos, 0); } else if (PT < IT_CHARPOS (it)) { clear_glyph_matrix (w->desired_matrix); - move_it_by_lines (&it, -1, 0); + move_it_by_lines (&it, -1); try_window (window, it.current.pos, 0); } else ------------------------------------------------------------ revno: 103785 committer: Christoph Scholtes branch nick: trunk timestamp: Wed 2011-03-30 16:44:07 -0600 message: * progmodes/python.el (python-default-interpreter) (python-python-command-args, python-jython-command-args) (python-which-shell, python-which-args, python-which-bufname) (python-file-queue, python-comint-output-filter-function) (python-toggle-shells, python-shell): Remove obsolete defcustoms, variables and functions. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-03-30 22:25:57 +0000 +++ lisp/ChangeLog 2011-03-30 22:44:07 +0000 @@ -1,3 +1,12 @@ +2011-03-30 Christoph Scholtes + + * progmodes/python.el (python-default-interpreter) + (python-python-command-args, python-jython-command-args) + (python-which-shell, python-which-args, python-which-bufname) + (python-file-queue, python-comint-output-filter-function) + (python-toggle-shells, python-shell): Remove obsolete defcustoms, + variables and functions. + 2011-03-30 Stefan Monnier * minibuffer.el (completion-table-dynamic): Optimize `boundaries'. === modified file 'lisp/progmodes/python.el' --- lisp/progmodes/python.el 2011-01-26 08:36:39 +0000 +++ lisp/progmodes/python.el 2011-03-30 22:44:07 +0000 @@ -499,44 +499,6 @@ :type 'integer) -(defcustom python-default-interpreter 'cpython - "*Which Python interpreter is used by default. -The value for this variable can be either `cpython' or `jpython'. - -When the value is `cpython', the variables `python-python-command' and -`python-python-command-args' are consulted to determine the interpreter -and arguments to use. - -When the value is `jpython', the variables `python-jpython-command' and -`python-jpython-command-args' are consulted to determine the interpreter -and arguments to use. - -Note that this variable is consulted only the first time that a Python -mode buffer is visited during an Emacs session. After that, use -\\[python-toggle-shells] to change the interpreter shell." - :type '(choice (const :tag "Python (a.k.a. CPython)" cpython) - (const :tag "JPython" jpython)) - :group 'python) - -(defcustom python-python-command-args '("-i") - "*List of string arguments to be used when starting a Python shell." - :type '(repeat string) - :group 'python) - -(defcustom python-jython-command-args '("-i") - "*List of string arguments to be used when starting a Jython shell." - :type '(repeat string) - :group 'python - :tag "JPython Command Args") - -;; for toggling between CPython and JPython -(defvar python-which-shell nil) -(defvar python-which-args python-python-command-args) -(defvar python-which-bufname "Python") -(make-variable-buffer-local 'python-which-shell) -(make-variable-buffer-local 'python-which-args) -(make-variable-buffer-local 'python-which-bufname) - (defcustom python-pdbtrack-do-tracking-p t "*Controls whether the pdbtrack feature is enabled or not. @@ -562,11 +524,6 @@ (push '(python-pdbtrack-is-tracking-p python-pdbtrack-minor-mode-string) minor-mode-alist)) -;; Bind python-file-queue before installing the kill-emacs-hook. -(defvar python-file-queue nil - "Queue of Python temp files awaiting execution. -Currently-active file is at the head of the list.") - (defcustom python-shell-prompt-alist '(("ipython" . "^In \\[[0-9]+\\]: *") (t . "^>>> ")) @@ -2584,20 +2541,6 @@ ;; pdbtrack features -(defun python-comint-output-filter-function (string) - "Watch output for Python prompt and exec next file waiting in queue. -This function is appropriate for `comint-output-filter-functions'." - ;; TBD: this should probably use split-string - (when (and (string-match python--prompt-regexp string) - python-file-queue) - (condition-case nil - (delete-file (car python-file-queue)) - (error nil)) - (setq python-file-queue (cdr python-file-queue)) - (if python-file-queue - (let ((pyproc (get-buffer-process (current-buffer)))) - (python-execute-file pyproc (car python-file-queue)))))) - (defun python-pdbtrack-overlay-arrow (activation) "Activate or deactivate arrow at beginning-of-line in current buffer." (if activation @@ -2742,45 +2685,6 @@ (setq got buf))) got)) -(defun python-toggle-shells (arg) - "Toggles between the CPython and JPython shells. - -With positive argument ARG (interactively \\[universal-argument]), -uses the CPython shell, with negative ARG uses the JPython shell, and -with a zero argument, toggles the shell. - -Programmatically, ARG can also be one of the symbols `cpython' or -`jpython', equivalent to positive arg and negative arg respectively." - (interactive "P") - ;; default is to toggle - (if (null arg) - (setq arg 0)) - ;; preprocess arg - (cond - ((equal arg 0) - ;; toggle - (if (string-equal python-which-bufname "Python") - (setq arg -1) - (setq arg 1))) - ((equal arg 'cpython) (setq arg 1)) - ((equal arg 'jpython) (setq arg -1))) - (let (msg) - (cond - ((< 0 arg) - ;; set to CPython - (setq python-which-shell python-python-command - python-which-args python-python-command-args - python-which-bufname "Python" - msg "CPython" - mode-name "Python")) - ((> 0 arg) - (setq python-which-shell python-jython-command - python-which-args python-jython-command-args - python-which-bufname "JPython" - msg "JPython" - mode-name "JPython"))) - (message "Using the %s shell" msg))) - ;; Python subprocess utilities and filters (defun python-execute-file (proc filename) "Send to Python interpreter process PROC \"execfile('FILENAME')\". @@ -2801,71 +2705,6 @@ (set-buffer curbuf)) (process-send-string proc cmd))) -;;;###autoload -(defun python-shell (&optional argprompt) - "Start an interactive Python interpreter in another window. -This is like Shell mode, except that Python is running in the window -instead of a shell. See the `Interactive Shell' and `Shell Mode' -sections of the Emacs manual for details, especially for the key -bindings active in the `*Python*' buffer. - -With optional \\[universal-argument], the user is prompted for the -flags to pass to the Python interpreter. This has no effect when this -command is used to switch to an existing process, only when a new -process is started. If you use this, you will probably want to ensure -that the current arguments are retained (they will be included in the -prompt). This argument is ignored when this function is called -programmatically. - -Note: You can toggle between using the CPython interpreter and the -JPython interpreter by hitting \\[python-toggle-shells]. This toggles -buffer local variables which control whether all your subshell -interactions happen to the `*JPython*' or `*Python*' buffers (the -latter is the name used for the CPython buffer). - -Warning: Don't use an interactive Python if you change sys.ps1 or -sys.ps2 from their default values, or if you're running code that -prints `>>> ' or `... ' at the start of a line. `python-mode' can't -distinguish your output from Python's output, and assumes that `>>> ' -at the start of a line is a prompt from Python. Similarly, the Emacs -Shell mode code assumes that both `>>> ' and `... ' at the start of a -line are Python prompts. Bad things can happen if you fool either -mode. - -Warning: If you do any editing *in* the process buffer *while* the -buffer is accepting output from Python, do NOT attempt to `undo' the -changes. Some of the output (nowhere near the parts you changed!) may -be lost if you do. This appears to be an Emacs bug, an unfortunate -interaction between undo and process filters; the same problem exists in -non-Python process buffers using the default (Emacs-supplied) process -filter." - (interactive "P") - (require 'ansi-color) ; For ipython - ;; Set the default shell if not already set - (when (null python-which-shell) - (python-toggle-shells python-default-interpreter)) - (let ((args python-which-args)) - (when (and argprompt - (called-interactively-p 'interactive) - (fboundp 'split-string)) - ;; TBD: Perhaps force "-i" in the final list? - (setq args (split-string - (read-string (concat python-which-bufname - " arguments: ") - (concat - (mapconcat 'identity python-which-args " ") " ") - )))) - (switch-to-buffer-other-window - (apply 'make-comint python-which-bufname python-which-shell nil args)) - (set-process-sentinel (get-buffer-process (current-buffer)) - 'python-sentinel) - (python--set-prompt-regexp) - (add-hook 'comint-output-filter-functions - 'python-comint-output-filter-function nil t) - ;; pdbtrack - (set-syntax-table python-mode-syntax-table) - (use-local-map python-shell-map))) - (defun python-pdbtrack-toggle-stack-tracking (arg) (interactive "P") (if (not (get-buffer-process (current-buffer))) ------------------------------------------------------------ revno: 103784 committer: Stefan Monnier branch nick: trunk timestamp: Wed 2011-03-30 18:25:57 -0400 message: (completion-in-region): Pop down *Completions* automatically. * lisp/minibuffer.el (completion-table-dynamic): Optimize `boundaries'. (completion-in-region-mode): New minor mode. (completion-in-region): Use it. (completion-in-region--data, completion-in-region-mode-map): New vars. (completion-in-region--postch): New function. (completion--capf-misbehave-funs, completion--capf-safe-funs): New vars. (completion--capf-wrapper): New function. (completion-at-point): Use it to track well-behavedness of hook functions. (completion-help-at-point): New command. diff: === modified file 'etc/NEWS' --- etc/NEWS 2011-03-28 20:26:35 +0000 +++ etc/NEWS 2011-03-30 22:25:57 +0000 @@ -67,6 +67,9 @@ * Changes in Emacs 24.1 +** Completion in a non-minibuffer now tries to detect the end of completion +and pops down the *Completions* buffer accordingly. + ** emacsclient changes *** New emacsclient argument --parent-id ID can be used to open a === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-03-30 21:56:04 +0000 +++ lisp/ChangeLog 2011-03-30 22:25:57 +0000 @@ -1,3 +1,17 @@ +2011-03-30 Stefan Monnier + + * minibuffer.el (completion-table-dynamic): Optimize `boundaries'. + (completion-in-region-mode): New minor mode. + (completion-in-region): Use it. + (completion-in-region--data, completion-in-region-mode-map): New vars. + (completion-in-region--postch): New function. + (completion--capf-misbehave-funs, completion--capf-safe-funs): + New vars. + (completion--capf-wrapper): New function. + (completion-at-point): Use it to track well-behavedness of + hook functions. + (completion-help-at-point): New command. + 2011-03-30 Jason Merrill (tiny change) * vc/add-log.el (add-change-log-entry): Don't use whitespace === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2011-03-24 22:05:01 +0000 +++ lisp/minibuffer.el 2011-03-30 22:25:57 +0000 @@ -173,10 +173,14 @@ `all-completions'. See Info node `(elisp)Programmed Completion'." (lexical-let ((fun fun)) (lambda (string pred action) - (with-current-buffer (let ((win (minibuffer-selected-window))) - (if (window-live-p win) (window-buffer win) - (current-buffer))) - (complete-with-action action (funcall fun string) string pred))))) + (if (eq (car-safe action) 'boundaries) + ;; `fun' is not supposed to return another function but a plain old + ;; completion table, whose boundaries are always trivial. + nil + (with-current-buffer (let ((win (minibuffer-selected-window))) + (if (window-live-p win) (window-buffer win) + (current-buffer))) + (complete-with-action action (funcall fun string) string pred)))))) (defmacro lazy-completion-table (var fun) "Initialize variable VAR as a lazy completion table. @@ -240,6 +244,10 @@ number 1 should match TERMINATOR. This is used when there is a need to distinguish occurrences of the TERMINATOR strings which are really terminators from others (e.g. escaped)." + ;; FIXME: This implementation is not right since it only adds the terminator + ;; in try-completion, so any completion-style that builds the completion via + ;; all-completions won't get the terminator, and selecting an entry in + ;; *Completions* won't get the terminator added either. (cond ((eq (car-safe action) 'boundaries) (let* ((suffix (cdr action)) @@ -716,6 +724,8 @@ (< (or s1 (length c1)) (or s2 (length c2)))))))) ;; Prefer recently used completions. + ;; FIXME: Additional sorting ideas: + ;; - for M-x, prefer commands that have no key binding. (let ((hist (symbol-value minibuffer-history-variable))) (setq all (sort all (lambda (c1 c2) (> (length (member c1 hist)) @@ -1008,8 +1018,8 @@ ;; a space displayed. (set-text-properties (- (point) 1) (point) ;; We can't just set tab-width, because - ;; completion-setup-function will kill all - ;; local variables :-( + ;; completion-setup-function will kill + ;; all local variables :-( `(display (space :align-to ,column))) nil)))) (if (not (consp str)) @@ -1237,6 +1247,8 @@ are expected to perform completion on START..END using COLLECTION and PREDICATE, either by calling NEXT-FUN or by doing it themselves.") +(defvar completion-in-region--data nil) + (defun completion-in-region (start end collection &optional predicate) "Complete the text between START and END using COLLECTION. Return nil if there is no valid completion, else t. @@ -1251,15 +1263,78 @@ (minibuffer-completion-predicate predicate) (ol (make-overlay start end nil nil t))) (overlay-put ol 'field 'completion) + (completion-in-region-mode 1) + (setq completion-in-region--data + (list (current-buffer) start end collection)) (unwind-protect (call-interactively 'minibuffer-complete) (delete-overlay ol))))) +(defvar completion-in-region-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "?" 'completion-help-at-point) + (define-key map "\t" 'completion-at-point) + map) + "Keymap activated during `completion-in-region'.") + +;; It is difficult to know when to exit completion-in-region-mode (i.e. hide +;; the *Completions*). +;; - lisp-mode: never. +;; - comint: only do it if you hit SPC at the right time. +;; - pcomplete: pop it down on SPC or after some time-delay. +;; - semantic: use a post-command-hook check similar to this one. +(defun completion-in-region--postch () + (message "completion-in-region--postch: cmd=%s" this-command) + (or unread-command-events ;Don't pop down the completions in the middle of + ;mouse-drag-region/mouse-set-point. + (and completion-in-region--data + (and (eq (car completion-in-region--data) + (current-buffer)) + (>= (point) (nth 1 completion-in-region--data)) + (<= (point) + (save-excursion + (goto-char (nth 2 completion-in-region--data)) + (line-end-position))) + (let ((comp-data (run-hook-wrapped + 'completion-at-point-functions + ;; Only use the known-safe functions. + #'completion--capf-wrapper 'safe))) + (eq (car comp-data) + ;; We're still in the same completion field. + (nth 1 completion-in-region--data))))) + (completion-in-region-mode -1))) + +;; (defalias 'completion-in-region--prech 'completion-in-region--postch) + +(define-minor-mode completion-in-region-mode + "Transient minor mode used during `completion-in-region'." + :global t + (setq completion-in-region--data nil) + ;; (remove-hook 'pre-command-hook #'completion-in-region--prech) + (remove-hook 'post-command-hook #'completion-in-region--postch) + (setq minor-mode-overriding-map-alist + (delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist) + minor-mode-overriding-map-alist)) + (if (null completion-in-region-mode) + (progn + (unless (equal "*Completions*" (buffer-name (window-buffer))) + (minibuffer-hide-completions)) + (message "Leaving completion-in-region-mode")) + ;; (add-hook 'pre-command-hook #'completion-in-region--prech) + (add-hook 'post-command-hook #'completion-in-region--postch) + (push `(completion-in-region-mode . ,completion-in-region-mode-map) + minor-mode-overriding-map-alist))) + +;; Define-minor-mode added our keymap to minor-mode-map-alist, but we want it +;; on minor-mode-overriding-map-alist instead. +(setq minor-mode-map-alist + (delq (assq 'completion-in-region-mode minor-mode-map-alist) + minor-mode-map-alist)) + (defvar completion-at-point-functions '(tags-completion-at-point-function) "Special hook to find the completion table for the thing at point. Each function on this hook is called in turns without any argument and should return either nil to mean that it is not applicable at point, -or t to mean that it already performed completion (discouraged), or a function of no argument to perform completion (discouraged), or a list of the form (START END COLLECTION &rest PROPS) where START and END delimit the entity to complete and should include point, @@ -1269,12 +1344,34 @@ `:predicate' a predicate that completion candidates need to satisfy. `:annotation-function' the value to use for `completion-annotate-function'.") +(defvar completion--capf-misbehave-funs nil + "List of functions found on `completion-at-point-functions' that misbehave.") +(defvar completion--capf-safe-funs nil + "List of well-behaved functions found on `completion-at-point-functions'.") + +(defun completion--capf-wrapper (fun which) + (if (case which + (all t) + (safe (member fun completion--capf-safe-funs)) + (optimist (not (member fun completion--capf-misbehave-funs)))) + (let ((res (funcall fun))) + (cond + ((consp res) + (unless (member fun completion--capf-safe-funs) + (push fun completion--capf-safe-funs))) + ((not (or (listp res) (functionp res))) + (unless (member fun completion--capf-misbehave-funs) + (message + "Completion function %S uses a deprecated calling convention" fun) + (push fun completion--capf-misbehave-funs)))) + res))) + (defun completion-at-point () "Perform completion on the text around point. The completion method is determined by `completion-at-point-functions'." (interactive) - (let ((res (run-hook-with-args-until-success - 'completion-at-point-functions))) + (let ((res (run-hook-wrapped 'completion-at-point-functions + #'completion--capf-wrapper 'all))) (cond ((functionp res) (funcall res)) ((consp res) @@ -1288,6 +1385,37 @@ (plist-get plist :predicate)))) (res)))) ;Maybe completion already happened and the function returned t. +(defun completion-help-at-point () + "Display the completions on the text around point. +The completion method is determined by `completion-at-point-functions'." + (interactive) + (let ((res (run-hook-wrapped 'completion-at-point-functions + ;; Ignore misbehaving functions. + #'completion--capf-wrapper 'optimist))) + (cond + ((functionp res) + (message "Don't know how to show completions for %S" res)) + ((consp res) + (let* ((plist (nthcdr 3 res)) + (minibuffer-completion-table (nth 2 res)) + (minibuffer-completion-predicate (plist-get plist :predicate)) + (completion-annotate-function + (or (plist-get plist :annotation-function) + completion-annotate-function)) + (ol (make-overlay (nth 0 res) (nth 1 res) nil nil t))) + ;; FIXME: We should somehow (ab)use completion-in-region-function or + ;; introduce a corresponding hook (plus another for word-completion, + ;; and another for force-completion, maybe?). + (overlay-put ol 'field 'completion) + (unwind-protect + (call-interactively 'minibuffer-completion-help) + (delete-overlay ol)))) + (res + ;; The hook function already performed completion :-( + ;; Not much we can do at this point. + nil) + (t (message "Nothing to complete at point"))))) + ;;; Key bindings. (define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map @@ -1910,9 +2038,9 @@ (append (completion-pcm--string->pattern prefix) '(point) (completion-pcm--string->pattern suffix))) - (let ((pattern nil) - (p 0) - (p0 0)) + (let* ((pattern nil) + (p 0) + (p0 p)) (while (and (setq p (string-match completion-pcm--delim-wild-regex string p)) ------------------------------------------------------------ revno: 103783 author: Jason Merrill committer: Stefan Monnier branch nick: trunk timestamp: Wed 2011-03-30 17:56:04 -0400 message: * lisp/vc/add-log.el (add-change-log-entry): Don't use whitespace syntax class to search for whitespace on a single line (Message-ID: <4D938140.4030905@redhat.com>). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2011-03-30 01:06:00 +0000 +++ lisp/ChangeLog 2011-03-30 21:56:04 +0000 @@ -1,3 +1,9 @@ +2011-03-30 Jason Merrill (tiny change) + + * vc/add-log.el (add-change-log-entry): Don't use whitespace + syntax class to search for whitespace on a single line + (Message-ID: <4D938140.4030905@redhat.com>). + 2011-03-30 Leo Liu * abbrev.el (abbrev-edit-save-to-file, abbrev-edit-save-buffer): === modified file 'lisp/vc/add-log.el' --- lisp/vc/add-log.el 2011-01-25 04:08:28 +0000 +++ lisp/vc/add-log.el 2011-03-30 21:56:04 +0000 @@ -886,7 +886,7 @@ (point)))) ;; Now insert the new line for this item. - (cond ((re-search-forward "^\\s *\\*\\s *$" bound t) + (cond ((re-search-forward "^\\s *\\* *$" bound t) ;; Put this file name into the existing empty item. (if item (insert item))) @@ -928,7 +928,7 @@ ;; No function name, so put in a colon unless we have just a star. (unless (save-excursion (beginning-of-line 1) - (looking-at "\\s *\\(\\*\\s *\\)?$")) + (looking-at "\\s *\\(\\* *\\)?$")) (insert ": ") (if version (insert version ?\s))) ;; Make it easy to get rid of the function name. ------------------------------------------------------------ revno: 103782 committer: Stefan Monnier branch nick: trunk timestamp: Wed 2011-03-30 15:18:12 -0400 message: * src/eval.c (struct backtrace): Don't cheat with negative numbers, but do steal a few bits to be more compact. (interactive_p, Fbacktrace, Fbacktrace_frame, mark_backtrace): Remove unneeded casts. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-03-30 18:04:11 +0000 +++ src/ChangeLog 2011-03-30 19:18:12 +0000 @@ -1,5 +1,10 @@ 2011-03-30 Stefan Monnier + * eval.c (struct backtrace): Don't cheat with negative numbers, but do + steal a few bits to be more compact. + (interactive_p, Fbacktrace, Fbacktrace_frame, mark_backtrace): + Remove unneeded casts. + * bytecode.c (Fbyte_code): CAR and CDR can GC. 2011-03-30 Zachary Kanfer (tiny change) @@ -344,8 +349,8 @@ (create_process): Use 'volatile' to avoid vfork clobbering (Bug#8298). Make tparam.h and terminfo.c consistent. - * cm.c (tputs, tgoto, BC, UP): Remove extern decls. Include - tparam.h instead, since it declares them. + * cm.c (tputs, tgoto, BC, UP): Remove extern decls. + Include tparam.h instead, since it declares them. * cm.h (PC): Remove extern decl; tparam.h now does this. * deps.mk (cm.o, terminfo.o): Depend on tparam.h. * terminfo.c: Include tparam.h, to check interfaces. @@ -391,8 +396,8 @@ * intervals.h (CHECK_TOTAL_LENGTH): Avoid empty "else". - * atimer.c (start_atimer, append_atimer_lists, set_alarm): Rename - locals to avoid shadowing. + * atimer.c (start_atimer, append_atimer_lists, set_alarm): + Rename locals to avoid shadowing. * sound.c (wav_play, au_play, Fplay_sound_internal): Fix pointer signedness. @@ -561,8 +566,8 @@ gcc -Wbad-function-cast warning. (default_value, arithcompare, arith_driver, arith_error): Now static. (store_symval_forwarding): Rename local to avoid shadowing. - (Fmake_variable_buffer_local, Fmake_local_variable): Mark - variables as initialized. + (Fmake_variable_buffer_local, Fmake_local_variable): + Mark variables as initialized. (do_blv_forwarding, do_symval_forwarding): Remove; unused. * alloc.c (check_cons_list): Do not define unless GC_CHECK_CONS_LIST. @@ -816,8 +821,8 @@ (BUF_PT_BYTE): Rewrite to handle indirect buffers (Bug#8219). These macros can no longer be used for assignment. - * buffer.c (Fget_buffer_create, Fmake_indirect_buffer): Assign - struct members directly, instead of using BUF_BEGV etc. + * buffer.c (Fget_buffer_create, Fmake_indirect_buffer): + Assign struct members directly, instead of using BUF_BEGV etc. (record_buffer_markers, fetch_buffer_markers): New functions for recording and fetching special buffer markers. (set_buffer_internal_1, set_buffer_temp): Use them. @@ -938,8 +943,8 @@ * term.c (encode_terminal_code): Now external again, used by w32console.c and msdos.c. - * makefile.w32-in ($(BLD)/term.$(O), ($(BLD)/tparam.$(O)): Depend - on $(SRC)/tparam.h, see revno 103623. + * makefile.w32-in ($(BLD)/term.$(O), ($(BLD)/tparam.$(O)): + Depend on $(SRC)/tparam.h, see revno 103623. 2011-03-11 Paul Eggert @@ -1003,8 +1008,8 @@ (x_delete_glyphs, x_ins_del_lines): Mark with NO_RETURN. (x_connection_closed): Tell GCC not to suggest NO_RETURN. - * xfaces.c (clear_face_cache, Fx_list_fonts, Fface_font): Rename - or move locals to avoid shadowing. + * xfaces.c (clear_face_cache, Fx_list_fonts, Fface_font): + Rename or move locals to avoid shadowing. (tty_defined_color, merge_face_heights): Now static. (free_realized_faces_for_fontset): Remove; not used. (Fx_list_fonts): Mark variable that gcc -Wuninitialized @@ -1162,12 +1167,12 @@ (xg_prepare_tooltip, xg_hide_tooltip): Call gdk_window_get_screen. (xg_prepare_tooltip, create_dialog, menubar_map_cb) (xg_update_frame_menubar, xg_tool_bar_detach_callback) - (xg_tool_bar_attach_callback, xg_update_tool_bar_sizes): Call - gtk_widget_get_preferred_size. + (xg_tool_bar_attach_callback, xg_update_tool_bar_sizes): + Call gtk_widget_get_preferred_size. (xg_frame_resized): gdk_window_get_geometry only takes 5 parameters. - (xg_win_to_widget, xg_event_is_for_menubar): Call - gdk_x11_window_lookup_for_display. + (xg_win_to_widget, xg_event_is_for_menubar): + Call gdk_x11_window_lookup_for_display. (xg_set_widget_bg): New function. (delete_cb): New function. (xg_create_frame_widgets): connect delete-event to delete_cb. @@ -1263,7 +1268,7 @@ (produce_glyphless_glyph): Make a pointer "const" since it might point to immutable storage. (update_window_cursor): Now static, since it's not used elsewhere. - (SKIP_GLYPHS): Removed unused macro. + (SKIP_GLYPHS): Remove unused macro. 2011-03-06 Michael Shields (tiny change) @@ -7760,7 +7765,7 @@ * xterm.c (x_send_scroll_bar_event, SET_SAVED_MENU_EVENT) (handle_one_xevent, x_check_errors, xim_initialize, x_term_init): Likewise. - * character.h (BCOPY_SHORT): Removed. + * character.h (BCOPY_SHORT): Remove. * config.in: Regenerate. * dispnew.c (safe_bcopy): Only define as dummy if PROFILING. * emacs.c (main) [PROFILING]: Don't declare @@ -19549,7 +19554,7 @@ Set xftfont_info->ft_size. Don't unlock the face. Check BDF properties if appropriate. (xftfont_close): Unlock the face. - (xftfont_anchor_point, xftfont_shape): Deleted. + (xftfont_anchor_point, xftfont_shape): Delete. (syms_of_xftfont): Don't set members anchor_point and shape of xftfont_driver. @@ -21454,7 +21459,7 @@ Delete externs. (fontset_from_font_name): Extern it. (FS_LOAD_FONT, FONT_INFO_ID, FONT_INFO_FROM_ID) - (FONT_INFO_FROM_FACE): Deleted. + (FONT_INFO_FROM_FACE): Delete. (face_for_font): Adjust prototype. * fontset.c: Throughout the file, delete all USE_FONT_BACKEND @@ -21471,7 +21476,7 @@ (fontset_compare_rfontdef): New function. (reorder_font_vector): Remove the argument CHARSET-ID. Sort rfont-defs by qsort. Adjusted for the change of font-group vector. - (load_font_get_repertory): Deleted. + (load_font_get_repertory): Delete. (fontset_find_font): Use new macros to ref/set elements of font-def and rfont-def. (fontset_font): Fix the timing of remembering that no font for C. @@ -21487,11 +21492,11 @@ font-def. (Fnew_fontset): Use font_unparse_xlfd to generate FONTSET_ASCII (fontset). - (new_fontset_from_font_name): Deleted. + (new_fontset_from_font_name): Delete. (fontset_from_font): Rename from new_fontset_from_font. Check if a fontset is already created for the font. FIx updating of Vfontset_alias_alist. - (fontset_ascii_font): Deleted. + (fontset_ascii_font): Delete. (Ffont_info): Adjust for the format change of font-spec. (Finternal_char_font): Likewise. (Ffontset_info): Likewise. @@ -21519,7 +21524,7 @@ (ftfont_list): Return a list, not vector. (ftfont_match): Use ftfont_spec_pattern to get a pattern. (ftfont_list_family): Don't downcase names. - (ftfont_free_entity): Deleted. + (ftfont_free_entity): Delete. (ftfont_open): Return a font-object. Adjusted for the change of struct font. Get underline_thickness and underline_position from font property. Don't update dpyinfo->smallest_font_height and @@ -21571,13 +21576,13 @@ (QCfoundry, QCadstyle, QCregistry, QCspacing, QCsize, QCavgwidth) (Qp): Extern them. (clear_font_table, load_face_font, xlfd_lookup_field_contents): - Deleted. - (struct font_name): Deleted. - (xlfd_numeric_value, xlfd_symbolic_value): Deleted. + Delete. + (struct font_name): Delete. + (xlfd_numeric_value, xlfd_symbolic_value): Delete. (compare_fonts_by_sort_order): New function. (xlfd_numeric_slant, xlfd_symbolic_slant, xlfd_numeric_weight) (xlfd_symbolic_weight, xlfd_numeric_swidth, xlfd_symbolic_swidth): - Deleted. + Delete. (Fx_family_fonts): Use font_list_entities, and sort fonts by compare_fonts_by_sort_order. (Fx_font_family_list): Call Ffont_family_list. @@ -21590,9 +21595,9 @@ (free_font_names, sort_fonts, x_face_list_fonts) (face_font_available_p, sorted_font_list, cmp_font_names) (font_list_1, concat_font_list, font_list, remove_duplicates): - Deleted. + Delete. (Fx_list_fonts): Use Ffont_list. - (LFACE_AVGWIDTH): Deleted. + (LFACE_AVGWIDTH): Delete. (check_lface_attrs): Don't check LFACE_AVGWIDTH. Check LFACE_FONT by FONTP. (lface_fully_specified_p): Don't check LFACE_AVGWIDTH. @@ -21614,7 +21619,7 @@ (Fface_font): Get a font name from font->props[FONT_NAME_INDEX]. (lface_same_font_attributes_p): Don't check LFACE_AVGWIDTH. Compare fonts by EQ. - (lookup_non_ascii_face): Deleted. + (lookup_non_ascii_face): Delete. (face_for_font): The 2nd argument changed. (x_supports_face_attributes_p): Don't check LFACE_AVGWIDTH. Check atomic font properties by case insensitive. @@ -21637,7 +21642,7 @@ * xfont.c: Include and "ccl.h". (struct xfont_info): New structure. - (xfont_query_font): Deleted. + (xfont_query_font): Delete. (xfont_find_ccl_program): Rename from x_find_ccl_program and moved from xterm.c. (xfont_driver): Adjust for the change of struct font_driver. @@ -21653,7 +21658,7 @@ dpyinfo->smallest_char_width. (xfont_close): Don't free struct font. (xfont_prepare_face): Adjust for the change of struct font. - (xfont_done_face): Deleted. + (xfont_done_face): Delete. (xfont_has_char): Adjust for the change of struct font. (xfont_encode_char, xfont_draw): Likewise. (xfont_check): New function. @@ -21683,7 +21688,7 @@ * xterm.c: Throughout the file, delete all USE_FONT_BACKEND conditionals. Don't check enable_font_backend. Delete all codes used only when USE_FONT_BACKEND is not defined. Don't include ccl.h. - (x_per_char_metric, x_encode_char): Deleted. + (x_per_char_metric, x_encode_char): Delete. (x_set_cursor_gc, x_set_mouse_face_gc): Don't set GCFont. (x_compute_glyph_string_overhangs): Adjust for the change of `struct face'. @@ -21692,10 +21697,10 @@ (x_draw_glyph_string): Likewise. Use font->underline_position and font->underline_thickness. (x_new_font): Rename from x_new_fontset2. - (x_new_fontset, x_get_font_info, x_list_fonts): Deleted. + (x_new_fontset, x_get_font_info, x_list_fonts): Delete. (x_check_font): Call `check' method of a font driver. (x_font_min_bounds, x_compute_min_glyph_bounds, x_load_font) - (x_query_font, x_get_font_repertory): Deleted. + (x_query_font, x_get_font_repertory): Delete. (x_find_ccl_program): Rename and moved to xfont.c. (x_redisplay_interface): Adjust for the change of `struct redisplay_interface'. === modified file 'src/eval.c' --- src/eval.c 2011-03-30 00:39:12 +0000 +++ src/eval.c 2011-03-30 19:18:12 +0000 @@ -38,16 +38,20 @@ struct backtrace *next; Lisp_Object *function; Lisp_Object *args; /* Points to vector of args. */ - size_t nargs; /* Length of vector. - If nargs is (size_t) UNEVALLED, args points - to slot holding list of unevalled args. */ - char evalargs; +#define NARGS_BITS (BITS_PER_INT - 2) + /* Let's not use size_t because we want to allow negative values (for + UNEVALLED). Also let's steal 2 bits so we save a word (or more for + alignment). In any case I doubt Emacs would survive a function call with + more than 500M arguments. */ + int nargs : NARGS_BITS; /* Length of vector. + If nargs is UNEVALLED, args points + to slot holding list of unevalled args. */ + char evalargs : 1; /* Nonzero means call value of debugger when done with this operation. */ - char debug_on_exit; + char debug_on_exit : 1; }; struct backtrace *backtrace_list; - struct catchtag *catchlist; #ifdef DEBUG_GCPRO @@ -553,7 +557,7 @@ looking at several frames for special forms. Skip past them. */ while (btp && (EQ (*btp->function, Qbytecode) - || btp->nargs == (size_t) UNEVALLED)) + || btp->nargs == UNEVALLED)) btp = btp->next; /* `btp' now points at the frame of the innermost function that isn't @@ -3335,7 +3339,7 @@ while (backlist) { write_string (backlist->debug_on_exit ? "* " : " ", 2); - if (backlist->nargs == (size_t) UNEVALLED) + if (backlist->nargs == UNEVALLED) { Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil); write_string ("\n", -1); @@ -3345,8 +3349,8 @@ tem = *backlist->function; Fprin1 (tem, Qnil); /* This can QUIT. */ write_string ("(", -1); - if (backlist->nargs == (size_t) MANY) - { + if (backlist->nargs == MANY) + { /* FIXME: Can this happen? */ int i; for (tail = *backlist->args, i = 0; !NILP (tail); @@ -3399,11 +3403,11 @@ if (!backlist) return Qnil; - if (backlist->nargs == (size_t) UNEVALLED) + if (backlist->nargs == UNEVALLED) return Fcons (Qnil, Fcons (*backlist->function, *backlist->args)); else { - if (backlist->nargs == (size_t) MANY) + if (backlist->nargs == MANY) /* FIXME: Can this happen? */ tem = *backlist->args; else tem = Flist (backlist->nargs, backlist->args); @@ -3423,8 +3427,8 @@ { mark_object (*backlist->function); - if (backlist->nargs == (size_t) UNEVALLED - || backlist->nargs == (size_t) MANY) + if (backlist->nargs == UNEVALLED + || backlist->nargs == MANY) /* FIXME: Can this happen? */ i = 1; else i = backlist->nargs; ------------------------------------------------------------ revno: 103781 committer: Stefan Monnier branch nick: trunk timestamp: Wed 2011-03-30 14:04:11 -0400 message: * src/bytecode.c (Fbyte_code): CAR and CDR can GC. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-03-30 13:35:37 +0000 +++ src/ChangeLog 2011-03-30 18:04:11 +0000 @@ -1,3 +1,7 @@ +2011-03-30 Stefan Monnier + + * bytecode.c (Fbyte_code): CAR and CDR can GC. + 2011-03-30 Zachary Kanfer (tiny change) * keyboard.c (Fexecute_extended_command): Do log the "suggest key === modified file 'src/bytecode.c' --- src/bytecode.c 2011-03-17 02:18:00 +0000 +++ src/bytecode.c 2011-03-30 18:04:11 +0000 @@ -554,7 +554,16 @@ { Lisp_Object v1; v1 = TOP; - TOP = CAR (v1); + if (CONSP (v1)) + TOP = XCAR (v1); + else if (NILP (v1)) + TOP = Qnil; + else + { + BEFORE_POTENTIAL_GC (); + wrong_type_argument (Qlistp, v1); + AFTER_POTENTIAL_GC (); + } break; } @@ -580,7 +589,17 @@ { Lisp_Object v1; v1 = TOP; - TOP = CDR (v1); + if (CONSP (v1)) + TOP = XCDR (v1); + else if (NILP (v1)) + TOP = Qnil; + else + { + BEFORE_POTENTIAL_GC (); + wrong_type_argument (Qlistp, v1); + AFTER_POTENTIAL_GC (); + } + break; break; } @@ -911,13 +930,13 @@ v1 = POP; v2 = TOP; CHECK_NUMBER (v2); - AFTER_POTENTIAL_GC (); op = XINT (v2); immediate_quit = 1; while (--op >= 0 && CONSP (v1)) v1 = XCDR (v1); immediate_quit = 0; TOP = CAR (v1); + AFTER_POTENTIAL_GC (); break; } ------------------------------------------------------------ revno: 103780 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Wed 2011-03-30 14:59:42 +0000 message: Merge Gnus' changes. gnus.texi (Listing Groups): Document gnus-group-list-ticked. gssapi.el (open-gssapi-stream): Remove the last mentions of the IMAP stuff. gnus-score.el (gnus-score-string): Fix calling convention of `gnus-simplify-buffer-fuzzy' after last patches. gnus-sum.el (gnus-update-marks): Don't send any marks updates to the server for articles we didn't get any headers for. This is a sanity check. nnimap.el (nnimap-open-connection-1): Is the login responds with a new CAPABILITY, use it. gnus-agent.el (gnus-agent-fetch-headers): Don't message if we're not downloading anything. gnus.el (gnus-splash-svg-color-symbols): Removed superfluous `and'. gnus.el (gnus-group-startup-message): Prefer svg file and replace colors. (gnus-splash-svg-color-symbols): New function. gnus-sum.el (gnus-simplify-buffer-fuzzy): Take the regexp explicitly instead of using the global gnus-simplify-subject-fuzzy-regexp. (gnus-simplify-subject-fuzzy): Use the local gnus-simplify-subject-fuzzy-regex instead of the global one. This makes using this variable in group parameters work. gnus-registry.el (gnus-registry-unfollowed-groups): Add "archive:sent" to the unfollowed group regex (for the recent Gnus archive:sent-YYYY-MM-DD groups). (gnus-registry-split-fancy-with-parent): Bail out early in sender tracking if there are more than `gnus-registry-max-track-groups' matches. message.el (message--yank-original-internal): New function to do the insertion cleanly inside eval in `message-yank-original'. (message-yank-original): Use it. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2011-03-18 13:45:04 +0000 +++ doc/misc/ChangeLog 2011-03-30 14:59:42 +0000 @@ -1,3 +1,7 @@ +2011-03-19 Antoine Levitt + + * gnus.texi (Listing Groups): Document gnus-group-list-ticked + 2011-03-17 Jay Belanger * calc.texi (Logarithmic Units): Update the function names. === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2011-02-23 04:19:28 +0000 +++ doc/misc/gnus.texi 2011-03-30 14:59:42 +0000 @@ -3320,6 +3320,11 @@ @findex gnus-group-list-dormant List all groups with dormant articles (@code{gnus-group-list-dormant}). +@item A ! +@kindex A ! (Group) +@findex gnus-group-list-ticked +List all groups with ticked articles (@code{gnus-group-list-ticked}). + @item A / @kindex A / (Group) @findex gnus-group-list-limit === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-03-30 02:21:28 +0000 +++ lisp/gnus/ChangeLog 2011-03-30 14:59:42 +0000 @@ -15,6 +15,59 @@ nntp-open-plain-stream value. (nntp-open-connection): Recognize that value. +2011-03-29 Lars Magne Ingebrigtsen + + * gssapi.el (open-gssapi-stream): Remove the last mentions of the IMAP + stuff. + + * gnus-score.el (gnus-score-string): Fix calling convention of + `gnus-simplify-buffer-fuzzy' after last patches. + + * gnus-sum.el (gnus-update-marks): Don't send any marks updates to the + server for articles we didn't get any headers for. This is a sanity + check. + +2011-03-29 Michael Welsh Duggan + + * nnimap.el (nnimap-open-connection-1): Is the login responds with a + new CAPABILITY, use it. + +2011-03-29 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-fetch-headers): Don't message if we're not + downloading anything. + + * gnus.el (gnus-splash-svg-color-symbols): Removed superfluous `and'. + +2011-03-29 Adam Sjøgren + + * gnus.el (gnus-group-startup-message): Prefer svg file and replace + colors. + (gnus-splash-svg-color-symbols): New function. + +2011-03-29 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-simplify-buffer-fuzzy): Take the regexp explicitly + instead of using the global gnus-simplify-subject-fuzzy-regexp. + (gnus-simplify-subject-fuzzy): Use the local + gnus-simplify-subject-fuzzy-regex instead of the global one. This + makes using this variable in group parameters work. + +2011-03-29 Teodor Zlatanov + + * gnus-registry.el (gnus-registry-unfollowed-groups): Add + "archive:sent" to the unfollowed group regex (for the recent Gnus + archive:sent-YYYY-MM-DD groups). + (gnus-registry-split-fancy-with-parent): Bail out early in sender + tracking if there are more than `gnus-registry-max-track-groups' + matches. + +2011-03-29 Stefan Monnier + + * message.el (message--yank-original-internal): New function to do the + insertion cleanly inside eval in `message-yank-original'. + (message-yank-original): Use it. + 2011-03-29 Julien Danjou * mm-view.el (mm-display-inline-fontify): Use `set-normal-mode' with === modified file 'lisp/gnus/gnus-agent.el' --- lisp/gnus/gnus-agent.el 2011-02-28 01:07:29 +0000 +++ lisp/gnus/gnus-agent.el 2011-03-30 14:59:42 +0000 @@ -1925,9 +1925,10 @@ (setq articles (gnus-list-range-intersection articles (list (cons low high))))))) - (gnus-message - 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" - (gnus-compress-sequence articles t)) + (when articles + (gnus-message + 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" + (gnus-compress-sequence articles t))) (with-current-buffer nntp-server-buffer (if articles === modified file 'lisp/gnus/gnus-registry.el' --- lisp/gnus/gnus-registry.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/gnus-registry.el 2011-03-30 14:59:42 +0000 @@ -124,7 +124,7 @@ :type 'symbol) (defcustom gnus-registry-unfollowed-groups - '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:") + '("delayed$" "drafts$" "queue$" "INBOX$" "^nnmairix:" "archive") "List of groups that gnus-registry-split-fancy-with-parent won't return. The group names are matched, they don't have to be fully qualified. This parameter tells the Registry 'never split a @@ -541,24 +541,26 @@ user-mail-address))) (maphash (lambda (key value) - (let ((this-sender (cdr - (gnus-registry-fetch-extra key 'sender))) - matches) - (when (and this-sender - (equal sender this-sender)) - (let ((groups (gnus-registry-fetch-groups - key - gnus-registry-max-track-groups))) - (dolist (group groups) - (when (and group (gnus-registry-follow-group-p group)) - (push group found-full) - (setq found (append (list group) (delete group found)))))) - (push key matches) - (gnus-message - ;; raise level of messaging if gnus-registry-track-extra - (if gnus-registry-track-extra 7 9) - "%s (extra tracking) traced sender %s to groups %s (keys %s)" - log-agent sender found matches)))) + ;; don't use more than gnus-registry-max-track-groups + (when (< (length found-full) gnus-registry-max-track-groups) + (let ((this-sender + (cdr (gnus-registry-fetch-extra key 'sender))) + matches) + (when (and this-sender + (equal sender this-sender)) + (let ((groups (gnus-registry-fetch-groups + key + gnus-registry-max-track-groups))) + (dolist (group groups) + (when (and group (gnus-registry-follow-group-p group)) + (push group found-full) + (setq found (append (list group) (delete group found)))))) + (push key matches) + (gnus-message + ;; raise level of messaging if gnus-registry-track-extra + (if gnus-registry-track-extra 7 9) + "%s (extra tracking) traced sender %s to groups %s (keys %s)" + log-agent sender found matches))))) gnus-registry-hashtb) ;; filter the found groups and return them ;; the found groups are NOT the full groups === modified file 'lisp/gnus/gnus-score.el' --- lisp/gnus/gnus-score.el 2011-01-25 04:08:28 +0000 +++ lisp/gnus/gnus-score.el 2011-03-30 14:59:42 +0000 @@ -2151,7 +2151,7 @@ ;; Find fuzzy matches. (when fuzzies ;; Simplify the entire buffer for easy matching. - (gnus-simplify-buffer-fuzzy) + (gnus-simplify-buffer-fuzzy gnus-simplify-subject-fuzzy-regexp) (while (setq kill (cadaar fuzzies)) (let* ((match (nth 0 kill)) (type (nth 3 kill)) === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2011-03-22 13:40:41 +0000 +++ lisp/gnus/gnus-sum.el 2011-03-30 14:59:42 +0000 @@ -1734,7 +1734,7 @@ (while (re-search-forward regexp nil t) (replace-match (or newtext "")))) -(defun gnus-simplify-buffer-fuzzy () +(defun gnus-simplify-buffer-fuzzy (regexp) "Simplify string in the buffer fuzzily. The string in the accessible portion of the current buffer is simplified. It is assumed to be a single-line subject. @@ -1748,11 +1748,10 @@ (while (not (eq modified-tick (buffer-modified-tick))) (setq modified-tick (buffer-modified-tick)) (cond - ((listp gnus-simplify-subject-fuzzy-regexp) - (mapc 'gnus-simplify-buffer-fuzzy-step - gnus-simplify-subject-fuzzy-regexp)) - (gnus-simplify-subject-fuzzy-regexp - (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp))) + ((listp regexp) + (mapc 'gnus-simplify-buffer-fuzzy-step regexp)) + (regexp + (gnus-simplify-buffer-fuzzy-step regexp))) (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") (gnus-simplify-buffer-fuzzy-step "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") @@ -1767,15 +1766,16 @@ "Simplify a subject string fuzzily. See `gnus-simplify-buffer-fuzzy' for details." (save-excursion - (gnus-set-work-buffer) - (let ((case-fold-search t)) - ;; Remove uninteresting prefixes. - (when (and gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) - (insert subject) - (inline (gnus-simplify-buffer-fuzzy)) - (buffer-string)))) + (let ((regexp gnus-simplify-subject-fuzzy-regexp)) + (gnus-set-work-buffer) + (let ((case-fold-search t)) + ;; Remove uninteresting prefixes. + (when (and gnus-simplify-ignored-prefixes + (string-match gnus-simplify-ignored-prefixes subject)) + (setq subject (substring subject (match-end 0)))) + (insert subject) + (inline (gnus-simplify-buffer-fuzzy regexp)) + (buffer-string))))) (defsubst gnus-simplify-subject-fully (subject) "Simplify a subject string according to `gnus-summary-gather-subject-limit'." @@ -6068,14 +6068,23 @@ 'request-set-mark gnus-newsgroup-name) (not (gnus-article-unpropagatable-p (cdr type)))) (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (del (gnus-remove-from-range (gnus-copy-sequence old) list)) - (add (gnus-remove-from-range - (gnus-copy-sequence list) old))) + ;; Don't do anything about marks for articles we + ;; didn't actually get any headers for. + (existing (gnus-compress-sequence gnus-newsgroup-articles)) + (del + (gnus-sorted-range-intersection + existing + (gnus-remove-from-range (gnus-copy-sequence old) list))) + (add + (gnus-sorted-range-intersection + existing + (gnus-remove-from-range + (gnus-copy-sequence list) old)))) (when add (push (list add 'add (list (cdr type))) delta-marks)) (when del - ;; Don't delete marks from outside the active range. This - ;; shouldn't happen, but is a sanity check. + ;; Don't delete marks from outside the active range. + ;; This shouldn't happen, but is a sanity check. (setq del (gnus-sorted-range-intersection (gnus-active gnus-newsgroup-name) del)) (push (list del 'del (list (cdr type))) delta-marks)))) === modified file 'lisp/gnus/gnus.el' --- lisp/gnus/gnus.el 2011-03-06 02:43:19 +0000 +++ lisp/gnus/gnus.el 2011-03-30 14:59:42 +0000 @@ -1043,12 +1043,15 @@ ((boundp 'image-load-path) (symbol-value 'image-load-path)) (t load-path))) - (image (find-image - `((:type xpm :file "gnus.xpm" + (image (gnus-splash-svg-color-symbols (find-image + `((:type svg :file "gnus.svg" + :color-symbols + (("#bf9900" . ,(car gnus-logo-colors)) + ("#ffcc00" . ,(cadr gnus-logo-colors)))) + (:type xpm :file "gnus.xpm" :color-symbols (("thing" . ,(car gnus-logo-colors)) ("shadow" . ,(cadr gnus-logo-colors)))) - (:type svg :file "gnus.svg") (:type png :file "gnus.png") (:type pbm :file "gnus.pbm" ;; Account for the pbm's background. @@ -1057,7 +1060,7 @@ (:type xbm :file "gnus.xbm" ;; Account for the xbm's background. :background ,(face-foreground 'gnus-splash) - :foreground ,(face-background 'default)))))) + :foreground ,(face-background 'default))))))) (when image (let ((size (image-size image))) (insert-char ?\n (max 0 (round (- (window-height) @@ -1103,6 +1106,20 @@ (setq mode-line-buffer-identification (concat " " gnus-version)) (set-buffer-modified-p t))) +(defun gnus-splash-svg-color-symbols (list) + "Do color-symbol search-and-replace in svg file" + (let ((type (plist-get (cdr list) :type)) + (file (plist-get (cdr list) :file)) + (color-symbols (plist-get (cdr list) :color-symbols))) + (if (string= type "svg") + (let ((data (with-temp-buffer (insert-file file) (buffer-string)))) + (mapc (lambda (rule) + (setq data (replace-regexp-in-string + (concat "fill:" (car rule)) + (concat "fill:" (cdr rule)) data))) color-symbols) + (cons (car list) (list :type type :data data))) + list))) + (eval-when (load) (let ((command (format "%s" this-command))) (when (string-match "gnus" command) === modified file 'lisp/gnus/gssapi.el' --- lisp/gnus/gssapi.el 2011-03-15 22:38:41 +0000 +++ lisp/gnus/gssapi.el 2011-03-30 14:59:42 +0000 @@ -33,14 +33,14 @@ "--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." +%s is replaced with server hostname, %p with port to connect to, +and %l with the user name. The program should accept 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) +(defun open-gssapi-stream (name buffer server port user) (let ((cmds gssapi-program) cmd done) (with-current-buffer buffer @@ -57,7 +57,7 @@ (format-spec-make ?s server ?p (number-to-string port) - ?l imap-default-user)))) + ?l user)))) response) (when process (while (and (memq (process-status process) '(open run)) @@ -92,7 +92,7 @@ (accept-process-output process 1) (sit-for 1)) (erase-buffer) - (message "GSSAPI IMAP connection: %s" (or response "failed")) + (message "GSSAPI connection: %s" (or response "failed")) (if (and response (let ((case-fold-search nil)) (not (string-match "failed" response)))) (setq done process) === modified file 'lisp/gnus/message.el' --- lisp/gnus/message.el 2011-03-15 22:38:41 +0000 +++ lisp/gnus/message.el 2011-03-30 14:59:42 +0000 @@ -3712,22 +3712,9 @@ (while (re-search-forward citexp nil t) (replace-match (if remove "" "\n")))))) -(defun message-yank-original (&optional arg) - "Insert the message being replied to, if any. -Puts point before the text and mark after. -Normally indents each nonblank line ARG spaces (default 3). However, -if `message-yank-prefix' is non-nil, insert that prefix on each line. - -This function uses `message-cite-function' to do the actual citing. - -Just \\[universal-argument] as argument means don't indent, insert no -prefix, and don't delete any headers." - (interactive "P") +(defun message--yank-original-internal (arg) (let ((modified (buffer-modified-p)) body-text) - ;; eval the let forms contained in message-cite-style - (eval - `(let ,message-cite-style (when (and message-reply-buffer message-cite-function) (when (equal message-cite-reply-position 'above) @@ -3767,7 +3754,23 @@ ;; Add a `message-setup-very-last-hook' here? ;; Add `gnus-article-highlight-citation' here? (unless modified - (setq message-checksum (message-checksum)))))))) + (setq message-checksum (message-checksum)))))) + +(defun message-yank-original (&optional arg) + "Insert the message being replied to, if any. +Puts point before the text and mark after. +Normally indents each nonblank line ARG spaces (default 3). However, +if `message-yank-prefix' is non-nil, insert that prefix on each line. + +This function uses `message-cite-function' to do the actual citing. + +Just \\[universal-argument] as argument means don't indent, insert no +prefix, and don't delete any headers." + (interactive "P") + ;; eval the let forms contained in message-cite-style + (eval + `(let ,message-cite-style + (message--yank-original-internal ',arg)))) (defun message-yank-buffer (buffer) "Insert BUFFER into the current buffer and quote it." === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2011-03-30 02:21:28 +0000 +++ lisp/gnus/nnimap.el 2011-03-30 14:59:42 +0000 @@ -410,11 +410,18 @@ (setq login-result (nnimap-login (car credentials) (cadr credentials)))) (if (car login-result) - ;; save the credentials if a save function exists + (progn + ;; Save the credentials if a save function exists ;; (such a function will only be passed if a new - ;; token was created) - (when (functionp (nth 2 credentials)) - (funcall (nth 2 credentials))) + ;; token was created). + (when (functionp (nth 2 credentials)) + (funcall (nth 2 credentials))) + ;; See if CAPABILITY is set as part of login + ;; response. + (dolist (response (cddr login-result)) + (when (string= "CAPABILITY" (upcase (car response))) + (setf (nnimap-capabilities nnimap-object) + (mapcar #'upcase (cdr response)))))) ;; If the login failed, then forget the credentials ;; that are now possibly cached. (dolist (host (list (nnoo-current-server 'nnimap) ------------------------------------------------------------ revno: 103779 author: Zachary Kanfer committer: Stefan Monnier branch nick: trunk timestamp: Wed 2011-03-30 09:35:37 -0400 message: * src/keyboard.c (Fexecute_extended_command): Do log the "suggest key binding" message. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2011-03-30 00:39:12 +0000 +++ src/ChangeLog 2011-03-30 13:35:37 +0000 @@ -1,3 +1,8 @@ +2011-03-30 Zachary Kanfer (tiny change) + + * keyboard.c (Fexecute_extended_command): Do log the "suggest key + binding" message (bug#7967). + 2011-03-30 Paul Eggert Fix more problems found by GCC 4.6.0's static checks. === modified file 'src/keyboard.c' --- src/keyboard.c 2011-03-29 23:35:49 +0000 +++ src/keyboard.c 2011-03-30 13:35:37 +0000 @@ -10340,9 +10340,9 @@ sprintf (newmessage, "You can run the command `%s' with %s", SDATA (SYMBOL_NAME (function)), SDATA (binding)); - message2_nolog (newmessage, - strlen (newmessage), - STRING_MULTIBYTE (binding)); + message2 (newmessage, + strlen (newmessage), + STRING_MULTIBYTE (binding)); if (NUMBERP (Vsuggest_key_bindings)) waited = sit_for (Vsuggest_key_bindings, 0, 2); else ------------------------------------------------------------ revno: 103778 committer: Chong Yidong branch nick: trunk timestamp: Tue 2011-03-29 22:21:28 -0400 message: Change default type of open-protocol-stream. * nnimap.el (nnimap-stream, nnimap-open-connection-1): Accept `network' value. * nntp.el (nntp-open-connection-function): Document the fact that some values are not functions but are instead handled specially. Recognize nntp-open-plain-stream value. (nntp-open-connection): Recognize that value. * proto-stream.el (open-protocol-stream): Bring back `network' type. Make this the default type. (proto-stream-open-plain): Rename from proto-stream-open-default. (open-protocol-stream, proto-stream-open-starttls) (proto-stream-open-tls, proto-stream-open-shell): Replace `default' with `plain'. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2011-03-29 13:23:38 +0000 +++ lisp/gnus/ChangeLog 2011-03-30 02:21:28 +0000 @@ -1,3 +1,20 @@ +2011-03-30 Chong Yidong + + * proto-stream.el (open-protocol-stream): Bring back `network' type. + Make this the default type. + (proto-stream-open-plain): Rename from proto-stream-open-default. + (open-protocol-stream, proto-stream-open-starttls) + (proto-stream-open-tls, proto-stream-open-shell): Replace `default' + with `plain'. + + * nnimap.el (nnimap-stream, nnimap-open-connection-1): Accept `network' + value. + + * nntp.el (nntp-open-connection-function): Document the fact that some + values are not functions but are instead handled specially. Recognize + nntp-open-plain-stream value. + (nntp-open-connection): Recognize that value. + 2011-03-29 Julien Danjou * mm-view.el (mm-display-inline-fontify): Use `set-normal-mode' with === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2011-03-26 23:18:42 +0000 +++ lisp/gnus/nnimap.el 2011-03-30 02:21:28 +0000 @@ -61,10 +61,12 @@ it will default to `imap'.") (defvoo nnimap-stream 'undecided - "How nnimap will talk to the IMAP server. -Values are `ssl', `default', `try-starttls', `starttls' or -`shell'. The default is to try `ssl' first, and then -`try-starttls'.") + "How nnimap talks to the IMAP server. +The value should be either `undecided', `ssl' or `tls', +`network', `starttls', `plain', or `shell'. + +If the value is `undecided', nnimap tries `ssl' first, then falls +back on `network'.") (defvoo nnimap-shell-program (if (boundp 'imap-shell-program) (if (listp imap-shell-program) @@ -319,7 +321,7 @@ (setq nnimap-stream 'ssl)) (let ((stream (if (eq nnimap-stream 'undecided) - (loop for type in '(ssl try-starttls) + (loop for type in '(ssl network) for stream = (let ((nnimap-stream type)) (nnimap-open-connection-1 buffer)) while (eq stream 'no-connect) @@ -339,7 +341,7 @@ (port nil) (ports (cond - ((memq nnimap-stream '(try-starttls default starttls)) + ((memq nnimap-stream '(network plain starttls)) (nnheader-message 7 "Opening connection to %s..." nnimap-address) '("imap" "143")) === modified file 'lisp/gnus/nntp.el' --- lisp/gnus/nntp.el 2011-03-26 23:18:42 +0000 +++ lisp/gnus/nntp.el 2011-03-30 02:21:28 +0000 @@ -76,27 +76,27 @@ You probably don't want to do that, though.") (defvoo nntp-open-connection-function 'nntp-open-network-stream - "*Function used for connecting to a remote system. -It will be called with the buffer to output in as argument. - -Currently, five such functions are provided (please refer to their -respective doc string for more information), three of them establishing -direct connections to the nntp server, and two of them using an indirect -host. - -Direct connections: -- `nntp-open-network-stream' (the default), -- `network-only' (the same as the above, but don't do automatic - STARTTLS upgrades). -- `nntp-open-ssl-stream', -- `nntp-open-tls-stream', -- `nntp-open-netcat-stream'. -- `nntp-open-telnet-stream'. - -Indirect connections: -- `nntp-open-via-rlogin-and-netcat', -- `nntp-open-via-rlogin-and-telnet', -- `nntp-open-via-telnet-and-telnet'.") + "Method for connecting to a remote system. +It should be a function, which is called with the output buffer +as its single argument, or one of the following special values: + +- `nntp-open-network-stream' specifies a network connection, + upgrading to a TLS connection via STARTTLS if possible. +- `nntp-open-plain-stream' specifies an unencrypted network + connection (no STARTTLS upgrade is attempted). +- `nntp-open-ssl-stream' or `nntp-open-tls-stream' specify a TLS + network connection. + +Apart from the above special values, valid functions are as +follows; please refer to their respective doc string for more +information. +For direct connections: +- `nntp-open-netcat-stream' +- `nntp-open-telnet-stream' +For indirect connections: +- `nntp-open-via-rlogin-and-netcat' +- `nntp-open-via-rlogin-and-telnet' +- `nntp-open-via-telnet-and-telnet'") (defvoo nntp-never-echoes-commands nil "*Non-nil means the nntp server never echoes commands. @@ -1339,15 +1339,15 @@ (condition-case err (let ((coding-system-for-read nntp-coding-system-for-read) (coding-system-for-write nntp-coding-system-for-write) - (map '((nntp-open-network-stream try-starttls) - (network-only default) + (map '((nntp-open-network-stream network) + (network-only plain) ; compat + (nntp-open-plain-stream plain) (nntp-open-ssl-stream tls) (nntp-open-tls-stream tls)))) (if (assoc nntp-open-connection-function map) (open-protocol-stream "nntpd" pbuffer nntp-address nntp-port-number - :type (or (cadr (assoc nntp-open-connection-function map)) - 'try-starttls) + :type (cadr (assoc nntp-open-connection-function map)) :end-of-command "^\\([2345]\\|[.]\\).*\n" :capability-command "CAPABILITIES\r\n" :success "^3" === modified file 'lisp/gnus/proto-stream.el' --- lisp/gnus/proto-stream.el 2011-03-26 23:18:42 +0000 +++ lisp/gnus/proto-stream.el 2011-03-30 02:21:28 +0000 @@ -37,7 +37,7 @@ ;; (open-protocol-stream ;; "*nnimap*" buffer address port -;; :type 'try-starttls +;; :type 'network ;; :capability-command "1 CAPABILITY\r\n" ;; :success " OK " ;; :starttls-function @@ -65,17 +65,20 @@ PARAMETERS should be a sequence of keywords and values: :type specifies the connection type, one of the following: - `default' -- An ordinary network connection. - `try-starttls' - -- Begin an ordinary network connection, and try - upgrading it to an encrypted connection via - STARTTLS if both HOST and Emacs support TLS. If - that fails, keep the unencrypted connection. - `starttls' -- Begin an ordinary connection, and try upgrading - it via STARTTLS. If that fails for any reason, - drop the connection; in this case, the returned - process object is a killed process. - `tls' or `ssl' -- A TLS connection. + nil or `network' + -- Begin with an ordinary network connection, and if + the parameters :success and :capability-command + are also supplied, try to upgrade to an encrypted + connection via STARTTLS. Even if that + fails (e.g. if HOST does not support TLS), retain + an unencrypted connection. + `plain' -- An ordinary, unencrypted network connection. + `starttls' -- Begin with an ordinary connection, and try + upgrading via STARTTLS. If that fails for any + reason, drop the connection; in that case the + returned object is a killed process. + `tls' -- A TLS connection. + `ssl' -- Equivalent to `tls'. `shell' -- A shell connection. :return-list specifies this function's return value. @@ -85,16 +88,15 @@ :greeting -- the greeting returned by HOST (a string), or nil. :capabilities -- a string representing HOST's capabilities, or nil if none could be found. - :type -- the actual connection type; either `default' for an - unencrypted connection, or `tls'. + :type -- the resulting connection type; `plain' (unencrypted) + or `tls' (TLS-encrypted). :end-of-command specifies a regexp matching the end of a command. If non-nil, it defaults to \"\\n\". :success specifies a regexp matching a message indicating a successful STARTTLS negotiation. For instance, the default - should be \"^3\" for an NNTP connection. If this is not - supplied, STARTTLS will always fail. + should be \"^3\" for an NNTP connection. :capability-command specifies a command used to query the HOST for its capabilities. For instance, for IMAP this should be @@ -106,27 +108,24 @@ STARTTLS if the server supports STARTTLS, and nil otherwise." (let ((type (plist-get parameters :type)) (return-list (plist-get parameters :return-list))) - (if (and (null return-list) (memq type '(nil default))) - ;; The simplest case---no encryption, and no need to report - ;; connection properties. Like `open-network-stream', this - ;; doesn't read anything into BUFFER yet. + (if (and (not return-list) + (or (eq type 'plain) + (and (memq type '(nil network)) + (not (and (plist-get parameters :success) + (plist-get parameters :capability-command)))))) + ;; The simplest case is equivalent to `open-network-stream'. (open-network-stream name buffer host service) ;; For everything else, refer to proto-stream-open-*. (unless (plist-get parameters :end-of-command) - (setq parameters - (append '(:end-of-command "\r\n") parameters))) + (setq parameters (append '(:end-of-command "\r\n") parameters))) (let* ((connection-function (cond - ((memq type '(nil default)) - 'proto-stream-open-default) - ((memq type '(try-starttls starttls)) + ((eq type 'plain) 'proto-stream-open-plain) + ((memq type '(nil network starttls)) 'proto-stream-open-starttls) - ((memq type '(tls ssl)) - 'proto-stream-open-tls) - ((eq type 'shell) - 'proto-stream-open-shell) - (t - (error "Invalid connection type %s" type)))) + ((memq type '(tls ssl)) 'proto-stream-open-tls) + ((eq type 'shell) 'proto-stream-open-shell) + (t (error "Invalid connection type %s" type)))) (result (funcall connection-function name buffer host service parameters))) (if return-list @@ -136,19 +135,18 @@ :type (nth 3 result)) (car result)))))) -(defun proto-stream-open-default (name buffer host service parameters) +(defun proto-stream-open-plain (name buffer host service parameters) (let ((start (with-current-buffer buffer (point))) (stream (open-network-stream name buffer host service))) (list stream (proto-stream-get-response stream start (plist-get parameters :end-of-command)) nil - 'default))) + 'plain))) (defun proto-stream-open-starttls (name buffer host service parameters) (let* ((start (with-current-buffer buffer (point))) - ;; This should be `starttls' or `try-starttls'. - (type (plist-get parameters :type)) + (require-tls (eq (plist-get parameters :type) 'starttls)) (starttls-function (plist-get parameters :starttls-function)) (success-string (plist-get parameters :success)) (capability-command (plist-get parameters :capability-command)) @@ -159,7 +157,7 @@ (capabilities (when capability-command (proto-stream-command stream capability-command eoc))) - (resulting-type 'default) + (resulting-type 'plain) starttls-command) ;; If we have STARTTLS support, try to upgrade the connection. @@ -175,11 +173,11 @@ (setq start (with-current-buffer buffer (point-max))) (let* ((starttls-use-gnutls t) (starttls-extra-arguments - (if (not (eq type 'starttls)) - ;; For opportunistic TLS upgrades, we don't - ;; really care about the identity of the peer. - (cons "--insecure" starttls-extra-arguments) - starttls-extra-arguments))) + (if require-tls + starttls-extra-arguments + ;; For opportunistic TLS upgrades, we don't really + ;; care about the identity of the peer. + (cons "--insecure" starttls-extra-arguments)))) (setq stream (starttls-open-stream name buffer host service))) (proto-stream-get-response stream start eoc)) (when (string-match success-string @@ -193,7 +191,7 @@ (setq resulting-type 'tls) ;; We didn't successfully negotiate STARTTLS; if TLS ;; isn't demanded, reopen an unencrypted connection. - (when (eq type 'try-starttls) + (unless require-tls (setq stream (open-network-stream name buffer host service)) (proto-stream-get-response stream start eoc))) ;; Re-get the capabilities, which may have now changed. @@ -201,8 +199,8 @@ (proto-stream-command stream capability-command eoc)))) ;; If TLS is mandatory, close the connection if it's unencrypted. - (and (eq type 'starttls) - (eq resulting-type 'default) + (and require-tls + (eq resulting-type 'plain) (delete-process stream)) ;; Return value: (list stream greeting capabilities resulting-type))) @@ -237,7 +235,7 @@ name buffer host service)) (eoc (plist-get parameters :end-of-command))) (if (null stream) - (list nil nil nil 'default) + (list nil nil nil 'plain) ;; If we're using tls.el, we have to delete the output from ;; openssl/gnutls-cli. (unless (fboundp 'open-gnutls-stream) @@ -260,7 +258,7 @@ (format-spec-make ?s host ?p service)))) - parameters 'default)) + parameters 'plain)) (defun proto-stream-capability-open (start stream parameters stream-type) (let* ((capability-command (plist-get parameters :capability-command))