+Tue Jun 18 12:24:34 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-xmas.el (gnus-xmas-group-startup-message): Fix mode line.
+
+ * gnus-picon.el (gnus-article-display-picons): When displaying in
+ the article buffer, insert picon in separator line.
+ (gnus-article-display-picons): Get more picons.
+ (gnus-picons-insert-face-if-exists): New implementation.
+ (gnus-picons-get-maximum-picons): New variable.
+
+ * gnus-xmas.el (gnus-xmas-summary-menu-add): Change order.
+
+ * messagexmas.el (message-toolbar): Go to message info.
+
+ * gnus-xmas.el (gnus-xmas-mode-line-buffer-identification): New
+ function.
+
+ * gnus-ems.el (gnus-mode-line-buffer-identification): New alias.
+
+ * gnus-xmas.el (gnus-xmas-article-show-hidden-text): New function.
+
+ * smiley.el (smiley-regexp-alist): Require whitespace before
+ smiley.
+
+ * gnus-xmas.el (gnus-xmas-article-display-xface): Use new
+ `gnus-x-face' face.
+
+ * smiley.el (smiley-end-paren-p): New function.
+ (smiley-buffer): Use it.
+
+ * gnus.el (gnus-group-update-group-line): Protect against nil
+ groups.
+
+ * nntp.el (nntp-open-server-semi-internal): Better error message.
+
+ * gnus.el (gnus-get-function): Accept a noerror param.
+ (gnus-request-head): Use it.
+
+ * messagexmas.el (message-xmas-setup-toolbar): Would bug out on
+ second run.
+
+Tue Jun 18 09:48:12 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
+
+ * gnus-xmas.el (gnus-xmas-article-display-xface): Insert X-Face
+ after From:.
+ (gnus-summary-toolbar): New exit tool.
+
+Tue Jun 18 09:46:57 1996 Chuck Thompson <cthomp@xemacs.org>
+
+ * custom.el (custom-face-import): Check for face name.
+
+Tue Jun 18 06:23:45 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-execute-command): Use `shell-command-name'.
+
+ * gnus-uu.el (gnus-uu-treat-archive): Use `shell-command-switch'.
+
+ * gnus.el (gnus-summary-mode-line-format-alist): Would break on
+ %U.
+
+ * message.el (message-setup): Delete excess line.
+
+ * nnmh.el (nnmh-request-list-1): Regexp-quote file name.
+
+Mon Jun 17 04:38:16 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-score.el (gnus-summary-increase-score): Always kill the
+ score help buffer.
+ (gnus-score-insert-help): Only insert scores on relevant match
+ types.
+
+ * message.el (message-send-news): Cleanup headers.
+
+ * gnus-picon.el (gnus-group-display-picons): Make sure the buffer
+ is created.
+
+ * smiley.el (annotations): Required.
+
+ * nnmail.el (nnmail-move-inbox): Didn't push proper file onto list
+ of moved inboxes.
+
+ * gnus-msg.el (gnus-copy-article-buffer): Exclude "From " lines.
+
+Sun Jun 16 08:18:18 1996 Barry A. Warsaw <bwarsaw@anthem.cnri.reston.va.us>
+
+ * gnus.el (gnus-read-save-file-name): Better prompting.
+
+Sun Jun 16 01:18:18 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-request-head): Support fetching heads from all
+ backends.
+ (gnus-read-header): Use it.
+ (gnus-header-value): No continuation headers.
+ (gnus-summary-mark-article-as-unread): Beep on unmarkable
+ articles.
+
+ * nnspool.el (nnspool-request-head): Fold continuation lines.
+ * nntp.el (nntp-request-head): Ditto.
+
+ * gnus.el (gnus-group-delete-group): Dox fix.
+ (gnus-summary-prepare-threads): Output saved mark.
+ (gnus-summary-reselect-current-group): Ding on ephemeral groups.
+
+ * nnmail.el (nnmail-internal-password): Cache password.
+
+ * message.el (message-buffer-name): Better non-group news name.
+ (message-insert-to): Don't insert ", , ,".
+ (message-insert-newsgroups): Ditto.
+
+ * gnus-srvr.el (gnus-server-set-status): New function.
+ (gnus-server-close-server): Use it.
+ (gnus-server-update-server): Update browsed servers.
+
+Sat Jun 15 11:32:14 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * smiley.el (smiley-circle-color): New variable.
+
+ * gnus-xmas.el (gnus-xmas-highlight-selected-summary): Only use on
+ XEmacs 19.13.
+
+Sat Jun 15 09:07:05 1996 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no>
+
+ * gnus.el: Gnus v5.2.18-19 is released.
+
Sat Jun 15 10:44:16 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* smiley.el: Included in distribution.
(gnus-group-line-format-alist): Let N have its old definition.
(gnus-group-catchup-group-hook): New variable.
(gnus-group-catchup): Use it.
- (gnus-group-remove-mark): Give a useful return value.
- (gnus-group-kill-group): Would bug out when killing lots of dead
- groups.
-
-Thu Jan 25 09:32:19 1996 Jack Vinson <jvinson@cheux.ecs.umass.edu>
-
- * gnus.el (gnus-group-insert-group-line) : Changed "header" to
- "gnus-tmp-header" for parameter that gets passed to user
- functions. Set to the group name, but may not necessarily want
- this.
- (gnus-group-set-mode-line) : ditto, gnus-tmp-header set to nil.
- (gnus-set-mode-line) : ditto, gnus-tmp-header set to nil.
-
-Fri Jan 26 07:47:59 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
-
- * gnus.el (gnus): Goto the first unread group.
-
- * gnus.el: 0.32 is released.
-
-Thu Jan 25 18:27:03 1996 Lars Ingebrigtsen <lars@eyesore.no>
-
- * gnus.el: Autoload `gnus-group-highlight-line'.
-
- * gnus-vis.el (gnus-article-highlight-headers): Wrap the regexp in
- parentheses.
-
- * nnmbox.el (nnmbox-request-group): Don't bug out on non-existant
- groups.
- * nnbabyl.el (nnbabyl-request-group): Ditto.
- (nnbabyl-possibly-change-newsgroup): Return t.
-
- * gnus.el (gnus-group-insert-group-line): Define gnus-tmp-header.
-
- * gnus-msg.el (gnus-mail-parse-comma-list): New function.
- (gnus-mail-reply): Use it.
- (gnus-mail-reply): Merge follow-to headers.
-
- * gnus-score.el (gnus-summary-score-map): New implementation.
-
- * gnus.el (gnus-summary-exit): Remove articles before updating.
- (gnus-summary-next-article): Accept a param to force slightly.
-
-Thu Jan 25 08:41:44 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
-
- * nnml.el (nnml-deletable-article-p): Always responed with nil.
-
-Thu Jan 25 08:45:52 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-
- * gnus.el: 0.31 is released.
-
- * nnmail.el (nnmail-insert-lines): Would return negative lines
- numbers.
-
- * gnus-xmas.el (gnus-xmas-extent-start-open): New function.
-
- * gnus-topic.el (gnus-topic-insert-topic-line): Remove excess
- properties.
-
- * gnus-xmas.el (gnus-xmas-topic-remove-excess-properties): New
- function.
-
-Thu Jan 25 07:34:05 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
-
- * gnus-ems.el (gnus-extent-detached-p): New alias.
-
- * gnus-xmas.el (gnus-xmas-find-glyph-directory): Changed from
- "etc" to "etc/gnus".
-
-Tue Jan 23 13:40:35 1996 Lars Ingebrigtsen <lars@eyesore.no>
-
- * gnus-score.el (gnus-score-make-menu-bar): New function.
- (gnus-score-menu-hook): New variable.
-
- * gnus-vis.el (gnus-article-next-button): Move point.
-
- * nndoc.el (nndoc-type-alist): Recognize ends of digests.
- (nndoc-retrieve-headers): Don't bug out on non-existant articles.
-
- * gnus-msg.el (gnus-mail-buffer): Renamed.
-
- * gnus-cache.el (gnus-cache-possibly-remove-articles): Check some
- more.
-
- * nnmail.el (nnmail-insert-lines): Off by 1.
-
- * nnml.el (nnml-deletable-article-p): Check for file writability.
- * nnmh.el (nnml-deletable-article-p): Ditto.
-
- * gnus-msg.el (gnus-associate-buffer-with-draft): Allow
- disabling.
- (gnus-use-draft): New variable.
-
- * gnus.el (gnus-summary-move-article): Use `move' action by
- default.
-
- * nnmail.el (nnmail-get-split-group): Be more restrictive in
- selecting procmail spools.
- (nnmail-get-spool-files): Don't return the spool file when doing a
- single procmail file.
-
- * gnus.el (gnus-summary-move-article): Allow moving to the same
- group.
-
- * gnus-score.el (gnus-score-pretty-print): New command and
- keystroke.
- (gnus-summary-increase-score): Would always bug out.
- (gnus-score-edit-done): Change windows before loading score file.
-
- * gnus.el (gnus-summary-reparent-thread): Rethread after
- reparenting.
-
- * gnus-xmas.el (gnus-xmas-make-overlay): Don't make extents
- undetachable.
-
- * nndoc.el (nndoc-post-type): New variable.
-
-Tue Jan 23 13:39:11 1996 Eberhard Mattes <mattes@azu.informatik.uni-stuttgart.de>
-
- * nndoc.el (nndoc-request-type): New function.
-
-Tue Jan 23 00:13:10 1996 Lars Ingebrigtsen <lars@eyesore.no>
-
- * gnus.el (gnus-group-group-indentation): New function.
- (gnus-group-update-group-line): Use it.
- (gnus-group-update-group): Indent.
-
- * gnus-topic.el (gnus-topic-hide-subtopics): Removed variable.
- (gnus-topic-prepare-topic): Indent group lines.
- (gnus-topic-yank-group): Indent groups.
-
- * gnus.el (gnus-group-update-hook): New variable.
- (gnus-group-insert-group-line): Use it.
-
- * gnus-vis.el (gnus-group-highlight-line): New function.
-
- * gnus.el (gnus-group-entry): New macro.
-
- * gnus-vis.el (gnus-group-highlight): New variable.
-
- * gnus-topic.el (gnus-topic-insert-topic-line): Would show "..."
- too often.
- (gnus-topic-indent): Don't move point.
- (gnus-topic-unindent): Ditto.
- (gnus-topic-prepare-topic): Display unread articles in sub-topics.
-
- * nnsoup.el (nnsoup-next-prefix): New function.
- (nnsoup-read-areas): Use it.
-
- * gnus-soup.el (gnus-soup-set-area-prefix): New macro.
-
- * nnsoup.el (nnsoup-tmp-directory): New directory.
- (nnsoup-write-active-file): Save it.
- (nnsoup-unpack-packets): Use it.
-
- * gnus-msg.el (gnus-dissociate-buffer-from-draft): New command and
- keystroke.
-
- * gnus.el (gnus-group-list-groups): Goto last group if at eob.
-
- * gnus-topic.el (gnus-topic-mode): Use it.
- (gnus-topic-goto-next-group): New function.
-
- * gnus.el (gnus-group-list-groups): Allow positioning point in
- topic buffers.
- (gnus-group-goto-next-group-function): New internal variable.
-
- * nnsoup.el (nnsoup-read-active-file): Give a proper return
- value.
-
- * gnus.el (gnus-start-news-server): Give a better error message.
-
-Mon Jan 21 23:34:55 1996 Morioka Tomohiko <morioka@jaist.ac.jp>
-
- * gnus-mh.el (gnus-mh-mail-setup): It didn't work when pressing
- `R' or yanking because of lack of setting to variable
- `mail-reply-buffer' and mh-sent-from-folder buffer local variable
- `mh-show-buffer'.
-
-Mon Jan 22 02:58:42 1996 Lars Ingebrigtsen <lars@eyesore.no>
-
- * nntp.el (nntp-open-server-internal): Make sure that the server
- was successfully opened.
-
- * gnus.el (gnus-read-active-file): Wouldn't activate properly.
- (gnus-read-active-file): Ignore errors from the archive server.
-
- * nnbabyl.el (nnbabyl-request-group): Ditto.
-
- * nnmbox.el (nnmbox-request-group): Would bug out.
-
-Sat Jan 20 20:39:03 1996 Steven L. Baur <steve@miranova.com>
-
- * nnmbox.el (nnmbox-read-mbox): find-file-noselect ->
- nnheader-find-file-noselect.
-
-Mon Jan 22 01:15:52 1996 Lars Ingebrigtsen <lars@eyesore.no>
-
- * gnus.el (gnus-group-mark-buffer): Optional param.
-
- * nnsoup.el (nnsoup-request-expire-articles): Message more.
- (nnsoup-read-active-file): Add proper active info.
- (nnsoup-request-group): New implementation.
- (nnsoup-request-list): Ditto.
-
-Sun Jan 21 08:22:47 1996 Lars Ingebrigtsen <lars@eyesore.no>
-
- * gnus.el (gnus-request-article-this-buffer): Update sparse
- articles.
- (gnus-data-set-number): New macro.
- (gnus-summary-update-article): Use it.
-
-Sun Jan 21 03:54:18 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
-
- * gnus-soup.el (gnus-soup-add-article): Don't save canceled
- articles.
-
+ (gnus-group-remove-mark): Gi\ No newline at end of file
(defun custom-face-import (custom value)
"Modify CUSTOM's VALUE to match internal expectations."
- (let ((name (symbol-name value)))
+ (let ((name (or (and (facep value) (symbol-name (face-name value)))
+ (symbol-name value))))
(list (if (string-match "\
custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)"
name)
(defvar gnus-supercite-regexp
(concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
">>>>> +\"\\([^\"\n]+\\)\" +==")
- "Regexp matching normal SuperCite attribution lines.
+ "Regexp matching normal Supercite attribution lines.
The first grouping must match prefixes added by other packages.")
(defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
- "Regexp matching mangled SuperCite attribution lines.
-The first regexp group should match the SuperCite attribution.")
+ "Regexp matching mangled Supercite attribution lines.
+The first regexp group should match the Supercite attribution.")
(defvar gnus-cite-minimum-match-count 2
"Minimum number of identical prefixes before we believe it's a citation.")
;; WROTE: is the attribution line number
;; IN: is the line number of the previous line if part of the same attribution,
;; PREFIX: Is the citation prefix of the attribution line(s), and
-;; TAG: Is a SuperCite tag, if any.
+;; TAG: Is a Supercite tag, if any.
(defvar gnus-cited-text-button-line-format-alist
`((?b beg ?d)
end (progn (beginning-of-line 2) (point))
start end)
(goto-char begin)
- ;; Ignore standard SuperCite attribution prefix.
+ ;; Ignore standard Supercite attribution prefix.
(if (looking-at gnus-supercite-regexp)
(if (match-end 1)
(setq end (1+ (match-end 1)))
;;
;; WROTE is the attribution line number.
;; PREFIX is the attribution line prefix.
- ;; TAG is the SuperCite tag on the attribution line.
+ ;; TAG is the Supercite tag on the attribution line.
(let ((atts gnus-cite-loose-attribution-alist)
(case-fold-search t)
att wrote in prefix tag regexp limit smallest best size)
(defalias 'gnus-character-to-event 'identity)
(defalias 'gnus-add-text-properties 'add-text-properties)
(defalias 'gnus-put-text-property 'put-text-property)
+(defalias 'gnus-mode-line-buffer-identification 'identity)
+
(eval-and-compile
(autoload 'gnus-xmas-define "gnus-xmas")
(or (memq gnus-article-copy gnus-buffer-list)
(setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
(let ((article-buffer (or article-buffer gnus-article-buffer))
- end)
+ end beg)
(when (and (get-buffer article-buffer)
(buffer-name (get-buffer article-buffer)))
(save-excursion
(copy-to-buffer gnus-article-copy (point-min) (point-max))
(set-buffer gnus-original-article-buffer)
(goto-char (point-min))
+ (while (looking-at message-unix-mail-delimiter)
+ (forward-line 1))
+ (setq beg (point))
(setq end (or (search-forward "\n\n" nil t) (point)))
(set-buffer gnus-article-copy)
(gnus-set-text-properties (point-min) (point-max) nil)
(delete-region (goto-char (point-min))
(or (search-forward "\n\n" nil t) (point)))
- (insert-buffer-substring gnus-original-article-buffer 1 end)))
+ (insert-buffer-substring gnus-original-article-buffer beg end)))
gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
(defvar gnus-picons-convert-x-face (format "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | pbmtoxbm > %s" gnus-picons-x-face-file-name)
"Command to convert the x-face header into a xbm file."
)
+
+(defvar gnus-picons-get-maximum-picons t
+ "*If non-nil, display all picons that apply to the article.
+If this is nil, use just the \"best\" (or most relevant) picon.")
(defvar gnus-group-annotations nil)
(defvar gnus-article-annotations nil)
(process nil))
(process-kill-without-query
(setq process (start-process
- "gnus-x-face" nil "sh" "-c" gnus-picons-convert-x-face)))
+ "gnus-x-face" nil shell-file-name shell-command-switch
+ gnus-picons-convert-x-face)))
(process-send-region "gnus-x-face" beg end)
(process-send-eof "gnus-x-face")
;; wait for it.
(set-buffer (get-buffer-create (gnus-get-buffer-name
gnus-picons-display-where)))
(gnus-add-current-to-buffer-list)
- (beginning-of-buffer)
- (let ((iconpoint (point)))
- (if (not (looking-at "^$"))
- (if buffer-read-only
- (progn
- (toggle-read-only)
- (open-line 1)
- (toggle-read-only)
- )
- (open-line 1)))
- (end-of-line)
+ (goto-char (point-min))
+ (let ((iconpoint (point))
+ buffer-read-only)
+ (unless (looking-at "$")
+ (insert "\n")
+ (forward-line -1))
;; append the annotation to gnus-article-annotations for deletion.
(setq gnus-x-face-annotations
(append
(or (not (fboundp 'device-type)) (equal (device-type) 'x))
(mail-fetch-field "from"))
(save-excursion
- (let* ((iconpoint (point)) (from (mail-fetch-field "from"))
+ (let* ((from (mail-fetch-field "from"))
(username
(progn
(string-match "\\([-_a-zA-Z0-9]+\\)@" from)
(match-string 1 from)))
(hostpath
- (concat (gnus-picons-reverse-domain-path
- (replace-in-string
- (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*"
- "\\1")
- "\\." "/")) "/")))
+ (concat
+ (gnus-picons-reverse-domain-path
+ (replace-in-string
+ (replace-in-string
+ (cadr (mail-extract-address-components from))
+ ".*@\\(.*\\)\\'" "\\1")
+ "\\." "/")) "/")))
(set-buffer (gnus-get-buffer-name gnus-picons-display-where))
(gnus-add-current-to-buffer-list)
- (beginning-of-buffer)
- (setq iconpoint (point))
- (if (not (looking-at "^$"))
- (if buffer-read-only
- (progn
- (toggle-read-only)
- (open-line 1)
- (toggle-read-only)
- )
- (open-line 1)))
+ (goto-char (point-min))
+ (if (eq gnus-picons-display-where 'article)
+ (and (search-forward "\n\n" nil t)
+ (forward-line -1))
+ (unless (eolp)
+ (open-line 1)))
- (end-of-line)
(gnus-picons-remove gnus-article-annotations)
- (setq gnus-article-annotations 'nil)
+ (setq gnus-article-annotations nil)
(if (equal username from)
(setq username (progn
(string-match "<\\([_a-zA-Z0-9-.]+\\)>" from)
(match-string 1 from))))
- (mapcar '(lambda (pathpart)
- (setq gnus-article-annotations
- (append
- (gnus-picons-insert-face-if-exists
- (concat
- (file-name-as-directory
- gnus-picons-database) pathpart)
- (concat hostpath username)
- iconpoint)
- gnus-article-annotations)))
+ (mapcar (lambda (pathpart)
+ (setq gnus-article-annotations
+ (append
+ (gnus-picons-insert-face-if-exists
+ (concat
+ (file-name-as-directory
+ gnus-picons-database) pathpart)
+ (concat hostpath username)
+ (point))
+ gnus-article-annotations)))
gnus-picons-user-directories)
- (mapcar '(lambda (pathpart)
- (setq gnus-article-annotations
- (append
- (gnus-picons-insert-face-if-exists
- (concat (file-name-as-directory
- gnus-picons-database) pathpart)
- (concat hostpath "unknown")
- iconpoint)
- gnus-article-annotations)))
+ (mapcar (lambda (pathpart)
+ (setq gnus-article-annotations
+ (append
+ (gnus-picons-insert-face-if-exists
+ (concat (file-name-as-directory
+ gnus-picons-database) pathpart)
+ (concat hostpath "unknown")
+ (point))
+ gnus-article-annotations)))
gnus-picons-domain-directories)
(add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)
))))
(defun gnus-group-display-picons ()
"Display icons for the group in the gnus-picons-display-where buffer."
(interactive)
- (if (and (featurep 'xpm)
- (or (not (fboundp 'device-type)) (equal (device-type) 'x)))
- (save-excursion
- (let
- ((iconpoint (point)))
- (set-buffer (gnus-get-buffer-name gnus-picons-display-where))
- (gnus-add-current-to-buffer-list)
- (beginning-of-buffer)
- (cond
- ((listp gnus-group-annotations)
- (mapcar 'delete-annotation gnus-group-annotations)
- (setq gnus-group-annotations nil))
- ((annotationp gnus-group-annotations)
- (delete-annotation gnus-group-annotations)
- (setq gnus-group-annotations nil))
- )
- (setq iconpoint (point))
- (if (not (looking-at "^$"))
- (open-line 1))
- (gnus-picons-remove gnus-group-annotations)
- (setq gnus-group-annotations nil)
- (setq gnus-group-annotations
- (gnus-picons-insert-face-if-exists
- (concat (file-name-as-directory gnus-picons-database)
- gnus-picons-news-directory)
- (concat (replace-in-string gnus-newsgroup-name "\\." "/")
- "/unknown")
- iconpoint t))
- (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))
-
+ (when (and (featurep 'xpm)
+ (or (not (fboundp 'device-type)) (equal (device-type) 'x)))
+ (save-excursion
+ (set-buffer (get-buffer-create
+ (gnus-get-buffer-name gnus-picons-display-where)))
+ (gnus-add-current-to-buffer-list)
+ (goto-char (point-min))
+ (if (eq gnus-picons-display-where 'article)
+ (and (search-forward "\n\n" nil t)
+ (forward-line -1)
+ )
+ (unless (eolp)
+ (open-line 1)))
+ (cond
+ ((listp gnus-group-annotations)
+ (mapcar 'delete-annotation gnus-group-annotations)
+ (setq gnus-group-annotations nil))
+ ((annotationp gnus-group-annotations)
+ (delete-annotation gnus-group-annotations)
+ (setq gnus-group-annotations nil)))
+ (gnus-picons-remove gnus-group-annotations)
+ (setq gnus-group-annotations nil)
+ (setq gnus-group-annotations
+ (gnus-picons-insert-face-if-exists
+ (concat (file-name-as-directory gnus-picons-database)
+ gnus-picons-news-directory)
+ (concat (replace-in-string gnus-newsgroup-name "\\." "/")
+ "/unknown")
+ (point) t))
+ (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))
(defun gnus-picons-insert-face-if-exists (path filename ipoint &optional rev)
"Inserts a face at point if I can find one"
- (let ((pathfile (concat path "/" filename "/face"))
- (newfilename
- (replace-in-string filename
- "[_a-zA-Z0-9-]+/\\([_A-Za-z0-9-]+\\)$" "\\1"))
- (annotations nil))
- (if (and rev
- (not (equal filename newfilename)))
- (setq annotations (append
- (gnus-picons-insert-face-if-exists path newfilename ipoint rev)
- annotations)))
- (if (eq (length annotations) (length (setq annotations (append
- (gnus-picons-try-to-find-face (concat pathfile ".xpm") ipoint)
- annotations))))
- (setq annotations (append
- (gnus-picons-try-to-find-face
- (concat pathfile ".xbm") ipoint)
- annotations)))
- (if (and (not rev)
- (not (equal filename newfilename)))
- (setq annotations (append
- (gnus-picons-insert-face-if-exists path newfilename ipoint rev)
- annotations)))
- annotations
- )
- )
-
+ (let ((file (concat path "/" filename))
+ (xpm (if (featurep 'xpm) "xpm" "xbm"))
+ picons found)
+ (while (and (or (not found)
+ gnus-picons-get-maximum-picons)
+ (>= (length file) (length path)))
+ (or (file-exists-p (setq found (concat file "/face." xpm)))
+ (file-exists-p (setq found (concat file "/unknown/face." xpm)))
+ (setq found nil))
+ (when found
+ (setq picons (nconc (gnus-picons-try-to-find-face found ipoint)
+ picons)))
+ (setq file (directory-file-name (file-name-directory file))))
+ (nreverse picons)))
+
(defun gnus-picons-try-to-find-face (path ipoint)
"If PATH exists, display it as a bitmap. Returns t if succedded."
(when (file-exists-p path)
(?e e "exact string" string)
(?f f "fuzzy string" string)
(?r r "regexp string" string)
- (?s s "substring" body-string)
- (?r s "regexp string" body-string)
+ (?z s "substring" body-string)
+ (?p s "regexp string" body-string)
(?b before "before date" date)
(?a at "at date" date)
(?n now "this date" date)
(pchar (and gnus-score-default-duration
(aref (symbol-name gnus-score-default-duration) 0)))
entry temporary type match)
-
- ;; First we read the header to score.
- (while (not hchar)
- (if mimic
- (progn
- (sit-for 1)
- (message "%c-" prefix))
- (message "%s header (%s?): " (if increase "Increase" "Lower")
- (mapconcat (lambda (s) (char-to-string (car s)))
- char-to-header "")))
- (setq hchar (read-char))
- (when (or (= hchar ??) (= hchar ?\C-h))
- (setq hchar nil)
- (gnus-score-insert-help "Match on header" char-to-header 1)))
-
- (gnus-score-kill-help-buffer)
- (unless (setq entry (assq (downcase hchar) char-to-header))
- (if mimic (error "%c %c" prefix hchar) (error "")))
-
- (when (/= (downcase hchar) hchar)
- ;; This was a majuscle, so we end reading and set the defaults.
- (if mimic (message "%c %c" prefix hchar) (message ""))
- (setq tchar (or tchar ?s)
- pchar (or pchar ?t)))
- ;; We continue reading - the type.
- (while (not tchar)
- (if mimic
- (progn
- (sit-for 1) (message "%c %c-" prefix hchar))
- (message "%s header '%s' with match type (%s?): "
- (if increase "Increase" "Lower")
- (nth 1 entry)
- (mapconcat (lambda (s)
- (if (eq (nth 4 entry)
- (nth 3 s))
- (char-to-string (car s))
- ""))
- char-to-type "")))
- (setq tchar (read-char))
- (when (or (= tchar ??) (= tchar ?\C-h))
- (setq tchar nil)
- (gnus-score-insert-help "Match type" char-to-type 2)))
-
- (gnus-score-kill-help-buffer)
- (unless (setq type (nth 1 (assq (downcase tchar) char-to-type)))
- (if mimic (error "%c %c" prefix hchar) (error "")))
-
- (when (/= (downcase tchar) tchar)
- ;; It was a majuscle, so we end reading and the the default.
- (if mimic (message "%c %c %c" prefix hchar tchar)
- (message ""))
- (setq pchar (or pchar ?p)))
-
- ;; We continue reading.
- (while (not pchar)
- (if mimic
- (progn
- (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
- (message "%s permanence (%s?): " (if increase "Increase" "Lower")
- (mapconcat (lambda (s) (char-to-string (car s)))
- char-to-perm "")))
- (setq pchar (read-char))
- (when (or (= pchar ??) (= pchar ?\C-h))
- (setq pchar nil)
- (gnus-score-insert-help "Match permanence" char-to-perm 2)))
-
- (gnus-score-kill-help-buffer)
- (if mimic (message "%c %c %c" prefix hchar tchar pchar)
- (message ""))
- (unless (setq temporary (cadr (assq pchar char-to-perm)))
- (if mimic
- (error "%c %c %c %c" prefix hchar tchar pchar)
- (error "")))
+ (unwind-protect
+ (progn
+
+ ;; First we read the header to score.
+ (while (not hchar)
+ (if mimic
+ (progn
+ (sit-for 1)
+ (message "%c-" prefix))
+ (message "%s header (%s?): " (if increase "Increase" "Lower")
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ char-to-header "")))
+ (setq hchar (read-char))
+ (when (or (= hchar ??) (= hchar ?\C-h))
+ (setq hchar nil)
+ (gnus-score-insert-help "Match on header" char-to-header 1)))
+
+ (gnus-score-kill-help-buffer)
+ (unless (setq entry (assq (downcase hchar) char-to-header))
+ (if mimic (error "%c %c" prefix hchar) (error "")))
+
+ (when (/= (downcase hchar) hchar)
+ ;; This was a majuscle, so we end reading and set the defaults.
+ (if mimic (message "%c %c" prefix hchar) (message ""))
+ (setq tchar (or tchar ?s)
+ pchar (or pchar ?t)))
+
+ ;; We continue reading - the type.
+ (while (not tchar)
+ (if mimic
+ (progn
+ (sit-for 1) (message "%c %c-" prefix hchar))
+ (message "%s header '%s' with match type (%s?): "
+ (if increase "Increase" "Lower")
+ (nth 1 entry)
+ (mapconcat (lambda (s)
+ (if (eq (nth 4 entry)
+ (nth 3 s))
+ (char-to-string (car s))
+ ""))
+ char-to-type "")))
+ (setq tchar (read-char))
+ (when (or (= tchar ??) (= tchar ?\C-h))
+ (setq tchar nil)
+ (gnus-score-insert-help
+ "Match type"
+ (delq nil
+ (mapcar (lambda (s)
+ (if (eq (nth 4 entry)
+ (nth 3 s))
+ s nil))
+ char-to-type ))
+ 2)))
+
+ (gnus-score-kill-help-buffer)
+ (unless (setq type (nth 1 (assq (downcase tchar) char-to-type)))
+ (if mimic (error "%c %c" prefix hchar) (error "")))
+
+ (when (/= (downcase tchar) tchar)
+ ;; It was a majuscle, so we end reading and the the default.
+ (if mimic (message "%c %c %c" prefix hchar tchar)
+ (message ""))
+ (setq pchar (or pchar ?p)))
+
+ ;; We continue reading.
+ (while (not pchar)
+ (if mimic
+ (progn
+ (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
+ (message "%s permanence (%s?): " (if increase "Increase" "Lower")
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ char-to-perm "")))
+ (setq pchar (read-char))
+ (when (or (= pchar ??) (= pchar ?\C-h))
+ (setq pchar nil)
+ (gnus-score-insert-help "Match permanence" char-to-perm 2)))
+
+ (gnus-score-kill-help-buffer)
+ (if mimic (message "%c %c %c" prefix hchar tchar pchar)
+ (message ""))
+ (unless (setq temporary (cadr (assq pchar char-to-perm)))
+ (if mimic
+ (error "%c %c %c %c" prefix hchar tchar pchar)
+ (error ""))))
+ ;; Always kill the score help buffer.
+ (gnus-score-kill-help-buffer))
;; We have all the data, so we enter this score.
(setq match (if (string= (nth 2 entry) "") ""
(setq max n))
(setq list (cdr list)))
(setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
- (setq n (/ (window-width) max)) ; items per line
- (setq width (/ (window-width) n)) ; width of each item
+ (setq n (/ (1- (window-width)) max)) ; items per line
+ (setq width (/ (1- (window-width)) n)) ; width of each item
;; insert `n' items, each in a field of width `width'
(while alist
(if (< i n)
(gnus-appt-select-lowest-window)
(split-window)
(pop-to-buffer "*Score Help*")
- (shrink-window-if-larger-than-buffer)
+ (let ((window-min-height 1))
+ (shrink-window-if-larger-than-buffer))
(select-window (get-buffer-window gnus-summary-buffer))))
(defun gnus-summary-header (header &optional no-err)
(gnus-make-directory dir))
(setq gnus-soup-areas nil)
(gnus-message 4 "Packing %s..." packer)
- (if (zerop (call-process "sh" nil nil nil "-c"
+ (if (zerop (call-process shell-file-name
+ nil nil nil shell-command-switch
(concat "cd " dir " ; " packer)))
(progn
- (call-process "sh" nil nil nil "-c"
+ (call-process shell-file-name nil nil nil shell-command-switch
(concat "cd " dir " ; rm " files))
(gnus-message 4 "Packing...done" packer))
(error "Couldn't pack packet."))))
(gnus-message 4 "Unpacking: %s" (format unpacker packet))
(prog1
(zerop (call-process
- "sh" nil nil nil "-c"
+ shell-file-name nil nil nil shell-command-switch
(format "cd %s ; %s" (expand-file-name dir)
(format unpacker packet))))
(gnus-message 4 "Unpacking...done")))
(save-excursion
(set-buffer gnus-server-buffer)
(let* ((buffer-read-only nil)
- (entry (assoc server gnus-server-alist)))
+ (entry (assoc server gnus-server-alist))
+ (oentry (assoc (gnus-server-to-method server)
+ gnus-opened-servers)))
(when entry
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (prin1-to-string (cdr entry)) ")"))
+ (prin1-to-string (cdr entry)) ")")))
+ (when (or entry oentry)
;; Buffer may be narrowed.
(save-restriction
(widen)
(when (gnus-server-goto-server server)
(gnus-delete-line))
- (gnus-server-insert-server-line (car entry) (cdr entry))
+ (if entry
+ (gnus-server-insert-server-line (car entry) (cdr entry))
+ (gnus-server-insert-server-line
+ (format "%s:%s" (caar oentry) (nth 1 (car oentry)))
+ (car oentry)))
(gnus-server-position-point))))))
(defun gnus-server-set-info (server info)
(forward-line -1))
(gnus-server-position-point)))
+(defun gnus-server-set-status (method status)
+ "Make METHOD have STATUS."
+ (let ((entry (assoc method gnus-opened-servers)))
+ (if entry
+ (setcar (cdr entry) status)
+ (push (list method status) gnus-opened-servers))))
+
(defun gnus-opened-servers-remove (method)
"Remove METHOD from the list of opened servers."
(setq gnus-opened-servers (delq (assoc method gnus-opened-servers)
(interactive (list (gnus-server-server-name)))
(let ((method (gnus-server-to-method server)))
(or method (error "No such server: %s" server))
- (gnus-opened-servers-remove method)
+ (gnus-server-set-status method 'ok)
(prog1
(or (gnus-open-server method)
(progn (message "Couldn't open %s" server) nil))
(interactive (list (gnus-server-server-name)))
(let ((method (gnus-server-to-method server)))
(or method (error "No such server: %s" server))
- (gnus-opened-servers-remove method)
+ (gnus-server-set-status method 'closed)
(prog1
(gnus-close-server method)
(gnus-server-update-server server)
(interactive (list (gnus-server-server-name)))
(let ((method (gnus-server-to-method server)))
(or method (error "No such server: %s" server))
- (gnus-opened-servers-remove method)
- (setq gnus-opened-servers
- (cons (list method 'denied) gnus-opened-servers)))
+ (gnus-server-set-status method 'denied))
(gnus-server-update-server server)
- (gnus-server-position-point))
+ (gnus-server-position-point)
+ t)
(defun gnus-server-remove-denials ()
"Make all denied servers into closed servers."
(start-process
"*uudecode*"
(get-buffer-create gnus-uu-output-buffer-name)
- "sh" "-c"
+ shell-file-name shell-command-switch
(format "cd %s ; uudecode" gnus-uu-work-dir)))
(set-process-sentinel
gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
(beginning-of-line)
(setq start-char (point))
(call-process-region
- start-char (point-max) "sh" nil
+ start-char (point-max) shell-file-name nil
(get-buffer-create gnus-uu-output-buffer-name) nil
- "-c" (concat "cd " gnus-uu-work-dir " ; sh"))))
+ shell-command-switch (concat "cd " gnus-uu-work-dir " ; sh"))))
state))
;; Returns the name of what the shar file is going to unpack.
(gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
- (if (= 0 (call-process "sh" nil
+ (if (= 0 (call-process shell-file-name nil
(get-buffer-create gnus-uu-output-buffer-name)
- nil "-c" command))
+ nil shell-command-switch command))
(message "")
(gnus-message 2 "Error during unpacking of archive")
(setq did-unpack nil))
;; Encodes a file PATH with COMMAND, leaving the result in the
;; current buffer.
(defun gnus-uu-post-encode-file (command path file-name)
- (= 0 (call-process "sh" nil t nil "-c"
+ (= 0 (call-process shell-file-name nil t nil shell-command-switch
(format "%s %s %s" command path file-name))))
(defun gnus-uu-post-news-inews ()
;;; Group mode highlighting.
;see gnus-cus.el
-(defvar gnus-group-highlight nil
- "Group lines are highlighted with the FACE for the first FORM which
-evaluate to a non-nil value.
-
-Point will be at the beginning of the line when FORM is evaluated.
-Variables bound when these forms are evaluated include:
-
-group: The group name.
-unread: The number of unread articles.
-method: The select method.
-mailp: Whether the select method is a mail method.
-level: The level of the group.
-score: The score of the group.
-ticked: The number of ticked articles in the group.
-")
+;(defvar gnus-group-highlight nil
+; "Group lines are highlighted with the FACE for the first FORM which
+;evaluate to a non-nil value.
+;
+;Point will be at the beginning of the line when FORM is evaluated.
+;Variables bound when these forms are evaluated include:
+;
+;group: The group name.
+;unread: The number of unread articles.
+;method: The select method.
+;mailp: Whether the select method is a mail method.
+;level: The level of the group.
+;score: The score of the group.
+;ticked: The number of ticked articles in the group.
+;")
;;; Internal variables.
["Fetch article with id..." gnus-summary-refer-article t]
["Redisplay" gnus-summary-show-article t]))
-
-
(easy-menu-define
gnus-summary-thread-menu gnus-summary-mode-map ""
'("Threads"
(defun gnus-xmas-highlight-selected-summary ()
;; Highlight selected article in summary buffer
- (if gnus-summary-selected-face
- (progn
- (if gnus-newsgroup-selected-overlay
- (delete-extent gnus-newsgroup-selected-overlay))
- (setq gnus-newsgroup-selected-overlay
- (make-extent (gnus-point-at-bol) (gnus-point-at-eol)))
- (set-extent-face gnus-newsgroup-selected-overlay
- gnus-summary-selected-face))))
+ (when gnus-summary-selected-face
+ (if gnus-newsgroup-selected-overlay
+ (delete-extent gnus-newsgroup-selected-overlay))
+ (setq gnus-newsgroup-selected-overlay
+ (make-extent (gnus-point-at-bol) (gnus-point-at-eol)))
+ (set-extent-face gnus-newsgroup-selected-overlay
+ gnus-summary-selected-face)))
(defun gnus-xmas-summary-recenter ()
"\"Center\" point in the summary window.
(defun gnus-xmas-summary-menu-add ()
(gnus-xmas-menu-add summary
+ gnus-summary-misc-menu gnus-summary-kill-menu
gnus-summary-article-menu gnus-summary-thread-menu
- gnus-summary-misc-menu gnus-summary-post-menu gnus-summary-kill-menu))
+ gnus-summary-post-menu ))
(defun gnus-xmas-article-menu-add ()
(gnus-xmas-menu-add article
"Redefine lots of Gnus functions for XEmacs."
(fset 'gnus-summary-make-display-table 'ignore)
(fset 'gnus-visual-turn-off-edit-menu 'identity)
- (fset 'gnus-highlight-selected-summary
- 'gnus-xmas-highlight-selected-summary)
(fset 'gnus-summary-recenter 'gnus-xmas-summary-recenter)
(fset 'gnus-extent-start-open 'gnus-xmas-extent-start-open)
(fset 'gnus-copy-article-buffer 'gnus-xmas-copy-article-buffer)
(fset 'gnus-make-local-hook 'make-local-variable)
(fset 'gnus-add-hook 'gnus-xmas-add-hook)
(fset 'gnus-character-to-event 'character-to-event)
+ (fset 'gnus-article-show-hidden-text 'gnus-xmas-article-show-hidden-text)
+ (fset 'gnus-mode-line-buffer-identification
+ 'gnus-xmas-mode-line-buffer-identification)
(add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
(add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
(when (and (<= emacs-major-version 19)
(<= emacs-minor-version 13))
+ (fset 'gnus-highlight-selected-summary
+ 'gnus-xmas-highlight-selected-summary)
(fset 'gnus-group-remove-excess-properties
'gnus-xmas-group-remove-excess-properties)
(fset 'gnus-topic-remove-excess-properties
(goto-char (point-min))
(let* ((mode-string (gnus-group-set-mode-line)))
(setq modeline-buffer-identification
- (list (concat gnus-version (substring (car mode-string) 4))))
+ (list (concat gnus-version ": *Group*")))
(set-buffer-modified-p t))))
gnus-summary-cancel-article t "Cancel article"]
[gnus-summary-catchup-and-exit
gnus-summary-catchup-and-exit t "Catchup and exit"]
+ [gnus-summary-exit gnus-summary-exit t "Exit this summary"]
)
"The summary buffer toolbar.")
gnus-summary-save-article t "Save article"]
[gnus-summary-catchup-and-exit
gnus-summary-catchup-and-exit t "Catchup and exit"]
+ [gnus-summary-exit gnus-summary-exit t "Exit this summary"]
)
"The summary buffer mail toolbar.")
(defun gnus-xmas-setup-group-toolbar ()
- (let (dir)
- (and gnus-use-toolbar
- (setq dir (message-xmas-setup-toolbar gnus-group-toolbar nil "gnus"))
- (file-exists-p (concat dir "gnus-group-catchup-current-up.xpm"))
- (set-specifier (symbol-value gnus-use-toolbar)
- (cons (current-buffer) gnus-group-toolbar)))))
+ (and gnus-use-toolbar
+ (message-xmas-setup-toolbar gnus-group-toolbar nil "gnus")
+ (set-specifier (symbol-value gnus-use-toolbar)
+ (cons (current-buffer) gnus-group-toolbar))))
(defun gnus-xmas-setup-summary-toolbar ()
(let ((bar (if (gnus-news-group-p gnus-newsgroup-name)
- gnus-summary-toolbar gnus-summary-mail-toolbar))
- dir)
+ gnus-summary-toolbar gnus-summary-mail-toolbar)))
(and gnus-use-toolbar
- (setq dir (message-xmas-setup-toolbar bar nil "gnus"))
- (file-exists-p (concat dir "gnus-group-catchup-current-up.xpm"))
+ (message-xmas-setup-toolbar bar nil "gnus")
(set-specifier (symbol-value gnus-use-toolbar)
(cons (current-buffer) bar)))))
'call-process-region (point-min) (point-max) command t '(t nil) nil
args))
+(unless (find-face 'gnus-x-face)
+ (copy-face 'default 'gnus-x-face))
+
(defun gnus-xmas-article-display-xface (beg end)
"Display any XFace headers in the current article."
(save-excursion
(setq xface-glyph
(make-glyph
(vector 'xpm :data (buffer-string )))))))
+ (set-glyph-face xface-glyph 'gnus-x-face)
(goto-char (point-min))
(re-search-forward "^From:" nil t)
- (beginning-of-line)
(set-extent-begin-glyph
(make-extent (point) (1+ (point))) xface-glyph))))
+(defun gnus-xmas-article-show-hidden-text (type &optional hide)
+ "Show all hidden text of type TYPE.
+If HIDE, hide the text instead."
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (beg (point-min)))
+ (while (gnus-goto-char (text-property-any
+ beg (point-max) 'gnus-type type))
+ (setq beg (point))
+ (forward-char)
+ (if hide
+ (gnus-hide-text beg (point) gnus-hidden-properties)
+ (gnus-unhide-text beg (point)))
+ (setq beg (point)))
+ (save-window-excursion
+ (select-window (get-buffer-window (current-buffer)))
+ (recenter))
+ t)))
+
+(defun gnus-xmas-mode-line-buffer-identification (line)
+ (let ((line (car line))
+ chop)
+ (if (not (stringp line))
+ (list line)
+ (unless (setq chop (string-match ":" line))
+ (setq chop (/ (length line) 2)))
+ (list (cons modeline-buffer-id-left-extent (substring line 0 chop))
+ (cons modeline-buffer-id-right-extent (substring line chop))))))
+
+(provide 'gnus-xmas)
+
;;; gnus-xmas.el ends here
(?A gnus-tmp-article-number ?d)
(?Z gnus-tmp-unread-and-unselected ?s)
(?V gnus-version ?s)
- (?U gnus-tmp-unread ?d)
+ (?U gnus-tmp-unread-and-unticked ?d)
(?S gnus-tmp-subject ?s)
(?e gnus-tmp-unselected ?d)
(?u gnus-tmp-user-defined ?s)
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version-number "5.2.19"
+(defconst gnus-version-number "5.2.20"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
(remove-text-properties b e gnus-hidden-properties)
(when (memq 'intangible gnus-hidden-properties)
(gnus-put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
+ b 'intangible nil)))
(defun gnus-hide-text-type (b e type)
"Hide text of TYPE between B and E."
(group (gnus-group-group-name))
(entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
gnus-group-indentation)
- (and entry
- (not (gnus-ephemeral-group-p group))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (prin1-to-string (nth 2 entry)) ")")))
- (setq gnus-group-indentation (gnus-group-group-indentation))
- (gnus-delete-line)
- (gnus-group-insert-group-line-info group)
- (forward-line -1)
- (gnus-group-position-point)))
+ (when group
+ (and entry
+ (not (gnus-ephemeral-group-p group))
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (prin1-to-string (nth 2 entry)) ")")))
+ (setq gnus-group-indentation (gnus-group-group-indentation))
+ (gnus-delete-line)
+ (gnus-group-insert-group-line-info group)
+ (forward-line -1)
+ (gnus-group-position-point))))
(defun gnus-group-insert-group-line-info (group)
"Insert GROUP on the current line."
(setq mode-string (substring mode-string 0 (- max-len 4))))
(prog1
(setq mode-line-buffer-identification
- (list mode-string))
+ (gnus-mode-line-buffer-identification
+ (list mode-string)))
(set-buffer-modified-p t))))))
(defun gnus-group-group-name ()
t))
(defun gnus-group-delete-group (group &optional force)
- "Delete the current group.
+ "Delete the current group. Only meaningful with mail groups.
If FORCE (the prefix) is non-nil, all the articles in the group will
be deleted. This is \"deleted\" as in \"removed forever from the face
-of the Earth\". There is no undo."
+of the Earth\". There is no undo. The user will be prompted before
+doing the deletion."
(interactive
(list (gnus-group-group-name)
current-prefix-arg))
gnus-cached-mark)
((memq number gnus-newsgroup-replied)
gnus-replied-mark)
+ ((memq number gnus-newsgroup-saved)
+ gnus-saved-mark)
(t gnus-unread-mark))
gnus-tmp-from (mail-header-from gnus-tmp-header)
gnus-tmp-name
(car type))))))
(push (cons (cdr type)
(if (memq (cdr type) uncompressed) list
- (gnus-compress-sequence (set symbol (sort list '<)) t)))
+ (gnus-compress-sequence
+ (set symbol (sort list '<)) t)))
newmarked)))
;; Enter these new marks into the info of the group.
;; Pad the mode string a bit.
(setq mode-string (format (format "%%-%ds" max-len) mode-string))))
;; Update the mode line.
- (setq mode-line-buffer-identification (list mode-string))
+ (setq mode-line-buffer-identification
+ (gnus-mode-line-buffer-identification
+ (list mode-string)))
(set-buffer-modified-p t))))
(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
(equal (nth 1 m1) (nth 1 m2)))))))
(defsubst gnus-header-value ()
- (buffer-substring
- (match-end 0)
- (if (re-search-forward "^[^ \t]" nil t)
- (progn
- (backward-char 2)
- (point))
- (gnus-point-at-eol))))
+ (buffer-substring (match-end 0) (gnus-point-at-eol)))
(defvar gnus-newsgroup-none-id 0)
The prefix argument ALL means to select all articles."
(interactive "P")
(gnus-set-global-variables)
+ (when (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (error "Ephemeral groups can't be reselected"))
(let ((current-subject (gnus-summary-article-number))
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
(defun gnus-summary-mark-forward (n &optional mark no-expire)
"Mark N articles as read forwards.
-If N is negative, mark backwards instead.
-Mark with MARK. If MARK is ? , ?! or ??, articles will be
-marked as unread.
+If N is negative, mark backwards instead. Mark with MARK, ?r by default.
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
(defun gnus-summary-mark-article-as-unread (mark)
"Mark the current article quickly as unread with MARK."
(let ((article (gnus-summary-article-number)))
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
- (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
- (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
- (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
- (cond ((= mark gnus-ticked-mark)
- (push article gnus-newsgroup-marked))
- ((= mark gnus-dormant-mark)
- (push article gnus-newsgroup-dormant))
- (t
- (push article gnus-newsgroup-unreads)))
- (setq gnus-newsgroup-reads
- (delq (assq article gnus-newsgroup-reads)
- gnus-newsgroup-reads))
-
- ;; See whether the article is to be put in the cache.
- (and gnus-use-cache
- (vectorp (gnus-summary-article-header article))
- (save-excursion
- (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- (gnus-summary-article-header article)
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
- ;; Fix the mark.
- (gnus-summary-update-mark mark 'unread)
+ (if (< article 0)
+ (gnus-error 1 "Unmarkable article")
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
+ (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
+ (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
+ (cond ((= mark gnus-ticked-mark)
+ (push article gnus-newsgroup-marked))
+ ((= mark gnus-dormant-mark)
+ (push article gnus-newsgroup-dormant))
+ (t
+ (push article gnus-newsgroup-unreads)))
+ (setq gnus-newsgroup-reads
+ (delq (assq article gnus-newsgroup-reads)
+ gnus-newsgroup-reads))
+
+ ;; See whether the article is to be put in the cache.
+ (and gnus-use-cache
+ (vectorp (gnus-summary-article-header article))
+ (save-excursion
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
+
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread))
t))
(defun gnus-summary-mark-article (&optional article mark no-expire)
If the prefix argument is negative, tick articles instead."
(interactive "P")
(gnus-set-global-variables)
- (if unmark
- (setq unmark (prefix-numeric-value unmark)))
+ (when unmark
+ (setq unmark (prefix-numeric-value unmark)))
(let ((articles (gnus-summary-articles-in-thread)))
(save-excursion
;; Expand the thread.
default-name))
;; A single split name was found
((= 1 (length split-name))
- (read-file-name
- (concat prompt " (default " (car split-name) ") ")
- gnus-article-save-directory
- (concat gnus-article-save-directory (car split-name))))
+ (let* ((name (car split-name))
+ (dir (cond ((file-directory-p name)
+ (file-name-as-directory name))
+ ((file-exists-p name) name)
+ (t gnus-article-save-directory))))
+ (read-file-name
+ (concat prompt " (default " name ") ")
+ dir name)))
;; A list of splits was found.
(t
(setq split-name (nreverse split-name))
(erase-buffer)
(insert "$ " command "\n\n")
(if gnus-view-pseudo-asynchronously
- (start-process "gnus-execute" nil "sh" "-c" command)
- (call-process "sh" nil t nil "-c" command)))))
+ (start-process "gnus-execute" nil shell-file-name
+ shell-command-switch command)
+ (call-process shell-file-name nil t nil
+ shell-command-switch command)))))
(defun gnus-copy-file (file &optional to)
"Copy FILE to TO."
;; We have found the header.
header
;; We have to really fetch the header to this article.
- (when (setq where
- (if (gnus-check-backend-function 'request-head group)
- (gnus-request-head id group)
- (gnus-request-article id group)))
+ (when (setq where (gnus-request-head id group))
(save-excursion
(set-buffer nntp-server-buffer)
- (and (search-forward "\n\n" nil t)
- (delete-region (1- (point)) (point-max)))
(goto-char (point-max))
(insert ".\n")
(goto-char (point-min))
(let ((process-connection-type nil))
(process-kill-without-query
(start-process
- "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
+ "gnus-x-face" nil shell-file-name shell-command-switch
+ gnus-article-x-face-command))
(process-send-region "gnus-x-face" beg end)
(process-send-eof "gnus-x-face")))))))))
(unless silent
(message ""))))))
-(defun gnus-get-function (method function)
+(defun gnus-get-function (method function &optional noerror)
"Return a function symbol based on METHOD and FUNCTION."
;; Translate server names into methods.
(unless method
;; question.
(unless (fboundp func)
(require (car method))
- (unless (fboundp func)
+ (when (and (not (fboundp func))
+ (not noerror))
;; This backend doesn't implement this function.
(error "No such function: %s" func)))
func))
(defun gnus-request-head (article group)
"Request the head of ARTICLE in GROUP."
- (let ((method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function method 'request-head)
- article (gnus-group-real-name group) (nth 1 method))))
+ (let* ((method (gnus-find-method-for-group group))
+ (head (gnus-get-function method 'request-head t)))
+ (if (fboundp head)
+ (funcall head article (gnus-group-real-name group) (nth 1 method))
+ (let ((res (gnus-request-article article group)))
+ (when res
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (1- (point)) (point-max)))
+ (nnheader-fold-continuation-lines)))
+ res))))
(defun gnus-request-body (article group)
"Request the body of ARTICLE in GROUP."
(defun message-insert-to ()
"Insert a To header that points to the author of the article being replied to."
(interactive)
- (when (message-position-on-field "To")
+ (when (and (message-position-on-field "To")
+ (mail-fetch-field "to")
+ (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
(insert ", "))
(insert (or (message-fetch-reply-field "reply-to")
(message-fetch-reply-field "from") "")))
(defun message-insert-newsgroups ()
"Insert the Newsgroups header from the article being replied to."
(interactive)
- (when (message-position-on-field "Newsgroups")
+ (when (and (message-position-on-field "Newsgroups")
+ (mail-fetch-field "newsgroups")
+ (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
(insert ","))
(insert (or (message-fetch-reply-field "newsgroups") "")))
(message-generate-headers message-required-news-headers)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
+ (message-cleanup-headers)
(when (message-check-news-syntax)
(unwind-protect
(save-excursion
(if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
;; Pipe the article to the program in question.
(call-process-region (point-min) (point-max) shell-file-name
- nil nil nil "-c" (match-string 1 file))
+ nil nil nil shell-command-switch
+ (match-string 1 file))
;; Save the article.
(setq file (expand-file-name file))
(unless (file-exists-p (file-name-directory file))
(or (car (mail-extract-address-components to))
to) "")
"")
- (if group (concat " on " group) "")
+ (if (and group (not (string= group ""))) (concat " on " group) "")
"*")))
;; Use standard name.
(t
(pop h))
alist)
headers)
- (forward-line -1)
+ (delete-region (point) (progn (forward-line -1) (point)))
(when message-default-headers
(insert message-default-headers))
(put-text-property
(defvar message-toolbar
'([message-spell ispell-message t "Spell"]
- [message-help (toolbar-info "message") t "Message help"])
+ [message-help (Info-goto-node "(Message)Top") t "Message help"])
"The message buffer toolbar.")
(defun message-xmas-find-glyph-directory (&optional package)
(setq down (concat dir name "-down." xpm))
(setq disabled (concat dir name "-disabled." xpm))
(if (not (file-exists-p up))
- (progn
- (set icon nil)
- (setq bar nil
- dir nil))
+ (setq bar nil
+ dir nil)
(set icon (toolbar-make-button-list
up (and (file-exists-p down) down)
(and (file-exists-p disabled) disabled)))))))
"*A command to be executed to move mail from the inbox.
The default is \"movemail\".")
-(defvar nnmail-pop-password nil
- "*Password to use when reading mail from a POP server, if required.")
-
(defvar nnmail-pop-password-required nil
"*Non-nil if a password is required when reading mail using POP.")
;;; Internal variables.
+(defvar nnmail-pop-password nil
+ "*Password to use when reading mail from a POP server, if required.")
+
(defvar nnmail-split-fancy-syntax-table
(copy-syntax-table (standard-syntax-table))
"Syntax table used by `nnmail-split-fancy'.")
(defvar nnmail-moved-inboxes nil
"List of inboxes that have been moved.")
+(defvar nnmail-internal-password nil)
+
\f
(defconst nnmail-version "nnmail 1.0"
nil
(if popmail
(progn
- (setq password nnmail-pop-password)
+ (setq nnmail-internal-password nnmail-pop-password)
(when (and nnmail-pop-password-required (not nnmail-pop-password))
- (setq password
+ (setq nnmail-internal-password
(nnmail-read-passwd
(format "Password for %s: "
(substring inbox (+ popmail 3))))))
(list
(expand-file-name nnmail-movemail-program exec-directory)
nil errors nil inbox tofile)
- (when password (list password)))))
+ (when nnmail-internal-password
+ (list nnmail-internal-password)))))
(if (not (buffer-modified-p errors))
;; No output => movemail won
- (push tofile nnmail-moved-inboxes)
+ (push inbox nnmail-moved-inboxes)
(set-buffer errors)
(subst-char-in-region (point-min) (point-max) ?\n ?\ )
(goto-char (point-max))
"%s %d %d y\n"
(progn
(string-match
- (file-truename (file-name-as-directory
- (expand-file-name nnmh-toplev))) dir)
+ (regexp-quote
+ (file-truename (file-name-as-directory
+ (expand-file-name nnmh-toplev)))) dir)
(nnheader-replace-chars-in-string
(substring dir (match-end 0)) ?/ ?.))
(apply 'max files)
(set-buffer nntp-server-buffer)
(goto-char (point-min))
(when (search-forward "\n\n" nil t)
- (delete-region (1- (point)) (point-max)))))
+ (delete-region (1- (point)) (point-max)))
+ (nnheader-fold-continuation-lines)))
res))
(deffoo nnspool-request-group (group &optional server dont-check)
(if (numberp id) id
;; We find out what the article number was.
(nntp-find-group-and-number)))
- (nntp-decode-text)))
+ (nntp-decode-text)
+ (nnheader-fold-continuation-lines)))
(deffoo nntp-request-stat (id &optional group server)
"Request STAT of article ID (Message-ID or number)."
(unless status
(nntp-close-server-internal server)
(nnheader-report
- 'nntp "Couldn't open connection to %s" nntp-address))
+ 'nntp "Couldn't open connection to %s"
+ (if (and nntp-address
+ (not (equal nntp-address "")))
+ nntp-address server)))
(when nntp-server-process
(set-process-sentinel
nntp-server-process 'nntp-default-sentinel)
;; comments go here.
;;
-;;; Test smileys: :-] :-o :-) ;-) :-< :-d :-P 8-| :-(
+;;; Test smileys: :-] :-o :-) ;-) :-\ :-| :-d :-P 8-| :-(
;; To use:
;; (require 'smiley)
;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t)
+(require 'annotations)
(eval-when-compile (require 'cl))
(defvar smiley-data-directory (message-xmas-find-glyph-directory "smilies")
"Location of the smiley faces files.")
(defvar smiley-regexp-alist
- '((":-*\\]" 0 "FaceGrinning.xpm")
- (":-*[oO]" 0 "FaceStartled.xpm")
- (":-*[)>]" 0 "FaceHappy.xpm")
- (";-*[>)]" 0 "FaceWinking.xpm")
- (":-[/\\]" 0 "FaceIronic.xpm")
- (":-*|" 0 "FaceStraight.xpm")
- (":-*<" 0 "FaceAngry.xpm")
- (":-*d" 0 "FaceTasty.xpm")
- (":-*[pP]" 0 "FaceYukky.xpm")
- ("8-*|" 0 "FaceKOed.xpm")
- (":-*(" 0 "FaceAngry.xpm"))
+ '(("\\s-\\(:-*\\]\\)" 1 "FaceGrinning.xpm")
+ ("\\s-\\(:-*[oO]\\)" 1 "FaceStartled.xpm")
+ ("\\s-\\(:-*[)>]\\)" 1 "FaceHappy.xpm")
+ ("\\s-\\(;-*[>)]\\)" 1 "FaceWinking.xpm")
+ ("\\s-\\(:-[/\\]\\)" 1 "FaceIronic.xpm")
+ ("\\s-\\(:-*|\\)" 1 "FaceStraight.xpm")
+ ("\\s-\\(:-*<\\)" 1 "FaceAngry.xpm")
+ ("\\s-\\(:-*d\\)" 1 "FaceTasty.xpm")
+ ("\\s-\\(:-*[pP]\\)" 1 "FaceYukky.xpm")
+ ("\\s-\\(8-*|\\)" 1 "FaceKOed.xpm")
+ ("\\s-\\(:-*(\\)" 1 "FaceAngry.xpm"))
"A list of regexps to map smilies to real images.")
(defvar smiley-flesh-color "yellow"
(defvar smiley-tongue-color "red"
"Tongue color.")
+(defvar smiley-circle-color "black"
+ "Tongue color.")
+
(defvar smiley-glyph-cache nil)
(defvar smiley-running-xemacs (string-match "XEmacs" emacs-version))
(end (match-end group))
(glyph (smiley-create-glyph (buffer-substring start end)
file)))
- (if glyph
- (progn
- (mapcar 'delete-annotation (annotations-at end))
- (let ((ext (make-extent start end)))
- (set-extent-property ext 'invisible t)
- (set-extent-property ext 'end-open t)
- (set-extent-property ext 'intangible t))
- (make-annotation glyph end 'text)
- (goto-char end)))))))))
+ (when glyph
+ (mapcar 'delete-annotation (annotations-at end))
+ (let ((ext (make-extent start end)))
+ (set-extent-property ext 'invisible t)
+ (set-extent-property ext 'end-open t)
+ (set-extent-property ext 'intangible t))
+ (make-annotation glyph end 'text)
+ (when (smiley-end-paren-p start end)
+ (make-annotation ")" end 'text))
+ (goto-char end))))))))
+
+(defun smiley-end-paren-p (start end)
+ "Try to guess whether the current smiley is an end-paren smiley."
+ (save-excursion
+ (goto-char start)
+ (when (and (re-search-backward "[()]" nil t)
+ (= (following-char) ?\()
+ (goto-char end)
+ (or (not (re-search-forward "[()]" nil t))
+ (= (char-after (1- (point))) ?\()))
+ t)))
;;;###autoload
(defun gnus-smiley-display ()
+Sun Jun 16 08:13:44 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Saving Articles): Fix.
+
Sat Jun 15 02:09:46 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Article Washing): Addition.
We see that this is a list where each element is a list that has two
elements---the @dfn{match} and the @dfn{file}. The match can either be
a string (in which case it is used as a regexp to match on the article
-head); it can be a symbol (which will be called as a function); or it
-can be a list (which will be @code{eval}ed). If any of these actions
-have a non-@code{nil} result, the @dfn{file} will be used as a default
-prompt. In addition, the result of the operation itself will be used if
-the function or form called returns a string or a list of strings.
+head); it can be a symbol (which will be called as a function with the
+group name as a parameter); or it can be a list (which will be
+@code{eval}ed). If any of these actions have a non-@code{nil} result,
+the @dfn{file} will be used as a default prompt. In addition, the
+result of the operation itself will be used if the function or form
+called returns a string or a list of strings.
You basically end up with a list of file names that might be used when
saving the current article. (All ``matches'' will be used.) You will
@item gnus-supercite-regexp
@vindex gnus-supercite-regexp
-Regexp matching normal SuperCite attribution lines.
+Regexp matching normal Supercite attribution lines.
@item gnus-supercite-secondary-regexp
@vindex gnus-supercite-secondary-regexp
-Regexp matching mangled SuperCite attribution lines.
+Regexp matching mangled Supercite attribution lines.
@item gnus-cite-minimum-match-count
@vindex gnus-cite-minimum-match-count
@vindex message-cite-function
@findex message-cite-original
@findex sc-cite-original
-@cindex SuperCite
+@cindex Supercite
Function for citing an original message. The default is
@code{message-cite-original}. You can also set it to
-@code{sc-cite-original} to use SuperCite.
+@code{sc-cite-original} to use Supercite.
@item message-indent-citation-function
@vindex message-indent-citation-function
projects / gnus / commitdiff