Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

*** empty log message ***

  • Loading branch information...
commit 3705de64dd93fd0605c317409d0263a6570311d7 1 parent 140ca7f
@larsmagne larsmagne authored
View
162 GNUS-NEWS
@@ -0,0 +1,162 @@
+** Gnus changes.
+
+Gnus, the Emacs newsreader, has undergone further rewriting. Many new
+commands and variables have been added. There should be no
+significant imcompatabilities between this Gnus version and the
+previosly released version, except in the message composition area.
+
+Below is a list of the more user-visible changes. Coding changes
+between Gnus 5.1 and 5.2 are more extensive.
+
+*** A new message composition mode is used. All old customization
+variables for mail-mode, rnews-reply-mode and gnus-msg are now
+absolete.
+
+*** Gnus is now able to generate "sparse" threads -- threads where
+missing articles are represented by empty nodes.
+
+ (setq gnus-build-sparse-threads 'some)
+
+*** Outgoing articles are stored on a special archive server.
+
+ To disable this: (setq gnus-message-archive-group nil)
+
+*** Partial thread regeneration now happens when articles are
+referred.
+
+*** Gnus can make use of GroupLens predictions:
+
+ (setq gnus-use-grouplens t)
+
+*** Picons (personal icons) can be displayed under XEmacs.
+
+ (setq gnus-use-picons t)
+
+*** A trn-line tree buffer can be displayed.
+
+ (setq gnus-use-trees t)
+
+*** An nn-like pick-and-read minor mode is available for the summary
+buffers.
+
+ (add-hook 'gnus-summary-mode-hook 'gnus-pick-mode)
+
+*** In binary groups you can use a special binary minor mode:
+
+ `M-x gnus-binary-mode'
+
+*** Groups can be grouped in a folding topic hierarchy.
+
+ (add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
+
+*** Gnus can resend and bounce mail.
+
+ Use the `S D r' and `S D b'.
+
+*** Groups can now have a score, and bubbling based on entry frequency
+is possible.
+
+ (add-hook 'gnus-summary-exit-hook 'gnus-summary-bubble-group)
+
+*** Groups can be process-marked, and commands can be performed on
+groups of groups.
+
+*** Caching is possible in virtual groups.
+
+*** nndoc now understands all kinds of digests, mail boxes, rnews news
+batches, ClariNet briefs collections, and just about everything else.
+
+*** Gnus has a new backend (nnsoup) to create/read SOUP packets.
+
+*** The Gnus cache is much faster.
+
+*** Groups can be sorted according to many criteria.
+
+ For instance: (setq gnus-group-sort-function 'gnus-group-sort-by-rank)
+
+*** New group parameters have been introduced to set list-address and
+expiry times.
+
+*** All formatting specs allow specifying faces to be used.
+
+*** There are several more commands for setting/removing/acting on
+process marked articles on the `M P' submap.
+
+*** The summary buffer can be limited to show parts of the available
+articles based on a wide range of criteria. These commands have been
+bound to keys on the `/' submap.
+
+*** Articles can be made persistent -- as an alternative to saving
+articles with the `*' command.
+
+*** All functions for hiding article elements are now toggles.
+
+*** Article headers can be buttonized.
+
+ (add-hook 'gnus-article-display-hook 'gnus-article-add-buttons-to-head)
+
+*** All mail backends support fetching articles by Message-ID.
+
+*** Duplicate mail can now be treated properly. See the
+`nnmail-treat-duplicates' variable.
+
+*** All summary mode commands are available directly from the article
+buffer.
+
+*** Frames can be part of `gnus-buffer-configuration'.
+
+*** Mail can be re-scanned by a daemonic process.
+
+*** Gnus can make use of NoCeM files to filter spam.
+
+ (setq gnus-use-nocem t)
+
+*** Groups can be made permanently visible.
+
+ (setq gnus-permanently-visible-groups "^nnml:")
+
+*** Many new hooks have been introduced to make customizing easier.
+
+*** Gnus respects the Mail-Copies-To header.
+
+*** Threads can be gathered by looking at the References header.
+
+ (setq gnus-summary-thread-gathering-function
+ 'gnus-gather-threads-by-references)
+
+*** Read articles can be stored in a special backlog buffer to avoid
+refetching.
+
+ (setq gnus-keep-backlog 50)
+
+*** A clean copy of the current article is always stored in a separate
+buffer to allow easier treatment.
+
+*** Gnus can suggest where to save articles. See `gnus-split-methods'.
+
+*** Gnus doesn't have to do as much prompting when saving.
+
+ (setq gnus-prompt-before-saving t)
+
+*** gnus-uu can view decoded files asynchronously while fetching
+articles.
+
+ (setq gnus-uu-grabbed-file-functions '`gnus-uu-grab-view)
+
+*** Filling in the article buffer now works properly on cited text.
+
+*** Hiding cited text adds buttons to toggle hiding, and how much
+cited text to hide is now customizable.
+
+ (setq gnus-cited-lines-visible 2)
+
+*** Boring headers can be hidden.
+
+ (add-hook 'gnus-article-display-hook 'gnus-article-hide-boring-headers)
+
+*** Default scoring values can now be set from the menu bar.
+
+*** Further syntax checking of outgoing articles have been added.
+
+The Gnus manual has been expanded. It explains all these new features
+in greater detail.
View
73 lisp/ChangeLog
@@ -1,3 +1,72 @@
+Wed May 29 05:08:04 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * custom.el (custom-xmas-add-text-properties,
+ custom-xmas-put-text-property): New functions used throughout.
+ May now work under XEmacs.
+
+Wed May 29 00:07:13 1996 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no>
+
+ * gnus-cite.el (gnus-cite-article): New variable.
+ (gnus-cite-parse-maybe): Use it.
+
+ * nnspool.el (nnspool-open-server): Refuse opening if the active
+ file doesn't exist.
+
+ * gnus.el (gnus-read-active-file): Message more.
+
+ * nntp.el (nntp-request-article): Wouldn't wait until the entire
+ article had arrived.
+
+ * nnvirtual.el (nnvirtual-request-group): Make sure that things
+ don't recurse endlessly.
+
+ * message.el (message-expand-group): Make buffer not read-only.
+
+ * gnus-nocem.el (gnus-nocem-verifyer): New variable.
+ (gnus-nocem-verify-issuer): Use it.
+
+ * gnus-xmas.el (gnus-xmas-logo-color-alist): New variable.
+ (gnus-xmas-logo-color-style): New variable.
+ (gnus-xmas-logo-colors): Use them.
+
+Tue May 28 00:28:38 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-score.el (gnus-score-followup): Would infloop on exact
+ matches.
+
+ * message.el (message-forward): Insert separator at the start of
+ the line.
+
+ * nnfolder.el (nnfolder-save-buffer): New function.
+ (nnfolder-save-buffer-hook): New variable.
+
+ * message.el (message-mode-hook): Defined variable.
+
+ * nntp.el (nntp-request-close): Remove the sentinel before closing
+ connection.
+
+ * gnus.el (gnus-group-mode): Add to local hook.
+ (gnus-continuum-version): Would return wrong answer for non-alpha
+ releases.
+ (gnus-version-number): New variable.
+ (gnus-version): Use it.
+
+ * gnus-msg.el (gnus-inews-add-send-actions): Add to local hook.
+
+ * gnus-xmas.el (gnus-xmas-add-hook): New function.
+
+ * gnus-ems.el (gnus-add-hook): New alias.
+
+Tue May 28 00:23:17 1996 Joao Cachopo <jcachopo@gia.ist.utl.pt>
+
+ * gnus-salt.el (gnus-binary-mode): Would put wrong minor mode
+ keymap into alist.
+
+Tue May 28 00:18:19 1996 Thor Kristoffersen <thor@unik.no>
+
+ * nntp.el (nntp-close-server): Supply parameter to
+ `nntp-server-opened'.
+
Sun May 26 20:29:02 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
* gnus.el (gnus-article-sort-by-date): Inline.
@@ -18,6 +87,10 @@ Sun May 26 20:29:02 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
Sun May 26 03:51:38 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+ * gnus.el: Gnus v5.2.1 is released.
+
+ * gnus.el: Gnus v5.2.0 is released.
+
* gnus.el: September Gnus v0.96 is released.
* nnheader-ems.el: Raw-file confusion.
View
179 lisp/custom.el
@@ -1,12 +1,30 @@
;;; custom.el --- User friendly customization support.
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-;;
+
+;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+
;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
;; Keywords: help
;; Version: 0.5
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
;;; Commentary:
-;;
+
;; WARNING: This package is still under construction and not all of
;; the features below are implemented.
;;
@@ -15,7 +33,7 @@
;; editing a text file in some arcane syntax is user hostile in the
;; extreme, and to most users emacs lisp definitely count as arcane.
;;
-;; The intension is that authors of emacs lisp packages declare the
+;; The intent is that authors of emacs lisp packages declare the
;; variables intended for user customization with `custom-declare'.
;; Custom can then automatically generate a customization buffer with
;; `custom-buffer-create' where the user can edit the package
@@ -46,18 +64,42 @@
;; - Make it possible to declare default value and type for a single
;; variable, storing the data in a symbol property.
;; - Syntactic sugar for CUSTOM declarations.
-;; - Use W3 for variable documenation.
+;; - Use W3 for variable documentation.
;;; Code:
;;; Compatibility:
+(defun custom-xmas-add-text-properties (start end props &optional object)
+ (add-text-properties start end props object)
+ (put-text-property start end 'start-open t object)
+ (put-text-property start end 'end-open t object))
+
+(defun custom-xmas-put-text-property (start end prop value &optional object)
+ (put-text-property start end prop value object)
+ (put-text-property start end 'start-open t object)
+ (put-text-property start end 'end-open t object))
+
+(defun custom-xmas-extent-start-open ()
+ (map-extents (lambda (extent arg)
+ (set-extent-property extent 'start-open t))
+ nil (point) (min (1+ (point)) (point-max))))
+
+(if (string-match "XEmacs\\|Lucid" emacs-version)
+ (progn
+ (fset 'custom-add-text-properties 'custom-xmas-add-text-properties)
+ (fset 'custom-put-text-property 'custom-xmas-put-text-property)
+ (fset 'custom-extent-start-open 'custom-xmas-extent-start-open))
+ (fset 'custom-add-text-properties 'add-text-properties)
+ (fset 'custom-put-text-property 'put-text-property)
+ (fset 'custom-extent-start-open 'ignore))
+
(or (fboundp 'buffer-substring-no-properties)
;; Introduced in Emacs 19.29.
(defun buffer-substring-no-properties (beg end)
"Return the text from BEG to END, without text properties, as a string."
(let ((string (buffer-substring beg end)))
- (custom-set-text-properties 0 (length string) nil string)
+ (set-text-properties 0 (length string) nil string)
string)))
(or (fboundp 'add-to-list)
@@ -153,24 +195,18 @@ STRING should be given if the last search was by `string-match' on STRING."
(and (fboundp 'set-face-underline-p)
(funcall 'set-face-underline-p 'underline t))))
-(defun custom-xmas-set-text-properties (start end props &optional buffer)
- "You should NEVER use this function. It is ideologically blasphemous.
-It is provided only to ease porting of broken FSF Emacs programs."
- (if (stringp buffer)
- nil
- (map-extents (lambda (extent ignored)
- (remove-text-properties
- start end
- (list (extent-property extent 'text-prop) nil)
- buffer))
- buffer start end nil nil 'text-prop)
- (add-text-properties start end props buffer)))
-
-(if (string-match "XEmacs" emacs-version)
- (fset 'custom-set-text-properties 'gnus-xmas-set-text-properties)
- (fset 'custom-set-text-properties 'set-text-properties))
-
-(or (fboundp 'event-point)
+(or (fboundp 'set-text-properties)
+ ;; Missing in XEmacs 19.12.
+ (defun set-text-properties (start end props &optional buffer)
+ (if (or (null buffer) (bufferp buffer))
+ (if props
+ (while props
+ (custom-put-text-property
+ start end (car props) (nth 1 props) buffer)
+ (setq props (nthcdr 2 props)))
+ (remove-text-properties start end ())))))
+
+(or (fboundp 'event-closest-point)
;; Missing in Emacs 19.29.
(defun event-point (event)
"Return the character position of the given mouse-motion, button-press,
@@ -250,12 +286,12 @@ If called interactively, prompts for a face and face attributes."
(> emacs-minor-version 28))))
(setq intangible 'intangible)
(setq intangible 'intangible-if-it-had-been-working))
- "The symbol making text intangible")
+ "The symbol making text intangible.")
(defconst rear-nonsticky (if (string-match "XEmacs" emacs-version)
'end-open
'rear-nonsticky)
- "The symbol making text proeprties non-sticky in the rear end.")
+ "The symbol making text properties non-sticky in the rear end.")
(defconst front-sticky (if (string-match "XEmacs" emacs-version)
'front-closed
@@ -347,7 +383,7 @@ If called interactively, prompts for a face and face attributes."
(defun custom-category-set (from to category)
"Make text between FROM and TWO have category CATEGORY."
- (put-text-property from to 'category category)))
+ (custom-put-text-property from to 'category category)))
;;; External Data:
;;
@@ -400,10 +436,10 @@ If called interactively, prompts for a face and face attributes."
;; The following functions are part of the public interface to the
;; CUSTOM datastructure. Each CUSTOM describes a group of variables,
;; a single variable, or a component of a structured variable. The
-;; CUSTOM instances are part of two hiearachies, the first is the
+;; CUSTOM instances are part of two hierarchies, the first is the
;; `part-of' hierarchy in which each CUSTOM is a component of another
;; CUSTOM, except for the top level CUSTOM which is contained in
-;; `custom-data'. The second hiearachy is a `is-a' type hierarchy
+;; `custom-data'. The second hierarchy is a `is-a' type hierarchy
;; where each CUSTOM is a leaf in the hierarchy defined by the `type'
;; property and `custom-type-properties'.
@@ -502,6 +538,17 @@ hierarchy the new entry should be added. CUSTOM is the entry to add."
((type . const)
(tag . "Off")
(default . nil))))
+ (triggle (type . choice)
+ ;; On/Off/Default.
+ (data ((type . const)
+ (tag . "On ")
+ (default . t))
+ ((type . const)
+ (tag . "Off")
+ (default . nil))
+ ((type . const)
+ (tag . "Def")
+ (default . custom:asis))))
(choice (type . default)
;; See `custom-match'.
(query . custom-choice-query)
@@ -609,17 +656,17 @@ Select the properties you want this face to have.")
(type . string))
"\n"
((tag . "Bold")
- (default . nil)
- (type . toggle))
+ (default . custom:asis)
+ (type . triggle))
" "
((tag . "Italic")
- (default . nil)
- (type . toggle))
+ (default . custom:asis)
+ (type . triggle))
" "
((tag . "Underline")
(hidden . t)
- (default . nil)
- (type . toggle)))
+ (default . custom:asis)
+ (type . triggle)))
(default . (custom-face-lookup "default" "default" "default"
nil nil nil))
(type . list))
@@ -710,6 +757,9 @@ Entries in this list take precedence over `custom-type-properties'.")
(defconst custom-invalid '__invalid__
"Special value representing an invalid field.")
+(defconst custom:asis 'custom:asis)
+;; Bad, ugly, and horrible kludge.
+
(defun custom-property (custom property)
"Extract from CUSTOM property PROPERTY."
(let ((entry (assq property custom)))
@@ -735,7 +785,7 @@ Entries in this list take precedence over `custom-type-properties'.")
(cdr entry)))
(defun custom-property-set (custom property value)
- "Set CUSTOM PROPERY to VALUE by side effect.
+ "Set CUSTOM PROPERTY to VALUE by side effect.
CUSTOM must have at least one property already."
(let ((entry (assq property custom)))
(if entry
@@ -884,7 +934,7 @@ position of the error, and the cdr is a text describing the error."
;; FIELD datatype. The FIELD instance hold information about a
;; specific editing field in the customization buffer.
;;
-;; Each FIELD can be seen as an instanciation of a CUSTOM.
+;; Each FIELD can be seen as an instantiation of a CUSTOM.
(defvar custom-field-last nil)
;; Last field containing point.
@@ -943,7 +993,7 @@ START and END are markers to the start and end of the field."
(defun custom-field-accept (field value &optional original)
"Store a new value into field FIELD, taking it from VALUE.
-If optional ORIGINAL is non-nil, concider VALUE for the original value."
+If optional ORIGINAL is non-nil, consider VALUE for the original value."
(let ((inhibit-point-motion-hooks t))
(funcall (custom-property (custom-field-custom field) 'accept)
field value original)))
@@ -1054,6 +1104,7 @@ If optional ORIGINAL is non-nil, concider VALUE for the original value."
(end (make-marker))
(data (vector repeat nil start end))
field)
+ (custom-extent-start-open)
(insert-before-markers "\n")
(backward-char 1)
(set-marker start (point))
@@ -1106,7 +1157,7 @@ If optional ORIGINAL is non-nil, concider VALUE for the original value."
(cons (nreverse matches) values)))
(defun custom-repeat-extract (custom field)
- "Extract list of childrens values."
+ "Extract list of children's values."
(let ((values (custom-field-value field))
(data (custom-data custom))
result)
@@ -1153,7 +1204,7 @@ If optional ORIGINAL is non-nil, concider VALUE for the original value."
(custom-default-quote custom value)))
(defun custom-pair-extract (custom field)
- "Extract cons of childrens values."
+ "Extract cons of children's values."
(let ((values (custom-field-value field))
(data (custom-data custom))
result)
@@ -1174,7 +1225,7 @@ If optional ORIGINAL is non-nil, concider VALUE for the original value."
(custom-default-quote custom value)))
(defun custom-list-extract (custom field)
- "Extract list of childrens values."
+ "Extract list of children's values."
(let ((values (custom-field-value field))
(data (custom-data custom))
result)
@@ -1283,7 +1334,7 @@ If optional ORIGINAL is non-nil, concider VALUE for the original value."
(face-tag (custom-face-tag custom))
current)
(if face-tag
- (put-text-property from (+ from (length (custom-tag custom)))
+ (custom-put-text-property from (+ from (length (custom-tag custom)))
'face (funcall face-tag field value)))
(if original
(custom-field-original-set field value))
@@ -1369,9 +1420,10 @@ If optional ORIGINAL is non-nil, concider VALUE for the original value."
()
(setq begin (point)
found (custom-insert (custom-property custom 'none) nil))
- (add-text-properties begin (point)
- (list rear-nonsticky t
- 'face custom-field-uninitialized-face)))
+ (custom-add-text-properties
+ begin (point)
+ (list rear-nonsticky t
+ 'face custom-field-uninitialized-face)))
(or original
(custom-field-original-set found (custom-field-original field)))
(custom-field-accept found value original)
@@ -1379,12 +1431,12 @@ If optional ORIGINAL is non-nil, concider VALUE for the original value."
(custom-field-move field from end))))
(defun custom-choice-extract (custom field)
- "Extract childs value."
+ "Extract child's value."
(let ((value (custom-field-value field)))
(custom-field-extract (custom-field-custom value) value)))
(defun custom-choice-validate (custom field)
- "Validate childs value."
+ "Validate child's value."
(let ((value (custom-field-value field))
(custom (custom-field-custom field)))
(if (or (eq value custom-nil)
@@ -1492,8 +1544,8 @@ FG BG STIPPLE BOLD ITALIC UNDERLINE"
(defun custom-face-hack (field value)
"Face that should be used for highlighting FIELD containing VALUE."
(let* ((custom (custom-field-custom field))
- (face (eval (funcall (custom-property custom 'export)
- custom value))))
+ (form (funcall (custom-property custom 'export) custom value))
+ (face (apply (car form) (cdr form))))
(if (custom-facep face) face nil)))
(defun custom-const-insert (custom level)
@@ -1502,7 +1554,7 @@ FG BG STIPPLE BOLD ITALIC UNDERLINE"
(face (custom-field-face field))
(from (point)))
(custom-text-insert (custom-tag custom))
- (add-text-properties from (point)
+ (custom-add-text-properties from (point)
(list 'face face
rear-nonsticky t))
(custom-documentation-insert custom)
@@ -1513,7 +1565,7 @@ FG BG STIPPLE BOLD ITALIC UNDERLINE"
"Update face of FIELD."
(let ((from (custom-field-start field))
(custom (custom-field-custom field)))
- (put-text-property from (+ from (length (custom-tag custom)))
+ (custom-put-text-property from (+ from (length (custom-tag custom)))
'face (custom-field-face field))))
(defun custom-const-valid (custom value)
@@ -1672,7 +1724,7 @@ FG BG STIPPLE BOLD ITALIC UNDERLINE"
(cond ((eq value custom-nil)
(cons start "Uninitialized field"))
((and (consp value) (eq (car value) custom-invalid))
- (cons start "Unparseable field content"))
+ (cons start "Unparsable field content"))
((custom-valid custom value)
nil)
(t
@@ -1802,9 +1854,9 @@ If the optional argument SAVE is non-nil, use that for saving changes."
(let ((from (point)))
(insert tag)
(custom-category-set from (point) 'custom-button-properties)
- (put-text-property from (point) 'custom-tag field)
+ (custom-put-text-property from (point) 'custom-tag field)
(if data
- (add-text-properties from (point) (list 'custom-data data)))))
+ (custom-add-text-properties from (point) (list 'custom-data data)))))
(defun custom-documentation-insert (custom &rest ignore)
"Insert documentation from CUSTOM in current buffer."
@@ -1823,11 +1875,13 @@ If the optional argument SAVE is non-nil, use that for saving changes."
"Describe how to execute COMMAND."
(let ((from (point)))
(insert "`" (key-description (where-is-internal command nil t)) "'")
- (custom-set-text-properties from (point)
+ (set-text-properties from (point)
(list 'face custom-button-face
mouse-face custom-mouse-face
'custom-jump t ;Make TAB jump over it.
- 'custom-tag command))
+ 'custom-tag command
+ 'start-open t
+ 'end-open t))
(custom-category-set from (point) 'custom-documentation-properties))
(custom-help-insert ": " (custom-first-line (documentation command)) "\n"))
@@ -1836,7 +1890,7 @@ If the optional argument SAVE is non-nil, use that for saving changes."
;; The Customization major mode and interactive commands.
(defvar custom-mode-map nil
- "Keymap for Custum Mode.")
+ "Keymap for Custom Mode.")
(if custom-mode-map
nil
(setq custom-mode-map (make-sparse-keymap))
@@ -2149,12 +2203,13 @@ If the optional argument is non-nil, show text iff the argument is positive."
(insert-char (custom-padding custom)
(- (custom-width custom) (- (point) from)))
(custom-field-move field from (point))
- (custom-set-text-properties
+ (set-text-properties
from (point)
(list 'custom-field field
'custom-tag field
'face (custom-field-face field)
- front-sticky t))))
+ 'start-open t
+ 'end-open t))))
(defun custom-field-read (field)
;; Read the screen content of FIELD.
@@ -2170,7 +2225,7 @@ If the optional argument is non-nil, show text iff the argument is positive."
;; Deactivate FIELD.
(let ((before-change-functions nil)
(after-change-functions nil))
- (put-text-property (custom-field-start field) (custom-field-end field)
+ (custom-put-text-property (custom-field-start field) (custom-field-end field)
'face (custom-field-face field))))
(defun custom-field-enter (field)
@@ -2188,7 +2243,7 @@ If the optional argument is non-nil, show text iff the argument is positive."
(setq pos (1- pos)))
(if (< pos (point))
(goto-char pos))))
- (put-text-property start end 'face custom-field-active-face)))
+ (custom-put-text-property start end 'face custom-field-active-face)))
(defun custom-field-resize (field)
;; Resize FIELD after change.
@@ -2270,7 +2325,7 @@ If the optional argument is non-nil, show text iff the argument is positive."
(let ((field custom-field-was))
(custom-assert '(prog1 field (setq custom-field-was nil)))
;; Prevent mixing fields properties.
- (put-text-property begin end 'custom-field field)
+ (custom-put-text-property begin end 'custom-field field)
;; Update the field after modification.
(if (eq (custom-field-property begin) field)
(let ((field-end (custom-field-end field)))
View
9 lisp/gnus-cite.el
@@ -117,9 +117,7 @@ The text matching the first grouping will be used as a button.")
;;; Internal Variables:
-(defvar gnus-article-length nil)
-;; Length of article last time we parsed it.
-;; BUG! KLUDGE! UGLY! FIX ME!
+(defvar gnus-cite-article nil)
(defvar gnus-cite-prefix-alist nil)
;; Alist of citation prefixes.
@@ -416,7 +414,7 @@ See also the documentation for `gnus-article-highlight-citation'."
(defun gnus-cite-parse-maybe (&optional force)
;; Parse if the buffer has changes since last time.
- (if (eq gnus-article-length (- (point-max) (point-min)))
+ (if (equal gnus-cite-article gnus-article-current)
()
;;Reset parser information.
(setq gnus-cite-prefix-alist nil
@@ -428,7 +426,8 @@ See also the documentation for `gnus-article-highlight-citation'."
gnus-cite-parse-max-size
(> (buffer-size) gnus-cite-parse-max-size))
()
- (setq gnus-article-length (- (point-max) (point-min)))
+ (setq gnus-cite-article (cons (car gnus-article-current)
+ (cdr gnus-article-current)))
(gnus-cite-parse))))
(defun gnus-cite-parse ()
View
1  lisp/gnus-ems.el
@@ -41,6 +41,7 @@
(defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
(defalias 'gnus-make-local-hook 'make-local-hook)
+(defalias 'gnus-add-hook 'add-hook)
(defalias 'gnus-character-to-event 'identity)
(defalias 'gnus-add-text-properties 'add-text-properties)
(defalias 'gnus-put-text-property 'put-text-property)
View
2  lisp/gnus-msg.el
@@ -138,7 +138,7 @@ the group.")
(defun gnus-inews-add-send-actions (winconf buffer article)
(gnus-make-local-hook 'message-sent-hook)
- (add-hook 'message-sent-hook 'gnus-inews-do-gcc)
+ (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
(setq message-post-method
`(lambda (arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
View
10 lisp/gnus-nocem.el
@@ -48,6 +48,11 @@
(defvar gnus-nocem-expiry-wait 15
"*Number of days to keep NoCeM headers in the cache.")
+(defvar gnus-nocem-verifyer 'mc-verify
+ "*Function called to verify that the NoCeM message is valid.
+If the function in this variable isn't bound, the message will
+be used unconditionally.")
+
;;; Internal variables
(defvar gnus-nocem-active nil)
@@ -146,7 +151,10 @@
(defun gnus-nocem-verify-issuer (person)
"Verify using PGP that the canceler is who she says she is."
- t)
+ (if (fboundp gnus-nocem-verifyer)
+ (funcall gnus-nocem-verifyer)
+ ;; If we don't have MailCrypt, then we use the message anyway.
+ t))
(defun gnus-nocem-enter-article ()
"Enter the current article into the NoCeM cache."
View
4 lisp/gnus-salt.el
@@ -167,8 +167,8 @@ If given a prefix, mark all unpicked articles as read."
(gnus-binary-make-menu-bar))
(unless (assq 'gnus-binary-mode minor-mode-alist)
(push '(gnus-binary-mode " Binary") minor-mode-alist))
- (unless (assq 'gnus-topic-mode minor-mode-map-alist)
- (push (cons 'gnus-topic-mode gnus-binary-mode-map)
+ (unless (assq 'gnus-binary-mode minor-mode-map-alist)
+ (push (cons 'gnus-binary-mode gnus-binary-mode-map)
minor-mode-map-alist))
(run-hooks 'gnus-binary-mode-hook))))
View
3  lisp/gnus-score.el
@@ -1528,7 +1528,8 @@ SCORE is the score to add."
(setq art (car arts)
arts (cdr arts))
(gnus-score-add-followups
- (car art) score all-scores thread)))))
+ (car art) score all-scores thread))))
+ (end-of-line))
(while (funcall search-func match nil t)
(end-of-line)
(setq found (setq arts (get-text-property (point) 'articles)))
View
27 lisp/gnus-xmas.el
@@ -35,8 +35,27 @@
If this variable is nil, Gnus will try to locate the directory
automatically.")
-(defvar gnus-xmas-logo-colors '("#bf9900" "#ffcc00")
- "Colors user for the Gnus logo.")
+(defvar gnus-xmas-logo-color-alist
+ '((flame "##cc3300" "##ff2200")
+ (pine "##c0cc93" "##f8ffb8")
+ (moss "##a1cc93" "##d2ffb8")
+ (irish "##04cc90" "##05ff97")
+ (sky "##049acc" "##05deff")
+ (tin "##6886cc" "##82b6ff")
+ (velvet "##7c68cc" "##8c82ff")
+ (grape "##b264cc" "##cf7df")
+ (labia "##cc64c2" "##fd7dff")
+ (berry "##cc6485" "##ff7db5")
+ (neutral "##b4b4b4" "##878787")
+ (september "#bf9900" "#ffcc00"))
+ "Color alist used for the Gnus logo.")
+
+(defvar gnus-xmas-logo-color-style 'september
+ "Color styles used for the Gnus logo.")
+
+(defvar gnus-xmas-logo-colors (cdr (assq gnus-xmas-logo-color-style
+ gnus-xmas-logo-color-alist))
+ "Colors used for the Gnus logo.")
;;; Internal variables.
@@ -145,6 +164,9 @@ displayed, no centering will be performed."
(gnus-horizontal-recenter)
(select-window selected))))))
+(defun gnus-xmas-add-hook (hook function &optional append local)
+ (add-hook hook function))
+
(defun gnus-xmas-add-text-properties (start end props &optional object)
(add-text-properties start end props object)
(put-text-property start end 'start-closed nil object))
@@ -453,6 +475,7 @@ pounce directly on the real variables themselves.")
'gnus-xmas-appt-select-lowest-window)
(fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names)
(fset 'gnus-make-local-hook 'make-local-variable)
+ (fset 'gnus-add-hook 'gnus-xmas-add-hook)
(fset 'gnus-character-to-event 'character-to-event)
(add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
View
10 lisp/gnus.el
@@ -1723,9 +1723,12 @@ variable (string, integer, character, etc).")
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "Gnus v5.2.1"
+(defconst gnus-version-number "5.2.2"
"Version number for this version of Gnus.")
+(defconst gnus-version (format "Gnus v%s" gnus-version-number)
+ "Version string for this version of Gnus.")
+
(defvar gnus-info-nodes
'((gnus-group-mode "(gnus)The Group Buffer")
(gnus-summary-mode "(gnus)The Summary Buffer")
@@ -4266,7 +4269,7 @@ The following commands are available:
(setq truncate-lines t)
(setq buffer-read-only t)
(gnus-make-local-hook 'post-command-hook)
- (add-hook 'post-command-hook 'gnus-clear-inboxes-moved)
+ (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(run-hooks 'gnus-group-mode-hook))
(defun gnus-clear-inboxes-moved ()
@@ -16068,6 +16071,7 @@ Returns whether the updating was successful."
(unless (equal method gnus-message-archive-method)
(gnus-error 1 "Cannot read active file from %s server."
(car method)))
+ (gnus-message 5 mesg)
(gnus-active-to-gnus-format method gnus-active-hashtb)
;; We mark this active file as read.
(push method gnus-have-read-active-file)
@@ -16290,7 +16294,7 @@ If FORCE is non-nil, the .newsrc file is read."
((string= alpha "September") "5.01")
((string= alpha "Red") "5.03"))
minor least)
- (format "%d.%02d%20d" major minor least))))))
+ (format "%d.%02d%02d" major minor least))))))
(defun gnus-convert-old-newsrc ()
"Convert old newsrc into the new format, if needed."
View
19 lisp/message.el
@@ -252,6 +252,9 @@ always use the value.")
"Normal hook, run each time a new outgoing message is initialized.
The function `message-setup' runs this hook.")
+(defvar message-mode-hook nil
+ "Hook run in message mode buffers.")
+
(defvar message-header-setup-hook nil
"Hook called narrowed to the headers when setting up a message buffer.")
@@ -708,6 +711,8 @@ Return the number of headers removed."
"----"
["To" message-goto-to t]
["Subject" message-goto-subject t]
+ ["Cc" message-goto-cc t]
+ ["Reply-to" message-goto-reply-to t]
["Summary" message-goto-summary t]
["Keywords" message-goto-keywords t]
["Newsgroups" message-goto-newsgroups t]
@@ -2557,6 +2562,9 @@ Optional NEWS will use news to forward instead of mail."
(if message-signature-before-forwarded-message
(goto-char (point-max))
(message-goto-body))
+ ;; Make sure we're at the start of the line.
+ (unless (eolp)
+ (insert "\n"))
;; Narrow to the area we are to insert.
(narrow-to-region (point) (point))
;; Insert the separators and the forwarded buffer.
@@ -2792,11 +2800,12 @@ Do a `tab-to-tab-stop' if not in those headers."
(message "No matching groups")
(pop-to-buffer "*Completions*")
(buffer-disable-undo (current-buffer))
- (erase-buffer)
- (let ((standard-output (current-buffer)))
- (display-completion-list (sort completions 'string<)))
- (goto-char (point-min))
- (pop-to-buffer cur))))))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (let ((standard-output (current-buffer)))
+ (display-completion-list (sort completions 'string<)))
+ (goto-char (point-min))
+ (pop-to-buffer cur)))))))
;;; Help stuff.
View
667 lisp/nnatp.el
@@ -1,667 +0,0 @@
-;;; nntp.el --- nntp access for Gnus
-;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'rnews)
-(require 'sendmail)
-(require 'nnheader)
-
-(eval-and-compile
- (unless (fboundp 'open-network-stream)
- (require 'tcp)))
-
-(eval-when-compile (require 'cl))
-
-(defvar nntp-address nil
- "Address of the physical nntp server.")
-
-(defvar nntp-port-number "nntp"
- "Port number on the physical nntp server.")
-
-(defvar nntp-server-hook nil
- "*Hooks for the NNTP server.
-If the kanji code of the NNTP server is different from the local kanji
-code, the correct kanji code of the buffer associated with the NNTP
-server must be specified as follows:
-
-\(setq nntp-server-hook
- (lambda ()
- ;; Server's Kanji code is EUC (NEmacs hack).
- (make-local-variable 'kanji-fileio-code)
- (setq kanji-fileio-code 0)))
-
-If you'd like to change something depending on the server in this
-hook, use the variable `nntp-address'.")
-
-(defvar nntp-server-opened-hook nil
- "*Hook used for sending commands to the server at startup.
-The default value is `nntp-send-mode-reader', which makes an innd
-server spawn an nnrpd server. Another useful function to put in this
-hook might be `nntp-send-authinfo', which will prompt for a password
-to allow posting from the server. Note that this is only necessary to
-do on servers that use strict access control.")
-(add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)
-
-(defvar nntp-server-action-alist
- '(("nntpd 1\\.5\\.11t"
- (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)))
- "Alist of regexps to match on server types and actions to be taken.
-For instance, if you want Gnus to beep every time you connect
-to innd, you could say something like:
-
-\(setq nntp-server-action-alist
- '((\"innd\" (ding))))
-
-You probably don't want to do that, though.")
-
-(defvar nntp-open-connection-function 'nntp-open-network-stream
- "*Function used for connecting to a remote system.
-It will be called with the address of the remote system.
-
-Two pre-made functions are `nntp-open-network-stream', which is the
-default, and simply connects to some port or other on the remote
-system (see nntp-port-number). The other is `nntp-open-rlogin', which
-does an rlogin on the remote system, and then does a telnet to the
-NNTP server available there (see nntp-rlogin-parameters).")
-
-(defvar nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp")
- "*Parameters to `nntp-open-login'.
-That function may be used as `nntp-open-server-function'. In that
-case, this list will be used as the parameter list given to rsh.")
-
-(defvar nntp-rlogin-user-name nil
- "*User name on remote system when using the rlogin connect method.")
-
-(defvar nntp-large-newsgroup 50
- "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
-messages will be shown to indicate the current status.")
-
-(defvar nntp-maximum-request 400
- "*The maximum number of the requests sent to the NNTP server at one time.
-If Emacs hangs up while retrieving headers, set the variable to a
-lower value.")
-
-(defvar nntp-nov-is-evil nil
- "*If non-nil, nntp will never attempt to use XOVER when talking to the server.")
-
-(defvar nntp-xover-commands '("XOVER" "XOVERVIEW")
- "*List of strings that are used as commands to fetch NOV lines from a server.
-The strings are tried in turn until a positive response is gotten. If
-none of the commands are successful, nntp will just grab headers one
-by one.")
-
-(defvar nntp-nov-gap 20
- "*Maximum allowed gap between two articles.
-If the gap between two consecutive articles is bigger than this
-variable, split the XOVER request into two requests.")
-
-(defvar nntp-connection-timeout nil
- "*Number of seconds to wait before an nntp connection times out.
-If this variable is nil, which is the default, no timers are set.")
-
-(defvar nntp-news-default-headers nil
- "*If non-nil, override `mail-default-headers' when posting news.")
-
-(defvar nntp-prepare-server-hook nil
- "*Hook run before a server is opened.
-If can be used to set up a server remotely, for instance. Say you
-have an account at the machine \"other.machine\". This machine has
-access to an NNTP server that you can't access locally. You could
-then use this hook to rsh to the remote machine and start a proxy NNTP
-server there that you can connect to.")
-
-(defvar nntp-warn-about-losing-connection t
- "*If non-nil, beep when a server closes connection.")
-
-
-
-;;; Internal variables.
-
-(defvar nntp-connection-alist nil)
-(defvar nntp-status-string "")
-(defconst nntp-version "nntp 5.0")
-(defvar nntp-inhibit-erase nil)
-
-(defvar nntp-server-xover 'try)
-(defvar nntp-server-list-active-group 'try)
-
-;; Virtual server defs.
-(defvar nntp-current-server nil)
-(defvar nntp-server-alist nil)
-(defvar nntp-server-variables
- `((nntp-address ,nntp-address)
- (nntp-open-connection-function ,nntp-open-connection-function)
- (nntp-port-number ,nntp-port-number)
- (nntp-status-string ,nntp-status-string)
- (nntp-connection-alist nil)))
-
-
-
-;;; Interface functions.
-
-(defun nntp-retrieve-headers (articles &optional group server fetch-old)
- "Retrieve the headers of ARTICLES."
- (nntp-possibly-change-group group server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (if (and (not gnus-nov-is-evil)
- (not nntp-nov-is-evil)
- (nntp-retrieve-headers-with-xover articles fetch-old))
- ;; We successfully retrieved the headers via XOVER.
- 'nov
- ;; XOVER didn't work, so we do it the hard, slow and inefficient
- ;; way.
- (let ((number (length articles))
- (count 0)
- (received 0)
- (last-point (point-min)))
- ;; Send HEAD command.
- (while articles
- (nntp-send-command
- nil
- "HEAD" (if (numberp (car articles))
- (int-to-string (car articles))
- ;; `articles' is either a list of article numbers
- ;; or a list of article IDs.
- (car articles)))
- (setq articles (cdr articles)
- count (1+ count))
- ;; Every 400 header requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9]" nil t)
- (setq received (1+ received)))
- (setq last-point (point))
- (< received count))
- ;; If number of headers is greater than 100, give
- ;; informative messages.
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (zerop (% received 20))
- (message "NNTP: Receiving headers... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response))))
- ;; Wait for text of last command.
- (goto-char (point-max))
- (re-search-backward "^[0-9]" nil t)
- (when (looking-at "^[23]")
- (while (progn
- (goto-char (- (point-max) 3))
- (not (looking-at "^\\.\r?\n")))
- (nntp-accept-response)))
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (message "NNTP: Receiving headers...done"))
-
- ;; Now all of replies are received. Fold continuation lines.
- (nnheader-fold-continuation-lines)
- ;; Remove all "\r"'s.
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (replace-match "" t t))
- 'headers))))
-
-(defun nntp-request-article (article &optional group server buffer)
- (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
- (nntp-possibly-change-group group server)
- (nntp-send-command-and-decode
- "\r\n\\.\r\n" "ARTICLE"
- (if (numberp article) (int-to-string article) article))))
-
-(defun nntp-request-body (article &optional group server)
- (nntp-possibly-change-group group server)
- (nntp-send-command
- "\r\n\\.\r\n" "BODY"
- (if (numberp article) (int-to-string article) article)))
-
-(defun nntp-request-group (group &optional server dont-check)
- (nntp-possibly-change-group nil server)
- (when (nntp-send-command "^2.*\r\n" "GROUP" group)
- (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
- (setcar (cddr entry) group))))
-
-(defun nntp-close-group (group &optional server)
- t)
-
-(defun nntp-server-opened (server)
- (and (equal server nntp-current-server)
- nntp-server-buffer
- (buffer-name nntp-server-buffer)))
-
-(defun nntp-open-server (server &optional defs connectionless)
- (nnheader-init-server-buffer)
- (if (nntp-server-opened server)
- t
- (when (or (stringp (car defs))
- (numberp (car defs)))
- (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs))))
- (unless (assq 'nntp-address defs)
- (setq defs (append defs (list (list 'nntp-address server)))))
- (nnheader-change-server 'nntp server defs)
- (or (nntp-find-connection nntp-server-buffer)
- (nntp-open-connection nntp-server-buffer))))
-
-(defun nntp-close-server (&optional server)
- (nntp-possibly-change-group nil server t)
- (let (process)
- (while (setq process (car (pop nntp-connection-alist)))
- (when (memq (process-status process) '(open run))
- (set-process-sentinel process nil)
- (set-process-filter process nil)
- (nntp-send-string process "QUIT"))
- (when (buffer-name (process-buffer process))
- (kill-buffer (process-buffer process))))))
-
-(defun nntp-request-list (&optional server)
- (nntp-possibly-change-group nil server)
- (nntp-send-command "\r\n\\.\r\n" "LIST"))
-
-(defun nntp-request-list-newsgroups (&optional server)
- (nntp-possibly-change-group nil server)
- (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS"))
-
-(defun nntp-asynchronous-p ()
- t)
-
-
-;;; Hooky functions.
-
-(defun nntp-send-mode-reader ()
- "Send the MODE READER command to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will make innd servers spawn an nnrpd process to allow actual article
-reading."
- (nntp-send-command "^.*\r\n" "MODE READER"))
-
-(defun nntp-send-nosy-authinfo ()
- "Send the AUTHINFO to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will prompt for a password."
- (nntp-send-command "^.*\r\n" "AUTHINFO USER"
- (read-string "NNTP user name: "))
- (nntp-send-command "^.*\r\n" "AUTHINFO PASS"
- (read-string "NNTP password: ")))
-
-(defun nntp-send-authinfo ()
- "Send the AUTHINFO to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will prompt for a password."
- (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name))
- (nntp-send-command "^.*\r\n" "AUTHINFO PASS"
- (read-string "NNTP password: ")))
-
-(defun nntp-send-authinfo-from-file ()
- "Send the AUTHINFO to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will prompt for a password."
- (when (file-exists-p "~/.nntp-authinfo")
- (save-excursion
- (set-buffer (get-buffer-create " *authinfo*"))
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (insert-file-contents "~/.nntp-authinfo")
- (goto-char (point-min))
- (nntp-send-command "^.*\r\n" "AUTHINFO USER" (user-login-name))
- (nntp-send-command
- "^.*\r\n" "AUTHINFO PASS"
- (buffer-substring (point) (progn (end-of-line) (point))))
- (kill-buffer (current-buffer)))))
-
-;;; Internal functions.
-
-(defun nntp-send-command (wait-for &rest strings)
- "Send STRINGS to server and wait until WAIT-FOR returns."
- (nntp-retrieve-data
- (mapconcat 'identity strings " ")
- nntp-address nntp-port-number nntp-server-buffer
- wait-for nnheader-callback-function))
-
-(defun nntp-send-command-and-decode (wait-for &rest strings)
- "Send STRINGS to server and wait until WAIT-FOR returns."
- (nntp-retrieve-data
- (mapconcat 'identity strings " ")
- nntp-address nntp-port-number nntp-server-buffer
- wait-for nnheader-callback-function t))
-
-(defun nntp-find-connection (buffer)
- "Find the connection delivering to BUFFER."
- (let ((alist nntp-connection-alist)
- process entry)
- (while (setq entry (pop alist))
- (when (eq buffer (cadr entry))
- (setq process (car entry)
- alist nil)))
- (when process
- (if (memq (process-status process) '(open run))
- process
- (when (buffer-name (process-buffer process))
- (kill-buffer (process-buffer process)))
- (setq nntp-connection-alist (delq entry nntp-connection-alist))
- nil))))
-
-(defun nntp-find-connection-entry (buffer)
- "Return the entry for the connection to BUFFER."
- (assq (nntp-find-connection buffer) nntp-connection-alist))
-
-(defun nntp-open-connection (buffer)
- "Open a connection to PORT on ADDRESS delivering output to BUFFER."
- (let* ((pbuffer (save-excursion
- (set-buffer
- (generate-new-buffer
- (format " *nntpd %s %s %s*"
- nntp-address nntp-port-number
- (buffer-name (get-buffer buffer)))))
- (buffer-disable-undo (current-buffer))
- (current-buffer)))
- (process (funcall nntp-open-connection-function pbuffer)))
- (when process
- (process-kill-without-query process)
- (nntp-wait-for process "^.*\r\n" buffer)
- (if (memq (process-status process) '(open run))
- (caar (push (list process buffer nil)
- nntp-connection-alist))
- (when (buffer-name (process-buffer process))
- (kill-buffer (process-buffer process)))
- nil))))
-
-(defun nntp-open-network-stream (buffer)
- (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
-
-(defvar nntp-tmp-first)
-(defvar nntp-tmp-wait-for)
-(defvar nntp-tmp-callback)
-(defvar nntp-tmp-buffer)
-
-(defun nntp-make-process-filter (wait-for callback buffer decode)
- `(lambda (proc string)
- (let ((nntp-tmp-wait-for ,wait-for)
- (nntp-tmp-callback ,callback)
- (nntp-tmp-buffer ,buffer))
- (nntp-process-filter proc string))))
-
-(defun nntp-process-filter (proc string)
- (let ((old-buffer (current-buffer)))
- (unwind-protect
- (let (point)
- (set-buffer (process-buffer proc))
- ;; Insert the text, moving the process-marker.
- (setq point (goto-char (process-mark proc)))
- (insert string)
- (set-marker (process-mark proc) (point))
- (if (and (= point (point-min))
- (string-match "^45" string))
- (progn
- (nntp-snarf-error-message)
- (funcall nntp-tmp-callback nil)
- (set-process-filter proc nil))
- (setq nntp-tmp-first nil)
- (if (re-search-backward nntp-tmp-wait-for nil t)
- (progn
- (if (buffer-name (get-buffer nntp-tmp-buffer))
- (save-excursion
- (set-buffer (get-buffer nntp-tmp-buffer))
- (insert-buffer-substring (process-buffer proc))))
- (funcall nntp-tmp-callback t)
- (set-process-filter proc nil)
- (erase-buffer)))))
- (set-buffer old-buffer))))
-
-(defun nntp-retrieve-data (command address port buffer
- &optional wait-for callback decode)
- "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."
- (let ((process (or (nntp-find-connection buffer)
- (nntp-open-connection buffer))))
- (if (not process)
- (nnheader-report 'nntp "Couldn't open connection to %a" address)
- (unless nntp-inhibit-erase
- (save-excursion
- (set-buffer (process-buffer process))
- (erase-buffer)))
- (nntp-send-string process command)
- (cond
- ((eq callback 'ignore)
- t)
- ((and callback wait-for)
- (set-process-filter
- process (nntp-make-process-filter wait-for callback buffer decode))
- t)
- (wait-for
- (nntp-wait-for process wait-for buffer decode))
- (t t)))))
-
-(defun nntp-send-string (process string)
- "Send STRING to PROCESS."
- (process-send-string process (concat string "\r\n")))
-
-(defun nntp-wait-for (process wait-for buffer &optional decode)
- "Wait for WAIT-FOR to arrive from PROCESS."
- (save-excursion
- (set-buffer (process-buffer process))
- (goto-char (point-min))
- (while (not (looking-at "[2345]"))
- (nntp-accept-process-output process)
- (goto-char (point-min)))
- (prog1
- (if (looking-at "[345]")
- (progn
- (nntp-snarf-error-message)
- nil)
- (goto-char (point-max))
- (while (not (re-search-backward wait-for nil t))
- (nntp-accept-process-output process))
- (nntp-decode-text (not decode))
- (save-excursion
- (set-buffer buffer)
- (insert-buffer-substring (process-buffer process))
- t))
- (erase-buffer))))
-
-(defun nntp-snarf-error-message ()
- "Save the error message in the current buffer."
- (setq nntp-status-string (buffer-string)))
-
-(defun nntp-accept-process-output (process)
- "Wait for output from PROCESS and message some dots."
- (message "Reading%s" (make-string (/ (point-max) 1000) ?.))
- (accept-process-output process))
-
-(defun nntp-accept-response ()
- "Wait for output from the process that outputs to BUFFER."
- (nntp-accept-process-output (nntp-find-connection nntp-server-buffer)))
-
-(defun nntp-possibly-change-group (group server &optional connectionless)
- (when server
- (or (nntp-server-opened server)
- (nntp-open-server server nil connectionless)))
-
- (or (nntp-find-connection nntp-server-buffer)
- (nntp-open-connection nntp-server-buffer))
-
- (when group
- (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
- (when (not (equal group (caddr entry)))
- (nntp-request-group group)))))
-
-(defun nntp-decode-text (&optional cr-only)
- "Decode the text in the current buffer."
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (delete-char -1))
- (unless cr-only
- (goto-char (point-max))
- (forward-line -1)
- (when (looking-at ".\n")
- (delete-char 2))
- (goto-char (point-min))
- (delete-region (point) (progn (forward-line 1) (point)))
- (while (search-forward "\n.." nil t)
- (delete-char -1))))
-
-(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
- (erase-buffer)
- (cond
-
- ;; This server does not talk NOV.
- ((not nntp-server-xover)
- nil)
-
- ;; We don't care about gaps.
- ((or (not nntp-nov-gap)
- fetch-old)
- (nntp-send-xover-command
- (if fetch-old
- (if (numberp fetch-old)
- (max 1 (- (car articles) fetch-old))
- 1)
- (car articles))
- (last articles) 'wait)
-
- (goto-char (point-min))
- (when (looking-at "[1-5][0-9][0-9] ")
- (delete-region (point) (progn (forward-line 1) (point))))
- (while (search-forward "\r" nil t)
- (replace-match "" t t))
- (goto-char (point-max))
- (forward-line -1)
- (when (looking-at "\\.")
- (delete-region (point) (progn (forward-line 1) (point)))))
-
- ;; We do it the hard way. For each gap, an XOVER command is sent
- ;; to the server. We do not wait for a reply from the server, we
- ;; just send them off as fast as we can. That means that we have
- ;; to count the number of responses we get back to find out when we
- ;; have gotten all we asked for.
- ((numberp nntp-nov-gap)
- (let ((count 0)
- (received 0)
- (last-point (point-min))
- (buf nntp-server-buffer) ;(process-buffer (nntp-find-connection (current-buffer))))
- first)
- ;; We have to check `nntp-server-xover'. If it gets set to nil,
- ;; that means that the server does not understand XOVER, but we
- ;; won't know that until we try.
- (while (and nntp-server-xover articles)
- (setq first (car articles))
- ;; Search forward until we find a gap, or until we run out of
- ;; articles.
- (while (and (cdr articles)
- (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
- (setq articles (cdr articles)))
-
- (when (nntp-send-xover-command first (car articles))
- (setq articles (cdr articles)
- count (1+ count))
-
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (accept-process-output)
- ;; On some Emacs versions the preceding function has
- ;; a tendency to change the buffer. Perhaps. It's
- ;; quite difficult to reproduce, because it only
- ;; seems to happen once in a blue moon.
- (set-buffer buf)
- (while (progn
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
- (setq received (1+ received)))
- (setq last-point (point))
- (< received count))
- (accept-process-output)
- (set-buffer buf)))))
-
- (when nntp-server-xover
- ;; Wait for the reply from the final command.
- (goto-char (point-max))
- (re-search-backward "^[0-9][0-9][0-9] " nil t)
- (when (looking-at "^[23]")
- (while (progn
- (goto-char (point-max))
- (forward-line -1)
- (not (looking-at "^\\.\r?\n")))
- (nntp-accept-response)))
-
- ;; We remove any "." lines and status lines.
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (delete-char -1))
- (goto-char (point-min))
- (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")
- ;(save-excursion
- ; (set-buffer nntp-server-buffer)
- ; (insert-buffer-substring buf))
- ;(erase-buffer)
- ))))
-
- nntp-server-xover)
-
-(defun nntp-send-xover-command (beg end &optional wait-for-reply)
- "Send the XOVER command to the server."
- (let ((range (format "%d-%d" beg end))
- (nntp-inhibit-erase t))
- (if (stringp nntp-server-xover)
- ;; If `nntp-server-xover' is a string, then we just send this
- ;; command.
- (if wait-for-reply
- (nntp-send-command "\r\n\\.\r\n" nntp-server-xover range)
- ;; We do not wait for the reply.
- (nntp-send-command "\r\n\\.\r\n" nntp-server-xover range))
- (let ((commands nntp-xover-commands))
- ;; `nntp-xover-commands' is a list of possible XOVER commands.
- ;; We try them all until we get at positive response.
- (while (and commands (eq nntp-server-xover 'try))
- (nntp-send-command "\r\n\\.\r\n" (car commands) range)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (and (looking-at "[23]") ; No error message.
- ;; We also have to look at the lines. Some buggy
- ;; servers give back simple lines with just the
- ;; article number. How... helpful.
- (progn
- (forward-line 1)
- (looking-at "[0-9]+\t...")) ; More text after number.
- (setq nntp-server-xover (car commands))))
- (setq commands (cdr commands)))
- ;; If none of the commands worked, we disable XOVER.
- (when (eq nntp-server-xover 'try)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (setq nntp-server-xover nil)))
- nntp-server-xover))))
-
-(provide 'nntp)
-
-;;; nntp.el ends here
View
23 lisp/nnfolder.el
@@ -66,6 +66,9 @@ it.")
(defvoo nnfolder-prepare-save-mail-hook nil
"Hook run narrowed to an article before saving.")
+(defvoo nnfolder-save-buffer-hook nil
+ "Hook run before saving the nnfolder mbox buffer.")
+
(defvoo nnfolder-inhibit-expiry nil
"If non-nil, inhibit expiry.")
@@ -222,7 +225,7 @@ it.")
(setq nnfolder-buffer-alist
(delq (car bufs) nnfolder-buffer-alist))
(set-buffer (nth 1 (car bufs)))
- (and (buffer-modified-p) (save-buffer))
+ (nnfolder-save-buffer)
(kill-buffer (current-buffer)))
(setq bufs (cdr bufs))))))
nnfolder-directory
@@ -251,7 +254,7 @@ it.")
(save-excursion
(set-buffer nnfolder-current-buffer)
;; If the buffer was modified, write the file out now.
- (and (buffer-modified-p) (save-buffer))
+ (nnfolder-save-buffer)
;; If we're shutting the server down, we need to kill the
;; buffer and remove it from the open buffer list. Or, of
;; course, if we're trying to minimize our space impact.
@@ -310,7 +313,7 @@ it.")
(nnfolder-delete-mail))
(setq rest (cons (car articles) rest))))
(setq articles (cdr articles)))
- (and (buffer-modified-p) (save-buffer))
+ (nnfolder-save-buffer)
;; Find the lowest active article in this group.
(let* ((active (cadr (assoc newsgroup nnfolder-group-alist)))
(marker (concat "\n" nnfolder-article-marker))
@@ -354,9 +357,7 @@ it.")
(goto-char (point-min))
(if (search-forward (nnfolder-article-string article) nil t)
(nnfolder-delete-mail))
- (and last
- (buffer-modified-p)
- (save-buffer))))
+ (and last (nnfolder-save-buffer))))
result))
(deffoo nnfolder-request-accept-article (group &optional server last)
@@ -379,7 +380,7 @@ it.")
(setq result (car (nnfolder-save-mail (and (stringp group) group)))))
(save-excursion
(set-buffer nnfolder-current-buffer)
- (and last (buffer-modified-p) (save-buffer))))
+ (and last (nnfolder-save-buffer))))
(nnmail-save-active nnfolder-group-alist nnfolder-active-file)
(unless result
(nnheader-report 'nnfolder "Couldn't store article"))
@@ -394,7 +395,7 @@ it.")
nil
(nnfolder-delete-mail t t)
(insert-buffer-substring buffer)
- (and (buffer-modified-p) (save-buffer))
+ (nnfolder-save-buffer)
t)))
(deffoo nnfolder-request-delete-group (group &optional force server)
@@ -720,6 +721,12 @@ it.")
;; If not, we translate dots into slashes.
(concat dir (nnheader-replace-chars-in-string group ?. ?/)))))
+(defun nnfolder-save-buffer ()
+ "Save the buffer."
+ (when (buffer-modified-p)
+ (run-hooks 'nnfolder-save-buffer-hook)
+ (save-buffer)))
+
(provide 'nnfolder)
;;; nnfolder.el ends here
View
3  lisp/nnspool.el
@@ -162,6 +162,9 @@ there.")
(file-truename nnspool-spool-directory))))
(nnspool-close-server)
(nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory))
+ ((not (file-exists-p nnspool-active-file))
+ (nnheader-report 'nnspool "The active file doesn't exist: %s"
+ nnspool-active-file))
(t
(nnheader-report 'nnspool "Opened server %s using directory %s"
server nnspool-spool-directory)
View
30 lisp/nntp.el
@@ -257,8 +257,8 @@ instead use `nntp-server-buffer'.")
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
(zerop (% received 20))
- (message "NNTP: Receiving headers... %d%%"
- (/ (* received 100) number)))
+ (nnheader-message 7 "NNTP: Receiving headers... %d%%"
+ (/ (* received 100) number)))
(nntp-accept-response))))
;; Wait for text of last command.
(goto-char (point-max))
@@ -270,7 +270,7 @@ instead use `nntp-server-buffer'.")
(nntp-accept-response)))
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
- (message "NNTP: Receiving headers...done"))
+ (nnheader-message 7 "NNTP: Receiving headers...done"))
;; Now all of replies are received. Fold continuation lines.
(nnheader-fold-continuation-lines)
@@ -370,7 +370,7 @@ servers."
(process-sentinel nntp-server-process))
(set-process-sentinel nntp-server-process nil))
;; We cannot send QUIT command unless the process is running.
- (when (nntp-server-opened)
+ (when (nntp-server-opened server)
(nntp-send-command nil "QUIT")
;; Give the QUIT time to arrive.
(sleep-for 1)))
@@ -378,9 +378,12 @@ servers."
(deffoo nntp-request-close ()
"Close all server connections."
- (let (proc entry)
+ (let (proc)
(while nntp-opened-connections
(when (setq proc (pop nntp-opened-connections))
+ ;; Un-set default sentinel function before closing connection.
+ (when (eq 'nntp-default-sentinel (process-sentinel proc))
+ (set-process-sentinel proc nil))
(condition-case ()
(process-send-string proc (concat "QUIT" nntp-end-of-line))
(error nil))
@@ -391,7 +394,8 @@ servers."
(and nntp-async-buffer
(buffer-name nntp-async-buffer)
(kill-buffer nntp-async-buffer))
- (let ((alist (cddr (assq 'nntp nnoo-state-alist))))
+ (let ((alist (cddr (assq 'nntp nnoo-state-alist)))
+ entry)
(while (setq entry (pop alist))
(and (setq proc (cdr (assq 'nntp-async-buffer entry)))
(buffer-name proc)
@@ -462,7 +466,7 @@ servers."
(prog1
(and (nntp-send-command
;; A bit odd regexp to ensure working over rlogin.
- "^\\.\\(\r?\n\\|\r$\\)" "ARTICLE" art)
+ "^\\.\r?\n" "ARTICLE" art)
(if (numberp id)
(cons nntp-current-group id)
;; We find out what the article number was.
@@ -664,7 +668,7 @@ It will prompt for a password."
(setq server (caar servers)))
(when (and server
nntp-warn-about-losing-connection)
- (message "nntp: Connection closed to server %s" server)
+ (nnheader-message 3 "nntp: Connection closed to server %s" server)
(setq nntp-current-group "")
(ding))))
@@ -845,8 +849,8 @@ It will prompt for a password."
(message-log-max nil))
(unless (= dotnum newnum)
(setq dotnum newnum)
- (message "NNTP: Reading %s"
- (make-string dotnum ?.)))))
+ (nnheader-message 7 "NNTP: Reading %s"
+ (make-string dotnum ?.)))))
(nntp-accept-response)))
;; Remove "...".
(when (and nntp-debug-read (> dotnum 0))
@@ -1076,7 +1080,7 @@ If SERVICE, this this as the port number."
(save-excursion
(set-buffer nntp-server-buffer)
(setq nntp-status-string "")
- (message "nntp: Connecting to server on %s..." nntp-address)
+ (nnheader-message 5 "nntp: Connecting to server on %s..." nntp-address)
(cond ((and server (nntp-open-server-internal server service))
(setq nntp-address server)
(setq status
@@ -1222,9 +1226,9 @@ defining this function as macro."
;; We cannot use `accept-process-output'.
;; Fujitsu UTS requires messages during sleep-for.
;; I don't know why.
- (message "NNTP: Reading...")
+ (nnheader-message 5 "NNTP: Reading...")
(sleep-for 1)
- (message ""))
+ (nnheader-message 5 ""))
(condition-case errorcode
(accept-process-output nntp-server-process 1)
(error
View
4 lisp/nnvirtual.el
@@ -203,14 +203,14 @@ virtual group.")
(deffoo nnvirtual-request-group (group &optional server dont-check)
(nnvirtual-possibly-change-server server)
+ (setq nnvirtual-component-groups
+ (delete (nnvirtual-current-group) nnvirtual-component-groups))
(cond
((null nnvirtual-component-groups)
(setq nnvirtual-current-group nil)
(nnheader-report 'nnvirtual "No component groups in %s" group))
(t
(unless dont-check
- (setq nnvirtual-component-groups
- (delete (nnvirtual-current-group) nnvirtual-component-groups))
(nnvirtual-create-mapping))
(setq nnvirtual-current-group group)
(let ((len (length nnvirtual-mapping)))
View
177 lisp/x-easymenu.el
@@ -1,177 +0,0 @@
-;;; easymenu.el - Easy menu support for Emacs 19 and XEmacs.
-;;
-;; $Id: x-easymenu.el,v 1.1 1996/05/29 05:36:45 steve Exp $
-;;
-;; LCD Archive Entry:
-;; easymenu|Per Abrahamsen|abraham@iesd.auc.dk|
-;; Easy menu support for XEmacs|
-;; $Date: 1996/05/29 05:36:45 $|$Revision: 1.1 $|~/misc/easymenu.el.gz|
-
-;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-;;
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;; Commentary:
-;;
-;; Easymenu allows you to define menus for both Emacs 19 and XEmacs.
-;;
-;; This file
-;; The advantages of using easymenu are:
-;;
-;; - Easier to use than either the Emacs 19 and XEmacs menu syntax.
-;;
-;; - Common interface for Emacs 18, Emacs 19, and XEmacs.
-;; (The code does nothing when run under Emacs 18).
-;;
-;; The public functions are:
-;;
-;; - Function: easy-menu-define SYMBOL MAPS DOC MENU
-;; SYMBOL is both the name of the variable that holds the menu and
-;; the name of a function that will present a the menu.
-;; MAPS is a list of keymaps where the menu should appear in the menubar.
-;; DOC is the documentation string for the variable.
-;; MENU is an XEmacs style menu description.
-;;
-;; See the documentation for easy-menu-define for details.
-;;
-;; - Function: easy-menu-change PATH NAME ITEMS
-;; Change an existing menu.
-;; The menu must already exist an be visible on the menu bar.
-;; PATH is a list of strings used for locating the menu on the menu bar.
-;; NAME is the name of the menu.
-;; ITEMS is a list of menu items, as defined in `easy-menu-define'.
-;;
-;; - Function: easy-menu-add MENU [ MAP ]
-;; Add MENU to the current menubar in MAP.
-;;
-;; - Function: easy-menu-remove MENU
-;; Remove MENU from the current menubar.
-;;
-;; Emacs 19 never uses `easy-menu-add' or `easy-menu-remove', menus
-;; automatically appear and disappear when the keymaps specified by
-;; the MAPS argument to `easy-menu-define' are activated.
-;;
-;; XEmacs will bind the map to button3 in each MAPS, but you must
-;; explicitly call `easy-menu-add' and `easy-menu-remove' to add and
-;; remove menus from the menu bar.
-
-;;; Code:
-
-;;;###autoload
-(defmacro easy-menu-define (symbol maps doc menu)
- "Define a menu bar submenu in maps MAPS, according to MENU.
-The arguments SYMBOL and DOC are ignored; they are present for
-compatibility only. SYMBOL is not evaluated. In other Emacs versions
-these arguments may be used as a variable to hold the menu data, and a
-doc string for that variable.
-
-The first element of MENU must be a string. It is the menu bar item name.
-The rest of the elements are menu items.
-
-A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE]
-
-NAME is a string--the menu item name.
-
-CALLBACK is a command to run when the item is chosen,
-or a list to evaluate when the item is chosen.
-
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
-
-Alternatively, a menu item may have the form:
-
- [ NAME CALLBACK [ KEYWORD ARG ] ... ]
-
-Where KEYWORD is one of the symbol defined below.
-
- :keys KEYS
-
-KEYS is a string; a complex keyboard equivalent to this menu item.
-
- :active ENABLE
-
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
-
- :suffix NAME
-
-NAME is a string; the name of an argument to CALLBACK.
-
- :style STYLE
-
-STYLE is a symbol describing the type of menu item. The following are
-defined:
-
-toggle: A checkbox.
- Currently just prepend the name with the string \"Toggle \".
-radio: A radio button.
-nil: An ordinary menu item.
-
- :selected SELECTED
-
-SELECTED is an expression; the checkbox or radio button is selected
-whenever this expression's value is non-nil.
-Currently just disable radio buttons, no effect on checkboxes.
-
-A menu item can be a string. Then that string appears in the menu as
-unselectable text. A string consisting solely of hyphens is displayed
-as a solid horizontal line.
-
-A menu item can be a list. It is treated as a submenu.
-The first element should be the submenu name. That's used as the
-menu item in the top-level menu. The cdr of the submenu list
-is a list of menu items, as above."
- (` (progn
- (defvar (, symbol) nil (, doc))
- (easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu)))))
-
-(defun easy-menu-do-define (symbol maps doc menu)
- (set symbol menu)
- (fset symbol (list 'lambda '(e)
- doc
- '(interactive "@e")
- '(run-hooks 'activate-menubar-hook)
- '(setq zmacs-region-stays 't)
- (list 'popup-menu symbol)))
- (mapcar (function (lambda (map) (define-key map 'button3 symbol)))
- (if (keymapp maps) (list maps) maps)))
-
-(fset 'easy-menu-change (symbol-function 'add-menu))
-
-(defun easy-menu-add (menu &optional map)
- "Add MENU to the current menu bar."
- (cond ((null current-menubar)
- ;; Don't add it to a non-existing menubar.
- nil)
- ((assoc (car menu) current-menubar)
- ;; Already present.
- nil)
- ((equal current-menubar '(nil))
- ;; Set at left if only contains right marker.
- (set-buffer-menubar (list menu nil)))
- (t
- ;; Add at right.
- (set-buffer-menubar (copy-sequence current-menubar))
- (add-menu nil (car menu) (cdr menu)))))
-
-(defun easy-menu-remove (menu)
- "Remove MENU from the current menu bar."
- (and current-menubar
- (assoc (car menu) current-menubar)
- (delete-menu-item (list (car menu)))))
-
-(provide 'easymenu)
-
-;;; easymenu.el ends here
View
5 texi/ChangeLog
@@ -1,3 +1,8 @@
+Tue May 28 21:19:29 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Composing Messages): Deletia.
+ (Emacs/XEmacs code): New.
+
Sun May 26 18:28:19 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Paging the Article): Moved.
View
204 texi/gnus.texi
@@ -5421,7 +5421,7 @@ Commands}).
@findex gnus-summary-refer-parent-article
@kindex ^ (Summary)
If you'd like to read the parent of the current article, and it is not
-displayed in the article buffer, you might still be able to. That is,
+displayed in the summary buffer, you might still be able to. That is,
if the current group is fetched by @sc{nntp}, the parent hasn't expired
and the @code{References} in the current article are not mangled, you
can just press @kbd{^} or @kbd{A r}
@@ -6414,9 +6414,9 @@ to @kbd{C-c C-c} to make Gnus try to post using the foreign server.
* Posting Server:: What server should you post via?
* Mail and Post:: Mailing and posting at the same time.
* Archived Messages:: Where Gnus stores the messages you've sent.
-* Posting Styles:: An easier way to configure some key elements.
+@c * Posting Styles:: An easier way to configure some key elements.
@c * Drafts:: Postponing messages and rejected messages.
-* Rejected Articles:: What happens if the server doesn't like your article?
+@c * Rejected Articles:: What happens if the server doesn't like your article?
@end menu
Also see @pxref{Canceling and Superseding} for information on how to
@@ -6671,84 +6671,83 @@ of names).
@end table
-@node Posting Styles
-@section Posting Styles
-@cindex posting styles
-@cindex styles
-
-All them variables, they make my head swim.
-
-So what if you want a different @code{Organization} and signature based
-on what groups you post to? And you post both from your home machine
-and your work machine, and you want different @code{From} lines, and so
-on?
-
-@vindex gnus-posting-styles
-One way to do stuff like that is to write clever hooks that change the
-variables you need to have changed. That's a bit boring, so somebody
-came up with the bright idea of letting the user specify these things in
-a handy alist. Here's an example of a @code{gnus-posting-styles}
-variable:
-
-@lisp
-((".*"
- (signature . "Peace and happiness")
- (organization . "What me?"))
- ("^comp"
- (signature . "Death to everybody"))
- ("comp.emacs.i-love-it"
- (organization . "Emacs is it")))
-@end lisp
-
-As you might surmise from this example, this alist consists of several
-@dfn{styles}. Each style will be applicable if the first element
-``matches'', in some form or other. The entire alist will be iterated
-over, from the beginning towards the end, and each match will be
-applied, which means that attributes in later styles that match override
-the same attributes in earlier matching styles. So
-@samp{comp.programming.literate} will have the @samp{Death to everybody}
-signature and the @samp{What me?} @code{Organization} header.
-
-The first element in each style is called the @code{match}. If it's a
-string, then Gnus will try to regexp match it against the group name.
-If it's a function symbol, that function will be called with no
-arguments. If it's a variable symbol, then the variable will be
-referenced. If it's a list, then that list will be @code{eval}ed. In
-any case, if this returns a non-@code{nil} value, then the style is said
-to @dfn{match}.
-
-Each style may contain a arbitrary amount of @dfn{attributes}. Each
-attribute consists of a @var{(name . value)} pair. The attribute name
-can be one of @code{signature}, @code{organization} or @code{from}. The
-attribute name can also be a string. In that case, this will be used as
-a header name, and the value will be inserted in the headers of the
-article.
-
-The attribute value can be a string (used verbatim), a function (the
-return value will be used), a variable (its value will be used) or a
-list (it will be @code{eval}ed and the return value will be used).
-
-So here's a new example:
-
-@lisp
-(setq gnus-posting-styles
- '((".*"
- (signature . "~/.signature")
- (from . "user@@foo (user)")
- ("X-Home-Page" . (getenv "WWW_HOME"))
- (organization . "People's Front Against MWM"))
- ("^rec.humor"
- (signature . my-funny-signature-randomizer))
- ((equal (system-name) "gnarly")
- (signature . my-quote-randomizer))
- (posting-from-work-p
- (signature . "~/.work-signature")
- (from . "user@@bar.foo (user)")
- (organization . "Important Work, Inc"))
- ("^nn.+:"
- (signature . "~/.mail-signature"))))
-@end lisp
-
+@c @node Posting Styles
+@c @section Posting Styles
+@c @cindex posting styles
+@c @cindex styles
+@c
+@c All them variables, they make my head swim.
+@c
+@c So what if you want a different @code{Organization} and signature based
+@c on what groups you post to? And you post both from your home machine
+@c and your work machine, and you want different @code{From} lines, and so
+@c on?
+@c
+@c @vindex gnus-posting-styles
+@c One way to do stuff like that is to write clever hooks that change the
+@c variables you need to have changed. That's a bit boring, so somebody
+@c came up with the bright idea of letting the user specify these things in
+@c a handy alist. Here's an example of a @code{gnus-posting-styles}
+@c variable:
+@c
+@c @lisp
+@c ((".*"
+@c (signature . "Peace and happiness")
+@c (organization . "What me?"))
+@c ("^comp"
+@c (signature . "Death to everybody"))
+@c ("comp.emacs.i-love-it"
+@c (organization . "Emacs is it")))
+@c @end lisp
+@c
+@c As you might surmise from this example, this alist consists of several
+@c @dfn{styles}. Each style will be applicable if the first element
+@c ``matches'', in some form or other. The entire alist will be iterated
+@c over, from the beginning towards the end, and each match will be
+@c applied, which means that attributes in later styles that match override
+@c the same attributes in earlier matching styles. So
+@c @samp{comp.programming.literate} will have the @samp{Death to everybody}
+@c signature and the @samp{What me?} @code{Organization} header.
+@c
+@c The first element in each style is called the @code{match}. If it's a
+@c string, then Gnus will try to regexp match it against the group name.
+@c If it's a function symbol, that function will be called with no
+@c arguments. If it's a variable symbol, then the variable will be
+@c referenced. If it's a list, then that list will be @code{eval}ed. In
+@c any case, if this returns a non-@code{nil} value, then the style is said
+@c to @dfn{match}.
+@c
+@c Each style may contain a arbitrary amount of @dfn{attributes}. Each
+@c attribute consists of a @var{(name . value)} pair. The attribute name
+@c can be one of @code{signature}, @code{organization} or @code{from}. The
+@c attribute name can also be a string. In that case, this will be used as
+@c a header name, and the value will be inserted in the headers of the
+@c article.
+@c
+@c The attribute value can be a string (used verbatim), a function (the
+@c return value will be used), a variable (its value will be used) or a
+@c list (it will be @code{eval}ed and the return value will be used).
+@c
+@c So here's a new example:
+@c
+@c @lisp
+@c (setq gnus-posting-styles
+@c '((".*"
+@c (signature . "~/.signature")
+@c (from . "user@@foo (user)")
+@c ("X-Home-Page" . (getenv "WWW_HOME"))
+@c (organization . "People's Front Against MWM"))
+@c ("^rec.humor"
+@c (signature . my-funny-signature-randomizer))
+@c ((equal (system-name) "gnarly")
+@c (signature . my-quote-randomizer))
+@c (posting-from-work-p
+@c (signature . "~/.work-signature")
+@c (from . "user@@bar.foo (user)")
+@c (organization . "Important Work, Inc"))
+@c ("^nn.+:"
+@c (signature . "~/.mail-signature"))))
+@c @end lisp
@c @node Drafts
@c @section Drafts
@@ -11965,6 +11964,7 @@ and general method of operations.
* Headers:: How Gnus stores headers internally.
* Ranges:: A handy format for storing mucho numbers.
* Group Info:: The group info format.
+* Emacs/XEmacs Code:: Gnus can be run under all modern Emacsen.
* Various File Formats:: Formats of files that Gnus use.
@end menu
@@ -12851,6 +12851,48 @@ Actually that @samp{marks} rule is a fib. A @samp{marks} is a
in pseudo-BNF.
+@node Emacs/XEmacs Code
+@subsection Emacs/XEmacs Code
+@cindex XEmacs
+@cindex Emacsen
+
+While Gnus runs under Emacs, XEmacs and Mule, I decided that one of the
+platforms must be the primary one. I chose Emacs. Not because I don't
+like XEmacs or Mule, but because it comes first alphabetically.
+
+This means that Gnus will byte-compile under Emacs with nary a warning,
+while XEmacs will pump out gigabytes of warnings while byte-compiling.
+As I use byte-compilation warnings to help me root out trivial errors in
+Gnus, that's very useful.
+
+I've also consistently used Emacs function interfaces, but have used
+Gnusey aliases for the functions. To take an example: Emacs defines a
+@code{run-at-time} function while XEmacs defines a @code{start-itimer}
+function. I then define a function called @code{gnus-run-at-time} that
+takes the same parameters as the Emacs @code{run-at-time}. When running
+Gnus under Emacs, the former function is just an alias for the latter.
+However, when running under XEmacs, the former is an alias for the
+following function:
+
+@lisp
+(defun gnus-xmas-run-at-time (time repeat function &rest args)
+ (start-itimer
+ "gnus-run-at-time"
+ `(lambda ()
+ (,function ,@@args))
+ time repeat))
+@end lisp
+
+This sort of thing has been done for bunches of functions. Gnus does
+not redefine any native Emacs functions while running under XEmacs -- it
+does this @code{defalias} thing with Gnus equivalents instead. Cleaner
+all over.
+
+Of course, I could have chosen XEmacs as my native platform and done
+mapping functions the other way around. But I didn't. The performance
+hit these indirections impose on Gnus under XEmacs should be slight.
+
+
@node Various File Formats
@subsection Various File Formats
View
6 texi/message.texi
@@ -434,8 +434,12 @@ Number of spaces to indent yanked messages.
@item message-cite-function
@vindex message-cite-function
+@findex message-cite-original
+@findex sc-cite-original
+@cindex SuperCite
Function for citing an original message. The default is
-@code{message-cite-original}.
+@code{message-cite-original}. You can also set it to
+@code{sc-cite-original} to use SuperCite.
@item message-indent-citation-function
@vindex message-indent-citation-function
Please sign in to comment.
Something went wrong with that request. Please try again.