Using saved parent location: http://bzr.savannah.gnu.org/r/emacs/trunk/ Now on revision 102682. ------------------------------------------------------------ revno: 102682 committer: Chong Yidong branch nick: trunk timestamp: Fri 2010-12-17 12:04:06 +0800 message: Support for menu separators in the GTK tool-bar. * src/gtkutil.c (XG_BIN_CHILD): New macro. (xg_get_menu_item_label, xg_update_menubar) (xg_update_menu_item, xg_tool_bar_menu_proxy) (xg_show_toolbar_item, update_frame_tool_bar): Use it. (separator_names, xg_separator_p): Move to keyboard.c. (create_menus, xg_update_submenu, update_frame_tool_bar): Use menu_separator_name_p. * src/keyboard.c (parse_tool_bar_item): Allow menu separators in tool-bar maps. (menu_separator_name_p): New function, from gtkutil.c. (separator_names): Move from gtkutil.c. * src/keyboard.h (menu_separator_name_p): Add prototype. * src/nsmenu.m (name_is_separator): Function deleted. (addItemWithWidgetValue): Use menu_separator_name_p. * src/w32menu.c (name_is_separator): Function deleted. (add_menu_item): Use menu_separator_name_p. diff: === modified file 'etc/NEWS' --- etc/NEWS 2010-12-16 02:28:33 +0000 +++ etc/NEWS 2010-12-17 04:04:06 +0000 @@ -690,6 +690,11 @@ triplet, instead of signalling an error if the user provides a invalid input. +** Tool-bars can display separators. +Tool-bar separators are handled like menu separators in menu-bar maps, +i.e. with entries of the form `(menu-item "--")'. + +Currently, tool-bar separators are only displayed on GTK. ** Image API === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-12-16 02:35:56 +0000 +++ lisp/ChangeLog 2010-12-17 04:04:06 +0000 @@ -1,3 +1,9 @@ +2010-12-16 Chong Yidong + + * tool-bar.el (tool-bar-setup): Add separators. + + * menu-bar.el (featurep): Use menu-bar-separator. + 2010-12-16 Daiki Ueno * epa-file.el (epa-file-select-keys): Accept 'silent to inhibit === modified file 'lisp/menu-bar.el' --- lisp/menu-bar.el 2010-12-13 15:27:36 +0000 +++ lisp/menu-bar.el 2010-12-17 04:04:06 +0000 @@ -523,7 +523,8 @@ ,(purecopy "Cut (kill) text in region between mark and current position"))) ;; ns-win.el said: Separate undo from cut/paste section. (if (featurep 'ns) - (define-key menu-bar-edit-menu [separator-undo] `(,(purecopy "--")))) + (define-key menu-bar-edit-menu [separator-undo] menu-bar-separator)) + (define-key menu-bar-edit-menu [undo] `(menu-item ,(purecopy "Undo") undo :enable (and (not buffer-read-only) === modified file 'lisp/tool-bar.el' --- lisp/tool-bar.el 2010-11-21 18:29:08 +0000 +++ lisp/tool-bar.el 2010-12-17 04:04:06 +0000 @@ -257,23 +257,23 @@ ;;; Set up some global items. Additions/deletions up for grabs. (defun tool-bar-setup () - ;; People say it's bad to have EXIT on the tool bar, since users - ;; might inadvertently click that button. - ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") (tool-bar-add-item-from-menu 'find-file "new" nil :label "New File" :vert-only t) (tool-bar-add-item-from-menu 'menu-find-file-existing "open" nil - :vert-only t) + :label "Open" :vert-only t) (tool-bar-add-item-from-menu 'dired "diropen" nil :vert-only t) (tool-bar-add-item-from-menu 'kill-this-buffer "close" nil :vert-only t) (tool-bar-add-item-from-menu 'save-buffer "save" nil :vert-only t + :label "Save" :visible '(or buffer-file-name (not (eq 'special (get major-mode 'mode-class))))) + (define-key-after (default-value 'tool-bar-map) [separator-1] menu-bar-separator) (tool-bar-add-item-from-menu 'undo "undo" nil :vert-only t :visible '(not (eq 'special (get major-mode 'mode-class)))) + (define-key-after (default-value 'tool-bar-map) [separator-2] menu-bar-separator) (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut]) "cut" nil :vert-only t :visible '(not (eq 'special (get major-mode @@ -284,6 +284,7 @@ "paste" nil :vert-only t :visible '(not (eq 'special (get major-mode 'mode-class)))) + (define-key-after (default-value 'tool-bar-map) [separator-3] menu-bar-separator) (tool-bar-add-item-from-menu 'nonincremental-search-forward "search" nil :label "Search") ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell") === modified file 'src/ChangeLog' --- src/ChangeLog 2010-12-16 19:37:13 +0000 +++ src/ChangeLog 2010-12-17 04:04:06 +0000 @@ -1,3 +1,26 @@ +2010-12-17 Chong Yidong + + * keyboard.c (parse_tool_bar_item): Allow menu separators in + tool-bar maps. + (menu_separator_name_p): New function, from gtkutil.c. + (separator_names): Move from gtkutil.c. + + * keyboard.h (menu_separator_name_p): Add prototype. + + * gtkutil.c (XG_BIN_CHILD): New macro. + (xg_get_menu_item_label, xg_update_menubar) + (xg_update_menu_item, xg_tool_bar_menu_proxy) + (xg_show_toolbar_item, update_frame_tool_bar): Use it. + (separator_names, xg_separator_p): Move to keyboard.c. + (create_menus, xg_update_submenu, update_frame_tool_bar): Use + menu_separator_name_p. + + * nsmenu.m (name_is_separator): Function deleted. + (addItemWithWidgetValue): Use menu_separator_name_p. + + * w32menu.c (name_is_separator): Function deleted. + (add_menu_item): Use menu_separator_name_p. + 2010-12-16 Jan Djärv * nsterm.m (ns_draw_window_cursor): If the cursor color is the === modified file 'src/dispextern.h' --- src/dispextern.h 2010-12-13 15:27:36 +0000 +++ src/dispextern.h 2010-12-17 04:04:06 +0000 @@ -2881,7 +2881,8 @@ /* The binding. */ TOOL_BAR_ITEM_BINDING, - /* Button type. One of nil, `:radio' or `:toggle'. */ + /* Button type. One of nil (default button), t (a separator), + `:radio', or `:toggle'. The latter two currently do nothing. */ TOOL_BAR_ITEM_TYPE, /* Help string. */ === modified file 'src/gtkutil.c' --- src/gtkutil.c 2010-11-30 17:01:18 +0000 +++ src/gtkutil.c 2010-12-17 04:04:06 +0000 @@ -72,6 +72,8 @@ #define remove_submenu(w) gtk_menu_item_remove_submenu ((w)) #endif +#define XG_BIN_CHILD(x) gtk_bin_get_child (GTK_BIN (x)) + /*********************************************************************** Display handling functions @@ -2128,54 +2130,6 @@ return w; } -/* Return non-zero if LABEL specifies a separator (GTK only has one - separator type) */ - -static const char* separator_names[] = { - "space", - "no-line", - "single-line", - "double-line", - "single-dashed-line", - "double-dashed-line", - "shadow-etched-in", - "shadow-etched-out", - "shadow-etched-in-dash", - "shadow-etched-out-dash", - "shadow-double-etched-in", - "shadow-double-etched-out", - "shadow-double-etched-in-dash", - "shadow-double-etched-out-dash", - 0, -}; - -static int -xg_separator_p (const char *label) -{ - if (! label) return 0; - else if (strlen (label) > 3 - && strncmp (label, "--", 2) == 0 - && label[2] != '-') - { - int i; - - label += 2; - for (i = 0; separator_names[i]; ++i) - if (strcmp (label, separator_names[i]) == 0) - return 1; - } - else - { - /* Old-style separator, maybe. It's a separator if it contains - only dashes. */ - while (*label == '-') - ++label; - if (*label == 0) return 1; - } - - return 0; -} - static int xg_detached_menus; /* Returns non-zero if there are detached menus. */ @@ -2374,7 +2328,7 @@ GtkWidget *w; if (pop_up_p && !item->contents && !item->call_data - && !xg_separator_p (item->name)) + && !menu_separator_name_p (item->name)) { char *utf8_label; /* A title for a popup. We do the same as GTK does when @@ -2387,7 +2341,7 @@ gtk_widget_set_sensitive (w, FALSE); if (utf8_label) g_free (utf8_label); } - else if (xg_separator_p (item->name)) + else if (menu_separator_name_p (item->name)) { group = NULL; /* GTK only have one separator type. */ @@ -2499,7 +2453,7 @@ static const char * xg_get_menu_item_label (GtkMenuItem *witem) { - GtkLabel *wlabel = GTK_LABEL (gtk_bin_get_child (GTK_BIN (witem))); + GtkLabel *wlabel = GTK_LABEL (XG_BIN_CHILD (witem)); return gtk_label_get_label (wlabel); } @@ -2652,7 +2606,7 @@ Rename X to B (minibuf to C-mode menu). If the X menu hasn't been invoked, the menu under B is up to date when leaving the minibuffer. */ - GtkLabel *wlabel = GTK_LABEL (gtk_bin_get_child (GTK_BIN (witem))); + GtkLabel *wlabel = GTK_LABEL (XG_BIN_CHILD (witem)); char *utf8_label = get_utf8_string (val->name); GtkWidget *submenu = gtk_menu_item_get_submenu (witem); @@ -2751,7 +2705,7 @@ const char *old_key = 0; xg_menu_item_cb_data *cb_data; - wchild = gtk_bin_get_child (GTK_BIN (w)); + wchild = XG_BIN_CHILD (w); utf8_label = get_utf8_string (val->name); utf8_key = get_utf8_string (val->key); @@ -2910,7 +2864,7 @@ if (GTK_IS_SEPARATOR_MENU_ITEM (w)) { - if (! xg_separator_p (cur->name)) + if (! menu_separator_name_p (cur->name)) break; } else if (GTK_IS_CHECK_MENU_ITEM (w)) @@ -2933,7 +2887,7 @@ GtkWidget *sub; if (cur->button_type != BUTTON_TYPE_NONE || - xg_separator_p (cur->name)) + menu_separator_name_p (cur->name)) break; xg_update_menu_item (cur, w, select_cb, highlight_cb, cl_data); @@ -3725,9 +3679,8 @@ static gboolean xg_tool_bar_menu_proxy (GtkToolItem *toolitem, gpointer user_data) { - GtkWidget *weventbox = gtk_bin_get_child (GTK_BIN (toolitem)); - GtkButton *wbutton = GTK_BUTTON (gtk_bin_get_child (GTK_BIN (weventbox))); - GtkWidget *vb = gtk_bin_get_child (GTK_BIN (wbutton)); + GtkButton *wbutton = GTK_BUTTON (XG_BIN_CHILD (XG_BIN_CHILD (toolitem))); + GtkWidget *vb = XG_BIN_CHILD (wbutton); GtkWidget *c1; GtkLabel *wlbl = GTK_LABEL (xg_get_tool_bar_widgets (vb, &c1)); GtkImage *wimage = GTK_IMAGE (c1); @@ -4180,9 +4133,9 @@ int show_label = ! EQ (style, Qimage) && ! (vert_only && horiz); int show_image = ! EQ (style, Qtext); - GtkWidget *weventbox = gtk_bin_get_child (GTK_BIN (ti)); - GtkWidget *wbutton = gtk_bin_get_child (GTK_BIN (weventbox)); - GtkWidget *vb = gtk_bin_get_child (GTK_BIN (wbutton)); + GtkWidget *weventbox = XG_BIN_CHILD (ti); + GtkWidget *wbutton = XG_BIN_CHILD (weventbox); + GtkWidget *vb = XG_BIN_CHILD (wbutton); GtkWidget *wimage; GtkWidget *wlbl = xg_get_tool_bar_widgets (vb, &wimage); GtkWidget *new_box = NULL; @@ -4330,7 +4283,6 @@ char *icon_name = NULL; Lisp_Object rtl; GtkWidget *wbutton = NULL; - GtkWidget *weventbox; Lisp_Object specified_file; const char *label = (STRINGP (PROP (TOOL_BAR_ITEM_LABEL)) ? SSDATA (PROP (TOOL_BAR_ITEM_LABEL)) : ""); @@ -4338,16 +4290,34 @@ ti = gtk_toolbar_get_nth_item (GTK_TOOLBAR (wtoolbar), i); + /* If this is a separator, use a gtk separator item. */ + if (EQ (PROP (TOOL_BAR_ITEM_TYPE), Qt)) + { + if (ti == NULL || !GTK_IS_SEPARATOR_TOOL_ITEM (ti)) + { + if (ti) + gtk_container_remove (GTK_CONTAINER (wtoolbar), + GTK_WIDGET (ti)); + ti = gtk_separator_tool_item_new (); + gtk_toolbar_insert (GTK_TOOLBAR (wtoolbar), ti, i); + } + gtk_widget_show (GTK_WIDGET (ti)); + continue; + } + + /* Otherwise, the tool-bar item is an ordinary button. */ + + if (ti && GTK_IS_SEPARATOR_TOOL_ITEM (ti)) + { + gtk_container_remove (GTK_CONTAINER (wtoolbar), GTK_WIDGET (ti)); + ti = NULL; + } + if (ti) - { - weventbox = gtk_bin_get_child (GTK_BIN (ti)); - wbutton = gtk_bin_get_child (GTK_BIN (weventbox)); - } - - + wbutton = XG_BIN_CHILD (XG_BIN_CHILD (ti)); + + /* Ignore invalid image specifications. */ image = PROP (TOOL_BAR_ITEM_IMAGES); - - /* Ignore invalid image specifications. */ if (!valid_image_p (image)) { if (wbutton) gtk_widget_hide (wbutton); @@ -4426,7 +4396,7 @@ { /* Insert an empty (non-image) button */ ti = xg_make_tool_item (f, NULL, NULL, "", i, 0); - gtk_toolbar_insert (GTK_TOOLBAR (wtoolbar), ti, -1); + gtk_toolbar_insert (GTK_TOOLBAR (wtoolbar), ti, i); } continue; } @@ -4460,17 +4430,17 @@ gtk_misc_set_padding (GTK_MISC (w), hmargin, vmargin); ti = xg_make_tool_item (f, w, &wbutton, label, i, vert_only); - gtk_toolbar_insert (GTK_TOOLBAR (wtoolbar), ti, -1); + gtk_toolbar_insert (GTK_TOOLBAR (wtoolbar), ti, i); gtk_widget_set_sensitive (wbutton, enabled_p); } else { - GtkWidget *vb = gtk_bin_get_child (GTK_BIN (wbutton)); + GtkWidget *vb = XG_BIN_CHILD (wbutton); GtkWidget *wimage; GtkWidget *wlbl = xg_get_tool_bar_widgets (vb, &wimage); - Pixmap old_img = (Pixmap)g_object_get_data (G_OBJECT (wimage), - XG_TOOL_BAR_IMAGE_DATA); + Pixmap old_img = (Pixmap) g_object_get_data (G_OBJECT (wimage), + XG_TOOL_BAR_IMAGE_DATA); gpointer old_stock_name = g_object_get_data (G_OBJECT (wimage), XG_TOOL_BAR_STOCK_NAME); gpointer old_icon_name = g_object_get_data (G_OBJECT (wimage), === modified file 'src/keyboard.c' --- src/keyboard.c 2010-12-13 15:27:36 +0000 +++ src/keyboard.c 2010-12-17 04:04:06 +0000 @@ -7464,6 +7464,54 @@ static Lisp_Object menu_bar_items_vector; static int menu_bar_items_index; + +static const char* separator_names[] = { + "space", + "no-line", + "single-line", + "double-line", + "single-dashed-line", + "double-dashed-line", + "shadow-etched-in", + "shadow-etched-out", + "shadow-etched-in-dash", + "shadow-etched-out-dash", + "shadow-double-etched-in", + "shadow-double-etched-out", + "shadow-double-etched-in-dash", + "shadow-double-etched-out-dash", + 0, +}; + +/* Return non-zero if LABEL specifies a separator. */ + +int +menu_separator_name_p (const char *label) +{ + if (!label) + return 0; + else if (strlen (label) > 3 + && strncmp (label, "--", 2) == 0 + && label[2] != '-') + { + int i; + label += 2; + for (i = 0; separator_names[i]; ++i) + if (strcmp (label, separator_names[i]) == 0) + return 1; + } + else + { + /* It's a separator if it contains only dashes. */ + while (*label == '-') + ++label; + return (*label == 0); + } + + return 0; +} + + /* Return a vector of menu items for a menu bar, appropriate to the current buffer. Each item has three elements in the vector: KEY STRING MAPLIST. @@ -8201,10 +8249,14 @@ Rule out items that aren't lists, don't start with `menu-item' or whose rest following `tool-bar-item' is not a list. */ - if (!CONSP (item) - || !EQ (XCAR (item), Qmenu_item) - || (item = XCDR (item), - !CONSP (item))) + if (!CONSP (item)) + return 0; + + /* As an exception, allow old-style menu separators. */ + if (STRINGP (XCAR (item))) + item = Fcons (XCAR (item), Qnil); + else if (!EQ (XCAR (item), Qmenu_item) + || (item = XCDR (item), !CONSP (item))) return 0; /* Create tool_bar_item_properties vector if necessary. Reset it to @@ -8234,10 +8286,18 @@ } PROP (TOOL_BAR_ITEM_CAPTION) = caption; - /* Give up if rest following the caption is not a list. */ + /* If the rest following the caption is not a list, the menu item is + either a separator, or invalid. */ item = XCDR (item); if (!CONSP (item)) - return 0; + { + if (menu_separator_name_p (SDATA (caption))) + { + PROP (TOOL_BAR_ITEM_TYPE) = Qt; + return 1; + } + return 0; + } /* Store the binding. */ PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item); @@ -8270,10 +8330,10 @@ if (NILP (menu_item_eval_property (value))) return 0; } - else if (EQ (key, QChelp)) + else if (EQ (key, QChelp)) /* `:help HELP-STRING'. */ PROP (TOOL_BAR_ITEM_HELP) = value; - else if (EQ (key, QCvert_only)) + else if (EQ (key, QCvert_only)) /* `:vert-only t/nil'. */ PROP (TOOL_BAR_ITEM_VERT_ONLY) = value; else if (EQ (key, QClabel)) === modified file 'src/keyboard.h' --- src/keyboard.h 2010-11-18 16:57:00 +0000 +++ src/keyboard.h 2010-12-17 04:04:06 +0000 @@ -492,6 +492,7 @@ extern int timers_run; +extern int menu_separator_name_p (const char *); extern int parse_menu_item (Lisp_Object, int); extern void echo_now (void); === modified file 'src/nsmenu.m' --- src/nsmenu.m 2010-12-02 09:33:57 +0000 +++ src/nsmenu.m 2010-12-17 04:04:06 +0000 @@ -507,21 +507,6 @@ } -/* Utility (from macmenu.c): is this item a separator? */ -static int -name_is_separator ( const char *name) -{ - const char *start = name; - - /* Check if name string consists of only dashes ('-'). */ - while (*name == '-') name++; - /* Separators can also be of the form "--:TripleSuperMegaEtched" - or "--deep-shadow". We don't implement them yet, se we just treat - them like normal separators. */ - return (*name == '\0' || start + 2 == name); -} - - /* ========================================================================== Menu: class implementation @@ -624,7 +609,7 @@ NSMenuItem *item; widget_value *wv = (widget_value *)wvptr; - if (name_is_separator (wv->name)) + if (menu_separator_name_p (wv->name)) { item = [NSMenuItem separatorItem]; [self addItem: item]; === modified file 'src/w32menu.c' --- src/w32menu.c 2010-10-14 14:32:27 +0000 +++ src/w32menu.c 2010-12-17 04:04:06 +0000 @@ -1326,20 +1326,6 @@ #endif /* !HAVE_DIALOGS */ -/* Is this item a separator? */ -static int -name_is_separator (const char *name) -{ - const char *start = name; - - /* Check if name string consists of only dashes ('-'). */ - while (*name == '-') name++; - /* Separators can also be of the form "--:TripleSuperMegaEtched" - or "--deep-shadow". We don't implement them yet, se we just treat - them like normal separators. */ - return (*name == '\0' || start + 2 == name); -} - /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */ static void utf8to16 (unsigned char * src, int len, WCHAR * dest) @@ -1388,7 +1374,7 @@ int return_value; size_t nlen, orig_len; - if (name_is_separator (wv->name)) + if (menu_separator_name_p (wv->name)) { fuFlags = MF_SEPARATOR; out_string = NULL; === modified file 'src/xdisp.c' --- src/xdisp.c 2010-12-13 15:27:36 +0000 +++ src/xdisp.c 2010-12-17 04:04:06 +0000 @@ -10317,6 +10317,10 @@ int selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)); int hmargin, vmargin, relief, idx, end; + /* Ignore separator items. */ + if (EQ (PROP (TOOL_BAR_ITEM_TYPE), Qt)) + continue; + /* If image is a vector, choose the image according to the button state. */ image = PROP (TOOL_BAR_ITEM_IMAGES); ------------------------------------------------------------ revno: 102681 committer: Daiki Ueno branch nick: trunk timestamp: Fri 2010-12-17 10:43:03 +0900 message: Mention epa-file-select-keys in epa.texi. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-12-16 22:22:28 +0000 +++ doc/misc/ChangeLog 2010-12-17 01:43:03 +0000 @@ -1,3 +1,8 @@ +2010-12-17 Daiki Ueno + + * epa.texi (Encrypting/decrypting *.gpg files): Mention + epa-file-select-keys. + 2010-12-16 Lars Magne Ingebrigtsen * gnus.texi (Archived Messages): Remove outdated text. === modified file 'doc/misc/epa.texi' --- doc/misc/epa.texi 2010-10-25 12:24:44 +0000 +++ doc/misc/epa.texi 2010-12-17 01:43:03 +0000 @@ -353,16 +353,21 @@ @node Encrypting/decrypting *.gpg files @section Encrypting/decrypting *.gpg files -By default, every file whose extension is @samp{.gpg} will be treated -as encrypted. That is, when you attempt to open such a file which -already exists, the decrypted text is inserted in the buffer rather -than encrypted one. On the other hand, when you attempt to save the -buffer to a file whose extension is @samp{.gpg}, encrypted data is -written. - -If you want to temporarily disable this behavior, use @kbd{M-x -epa-file-disable}, and then to enable this behavior use @kbd{M-x -epa-file-enable}. +By default, every file whose name ends with @samp{.gpg} will be +treated as encrypted. That is, when you open such a file, the +decrypted text is inserted in the buffer rather than encrypted one. +Similarly, when you save the buffer to a @samp{foo.gpg} file, +encrypted data is written. + +The file name pattern for encrypted files can be controlled by +@var{epa-file-name-regexp}. + +@defvar epa-file-name-regexp +Regexp which matches filenames treated as encrypted. +@end defvar + +You can disable this behavior with @kbd{M-x epa-file-disable}, and +then get it back with @kbd{M-x epa-file-enable}. @deffn Command epa-file-disable Disable automatic encryption/decryption of *.gpg files. @@ -373,23 +378,48 @@ @end deffn @noindent -@code{epa-file} will let you select recipients. If you want to -suppress this question, it might be a good idea to put the following -line on the first line of the text being encrypted. +By default, @code{epa-file} will try to use symmetric encryption, aka +password-based encryption. If you want to use public key encryption +instead, do @kbd{M-x epa-file-select-keys}, which will pops up the key +selection dialog. + +@deffn Command epa-file-select-keys +Select recipient keys to encrypt the currently visiting file with +public key encryption. +@end deffn + +You can also change the default behavior with the variable +@var{epa-file-select-keys}. + +@defvar epa-file-select-keys +Control whether or not to pop up the key selection dialog. +@end defvar + +For frequently visited files, it might be a good idea to tell Emacs +which encryption method should be used through @xref{File Variables, , +, emacs, the Emacs Manual}. Use the @code{epa-file-encrypt-to} local +variable for this. @vindex epa-file-encrypt-to +For example, if you want an Elisp file should be encrypted with a +public key associated with an email address @samp{ueno@@unixuser.org}, +add the following line to the beginning of the file. + @cartouche @lisp ;; -*- epa-file-encrypt-to: ("ueno@@unixuser.org") -*- @end lisp @end cartouche -The file name extension of encrypted files can be controlled by -@var{epa-file-name-regexp}. +Instead, if you want the file always (regardless of the value of the +@code{epa-file-select-keys} variable) encrypted with symmetric +encryption, change the line as follows. -@defvar epa-file-name-regexp -Regexp which matches filenames treated as encrypted. -@end defvar +@cartouche +@lisp +;; -*- epa-file-encrypt-to: nil -*- +@end lisp +@end cartouche Other variables which control the automatic encryption/decryption behavior are below. ------------------------------------------------------------ revno: 102680 [merge] committer: Ken Manheimer branch nick: trunk timestamp: Thu 2010-12-16 18:30:57 -0500 message: Synopsis: Migrate allout encryption provisions from pgg library, which is obsolete, to epg library, which replaces pgg. Due to the underlying GnuPG V2 restrictions on external handling of passphrases (or epg's restrictions when working with GnuPG v2), we are dropping allout's symmetric encryption passphrase hinting and verification. This has the advantage that no emacs code has access to the passphrase, leaving all passphrase handling in GnuPG, which is much more secure. This, together with the reduction in allout code complexity and logistical complications the user would have in arranging to use GnuPG v1, requires dropping these features. Keypair encryption gains features, with adoption of respect for epa-file's 'epa-file-encrypt-to'. This means that allout outlines can be associated with recipients, and encryptions by default will be targeted to those recipients. The default encryption mode (whether to epa-file-encrypt-to recipients, if any, or symmetric mode) is overridden by providing a universal argument greater than 1 to the outline entry encryption command, 'allout-toggle-current-subtree-encryption'. The user is then prompted to select keypair identities from their list of known GnuPG keypairs. If they don't select any, then symmetric encryption is done. Otherwise, the selected keypair identities are targeted. If the universal argument is greater than 4 then the selected recipients (or none, if none were selected) are associated with the outline using a file local variable, as default recipients for subsequent encryptions. This is a big merge from a private branch. Code details: (allout-toggle-current-subtree-encryption, allout-toggle-subtree-encryption): Adjust docstrings to reflect defaulting policy and other changes. Change fetch-pass to keymode-cue, for simpler universal argument interpretation. (allout-toggle-subtree-encryption): Adjust docstring to describe changed encryption provisions. Change fetch-pass to keymode-cue, for simpler universal argument interpretation. Remove provisions for handling key type and identity - they'll all be within allout-encrypt-string or epg/epg or even contained all the way in gpg. (allout-encrypt-string): Include keymode-cue, for optionally prompting for keypair recipients (universal argument > 1) and, in addition, associating the specified recipients with the outline (universal argument > 4) using a file local variable setting for 'epa-file-encrypt-to'. Require epa, for recipients handling. Change how regexp filtering elements are named. Describe the problem with caching of incorrect symmetric-decryption keys. Use the epa-passphrase-callback-function, in case the user is using GnuPG v1. Support saving of the selected keypair recipients when invoked with a keymode-cue > 4. Remove obsolete arguments 'fetch-pass', 'target-cache-id', 'retried'. Require 'epa. Establish epg-context with armoring and default epg-protocol. Remove all passphrase cache, verification, and hinting code. (allout-passphrase-verifier-handling, allout-passphrase-hint-handling): No longer used, delete. (allout-mode): Adjust docstring to describe changed encryption provisions. Describe the problem with caching of incorrect symmetric-decryption keys. (allout-obtain-passphrase, allout-epg-passphrase-callback-function, allout-make-passphrase-state, allout-passphrase-state-passphrase, allout-encrypted-key-info, allout-update-passphrase-mnemonic-aids, allout-get-encryption-passphrase-verifier, allout-verify-passphrase): Obsolete, remove. diff: === modified file 'lisp/allout.el' --- lisp/allout.el 2010-12-16 22:33:13 +0000 +++ lisp/allout.el 2010-12-16 23:30:57 +0000 @@ -43,9 +43,8 @@ ;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase ;; mnemonic support, with verification against an established passphrase ;; (using a stashed encrypted dummy string) and user-supplied hint -;; maintenance. (See allout-toggle-current-subtree-encryption docstring. -;; Currently only GnuPG encryption is supported, and integration -;; with gpg-agent is not yet implemented.) +;; maintenance. Encryption is via the Emacs 'epg' library. See +;; allout-toggle-current-subtree-encryption docstring. ;; - Automatic topic-number maintenance ;; - "Hot-spot" operation, for single-keystroke maneuvering and ;; exposure control (see the allout-mode docstring) @@ -84,11 +83,10 @@ ;;;_* Dependency autoloads (require 'overlay) (eval-when-compile - ;; Most of the requires here are for stuff covered by autoloads. - ;; Since just byte-compiling doesn't trigger autoloads, so that - ;; "function not found" warnings would occur without these requires. - (require 'pgg) - (require 'pgg-gpg) + ;; Most of the requires here are for stuff covered by autoloads, which + ;; byte-compiling doesn't trigger. + (require 'epg) + (require 'epa) (require 'overlay) ;; `cl' is required for `assert'. `assert' is not covered by a standard ;; autoload, but it is a macro, so that eval-when-compile is sufficient @@ -818,32 +816,6 @@ :type '(choice (const nil) string) :version "22.1" :group 'allout-encryption) -;;;_ = allout-passphrase-verifier-handling -(defcustom allout-passphrase-verifier-handling t - "Enable use of symmetric encryption passphrase verifier if non-nil. - -See the docstring for the `allout-enable-file-variable-adjustment' -variable for details about allout ajustment of file variables." - :type 'boolean - :version "22.1" - :group 'allout-encryption) -(make-variable-buffer-local 'allout-passphrase-verifier-handling) -;;;_ = allout-passphrase-hint-handling -(defcustom allout-passphrase-hint-handling 'always - "Dictate outline encryption passphrase reminder handling: - - always -- always show reminder when prompting - needed -- show reminder on passphrase entry failure - disabled -- never present or adjust reminder - -See the docstring for the `allout-enable-file-variable-adjustment' -variable for details about allout ajustment of file variables." - :type '(choice (const always) - (const needed) - (const disabled)) - :version "22.1" - :group 'allout-encryption) -(make-variable-buffer-local 'allout-passphrase-hint-handling) ;;;_ = allout-encrypt-unencrypted-on-saves (defcustom allout-encrypt-unencrypted-on-saves t "When saving, should topics pending encryption be encrypted? @@ -1554,6 +1526,8 @@ the Emacs buffer state, if file variable adjustments are enabled. See `allout-enable-file-variable-adjustment' for details about that.") (make-variable-buffer-local 'allout-passphrase-verifier-string) +(make-obsolete 'allout-passphrase-verifier-string + 'allout-passphrase-verifier-string "23.3") ;;;###autoload (put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp) ;;;_ = allout-passphrase-hint-string @@ -1568,6 +1542,8 @@ `allout-enable-file-variable-adjustment' for details about that.") (make-variable-buffer-local 'allout-passphrase-hint-string) (setq-default allout-passphrase-hint-string "") +(make-obsolete 'allout-passphrase-hint-string + 'allout-passphrase-hint-string "23.3") ;;;###autoload (put 'allout-passphrase-hint-string 'safe-local-variable 'stringp) ;;;_ = allout-after-save-decrypt @@ -1599,15 +1575,15 @@ (defvar allout-encryption-ciphertext-rejection-regexps nil "Variable for regexps matching plaintext to remove before encryption. -This is for the sake of redoing encryption in cases where the ciphertext -incidentally contains strings that would disrupt mode operation -- -for example, a line that happens to look like an allout-mode topic prefix. +This is used to detect strings in encryption results that would +register as allout mode structural elements, for exmple, as a +topic prefix. Entries must be symbols that are bound to the desired regexp values. -The encryption will be retried up to -`allout-encryption-ciphertext-rejection-limit' times, after which an error -is raised.") +Encryptions that result in matches will be retried, up to +`allout-encryption-ciphertext-rejection-limit' times, after which +an error is raised.") (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps) ;;;_ = allout-encryption-ciphertext-rejection-ceiling @@ -1937,19 +1913,22 @@ Topic Encryption Outline mode supports gpg encryption of topics, with support for -symmetric and key-pair modes, passphrase timeout, passphrase -consistency checking, user-provided hinting for symmetric key -mode, and auto-encryption of topics pending encryption on save. +symmetric and key-pair modes, and auto-encryption of topics +pending encryption on save. Topics pending encryption are, by default, automatically -encrypted during file saves. If the contents of the topic -containing the cursor was encrypted for a save, it is -automatically decrypted for continued editing. +encrypted during file saves, including checkpoint saves, to avoid +exposing the plain text of encrypted topics in the file system. +If the content of the topic containing the cursor was encrypted +for a save, it is automatically decrypted for continued editing. -The aim of these measures is reliable topic privacy while -preventing accidents like neglected encryption before saves, -forgetting which passphrase was used, and other practical -pitfalls. +PROBLEM: Attempting symmetric decryption with an incorrect key +not only fails, but for some GnuPG v2 versions the incorrect key +is apparently retained in the gpg cache and reused, preventing +decryption, until the cache finally times out. That can take +several minutes. \(Decryption of other entries is not affected.) +To clear this problem before the cache times out, deliberately +clear your gpg-agent's cache by sending it a '-HUP' signal. See `allout-toggle-current-subtree-encryption' function docstring and `allout-encrypt-unencrypted-on-saves' customization variable @@ -5999,31 +5978,39 @@ (goto-char start-pt))) ;;;_ #8 Encryption -;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-pass) -(defun allout-toggle-current-subtree-encryption (&optional fetch-pass) - "Encrypt clear or decrypt encoded text of visibly-containing topic's contents. - -Optional FETCH-PASS universal argument provokes key-pair encryption with -single universal argument. With doubled universal argument (value = 16), -it forces prompting for the passphrase regardless of availability from the -passphrase cache. With no universal argument, the appropriate passphrase -is obtained from the cache, if available, else from the user. - -Only GnuPG encryption is supported. - -\*NOTE WELL* that the encrypted text must be ascii-armored. For gnupg -encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file. - -Both symmetric-key and key-pair encryption is implemented. Symmetric is -the default, use a single (x4) universal argument for keypair mode. - -Encrypted topic's bullet is set to a `~' to signal that the contents of the -topic (body and subtopics, but not heading) is pending encryption or -encrypted. `*' asterisk immediately after the bullet signals that the body -is encrypted, its' absence means the topic is meant to be encrypted but is -not. When a file with topics pending encryption is saved, topics pending -encryption are encrypted. See allout-encrypt-unencrypted-on-saves for -auto-encryption specifics. +;;;_ > allout-toggle-current-subtree-encryption (&optional keymode-cue) +(defun allout-toggle-current-subtree-encryption (&optional keymode-cue) + "Encrypt clear or decrypt encoded topic text. + +Allout uses emacs 'epg' libary to perform encryption. Symmetric +and keypair encryption are supported. All encryption is ascii +armored. + +Entry encryption defaults to symmetric key mode unless keypair +recipients are associated with the file \(see +`epa-file-encrypt-to') or the function is invoked with a +\(KEYMODE-CUE) universal argument greater than 1. + +When encrypting, KEYMODE-CUE universal argument greater than 1 +causes prompting for recipients for public-key keypair +encryption. Selecting no recipients results in symmetric key +encryption. + +Further, encrypting with a KEYMODE-CUE universal argument greater +than 4 - eg, preceded by a doubled Ctrl-U - causes association of +the specified recipients with the file, replacing those currently +associated with it. This can be used to deassociate any +recipients with the file, by selecting no recipients in the +dialog. + +Encrypted topic's bullets are set to a `~' to signal that the +contents of the topic (body and subtopics, but not heading) is +pending encryption or encrypted. `*' asterisk immediately after +the bullet signals that the body is encrypted, its absence means +the topic is meant to be encrypted but is not currently. When a +file with topics pending encryption is saved, topics pending +encryption are encrypted. See allout-encrypt-unencrypted-on-saves +for auto-encryption specifics. \*NOTE WELL* that automatic encryption that happens during saves will default to symmetric encryption -- you must deliberately (re)encrypt key-pair @@ -6031,59 +6018,35 @@ Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be encrypted. If you want to encrypt the contents of a top-level topic, use -\\[allout-shift-in] to increase its depth. - - Passphrase Caching - -The encryption passphrase is solicited if not currently available in the -passphrase cache from a recent encryption action. - -The solicited passphrase is retained for reuse in a cache, if enabled. See -`pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' for details. - - Symmetric Passphrase Hinting and Verification - -If the file previously had no associated passphrase, or had a different -passphrase than specified, the user is prompted to repeat the new one for -corroboration. A random string encrypted by the new passphrase is set on -the buffer-specific variable `allout-passphrase-verifier-string', for -confirmation of the passphrase when next obtained, before encrypting or -decrypting anything with it. This helps avoid mistakenly shifting between -keys. - -If allout customization var `allout-passphrase-verifier-handling' is -non-nil, an entry for `allout-passphrase-verifier-string' and its value is -added to an Emacs 'local variables' section at the end of the file, which -is created if necessary. That setting is for retention of the passphrase -verifier across Emacs sessions. - -Similarly, `allout-passphrase-hint-string' stores a user-provided reminder -about their passphrase, and `allout-passphrase-hint-handling' specifies -when the hint is presented, or if passphrase hints are disabled. If -enabled (see the `allout-passphrase-hint-handling' docstring for details), -the hint string is stored in the local-variables section of the file, and -solicited whenever the passphrase is changed." +\\[allout-shift-in] to increase its depth." (interactive "P") (save-excursion (allout-back-to-current-heading) - (allout-toggle-subtree-encryption fetch-pass) - ) - ) -;;;_ > allout-toggle-subtree-encryption (&optional fetch-pass) -(defun allout-toggle-subtree-encryption (&optional fetch-pass) + (allout-toggle-subtree-encryption keymode-cue))) +;;;_ > allout-toggle-subtree-encryption (&optional keymode-cue) +(defun allout-toggle-subtree-encryption (&optional keymode-cue) "Encrypt clear text or decrypt encoded topic contents (body and subtopics.) -Optional FETCH-PASS universal argument provokes key-pair encryption with -single universal argument. With doubled universal argument (value = 16), -it forces prompting for the passphrase regardless of availability from the -passphrase cache. With no universal argument, the appropriate passphrase -is obtained from the cache, if available, else from the user. - -Currently only GnuPG encryption is supported, and integration -with gpg-agent is not yet implemented. - -\**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg -encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file. +Entry encryption defaults to symmetric key mode unless keypair +recipients are associated with the file \(see +`epa-file-encrypt-to') or the function is invoked with a +\(KEYMODE-CUE) universal argument greater than 1. + +When encrypting, KEYMODE-CUE universal argument greater than 1 +causes prompting for recipients for public-key keypair +encryption. Selecting no recipients results in symmetric key +encryption. + +Further, encrypting with a KEYMODE-CUE universal argument greater +than 4 - eg, preceded by a doubled Ctrl-U - causes association of +the specified recipients with the file, replacing those currently +associated with it. This can be used to deassociate any +recipients with the file, by selecting no recipients in the +dialog. + +Encryption and decryption uses the emacs epg library. + +Encrypted text will be ascii-armored. See `allout-toggle-current-subtree-encryption' for more details." @@ -6121,16 +6084,6 @@ (if was-encrypted "de" "en")) nil)) ;; Assess key parameters: - (key-info (or - ;; detect the type by which it is already encrypted - (and was-encrypted - (allout-encrypted-key-info subject-text)) - (and (member fetch-pass '(4 (4))) - '(keypair nil)) - '(symmetric nil))) - (for-key-type (car key-info)) - (for-key-identity (cadr key-info)) - (fetch-pass (and fetch-pass (member fetch-pass '(16 (16))))) (was-coding-system buffer-file-coding-system)) (when (not was-encrypted) @@ -6156,8 +6109,7 @@ (setq result-text (allout-encrypt-string subject-text was-encrypted - (current-buffer) - for-key-type for-key-identity fetch-pass)) + (current-buffer) keymode-cue)) ;; Replace the subtree with the processed product. (allout-unprotected @@ -6188,335 +6140,172 @@ (insert "*")))) (run-hook-with-args 'allout-structure-added-hook bullet-pos subtree-end)))) -;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type for-key -;;; fetch-pass &optional retried verifying -;;; passphrase) -(defun allout-encrypt-string (text decrypt allout-buffer key-type for-key - fetch-pass &optional retried rejected - verifying passphrase) +;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue +;;; &optional rejected) +(defun allout-encrypt-string (text decrypt allout-buffer keymode-cue + &optional rejected) "Encrypt or decrypt message TEXT. +Returns the resulting string, or nil if the transformation fails. + If DECRYPT is true (default false), then decrypt instead of encrypt. -FETCH-PASS (default false) forces fresh prompting for the passphrase. - -KEY-TYPE, either `symmetric' or `keypair', specifies which type -of cypher to use. - -FOR-KEY is human readable identification of the first of the user's -eligible secret keys a keypair decryption targets, or else nil. - -Optional RETRIED is for internal use -- conveys the number of failed keys -that have been solicited in sequence leading to this current call. - -Optional PASSPHRASE enables explicit delivery of the decryption passphrase, -for verification purposes. - -Optional REJECTED is for internal use -- conveys the number of +ALLOUT-BUFFER identifies the buffer containing the text. + +Entry encryption defaults to symmetric key mode unless keypair +recipients are associated with the file \(see +`epa-file-encrypt-to') or the function is invoked with a +\(KEYMODE-CUE) universal argument greater than 1. + +When encrypting, KEYMODE-CUE universal argument greater than 1 +causes prompting for recipients for public-key keypair +encryption. Selecting no recipients results in symmetric key +encryption. + +Further, encrypting with a KEYMODE-CUE universal argument greater +than 4 - eg, preceded by a doubled Ctrl-U - causes association of +the specified recipients with the file, replacing those currently +associated with it. This can be used to deassociate any +recipients with the file, by selecting no recipients in the +dialog. + +Optional REJECTED is for internal use, to convey the number of rejections due to matches against `allout-encryption-ciphertext-rejection-regexps', as limited by `allout-encryption-ciphertext-rejection-ceiling'. -Returns the resulting string, or nil if the transformation fails." - - (require 'pgg) - - (if (not (fboundp 'pgg-encrypt-symmetric)) - (error "Allout encryption depends on a newer version of pgg")) - - (let* ((scheme (upcase - (format "%s" (or pgg-scheme pgg-default-scheme "GPG")))) - (for-key (and (equal key-type 'keypair) - (or for-key - (split-string (read-string - (format "%s message recipients: " - scheme)) - "[ \t,]+")))) - (target-prompt-id (if (equal key-type 'keypair) - (if (= (length for-key) 1) - (car for-key) for-key) - (buffer-name allout-buffer))) - (target-cache-id (format "%s-%s" - key-type - (if (equal key-type 'keypair) - target-prompt-id - (or (buffer-file-name allout-buffer) - target-prompt-id)))) +PROBLEM: Attempting symmetric decryption with an incorrect key +not only fails, but for some GnuPG v2 versions the incorrect key +is apparently retained in the gpg cache and reused, preventing +decryption, until the cache finally times out. That can take +several minutes. \(Decryption of other entries is not affected.) +To clear this problem before the cache times out, deliberately +clear your gpg-agent's cache by sending it a '-HUP' signal." + + (require 'epg) + (require 'epa) + + (let* ((epg-context (let* ((context (epg-make-context nil t))) + (epg-context-set-passphrase-callback + context #'epa-passphrase-callback-function) + context)) (encoding (with-current-buffer allout-buffer buffer-file-coding-system)) (multibyte (with-current-buffer allout-buffer - enable-multibyte-characters)) - (strip-plaintext-regexps - (if (not decrypt) - (allout-get-configvar-values - 'allout-encryption-plaintext-sanitization-regexps))) - (reject-ciphertext-regexps - (if (not decrypt) - (allout-get-configvar-values - 'allout-encryption-ciphertext-rejection-regexps))) + enable-multibyte-characters)) + ;; "sanitization" avoids encryption results that are outline structure. + (sani-regexps 'allout-encryption-plaintext-sanitization-regexps) + (strip-plaintext-regexps (if (not decrypt) + (allout-get-configvar-values + sani-regexps))) + (rejection-regexps 'allout-encryption-ciphertext-rejection-regexps) + (reject-ciphertext-regexps (if (not decrypt) + (allout-get-configvar-values + rejection-regexps))) (rejected (or rejected 0)) (rejections-left (- allout-encryption-ciphertext-rejection-ceiling rejected)) - result-text status + (keypair-mode (cond (decrypt 'decrypting) + ((<= (prefix-numeric-value keymode-cue) 1) + 'default) + ((<= (prefix-numeric-value keymode-cue) 4) + 'prompt) + ((> (prefix-numeric-value keymode-cue) 4) + 'prompt-save))) + (keypair-message (concat "Select encryption recipients.\n" + "Symmetric encryption is done if no" + " recipients are selected. ")) + (encrypt-to (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to)) + recipients + massaged-text + result-text ) - (if (and fetch-pass (not passphrase)) - ;; Force later fetch by evicting passphrase from the cache. - (pgg-remove-passphrase-from-cache target-cache-id t)) - - (catch 'encryption-failed - - ;; We handle only symmetric-key passphrase caching. - (if (and (not passphrase) - (not (equal key-type 'keypair))) - (setq passphrase (allout-obtain-passphrase for-key - target-cache-id - target-prompt-id - key-type - allout-buffer - retried fetch-pass))) - - (with-temp-buffer - - (insert text) - - ;; convey the text characteristics of the original buffer: - (allout-set-buffer-multibyte multibyte) - (when encoding - (set-buffer-file-coding-system encoding) - (if (not decrypt) - (encode-coding-region (point-min) (point-max) encoding))) - - (when (and strip-plaintext-regexps (not decrypt)) - (dolist (re strip-plaintext-regexps) - (let ((re (if (listp re) (car re) re)) - (replacement (if (listp re) (cadr re) ""))) - (goto-char (point-min)) - (save-match-data - (while (re-search-forward re nil t) - (replace-match replacement nil nil)))))) - - (cond - - ;; symmetric: - ((equal key-type 'symmetric) - (setq status - (if decrypt - - (pgg-decrypt (point-min) (point-max) passphrase) - - (pgg-encrypt-symmetric (point-min) (point-max) - passphrase))) - - (if status - (pgg-situate-output (point-min) (point-max)) - ;; failed -- handle passphrase caching - (if verifying - (throw 'encryption-failed nil) - (pgg-remove-passphrase-from-cache target-cache-id t) - (error "Symmetric-cipher %scryption failed -- %s" - (if decrypt "de" "en") - "try again with different passphrase")))) - - ;; encrypt `keypair': - ((not decrypt) - - (setq status - - (pgg-encrypt for-key - nil (point-min) (point-max) passphrase)) - - (if status - (pgg-situate-output (point-min) (point-max)) - (error (pgg-remove-passphrase-from-cache target-cache-id t) - (error "encryption failed")))) - - ;; decrypt `keypair': - (t - - (setq status - (pgg-decrypt (point-min) (point-max) passphrase)) - - (if status - (pgg-situate-output (point-min) (point-max)) - (error (pgg-remove-passphrase-from-cache target-cache-id t) - (error "decryption failed"))))) - - (setq result-text - (buffer-substring-no-properties - 1 (- (point-max) (if decrypt 0 1)))) - ) - - ;; validate result -- non-empty - (cond ((not result-text) - (if verifying - nil - ;; transform was fruitless, retry w/new passphrase. - (pgg-remove-passphrase-from-cache target-cache-id t) - (allout-encrypt-string text decrypt allout-buffer - key-type for-key nil - (if retried (1+ retried) 1) - rejected verifying nil))) - - ;; Retry (within limit) if ciphertext contains rejections: - ((and (not decrypt) - ;; Check for disqualification of this ciphertext: - (let ((regexps reject-ciphertext-regexps) - reject-it) - (while (and regexps (not reject-it)) - (setq reject-it (string-match (car regexps) - result-text)) - (pop regexps)) - reject-it)) - (setq rejections-left (1- rejections-left)) - (if (<= rejections-left 0) - (error (concat "Ciphertext rejected too many times" - " (%s), per `%s'") - allout-encryption-ciphertext-rejection-ceiling - 'allout-encryption-ciphertext-rejection-regexps) - (allout-encrypt-string text decrypt allout-buffer - key-type for-key nil - retried (1+ rejected) - verifying passphrase))) - ;; Barf if encryption yields extraordinary control chars: - ((and (not decrypt) - (string-match "[\C-a\C-k\C-o-\C-z\C-@]" - result-text)) - (error (concat "Encryption produced non-armored text, which" - "conflicts with allout mode -- reconfigure!"))) - - ;; valid result and just verifying or non-symmetric: - ((or verifying (not (equal key-type 'symmetric))) - (if (or verifying decrypt) - (pgg-add-passphrase-to-cache target-cache-id - passphrase t)) - result-text) - - ;; valid result and regular symmetric -- "register" - ;; passphrase with mnemonic aids/cache. - (t - (set-buffer allout-buffer) - (if passphrase - (pgg-add-passphrase-to-cache target-cache-id - passphrase t)) - (allout-update-passphrase-mnemonic-aids for-key passphrase - allout-buffer) - result-text) - ) - ) - ) - ) -;;;_ > allout-obtain-passphrase (for-key cache-id prompt-id key-type -;;; allout-buffer retried fetch-pass) -(defun allout-obtain-passphrase (for-key cache-id prompt-id key-type - allout-buffer retried fetch-pass) - "Obtain passphrase for a key from the cache or else from the user. - -When obtaining from the user, symmetric-cipher passphrases are verified -against either, if available and enabled, a random string that was -encrypted against the passphrase, or else against repeated entry by the -user for corroboration. - -FOR-KEY is the key for which the passphrase is being obtained. - -CACHE-ID is the cache id of the key for the passphrase. - -PROMPT-ID is the id for use when prompting the user. - -KEY-TYPE is either `symmetric' or `keypair'. - -ALLOUT-BUFFER is the buffer containing the entry being en/decrypted. - -RETRIED is the number of this attempt to obtain this passphrase. - -FETCH-PASS causes the passphrase to be solicited from the user, regardless -of the availability of a cached copy." - - (if (not (equal key-type 'symmetric)) - ;; do regular passphrase read on non-symmetric passphrase: - (pgg-read-passphrase (format "%s passphrase%s: " - (upcase (format "%s" (or pgg-scheme - pgg-default-scheme - "GPG"))) - (if prompt-id - (format " for %s" prompt-id) - "")) - cache-id t) - - ;; Symmetric hereon: - - (with-current-buffer allout-buffer - (let* ((hint (if (and (not (string= allout-passphrase-hint-string "")) - (or (equal allout-passphrase-hint-handling 'always) - (and (equal allout-passphrase-hint-handling - 'needed) - retried))) - (format " [%s]" allout-passphrase-hint-string) - "")) - (retry-message (if retried (format " (%s retry)" retried) "")) - (prompt-sans-hint (format "'%s' symmetric passphrase%s: " - prompt-id retry-message)) - (full-prompt (format "'%s' symmetric passphrase%s%s: " - prompt-id hint retry-message)) - (prompt full-prompt) - (verifier-string (allout-get-encryption-passphrase-verifier)) - - (cached (and (not fetch-pass) - (pgg-read-passphrase-from-cache cache-id t))) - (got-pass (or cached - (pgg-read-passphrase full-prompt cache-id t))) - confirmation) - - (if (not got-pass) - nil - - ;; Duplicate our handle on the passphrase so it's not clobbered by - ;; deactivate-passwd memory clearing: - (setq got-pass (copy-sequence got-pass)) - - (cond (verifier-string - (save-window-excursion - (if (allout-encrypt-string verifier-string 'decrypt - allout-buffer 'symmetric - for-key nil 0 0 'verifying - (copy-sequence got-pass)) - (setq confirmation (format "%s" got-pass)))) - - (if (and (not confirmation) - (if (yes-or-no-p - (concat "Passphrase differs from established" - " -- use new one instead? ")) - ;; deactivate password for subsequent - ;; confirmation: - (progn - (pgg-remove-passphrase-from-cache cache-id t) - (setq prompt prompt-sans-hint) - nil) - t)) - (progn (pgg-remove-passphrase-from-cache cache-id t) - (error "Wrong passphrase")))) - ;; No verifier string -- force confirmation by repetition of - ;; (new) passphrase: - ((or fetch-pass (not cached)) - (pgg-remove-passphrase-from-cache cache-id t)))) - ;; confirmation vs new input -- doing pgg-read-passphrase will do the - ;; right thing, in either case: - (if (not confirmation) - (setq confirmation - (pgg-read-passphrase (concat prompt - " ... confirm spelling: ") - cache-id t))) - (prog1 - (if (equal got-pass confirmation) - confirmation - (if (yes-or-no-p (concat "spelling of original and" - " confirmation differ -- retry? ")) - (progn (setq retried (if retried (1+ retried) 1)) - (pgg-remove-passphrase-from-cache cache-id t) - ;; recurse to this routine: - (pgg-read-passphrase prompt-sans-hint cache-id t)) - (pgg-remove-passphrase-from-cache cache-id t) - (error "Confirmation failed")))))))) + ;; Massage the subject text for encoding and filtering. + (with-temp-buffer + (insert text) + ;; convey the text characteristics of the original buffer: + (allout-set-buffer-multibyte multibyte) + (when encoding + (set-buffer-file-coding-system encoding) + (if (not decrypt) + (encode-coding-region (point-min) (point-max) encoding))) + + ;; remove sanitization regexps matches before encrypting: + (when (and strip-plaintext-regexps (not decrypt)) + (dolist (re strip-plaintext-regexps) + (let ((re (if (listp re) (car re) re)) + (replacement (if (listp re) (cadr re) ""))) + (goto-char (point-min)) + (save-match-data + (while (re-search-forward re nil t) + (replace-match replacement nil nil)))))) + (setq massaged-text (buffer-substring-no-properties (point-min) + (point-max)))) + ;; determine key mode and, if keypair, recipients: + (setq recipients + (case keypair-mode + + (decrypting nil) + + (default (if encrypt-to (epg-list-keys epg-context encrypt-to))) + + ((prompt prompt-save) + (save-window-excursion + (epa-select-keys epg-context keypair-message))))) + + (setq result-text + (if decrypt + (epg-decrypt-string epg-context + (encode-coding-string massaged-text + (or encoding 'utf-8))) + (epg-encrypt-string epg-context + (encode-coding-string massaged-text + (or encoding 'utf-8)) + recipients))) + + ;; validate result -- non-empty + (if (not result-text) + (error "%scryption failed." (if decrypt "De" "En"))) + + + (when (eq keypair-mode 'prompt-save) + ;; set epa-file-encrypt-to in the buffer: + (setq epa-file-encrypt-to (mapcar (lambda (key) + (epg-user-id-string + (car (epg-key-user-id-list key)))) + recipients)) + ;; change the file variable: + (allout-adjust-file-variable "epa-file-encrypt-to" epa-file-encrypt-to)) + + (cond + ;; Retry (within limit) if ciphertext contains rejections: + ((and (not decrypt) + ;; Check for disqualification of this ciphertext: + (let ((regexps reject-ciphertext-regexps) + reject-it) + (while (and regexps (not reject-it)) + (setq reject-it (string-match (car regexps) result-text)) + (pop regexps)) + reject-it)) + (setq rejections-left (1- rejections-left)) + (if (<= rejections-left 0) + (error (concat "Ciphertext rejected too many times" + " (%s), per `%s'") + allout-encryption-ciphertext-rejection-ceiling + 'allout-encryption-ciphertext-rejection-regexps) + ;; try again (gpg-agent may have the key cached): + (allout-encrypt-string text decrypt allout-buffer keypair-mode + (1+ rejected)))) + + ;; Barf if encryption yields extraordinary control chars: + ((and (not decrypt) + (string-match "[\C-a\C-k\C-o-\C-z\C-@]" + result-text)) + (error (concat "Encryption produced non-armored text, which" + "conflicts with allout mode -- reconfigure!"))) + + (t result-text)))) ;;;_ > allout-encrypted-topic-p () (defun allout-encrypted-topic-p () "True if the current topic is encryptable and encrypted." @@ -6527,129 +6316,6 @@ (save-match-data (looking-at "\\*"))) ) ) -;;;_ > allout-encrypted-key-info (text) -;; XXX gpg-specific, alas -(defun allout-encrypted-key-info (text) - "Return a pair of the key type and identity of a recipient's secret key. - -The key type is one of `symmetric' or `keypair'. - -If `keypair', and some of the user's secret keys are among those for which -the message was encoded, return the identity of the first. Otherwise, -return nil for the second item of the pair. - -An error is raised if the text is not encrypted." - (require 'pgg-parse) - (save-excursion - (with-temp-buffer - (insert text) - (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max))) - ;; pgg-gpg-symmetric-key-p has lost track. - (type (if (assq 'symmetric-key-algorithm (car (cdr parsed-armor))) - 'symmetric - 'keypair)) - secret-keys first-secret-key for-key-owner) - (if (equal type 'keypair) - (setq secret-keys (pgg-gpg-lookup-all-secret-keys) - first-secret-key (pgg-gpg-select-matching-key parsed-armor - secret-keys) - for-key-owner (and first-secret-key - (pgg-gpg-lookup-key-owner - first-secret-key)))) - (list type (pgg-gpg-key-id-from-key-owner for-key-owner)) - ) - ) - ) - ) -;;;_ > allout-create-encryption-passphrase-verifier (passphrase) -(defun allout-create-encryption-passphrase-verifier (passphrase) - "Encrypt random message for later validation of symmetric key's passphrase." - ;; use 20 random ascii characters, across the entire ascii range. - (random t) - (let ((spew (make-string 20 ?\0))) - (dotimes (i (length spew)) - (aset spew i (1+ (random 254)))) - (allout-encrypt-string spew nil (current-buffer) 'symmetric - nil nil 0 0 passphrase)) - ) -;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase -;;; outline-buffer) -(defun allout-update-passphrase-mnemonic-aids (for-key passphrase - outline-buffer) - "Update passphrase verifier and hint strings if necessary. - -See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string' -settings. - -PASSPHRASE is the passphrase being mnemonicized. - -OUTLINE-BUFFER is the buffer of the outline being adjusted. - -These are used to help the user keep track of the passphrase they use for -symmetric encryption in the file. - -Behavior is governed by `allout-passphrase-verifier-handling', -`allout-passphrase-hint-handling', and also, controlling whether the values -are preserved on Emacs local file variables, -`allout-enable-file-variable-adjustment'." - - ;; If passphrase doesn't agree with current verifier: - ;; - adjust the verifier - ;; - if passphrase hint handling is enabled, adjust the passphrase hint - ;; - if file var settings are enabled, adjust the file vars - - (let* ((new-verifier-needed (not (allout-verify-passphrase - for-key passphrase outline-buffer))) - (new-verifier-string - (if new-verifier-needed - ;; Collapse to a single line and enclose in string quotes: - (subst-char-in-string - ?\n ?\C-a (allout-create-encryption-passphrase-verifier - passphrase)))) - new-hint) - (when new-verifier-string - ;; do the passphrase hint first, since it's interactive - (when (and allout-passphrase-hint-handling - (not (equal allout-passphrase-hint-handling 'disabled))) - (setq new-hint - (read-from-minibuffer "Passphrase hint to jog your memory: " - allout-passphrase-hint-string)) - (when (not (string= new-hint allout-passphrase-hint-string)) - (setq allout-passphrase-hint-string new-hint) - (allout-adjust-file-variable "allout-passphrase-hint-string" - allout-passphrase-hint-string))) - (when allout-passphrase-verifier-handling - (setq allout-passphrase-verifier-string new-verifier-string) - (allout-adjust-file-variable "allout-passphrase-verifier-string" - allout-passphrase-verifier-string)) - ) - ) - ) -;;;_ > allout-get-encryption-passphrase-verifier () -(defun allout-get-encryption-passphrase-verifier () - "Return text of the encrypt passphrase verifier, unmassaged, or nil if none. - -Derived from value of `allout-passphrase-verifier-string'." - - (let ((verifier-string (and (boundp 'allout-passphrase-verifier-string) - allout-passphrase-verifier-string))) - (if verifier-string - ;; Return it uncollapsed - (subst-char-in-string ?\C-a ?\n verifier-string)) - ) - ) -;;;_ > allout-verify-passphrase (key passphrase allout-buffer) -(defun allout-verify-passphrase (key passphrase allout-buffer) - "True if passphrase successfully decrypts verifier, nil otherwise. - -\"Otherwise\" includes absence of passphrase verifier." - (with-current-buffer allout-buffer - (and (boundp 'allout-passphrase-verifier-string) - allout-passphrase-verifier-string - (allout-encrypt-string (allout-get-encryption-passphrase-verifier) - 'decrypt allout-buffer 'symmetric - key nil 0 0 'verifying passphrase) - t))) ;;;_ > allout-next-topic-pending-encryption (&optional except-mark) (defun allout-next-topic-pending-encryption (&optional except-mark) "Return the point of the next topic pending encryption, or nil if none. ------------------------------------------------------------ revno: 102679 author: Lars Magne Ingebrigtsen committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2010-12-16 23:18:57 +0000 message: nnimap.el (nnimap-wait-for-response): Fix the end-point calculation to really consider the last line. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-12-16 22:22:28 +0000 +++ lisp/gnus/ChangeLog 2010-12-16 23:18:57 +0000 @@ -1,3 +1,8 @@ +2010-12-16 Lars Magne Ingebrigtsen + + * nnimap.el (nnimap-wait-for-response): Fix the end-point calculation + to really consider the last line. + 2010-12-16 Daiki Ueno * auth-source.el (auth-source-gpg-encrypt-to): New variable to set the === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2010-12-16 22:22:28 +0000 +++ lisp/gnus/nnimap.el 2010-12-16 23:18:57 +0000 @@ -1565,10 +1565,11 @@ (format "^%d .*\n" sequence) (if nnimap-streaming (max (point-min) - (- (point) 500) - (save-excursion - (forward-line -1) - (point))) + (min + (- (point) 500) + (save-excursion + (forward-line -1) + (point)))) (point-min)) t))) (when messagep ------------------------------------------------------------ revno: 102678 committer: Ken Manheimer branch nick: trunk timestamp: Thu 2010-12-16 17:33:13 -0500 message: last pgg adjustment before migrating to epg. (allout-encrypted-key-info): replace pgg-gpg-symmetric-key-p with explicit examination of the parsed armoring structure. pgg-gpg-symmetric-key-p seems to have drifted, not recognizing parsed symmetric keys as being symmetric. diff: === modified file 'lisp/allout.el' --- lisp/allout.el 2010-11-27 03:25:35 +0000 +++ lisp/allout.el 2010-12-16 22:33:13 +0000 @@ -6544,7 +6544,8 @@ (with-temp-buffer (insert text) (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max))) - (type (if (pgg-gpg-symmetric-key-p parsed-armor) + ;; pgg-gpg-symmetric-key-p has lost track. + (type (if (assq 'symmetric-key-algorithm (car (cdr parsed-armor))) 'symmetric 'keypair)) secret-keys first-secret-key for-key-owner) ------------------------------------------------------------ revno: 102677 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2010-12-16 22:22:28 +0000 message: Merge changes made in Gnus trunk. nnimap.el (nnimap-wait-for-response): Always look (at least) at the previous line. nnimap.el (nnimap-quirk): New function. (nnimap-retrieve-group-data-early): Use it. (nnimap-quirks): New alist. gnus.texi (Foreign Groups): Added clarification of foreign groups. gnus-sum.el (gnus-summary-push-marks-to-backend): Fix the logic for copying read-ness to the backends. gnus-group.el (gnus-group-kill-group): Notify the backend that the group has been killed. (gnus-group-yank-group): Ditto. gnus-start.el (gnus-subscribe-newsgroup): Notify the backend. nnir.el: Improve customizations. gnus.texi (Archived Messages): Removed outdated comment and text. nnfolder.el (nnfolder-save-all-buffers): Refactor out into its own function. (nnfolder-request-expire-articles): Save all the buffers after doing expiry. nnmail.el (nnmail-expiry-target-group): Revert the "all articles are the last article", since that led to serious performance regressions when expiring nnml groups. gnus-html.el (gnus-html-schedule-image-fetching): Make sure the HTML fetching stops when Gnus exits. gnus-srvr.el: Avoid passing nil regexp argument to delete-matching-lines. auth-source.el (auth-source-gpg-encrypt-to): New variable to set the list of recipient keys, or use symmetric encryption if not a list. (auth-source-create): Use it to make `epa-file-encrypt-to' local for an EPA override, replacing the call to `netrc-store-data'. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-12-15 22:24:36 +0000 +++ doc/misc/ChangeLog 2010-12-16 22:22:28 +0000 @@ -1,3 +1,11 @@ +2010-12-16 Lars Magne Ingebrigtsen + + * gnus.texi (Archived Messages): Remove outdated text. + +2010-12-16 Teodor Zlatanov + + * gnus.texi (Foreign Groups): Added clarification of foreign groups. + 2010-12-15 Andrew Cohen * gnus.texi (The hyrex Engine): Say that this engine as obsolete. === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-12-15 22:24:36 +0000 +++ doc/misc/gnus.texi 2010-12-16 22:22:28 +0000 @@ -2512,6 +2512,15 @@ @section Foreign Groups @cindex foreign groups +If you recall how to subscribe to servers (@pxref{Finding the News}) +you will remember that @code{gnus-secondary-select-methods} and +@code{gnus-select-method} let you write a definition in Emacs Lisp of +what servers you want to see when you start up. The alternate +approach is to use foreign servers and groups. ``Foreign'' here means +they are not coming from the select methods. All foreign server +configuration and subscriptions are stored only in the +@file{~/.newsrc.eld} file. + Below are some group mode commands for making and editing general foreign groups, as well as commands to ease the creation of a few special-purpose groups. All these commands insert the newly created @@ -12611,9 +12620,6 @@ (concat "mail." (format-time-string "%Y-%m"))))) @end lisp -@c (XEmacs 19.13 doesn't have @code{format-time-string}, so you'll have to -@c use a different value for @code{gnus-message-archive-group} there.) - Now, when you send a message off, it will be stored in the appropriate group. (If you want to disable storing for just one particular message, you can just remove the @code{Gcc} header that has been inserted.) The @@ -12625,11 +12631,6 @@ nice---@samp{misc-mail-september-1995}, or whatever. New messages will continue to be stored in the old (now empty) group. -That's the default method of archiving sent messages. Gnus offers a -different way for the people who don't like the default method. In that -case you should set @code{gnus-message-archive-group} to @code{nil}; -this will disable archiving. - @table @code @item gnus-gcc-mark-as-read @vindex gnus-gcc-mark-as-read === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-12-16 00:55:04 +0000 +++ lisp/gnus/ChangeLog 2010-12-16 22:22:28 +0000 @@ -1,8 +1,65 @@ +2010-12-16 Daiki Ueno + + * auth-source.el (auth-source-gpg-encrypt-to): New variable to set the + list of recipient keys, or use symmetric encryption if not a list. + (auth-source-create): Use it to make `epa-file-encrypt-to' local for an + EPA override, replacing the call to `netrc-store-data'. + +2010-12-16 Dan Davison (tiny change) + + * gnus-srvr.el: Avoid passing nil regexp argument to + delete-matching-lines. + +2010-12-16 Lars Magne Ingebrigtsen + + * gnus-html.el (gnus-html-schedule-image-fetching): Make sure the HTML + fetching stops when Gnus exits. + + * nnfolder.el (nnfolder-save-all-buffers): Refactor out into its own + function. + (nnfolder-request-expire-articles): Save all the buffers after doing + expiry. + + * nnmail.el (nnmail-expiry-target-group): Revert the "all articles are + the last article", since that led to serious performance regressions + when expiring nnml groups. + +2010-12-16 Andrew Cohen + + * nnir.el: Improve customizations. + +2010-12-16 Lars Magne Ingebrigtsen + + * gnus-start.el (gnus-subscribe-newsgroup): Notify the backend. + + * gnus-group.el (gnus-group-kill-group): Notify the backend that the + group has been killed. + (gnus-group-yank-group): Ditto. + + * gnus-srvr.el (gnus-browse-unsubscribe-group): Ditto. + + * nnimap.el (nnimap-request-update-group-status): New function. + + * gnus-int.el (gnus-request-update-group-status): New interface + function. + + * gnus-sum.el (gnus-summary-push-marks-to-backend): Fix the logic for + copying read-ness to the backends. + + * nnimap.el (nnimap-quirk): New function. + (nnimap-retrieve-group-data-early): Use it. + (nnimap-quirks): New alist. + 2010-12-16 Katsumi Yamaoka * shr.el (shr-insert): Set shr-start after deleting trailing space; don't delete it within indentation. +2010-12-16 Lars Magne Ingebrigtsen + + * nnimap.el (nnimap-wait-for-response): Always look (at least) at the + previous line. + 2010-12-15 Lars Magne Ingebrigtsen * nnimap.el (nnimap-retrieve-group-data-early): Fix the syntax of the === modified file 'lisp/gnus/auth-source.el' --- lisp/gnus/auth-source.el 2010-10-10 22:48:40 +0000 +++ lisp/gnus/auth-source.el 2010-12-16 22:22:28 +0000 @@ -159,6 +159,15 @@ (const :tag "Any" t) (string :tag "Specific user name")))))))) +(defcustom auth-source-gpg-encrypt-to t + "List of recipient keys that `authinfo.gpg' encrypted to. +If the value is not a list, symmetric encryption will be used." + :group 'auth-source + :version "23.2" ;; No Gnus + :type '(choice (const :tag "Symmetric encryption" t) + (repeat :tag "Recipient public keys" + (string :tag "Recipient public key")))) + ;; temp for debugging ;; (unintern 'auth-source-protocols) ;; (unintern 'auth-sources) @@ -352,9 +361,28 @@ ;; netrc interface. (when (y-or-n-p (format "Do you want to save this password in %s? " source)) - (netrc-store-data source host prot - (or user (cdr (assoc "login" result))) - (cdr (assoc "password" result)))))) + ;; the code below is almost same as `netrc-store-data' except + ;; the `epa-file-encrypt-to' hack (see bug#7487). + (with-temp-buffer + (when (file-exists-p source) + (insert-file-contents source)) + (when auth-source-gpg-encrypt-to + ;; making `epa-file-encrypt-to' local to this buffer lets + ;; epa-file skip the key selection query (see the + ;; `local-variable-p' check in `epa-file-write-region'). + (unless (local-variable-p 'epa-file-encrypt-to) + (make-local-variable 'epa-file-encrypt-to)) + (if (listp auth-source-gpg-encrypt-to) + (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert (format "machine %s login %s password %s port %s\n" + host + (or user (cdr (assoc "login" result))) + (cdr (assoc "password" result)) + prot)) + (write-region (point-min) (point-max) source nil 'silent))))) (if (consp mode) (mapcar #'cdr result) (cdar result)))) === modified file 'lisp/gnus/gnus-group.el' --- lisp/gnus/gnus-group.el 2010-11-08 01:38:47 +0000 +++ lisp/gnus/gnus-group.el 2010-12-16 22:22:28 +0000 @@ -3781,6 +3781,7 @@ gnus-list-of-killed-groups)) (gnus-group-change-level (if entry entry group) gnus-level-killed (if entry nil level)) + (gnus-request-update-group-status group 'unsubscribe) (message "Killed group %s" (gnus-group-decoded-name group))) ;; If there are lots and lots of groups to be killed, we use ;; this thing instead. @@ -3803,7 +3804,8 @@ (setq gnus-zombie-list (delete group gnus-zombie-list)))) ;; There may be more than one instance displayed. (while (gnus-group-goto-group group) - (gnus-delete-line))) + (gnus-delete-line)) + (gnus-request-update-group-status group 'unsubscribe)) (gnus-make-hashtable-from-newsrc-alist)) (gnus-group-position-point) @@ -3831,6 +3833,7 @@ (and prev (gnus-group-entry prev)) t) (gnus-group-insert-group-line-info group) + (gnus-request-update-group-status group 'subscribe) (gnus-undo-register `(when (gnus-group-goto-group ,group) (gnus-group-kill-group 1)))) === modified file 'lisp/gnus/gnus-html.el' --- lisp/gnus/gnus-html.el 2010-12-05 22:17:34 +0000 +++ lisp/gnus/gnus-html.el 2010-12-16 22:22:28 +0000 @@ -395,7 +395,7 @@ 4) (setq args (nconc args (list t)))) (ignore-errors - (apply #'url-retrieve args)))) + (push (apply #'url-retrieve args) gnus-buffers)))) (defun gnus-html-image-fetched (status buffer image) "Callback function called when image has been fetched." === modified file 'lisp/gnus/gnus-int.el' --- lisp/gnus/gnus-int.el 2010-12-06 22:16:10 +0000 +++ lisp/gnus/gnus-int.el 2010-12-16 22:22:28 +0000 @@ -473,6 +473,18 @@ (funcall (gnus-get-function gnus-command-method 'request-type) (gnus-group-real-name group) article)))) +(defun gnus-request-update-group-status (group status) + "Change the status of a group. +Valid statuses include `subscribe' and `unsubscribe'." + (let ((gnus-command-method (gnus-find-method-for-group group))) + (if (not (gnus-check-backend-function + 'request-update-group-status (car gnus-command-method))) + nil + (funcall + (gnus-get-function gnus-command-method 'request-update-group-status) + (gnus-group-real-name group) status + (nth 1 gnus-command-method))))) + (defun gnus-request-set-mark (group action) "Set marks on articles in the back end." (let ((gnus-command-method (gnus-find-method-for-group group))) === modified file 'lisp/gnus/gnus-srvr.el' --- lisp/gnus/gnus-srvr.el 2010-11-21 22:46:16 +0000 +++ lisp/gnus/gnus-srvr.el 2010-12-16 22:22:28 +0000 @@ -766,7 +766,8 @@ (with-current-buffer nntp-server-buffer (let ((cur (current-buffer))) (goto-char (point-min)) - (unless (string= gnus-ignored-newsgroups "") + (unless (or (null gnus-ignored-newsgroups) + (string= gnus-ignored-newsgroups "")) (delete-matching-lines gnus-ignored-newsgroups)) ;; We treat NNTP as a special case to avoid problems with ;; garbage group names like `"foo' that appear in some badly @@ -992,7 +993,8 @@ ;; mechanism for new group subscription. (gnus-call-subscribe-functions gnus-browse-subscribe-newsgroup-method - group))) + group) + (gnus-request-update-group-status group 'subscribe))) (delete-char 1) (insert (let ((lvl (gnus-group-level group))) (cond === modified file 'lisp/gnus/gnus-start.el' --- lisp/gnus/gnus-start.el 2010-12-13 22:29:12 +0000 +++ lisp/gnus/gnus-start.el 2010-12-16 22:22:28 +0000 @@ -645,6 +645,7 @@ (gnus-group-change-level newsgroup gnus-level-default-subscribed gnus-level-killed (gnus-group-entry (or next "dummy.group"))) + (gnus-request-update-group-status newsgroup 'subscribe) (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup) t)) === modified file 'lisp/gnus/gnus-sum.el' --- lisp/gnus/gnus-sum.el 2010-12-13 04:22:39 +0000 +++ lisp/gnus/gnus-sum.el 2010-12-16 22:22:28 +0000 @@ -9958,7 +9958,7 @@ (defun gnus-summary-push-marks-to-backend (article) (let ((set nil) (marks gnus-article-mark-lists)) - (when (memq article gnus-newsgroup-unreads) + (unless (memq article gnus-newsgroup-unreads) (push 'read set)) (while marks (when (and (eq (gnus-article-mark-to-type (cdar marks)) 'list) === modified file 'lisp/gnus/nnfolder.el' --- lisp/gnus/nnfolder.el 2010-11-26 02:11:40 +0000 +++ lisp/gnus/nnfolder.el 2010-12-16 22:22:28 +0000 @@ -322,20 +322,20 @@ (when nnfolder-get-new-mail (nnfolder-possibly-change-group group server) (nnmail-get-new-mail - 'nnfolder - (lambda () - (let ((bufs nnfolder-buffer-alist)) - (save-excursion - (while bufs - (if (not (gnus-buffer-live-p (nth 1 (car bufs)))) - (setq nnfolder-buffer-alist - (delq (car bufs) nnfolder-buffer-alist)) - (set-buffer (nth 1 (car bufs))) - (nnfolder-save-buffer) - (kill-buffer (current-buffer))) - (setq bufs (cdr bufs)))))) - nnfolder-directory - group))) + 'nnfolder 'nnfolder-save-all-buffers + nnfolder-directory group))) + +(defun nnfolder-save-all-buffers () + (let ((bufs nnfolder-buffer-alist)) + (save-excursion + (while bufs + (if (not (gnus-buffer-live-p (nth 1 (car bufs)))) + (setq nnfolder-buffer-alist + (delq (car bufs) nnfolder-buffer-alist)) + (set-buffer (nth 1 (car bufs))) + (nnfolder-save-buffer) + (kill-buffer (current-buffer))) + (setq bufs (cdr bufs)))))) ;; Don't close the buffer if we're not shutting down the server. This way, ;; we can keep the buffer in the group buffer cache, and not have to grovel @@ -488,7 +488,8 @@ (nnfolder-save-buffer) (nnfolder-adjust-min-active newsgroup) (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) - (gnus-sorted-difference articles (nreverse deleted-articles))))) + (gnus-sorted-difference articles (nreverse deleted-articles))) + (nnfolder-save-all-buffers))) (deffoo nnfolder-request-move-article (article group server accept-form &optional last move-is-internal) === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2010-12-15 22:24:36 +0000 +++ lisp/gnus/nnimap.el 2010-12-16 22:22:28 +0000 @@ -139,6 +139,9 @@ (download "gnus-download") (forward "gnus-forward"))) +(defvar nnimap-quirks + '(("QRESYNC" "Zimbra" "QRESYNC "))) + (defun nnimap-buffer () (nnimap-find-process-buffer nntp-server-buffer)) @@ -897,6 +900,16 @@ (push flag flags))) flags)) +(deffoo nnimap-request-update-group-status (group status &optional server) + (when (nnimap-possibly-change-group nil server) + (let ((command (assoc + status + '((subscribe "SUBSCRIBE") + (unsubscribe "UNSUBSCRIBE"))))) + (when command + (with-current-buffer (nnimap-buffer) + (nnimap-command "%s %S" (cadr command) (utf7-encode group t))))))) + (deffoo nnimap-request-set-mark (group actions &optional server) (when (nnimap-possibly-change-group group server) (let (sequence) @@ -1080,8 +1093,9 @@ uidvalidity modseq) (push - (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))" + (list (nnimap-send-command "EXAMINE %S (%s (%s %s))" (utf7-encode group t) + (nnimap-quirk "QRESYNC") uidvalidity modseq) 'qresync nil group 'qresync) @@ -1107,6 +1121,15 @@ sequences)))) sequences)))) +(defun nnimap-quirk (command) + (let ((quirk (assoc command nnimap-quirks))) + ;; If this server is of a type that matches a quirk, then return + ;; the "quirked" command instead of the proper one. + (if (or (null quirk) + (not (string-match (nth 1 quirk) (nnimap-greeting nnimap-object)))) + command + (nth 2 quirk)))) + (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) (when (and sequences (nnimap-possibly-change-group nil server)) @@ -1541,7 +1564,11 @@ (not (re-search-backward (format "^%d .*\n" sequence) (if nnimap-streaming - (max (point-min) (- (point) 500)) + (max (point-min) + (- (point) 500) + (save-excursion + (forward-line -1) + (point))) (point-min)) t))) (when messagep === modified file 'lisp/gnus/nnir.el' --- lisp/gnus/nnir.el 2010-12-14 12:52:30 +0000 +++ lisp/gnus/nnir.el 2010-12-16 22:22:28 +0000 @@ -305,13 +305,6 @@ "Search groups in Gnus with assorted seach engines." :group 'gnus) -(defcustom nnir-method-default-engines - '((nnimap . imap) - (nntp . gmane)) - "*Alist of default search engines keyed by server method." - :type '(alist) - :group 'nnir) - (defcustom nnir-ignored-newsgroups "" "*A regexp to match newsgroups in the active file that should be skipped when searching." @@ -329,7 +322,7 @@ %g Article original short group name (string) If nil this will use `gnus-summary-line-format'." - :type '(regexp) + :type '(string) :group 'nnir) (defcustom nnir-retrieve-headers-override-function nil @@ -347,7 +340,8 @@ "*The default IMAP search key for an nnir search. Must be one of the keys in `nnir-imap-search-arguments'. To use raw imap queries by default set this to \"Imap\"." - :type '(string) + :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) + nnir-imap-search-arguments)) :group 'nnir) (defcustom nnir-swish++-configuration-file @@ -546,6 +540,18 @@ Add an entry here when adding a new search engine.") +(defcustom nnir-method-default-engines + '((nnimap . imap) + (nntp . gmane)) + "*Alist of default search engines keyed by server method." + :type `(repeat (cons (choice (const nnimap) (const nttp) (const nnspool) + (const nneething) (const nndir) (const nnmbox) + (const nnml) (const nnmh) (const nndraft) + (const nnfolder) (const nnmaildir)) + (choice + ,@(mapcar (lambda (elem) (list 'const (car elem))) + nnir-engines)))) + :group 'nnir) ;; Gnus glue. === modified file 'lisp/gnus/nnmail.el' --- lisp/gnus/nnmail.el 2010-11-26 02:37:23 +0000 +++ lisp/gnus/nnmail.el 2010-12-16 22:22:28 +0000 @@ -1915,7 +1915,7 @@ (unless (eq target 'delete) (when (or (gnus-request-group target) (gnus-request-create-group target)) - (let ((group-art (gnus-request-accept-article target nil t t))) + (let ((group-art (gnus-request-accept-article target nil nil t))) (when (and (consp group-art) (cdr group-art)) (gnus-group-mark-article-read target (cdr group-art)))))))) ------------------------------------------------------------ revno: 102676 committer: Jan D. branch nick: trunk timestamp: Thu 2010-12-16 20:37:13 +0100 message: Handle invisible cursor (bg same as cursor color) for Nextstep. * nsterm.m (ns_draw_window_cursor): If the cursor color is the same as the background, use the face forground as cursor. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2010-12-13 15:27:36 +0000 +++ src/ChangeLog 2010-12-16 19:37:13 +0000 @@ -1,3 +1,8 @@ +2010-12-16 Jan Djärv + + * nsterm.m (ns_draw_window_cursor): If the cursor color is the + same as the background, use the face forground as cursor. + 2010-12-13 Eli Zaretskii * fileio.c (Fexpand_file_name): Doc fix. (Bug#7617) === modified file 'src/nsterm.m' --- src/nsterm.m 2010-12-13 15:27:36 +0000 +++ src/nsterm.m 2010-12-16 19:37:13 +0000 @@ -2301,6 +2301,8 @@ struct glyph *phys_cursor_glyph; int overspill; struct glyph *cursor_glyph; + struct face *face; + NSColor *hollow_color = FRAME_BACKGROUND_COLOR (f); /* If cursor is out of bounds, don't draw garbage. This can happen in mini-buffer windows when switching between echo area glyphs @@ -2310,7 +2312,7 @@ //fprintf(stderr, "drawcursor (%d,%d) activep = %d\tonp = %d\tc_type = %d\twidth = %d\n",x,y, active_p,on_p,cursor_type,cursor_width); if (!on_p) - return; + return; w->phys_cursor_type = cursor_type; w->phys_cursor_on_p = on_p; @@ -2349,7 +2351,17 @@ /* TODO: only needed in rare cases with last-resort font in HELLO.. should we do this more efficiently? */ ns_clip_to_row (w, glyph_row, -1, NO); /* do ns_focus(f, &r, 1); if remove */ - [FRAME_CURSOR_COLOR (f) set]; + + + face = FACE_FROM_ID (f, phys_cursor_glyph->face_id); + if (face && NS_FACE_BACKGROUND (face) + == ns_index_color (FRAME_CURSOR_COLOR (f), f)) + { + [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; + hollow_color = FRAME_CURSOR_COLOR (f); + } + else + [FRAME_CURSOR_COLOR (f) set]; #ifdef NS_IMPL_COCOA /* TODO: This makes drawing of cursor plus that of phys_cursor_glyph @@ -2369,7 +2381,7 @@ break; case HOLLOW_BOX_CURSOR: NSRectFill (r); - [FRAME_BACKGROUND_COLOR (f) set]; + [hollow_color set]; NSRectFill (NSInsetRect (r, 1, 1)); [FRAME_CURSOR_COLOR (f) set]; break; ------------------------------------------------------------ revno: 102675 committer: Miles Bader branch nick: trunk timestamp: Thu 2010-12-16 13:14:48 +0900 message: url-cookie.el: Require 'cl when compiling diff: === modified file 'lisp/url/ChangeLog' --- lisp/url/ChangeLog 2010-12-14 04:18:22 +0000 +++ lisp/url/ChangeLog 2010-12-16 04:14:48 +0000 @@ -1,3 +1,8 @@ +2010-12-16 Miles Bader > + + * url-cookie.el: Require 'cl when compiling -- it's necessary for + defstruct. + 2010-12-14 Glenn Morris * url-cookie.el: Don't require cl when compiling. === modified file 'lisp/url/url-cookie.el' --- lisp/url/url-cookie.el 2010-12-14 04:18:22 +0000 +++ lisp/url/url-cookie.el 2010-12-16 04:14:48 +0000 @@ -27,6 +27,8 @@ (require 'url-util) (require 'url-parse) +(eval-when-compile (require 'cl)) ; defstruct + (defgroup url-cookie nil "URL cookies." :prefix "url-" ------------------------------------------------------------ revno: 102674 committer: Daiki Ueno branch nick: trunk timestamp: Thu 2010-12-16 11:35:56 +0900 message: Extend epa-file-select-keys to allow users to inhibit key selection. * epa-file.el (epa-file-select-keys): Accept 'silent to inhibit key selection prompt; make 'silent as default (Bug#7487). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-12-16 02:26:39 +0000 +++ lisp/ChangeLog 2010-12-16 02:35:56 +0000 @@ -1,3 +1,8 @@ +2010-12-16 Daiki Ueno + + * epa-file.el (epa-file-select-keys): Accept 'silent to inhibit + key selection prompt; make 'silent as default (Bug#7487). + 2010-12-16 Leo * eshell/eshell.el (eshell-directory-name): Use === modified file 'lisp/epa-file.el' --- lisp/epa-file.el 2010-10-10 01:45:45 +0000 +++ lisp/epa-file.el 2010-12-16 02:35:56 +0000 @@ -35,9 +35,16 @@ :type 'boolean :group 'epa-file) -(defcustom epa-file-select-keys nil - "If non-nil, always asks user to select recipients." - :type 'boolean +(defcustom epa-file-select-keys 'silent + "Control whether or not to pop up the key selection dialog. + +If t, always asks user to select recipients. +If nil, query user only when `epa-file-encrypt-to' is not set. +If neither t nor nil, doesn't ask user. In this case, symmetric +encryption is used." + :type '(choice (const :tag "Ask always" t) + (const :tag "Ask when recipients are not set" nil) + (const :tag "Don't ask" silent)) :group 'epa-file) (defvar epa-file-passphrase-alist nil) @@ -218,9 +225,10 @@ end (point-max))) (epa-file--encode-coding-string (buffer-substring start end) coding-system)) - (if (or epa-file-select-keys - (not (local-variable-p 'epa-file-encrypt-to - (current-buffer)))) + (if (or (eq epa-file-select-keys t) + (and (null epa-file-select-keys) + (not (local-variable-p 'epa-file-encrypt-to + (current-buffer))))) (epa-select-keys context "Select recipents for encryption. ------------------------------------------------------------ revno: 102673 committer: Chong Yidong branch nick: trunk timestamp: Thu 2010-12-16 10:28:33 +0800 message: etc/NEWS: Document eshell-directory-name change. diff: === modified file 'etc/NEWS' --- etc/NEWS 2010-12-16 01:20:46 +0000 +++ etc/NEWS 2010-12-16 02:28:33 +0000 @@ -340,6 +340,12 @@ The default is to decode strings that can be decoded as utf-8 as utf-8, and do the normal `undecided' decoding for the rest. +** Eshell changes + +*** The default value of eshell-directory-name is a directory named +"eshell" in `user-emacs-directory'. If the old "~/.eshell/" directory +exists, that is used instead. + ** In ido-mode, C-v is no longer bound to ido-toggle-vc. The reason is that this interferes with cua-mode. ------------------------------------------------------------ revno: 102672 author: Leo committer: Chong Yidong branch nick: trunk timestamp: Thu 2010-12-16 10:26:39 +0800 message: * eshell/eshell.el (eshell-directory-name): Use locate-user-emacs-file (Bug#7578). diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-12-15 08:16:53 +0000 +++ lisp/ChangeLog 2010-12-16 02:26:39 +0000 @@ -1,3 +1,8 @@ +2010-12-16 Leo + + * eshell/eshell.el (eshell-directory-name): Use + locate-user-emacs-file (Bug#7578). + 2010-12-15 Glenn Morris * loadup.el (symbol-file-load-history-loaded): Remove; unused. === modified file 'lisp/eshell/eshell.el' --- lisp/eshell/eshell.el 2010-05-25 02:11:08 +0000 +++ lisp/eshell/eshell.el 2010-12-16 02:26:39 +0000 @@ -285,7 +285,8 @@ "`eshell-buffer-name' is a member of `same-window-buffer-names'" (member eshell-buffer-name same-window-buffer-names)) -(defcustom eshell-directory-name (convert-standard-filename "~/.eshell/") +(defcustom eshell-directory-name + (locate-user-emacs-file "eshell/" ".eshell/") "The directory where Eshell control files should be kept." :type 'directory :group 'eshell) ------------------------------------------------------------ revno: 102671 committer: Chong Yidong branch nick: trunk timestamp: Thu 2010-12-16 09:20:46 +0800 message: Doc fix for just-one-space change. Document it in NEWS. diff: === modified file 'etc/NEWS' --- etc/NEWS 2010-12-15 02:56:22 +0000 +++ etc/NEWS 2010-12-16 01:20:46 +0000 @@ -232,6 +232,9 @@ ** The default value of `backup-by-copying-when-mismatch' is now t. +** The command `just-one-space' (C-SPC), if given a negative argument, +also deletes newlines around point. + ** Deletion changes *** New option `delete-active-region'. === modified file 'lisp/simple.el' --- lisp/simple.el 2010-12-13 15:27:36 +0000 +++ lisp/simple.el 2010-12-16 01:20:46 +0000 @@ -762,7 +762,7 @@ (defun just-one-space (&optional n) "Delete all spaces and tabs around point, leaving one space (or N spaces). -If N is negative, deletes carriage return and linefeed characters as well." +If N is negative, delete newlines as well." (interactive "*p") (unless n (setq n 1)) (let ((orig-pos (point)) ------------------------------------------------------------ revno: 102670 committer: Katsumi Yamaoka branch nick: trunk timestamp: Thu 2010-12-16 00:55:04 +0000 message: shr.el (shr-insert): Set shr-start after deleting trailing space; don't delete it within indentation. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-12-15 22:24:36 +0000 +++ lisp/gnus/ChangeLog 2010-12-16 00:55:04 +0000 @@ -1,3 +1,8 @@ +2010-12-16 Katsumi Yamaoka + + * shr.el (shr-insert): Set shr-start after deleting trailing space; + don't delete it within indentation. + 2010-12-15 Lars Magne Ingebrigtsen * nnimap.el (nnimap-retrieve-group-data-early): Fix the syntax of the === modified file 'lisp/gnus/shr.el' --- lisp/gnus/shr.el 2010-12-09 23:20:33 +0000 +++ lisp/gnus/shr.el 2010-12-16 00:55:04 +0000 @@ -253,16 +253,12 @@ (when (and (bolp) (> shr-indentation 0)) (shr-indent)) - ;; The shr-start is a special variable that is used to pass - ;; upwards the first point in the buffer where the text really - ;; starts. - (unless shr-start - (setq shr-start (point))) ;; No space is needed behind a wide character categorized as ;; kinsoku-bol, between characters both categorized as nospace, ;; or at the beginning of a line. (let (prev) - (when (and (eq (preceding-char) ? ) + (when (and (> (current-column) shr-indentation) + (eq (preceding-char) ? ) (or (= (line-beginning-position) (1- (point))) (and (shr-char-breakable-p (setq prev (char-after (- (point) 2)))) @@ -270,6 +266,11 @@ (and (shr-char-nospace-p prev) (shr-char-nospace-p (aref elem 0))))) (delete-char -1))) + ;; The shr-start is a special variable that is used to pass + ;; upwards the first point in the buffer where the text really + ;; starts. + (unless shr-start + (setq shr-start (point))) (insert elem) (let (found) (while (and (> (current-column) shr-width) ------------------------------------------------------------ revno: 102669 author: Gnus developers committer: Katsumi Yamaoka branch nick: trunk timestamp: Wed 2010-12-15 22:24:36 +0000 message: gnus-agent.el: Indent. gnus.texi: Fix a couple nnir -> @code{nnir} things. nnimap.el (nnimap-retrieve-group-data-early): Fix the syntax of the QRESYNC command by deleting a superfluous space which broke Cyrus servers. This change will break other servers that are buggy the other way around. gnus.texi (The hyrex Engine): Say that this engine as obsolete. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2010-12-14 22:11:38 +0000 +++ doc/misc/ChangeLog 2010-12-15 22:24:36 +0000 @@ -1,3 +1,7 @@ +2010-12-15 Andrew Cohen + + * gnus.texi (The hyrex Engine): Say that this engine as obsolete. + 2010-12-14 Andrew Cohen * gnus.texi (The swish++ Engine): Add customizable parameters === modified file 'doc/misc/gnus.texi' --- doc/misc/gnus.texi 2010-12-14 22:11:38 +0000 +++ doc/misc/gnus.texi 2010-12-15 22:24:36 +0000 @@ -793,7 +793,7 @@ nnir -* What is nnir:: What does nnir do. +* What is nnir?:: What does nnir do. * Basic Usage:: How to perform simple searches. * Setting up nnir:: How to set up nnir. @@ -21026,24 +21026,25 @@ within gnus. @menu -* What is nnir:: What does nnir do? +* What is nnir?:: What does @code{nnir} do? * Basic Usage:: How to perform simple searches. -* Setting up nnir:: How to set up nnir. +* Setting up nnir:: How to set up @code{nnir}. @end menu -@node What is nnir -@subsection What is nnir +@node What is nnir? +@subsection What is nnir? -@code{nnir} is a gnus interface to a number of tools for searching +@code{nnir} is a Gnus interface to a number of tools for searching through mail and news repositories. Different backends (like @code{nnimap} and @code{nntp}) work with different tools (called -@dfn{engines} in nnir lingo), but all use the same basic search +@dfn{engines} in @code{nnir} lingo), but all use the same basic search interface. The @code{nnimap} and @code{gmane} search engines should work with no configuration. Other engines require a local index that needs to be created and maintained outside of Gnus. + @node Basic Usage @subsection Basic Usage @@ -21083,6 +21084,7 @@ groups with different search engines you will be prompted for the special search features for each engine separately. + @node Setting up nnir @subsection Setting up nnir @@ -21120,10 +21122,10 @@ named @code{home} you can use @lisp -(setq gnus-secondary-select-methods '( - (nnml "home" - (nnimap-address "localhost") - (nnir-search-engine namazu)))) +(setq gnus-secondary-select-methods + '((nnml "home" + (nnimap-address "localhost") + (nnir-search-engine namazu)))) @end lisp Alternatively you might want to use a particular engine for all servers @@ -21335,7 +21337,7 @@ @node The hyrex Engine @subsubsection The hyrex Engine -FIXME: Add documentation. +This engine is obsolete. @node Customizations @subsubsection Custimozations === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2010-12-14 23:08:31 +0000 +++ lisp/gnus/ChangeLog 2010-12-15 22:24:36 +0000 @@ -1,3 +1,10 @@ +2010-12-15 Lars Magne Ingebrigtsen + + * nnimap.el (nnimap-retrieve-group-data-early): Fix the syntax of the + QRESYNC command by deleting a superfluous space which broke Cyrus + servers. This change will break other servers that are buggy the other + way around. + 2010-12-14 Teodor Zlatanov * spam.el: Reindent and fix long lines. === modified file 'lisp/gnus/gnus-agent.el' --- lisp/gnus/gnus-agent.el 2010-12-13 22:29:12 +0000 +++ lisp/gnus/gnus-agent.el 2010-12-15 22:24:36 +0000 @@ -1513,7 +1513,7 @@ "Fetch ARTICLES from GROUP and put them into the Agent." (when articles (gnus-agent-load-alist group) - (let* ((alist gnus-agent-article-alist) + (let* ((alist gnus-agent-article-alist) (headers (if (< (length articles) 2) nil gnus-newsgroup-headers)) (selected-sets (list nil)) (current-set-size 0) @@ -1555,9 +1555,9 @@ ;; 65 char/line. If the line count ;; is missing, arbitrarily assume a ;; size of 1000 characters. - (max (* 65 (mail-header-lines - (car headers))) - 1000) + (max (* 65 (mail-header-lines + (car headers))) + 1000) char-size)) 0)))) (setcar selected-sets (nreverse (car selected-sets))) === modified file 'lisp/gnus/nnimap.el' --- lisp/gnus/nnimap.el 2010-12-07 22:12:50 +0000 +++ lisp/gnus/nnimap.el 2010-12-15 22:24:36 +0000 @@ -1080,7 +1080,7 @@ uidvalidity modseq) (push - (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))" + (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))" (utf7-encode group t) uidvalidity modseq) 'qresync ------------------------------------------------------------ revno: 102668 committer: Glenn Morris branch nick: trunk timestamp: Wed 2010-12-15 00:16:53 -0800 message: Remove code and comments related to lib-src/fns-*.el; long removed. * Makefile.in (install-arch-dep, uninstall): Remove code relating to the long absent lib-src/fns-*.el. * lisp/loadup.el (symbol-file-load-history-loaded): Remove; unused. Remove related, old, commented-out code. * lisp/subr.el (symbol-file-load-history-loaded) (load-symbol-file-load-history): Remove old, commented-out code. diff: === modified file 'ChangeLog' --- ChangeLog 2010-12-13 15:27:36 +0000 +++ ChangeLog 2010-12-15 08:16:53 +0000 @@ -1,3 +1,8 @@ +2010-12-15 Glenn Morris + + * Makefile.in (install-arch-dep, uninstall): Remove code relating to the + long absent lib-src/fns-*.el. + 2010-12-11 Glenn Morris * make-dist: Exclude etc/*.pyc. === modified file 'Makefile.in' --- Makefile.in 2010-12-13 15:27:36 +0000 +++ Makefile.in 2010-12-15 08:16:53 +0000 @@ -424,12 +424,6 @@ -chmod 1755 $(DESTDIR)${bindir}/$(EMACSFULL) rm -f $(DESTDIR)${bindir}/$(EMACS) -ln $(DESTDIR)${bindir}/$(EMACSFULL) $(DESTDIR)${bindir}/$(EMACS) - -unset CDPATH; \ - for f in `cd lib-src && echo fns-*.el`; do \ - if test -r lib-src/$$f ; then \ - ${INSTALL_DATA} lib-src/$$f $(DESTDIR)${archlibdir}/$$f; \ - else true; fi ; \ - done if test "${ns_appresdir}" != ""; then \ ( cd ${ns_appresdir} ; \ if test -d share/emacs ; then dir=share/emacs/*/*; $(MV_DIRS); fi;\ @@ -682,9 +676,6 @@ esac ; \ fi ; \ done - if [ -d $(DESTDIR)${archlibdir} ]; then \ - (cd $(DESTDIR)${archlibdir} && rm -f fns-*) \ - fi -rm -rf $(DESTDIR)${libexecdir}/emacs/${version} (cd $(DESTDIR)${infodir} && \ for elt in $(INFO_FILES); do \ === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-12-15 02:56:22 +0000 +++ lisp/ChangeLog 2010-12-15 08:16:53 +0000 @@ -1,3 +1,7 @@ +2010-12-15 Glenn Morris + + * loadup.el (symbol-file-load-history-loaded): Remove; unused. + 2010-12-15 Jari Aalto Scott Evans === modified file 'lisp/loadup.el' --- lisp/loadup.el 2010-10-26 02:59:05 +0000 +++ lisp/loadup.el 2010-12-15 08:16:53 +0000 @@ -292,46 +292,16 @@ (error nil))) (message "Finding pointers to doc strings...done") -;;;Note: You can cause additional libraries to be preloaded -;;;by writing a site-init.el that loads them. -;;;See also "site-load" above. +;; Note: You can cause additional libraries to be preloaded +;; by writing a site-init.el that loads them. +;; See also "site-load" above. (load "site-init" t) (setq current-load-list nil) -;; Write the value of load-history into fns-VERSION.el, -;; then clear out load-history. -;; (if (or (equal (nth 3 command-line-args) "dump") -;; (equal (nth 4 command-line-args) "dump")) -;; (let ((buffer-undo-list t)) -;; (princ "(setq load-history\n" (current-buffer)) -;; (princ " (nconc load-history\n" (current-buffer)) -;; (princ " '(" (current-buffer)) -;; (let ((tem load-history)) -;; (while tem -;; (prin1 (car tem) (current-buffer)) -;; (terpri (current-buffer)) -;; (if (cdr tem) -;; (princ " " (current-buffer))) -;; (setq tem (cdr tem)))) -;; (princ ")))\n" (current-buffer)) -;; (write-region (point-min) (point-max) -;; (expand-file-name -;; (cond -;; ((eq system-type 'ms-dos) -;; "../lib-src/fns.el") -;; ((eq system-type 'windows-nt) -;; (format "../../../lib-src/fns-%s.el" emacs-version)) -;; (t -;; (format "../lib-src/fns-%s.el" emacs-version))) -;; invocation-directory)) -;; (erase-buffer) -;; (setq load-history nil)) -;; (setq symbol-file-load-history-loaded t)) -;; We don't use this fns-*.el file. Instead we keep the data in PURE space. +;; We keep the load-history data in PURE space. ;; Make sure that the spine of the list is not in pure space because it can ;; be destructively mutated in lread.c:build_load_history. (setq load-history (mapcar 'purecopy load-history)) -(setq symbol-file-load-history-loaded t) (set-buffer-modified-p nil) === modified file 'lisp/subr.el' --- lisp/subr.el 2010-12-13 15:27:36 +0000 +++ lisp/subr.el 2010-12-15 08:16:53 +0000 @@ -1482,26 +1482,6 @@ ;;; Load history -;; (defvar symbol-file-load-history-loaded nil -;; "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'. -;; That file records the part of `load-history' for preloaded files, -;; which is cleared out before dumping to make Emacs smaller.") - -;; (defun load-symbol-file-load-history () -;; "Load the file `fns-VERSION.el' in `exec-directory' if not already done. -;; That file records the part of `load-history' for preloaded files, -;; which is cleared out before dumping to make Emacs smaller." -;; (unless symbol-file-load-history-loaded -;; (load (expand-file-name -;; ;; fns-XX.YY.ZZ.el does not work on DOS filesystem. -;; (if (eq system-type 'ms-dos) -;; "fns.el" -;; (format "fns-%s.el" emacs-version)) -;; exec-directory) -;; ;; The file name fns-%s.el already has a .el extension. -;; nil nil t) -;; (setq symbol-file-load-history-loaded t))) - (defun symbol-file (symbol &optional type) "Return the name of the file that defined SYMBOL. The value is normally an absolute file name. It can also be nil, ------------------------------------------------------------ revno: 102667 author: Jari Aalto committer: Chong Yidong branch nick: trunk timestamp: Wed 2010-12-15 10:56:22 +0800 message: New command rectangle-number-lines (Bug#4382). * rect.el (rectange--default-line-number-format) (rectangle-number-line-callback): New functions. (rectangle-number-lines): New command, bound to C-x r N. diff: === modified file 'etc/NEWS' --- etc/NEWS 2010-12-14 20:42:57 +0000 +++ etc/NEWS 2010-12-15 02:56:22 +0000 @@ -303,6 +303,10 @@ *** Support for X cut buffers has been removed. +** New command `rectangle-number-lines', bound to `C-x r N', numbers +the lines in the current rectangle. With an prefix argument, this +prompts for a number to count from and for a format string. + * Changes in Specialized Modes and Packages in Emacs 24.1 === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2010-12-15 02:05:38 +0000 +++ lisp/ChangeLog 2010-12-15 02:56:22 +0000 @@ -1,3 +1,10 @@ +2010-12-15 Jari Aalto + Scott Evans + + * rect.el (rectange--default-line-number-format) + (rectangle-number-line-callback): New functions. + (rectangle-number-lines): New command, bound to C-x r N (Bug#4382). + 2010-12-15 Chong Yidong * rect.el (operate-on-rectangle-lines, string-rectangle-string): === modified file 'lisp/rect.el' --- lisp/rect.el 2010-12-15 02:05:38 +0000 +++ lisp/rect.el 2010-12-15 02:56:22 +0000 @@ -38,6 +38,7 @@ ;;;###autoload (define-key ctl-x-r-map "y" 'yank-rectangle) ;;;###autoload (define-key ctl-x-r-map "o" 'open-rectangle) ;;;###autoload (define-key ctl-x-r-map "t" 'string-rectangle) +;;;###autoload (define-key ctl-x-r-map "N" 'rectangle-number-lines) ;;; Code: @@ -370,6 +371,45 @@ (delete-region pt (point)) (indent-to endcol))))) +;; Line numbers for `rectangle-number-line-callback'. +(defvar rectangle-number-line-counter) + +(defun rectangle-number-line-callback (start end format-string) + (move-to-column start t) + (insert (format format-string rectangle-number-line-counter)) + (setq rectangle-number-line-counter + (1+ rectangle-number-line-counter))) + +(defun rectange--default-line-number-format (start end start-at) + (concat "%" + (int-to-string (length (int-to-string (+ (count-lines start end) + start-at)))) + "d ")) + +;;;###autoload +(defun rectangle-number-lines (start end start-at &optional format) + "Insert numbers in front of the region-rectangle. + +START-AT, if non-nil, should be a number from which to begin +counting. FORMAT, if non-nil, should be a format string to pass +to `format' along with the line count. When called interactively +with a prefix argument, prompt for START-AT and FORMAT." + (interactive + (if current-prefix-arg + (let* ((start (region-beginning)) + (end (region-end)) + (start-at (read-number "Number to count from: " 1))) + (list start end start-at + (read-string "Format string: " + (rectange--default-line-number-format + start end start-at)))) + (list (region-beginning) (region-end) 1 nil))) + (unless format + (setq format (rectange--default-line-number-format start end start-at))) + (let ((rectangle-number-line-counter start-at)) + (apply-on-rectangle 'rectangle-number-line-callback + start end format))) + (provide 'rect) ;; arch-tag: 178847b3-1f50-4b03-83de-a6e911cc1d16 ------------------------------------------------------------ Use --include-merges or -n0 to see merged revisions.