From 924913e6cedd0aeaeef01a251afa770a86c01815 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Tue, 4 Mar 1997 04:31:06 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 77 +++++- lisp/Makefile | 4 +- lisp/dgnushack.el | 23 +- lisp/gnus-ems.el | 602 ++++----------------------------------------- lisp/gnus-msg.el | 103 ++++---- lisp/gnus-topic.el | 2 +- lisp/gnus-uu.el | 3 +- lisp/gnus-vis.el | 33 +-- lisp/gnus-xmas.el | 491 ++++++++++++++++++++++++++++++++++++ lisp/gnus.el | 177 +++++++------ lisp/nnbabyl.el | 2 +- lisp/nndir.el | 14 +- lisp/nneething.el | 5 +- lisp/nnkiboze.el | 74 ++++-- lisp/nnml.el | 14 +- lisp/x-easymenu.el | 354 ++++++++++++++++++++++++++ texi/Makefile | 6 + texi/gnus.texi | 156 ++++++------ 18 files changed, 1346 insertions(+), 794 deletions(-) create mode 100644 lisp/gnus-xmas.el create mode 100644 lisp/x-easymenu.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 17c7692fb..ae0788b42 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,4 +1,79 @@ -Tue Sep 26 01:36:17 1995 Lars Magne Ingebrigtsen +Sat Sep 30 05:05:57 1995 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-news-followup): Insert signature before + composing. + +Fri Sep 29 05:33:01 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-article-mode-map): Took out boogaboo. + +Thu Sep 28 05:12:00 1995 Lars Ingebrigtsen + + * gnus-xmas.el: New file for XEmacs functions. + (gnus-xmas-find-glyph-directory): New function. + (gnus-xmas-glyph-directory): New variable. + + * nnkiboze.el (nnkiboze-generate-group): Also search read + articles. Would destroy mark lists. + (nnkiboze-level): New variable. + (nnkiboze-generate-group): Use it. + (nnkiboze-remove-read-articles): New variable. + (nnkiboze-close-group): Use it. + + * gnus.el (gnus-article-hide-pgp): New command and keystroke. + (gnus-group-make-kiboze-group): Didn't allow scoring on "all", + etc. + (gnus-group-make-kiboze-group): Ignored + `gnus-use-long-file-name'. + +Wed Sep 27 06:44:57 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-hide-thread): Didn't work. + (gnus-summary-go-to-next-thread): New implementation. + + * gnus-topic.el (gnus-group-topic-face): Changed to bold. + +Tue Sep 26 20:06:13 1995 Per Abrahamsen + + * gnus-vis.el (gnus-header-button-alist): Fixed regexps. Doc + cleanup. + (gnus-article-add-buttons-to-head): Allow multiple headers to be + match by the same `gnus-header-button-alist' entry. + +Wed Sep 27 04:19:55 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-group-make-doc-group): Move point to the group + that was created. + + * gnus-msg.el (gnus-news-followup): Would configure to `reply' + config. + + * gnus.el (gnus-summary-limit-to-marks): Did the opposite of what + it was supposed to do. + (gnus-summary-prepare-unthreaded): Would never allow + seeing dormant articles + + * nnml.el (nnml-find-id): Inserted dir instead of nov file. + + * gnus-msg.el (gnus-required-mail-headers): Make In-Reply-To a + required header, when it is optional. + + * nndir.el: Didn't work for the archive groups. + + * gnus.el (gnus-group-make-archive-group): Create a more sensible + server name. + (gnus-request-article-this-buffer): Used `insert-buffer'. + +Tue Sep 26 02:54:56 1995 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-prepare-threads): Would thread incorrectly + when using 'adopt, sometimes. + (gnus-read-newsrc-el-file): Give an error message when the .eld + file bugs out. + +Tue Sep 26 01:36:17 1995 Lars Magne Ingebrigtsen + + * gnus.el: 0.4 is released. * gnus.el (gnus-summary-prepare-threads): New roots would be ignored. diff --git a/lisp/Makefile b/lisp/Makefile index 3949a65ba..395d72f57 100644 --- a/lisp/Makefile +++ b/lisp/Makefile @@ -3,10 +3,10 @@ EMACS=emacs FLAGS=-batch -q -no-site-file -l ./dgnushack.el all: - rm -f *.elc ; $(EMACS) $(FLAGS) -f batch-byte-compile *.el + rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile some: $(EMACS) $(FLAGS) -f dgnushack-recompile separately: - rm -f *.elc ; for i in *.el; do $(EMACS) $(FLAGS) -f batch-byte-compile $i; done \ No newline at end of file + rm -f *.elc ; for i in *.el; do $(EMACS) $(FLAGS) -f batch-byte-compile $i; done diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index ba19e70ca..0880637b3 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -29,10 +29,29 @@ ;;; Code: -(setq byte-compile-warnings '(free-vars unresolved callargs redefine)) - (setq load-path (cons "." load-path)) +(defun dgnushack-compile () + (let ((files (directory-files "." nil ".el$")) + (xemacs (string-match "XEmacs" emacs-version)) + byte-compile-warnings file) + (while files + (setq file (car files) + files (cdr files)) + (cond + ((or (string= file "custom.el") (string= file "browse-url.el")) + (setq byte-compile-warnings nil)) + (xemacs + (setq byte-compile-warnings + '(free-vars unresolved callargs redefine))) + (t + (setq byte-compile-warnings + '(free-vars unresolved callargs redefine obsolete)))) + (and (or (and (not (string= file "gnus-xmas.el")) + (not (string= file "x-easymenu.el"))) + xemacs) + (byte-compile-file file))))) + (defun dgnushack-recompile () (byte-recompile-directory "." 0)) diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index bf7b8fa3c..85c23e09e 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -25,61 +25,58 @@ ;;; Code: (defvar gnus-mouse-2 [mouse-2]) -(defvar gnus-group-mode-hook ()) -(defvar gnus-summary-mode-hook ()) -(defvar gnus-article-mode-hook ()) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-overlay-put 'overlay-put) (defalias 'gnus-move-overlay 'move-overlay) -;; Don't warn about these undefined variables. - ;defined in gnus.el -(defvar gnus-active-hashtb) -(defvar gnus-article-buffer) -(defvar gnus-auto-center-summary) -(defvar gnus-buffer-list) -(defvar gnus-current-headers) -(defvar gnus-level-killed) -(defvar gnus-level-zombie) -(defvar gnus-newsgroup-bookmarks) -(defvar gnus-newsgroup-dependencies) -(defvar gnus-newsgroup-selected-overlay) -(defvar gnus-newsrc-hashtb) -(defvar gnus-read-mark) -(defvar gnus-refer-article-method) -(defvar gnus-reffed-article-number) -(defvar gnus-unread-mark) -(defvar gnus-version) -(defvar gnus-view-pseudos) -(defvar gnus-view-pseudos-separately) -(defvar gnus-visual) -(defvar gnus-zombie-list) - ;defined in gnus-msg.el -(defvar gnus-article-copy) -(defvar gnus-check-before-posting) - ;defined in gnus-vis.el -(defvar gnus-article-button-face) -(defvar gnus-article-mouse-face) -(defvar gnus-summary-selected-face) +(eval-and-compile + (autoload 'gnus-xmas-define "gnus-xmas") + (autoload 'gnus-xmas-redefine "gnus-xmas")) + +;;; Mule functions. + +(defun gnus-mule-truncate-string (str width) + (let ((w (string-width str)) + (col 0) (idx 0) (p-idx 0) chr) + (if (<= w width) + str + (while (< col width) + (setq chr (aref str idx) + col (+ col (char-width chr)) + p-idx idx + idx (+ idx (char-bytes chr)) + )) + (substring str 0 (if (= col width) + idx + p-idx))))) + +(defun gnus-mule-cite-add-face (number prefix face) + ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. + (if face + (let ((inhibit-point-motion-hooks t) + from to) + (goto-line number) + (if (boundp 'MULE) + (forward-char (chars-in-string prefix)) + (forward-char (length prefix))) + (skip-chars-forward " \t") + (setq from (point)) + (end-of-line 1) + (skip-chars-backward " \t") + (setq to (point)) + (if (< from to) + (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) + +(defun gnus-mule-max-width-function (el max-width) + (` (let* ((val (eval (, el))) + (valstr (if (numberp val) + (int-to-string val) val))) + (if (> (length valstr) (, max-width)) + (truncate-string valstr (, max-width)) + valstr)))) -;; We do not byte-compile this file, because error messages are such a -;; bore. - -(defun gnus-set-text-properties-xemacs (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 (and (stringp buffer) (not (setq buffer (get-buffer 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))) - (eval '(progn (if (string-match "XEmacs\\|Lucid" emacs-version) @@ -129,77 +126,7 @@ pounce directly on the real variables themselves.")) (cond ((string-match "XEmacs\\|Lucid" emacs-version) - ;; XEmacs definitions. - - (setq gnus-mouse-2 [button2]) - - (or (memq 'underline (list-faces)) - (and (fboundp 'make-face) - (funcall (intern "make-face") 'underline))) - ;; Must avoid calling set-face-underline-p directly, because it - ;; is a defsubst in emacs19, and will make the .elc files non - ;; portable! - (or (face-differs-from-default-p 'underline) - (funcall 'set-face-underline-p 'underline t)) - - (defalias 'gnus-make-overlay 'make-extent) - (defalias 'gnus-overlay-put 'set-extent-property) - (defun gnus-move-overlay (extent start end &optional buffer) - (set-extent-endpoints extent start end)) - - (require 'text-props) - (fset 'set-text-properties 'gnus-set-text-properties-xemacs) - - (or (boundp 'standard-display-table) (setq standard-display-table nil)) - (or (boundp 'read-event) (fset 'read-event 'next-command-event)) - - ;; Fix by "jeff (j.d.) sparkes" . - (defvar gnus-display-type (device-class) - "A symbol indicating the display Emacs is running under. -The symbol should be one of `color', `grayscale' or `mono'. If Emacs -guesses this display attribute wrongly, either set this variable in -your `~/.emacs' or set the resource `Emacs.displayType' in your -`~/.Xdefaults'. See also `gnus-background-mode'. - -This is a meta-variable that will affect what default values other -variables get. You would normally not change this variable, but -pounce directly on the real variables themselves.") - - - (or (fboundp 'x-color-values) - (fset 'x-color-values - (lambda (color) - (color-instance-rgb-components - (make-color-instance color))))) - - (defvar gnus-background-mode - (let ((bg-resource - (condition-case () - (x-get-resource ".backgroundMode" "BackgroundMode" 'string) - (error nil))) - (params (frame-parameters))) - (cond (bg-resource (intern (downcase bg-resource))) - ((and (assq 'background-color params) - (< (apply '+ (x-color-values - (cdr (assq 'background-color params)))) - (/ (apply '+ (x-color-values "white")) 3))) - 'dark) - (t 'light))) - "A symbol indicating the Emacs background brightness. -The symbol should be one of `light' or `dark'. -If Emacs guesses this frame attribute wrongly, either set this variable in -your `~/.emacs' or set the resource `Emacs.backgroundMode' in your -`~/.Xdefaults'. -See also `gnus-display-type'. - -This is a meta-variable that will affect what default values other -variables get. You would normally not change this variable, but -pounce directly on the real variables themselves.") - - - (defun gnus-install-mouse-tracker () - (require 'mode-motion) - (setq mode-motion-hook 'mode-motion-highlight-line))) + (gnus-xmas-define)) ((and (not (string-match "28.9" emacs-version)) (not (string-match "29" emacs-version))) @@ -215,7 +142,6 @@ pounce directly on the real variables themselves.") ((boundp 'MULE) (provide 'gnusutil)) - ))) (eval-and-compile @@ -237,449 +163,25 @@ pounce directly on the real variables themselves.") (defun face-list (&rest args))) ) -(defun gnus-highlight-selected-summary-xemacs () - ;; 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)))) - -(defun gnus-summary-recenter-xemacs () - (let* ((top (cond ((< (window-height) 4) 0) - ((< (window-height) 7) 1) - (t 2))) - (height (- (window-height) 2)) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point))) - (window (get-buffer-window (current-buffer)))) - (and - ;; The user has to want it, - gnus-auto-center-summary - ;; the article buffer must be displayed, - (get-buffer-window gnus-article-buffer) - ;; Set the window start to either `bottom', which is the biggest - ;; possible valid number, or the second line from the top, - ;; whichever is the least. - (set-window-start - window (min bottom (save-excursion (forward-line (- top)) - (point))))))) - -(defun gnus-group-insert-group-line-info-xemacs (group) - (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (beg (point)) - active info) - (if entry - (progn - (setq info (nth 2 entry)) - (gnus-group-insert-group-line - nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info))) - (setq active (gnus-gethash group gnus-active-hashtb)) - - (gnus-group-insert-group-line - nil group (if (member group gnus-zombie-list) gnus-level-zombie - gnus-level-killed) - nil (if active (- (1+ (cdr active)) (car active)) 0) nil)) - (save-excursion - (goto-char beg) - (remove-text-properties - (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) - '(gnus-group nil))))) - -(defun gnus-summary-refer-article-xemacs (message-id) - "Refer article specified by MESSAGE-ID. -NOTE: This command only works with newsgroups that use real or simulated NNTP." - (interactive "sMessage-ID: ") - (if (or (not (stringp message-id)) - (zerop (length message-id))) - () - ;; Construct the correct Message-ID if necessary. - ;; Suggested by tale@pawl.rpi.edu. - (or (string-match "^<" message-id) - (setq message-id (concat "<" message-id))) - (or (string-match ">$" message-id) - (setq message-id (concat message-id ">"))) - (let ((header (car (gnus-gethash (downcase message-id) - gnus-newsgroup-dependencies)))) - (if header - (or (gnus-summary-goto-article (mail-header-number header)) - ;; The header has been read, but the article had been - ;; expunged, so we insert it again. - (let ((beg (point))) - (gnus-summary-insert-line - nil header 0 nil gnus-read-mark nil nil - (mail-header-subject header)) - (save-excursion - (goto-char beg) - (remove-text-properties - (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) - '(gnus-number nil gnus-mark nil gnus-level nil))) - (forward-line -1) - (mail-header-number header))) - (let ((gnus-override-method gnus-refer-article-method) - (gnus-ancient-mark gnus-read-mark) - (tmp-point (window-start - (get-buffer-window gnus-article-buffer))) - number tmp-buf) - (and gnus-refer-article-method - (gnus-check-server gnus-refer-article-method)) - ;; Save the old article buffer. - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-kill-buffer " *temp Article*") - (setq tmp-buf (rename-buffer " *temp Article*"))) - (prog1 - (if (gnus-article-prepare - message-id nil (gnus-read-header message-id)) - (progn - (setq number (mail-header-number gnus-current-headers)) - (gnus-rebuild-thread message-id) - (gnus-summary-goto-subject number) - (gnus-summary-recenter) - (gnus-article-set-window-start - (cdr (assq number gnus-newsgroup-bookmarks))) - message-id) - ;; We restore the old article buffer. - (save-excursion - (kill-buffer gnus-article-buffer) - (set-buffer tmp-buf) - (rename-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) - (and tmp-point - (set-window-start (get-buffer-window (current-buffer)) - tmp-point))))))))))) - -(defun gnus-summary-insert-pseudos-xemacs (pslist &optional not-view) - (let ((buffer-read-only nil) - (article (gnus-summary-article-number)) - b) - (or (gnus-summary-goto-subject article) - (error (format "No such article: %d" article))) - (gnus-summary-position-point) - ;; If all commands are to be bunched up on one line, we collect - ;; them here. - (if gnus-view-pseudos-separately - () - (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) - files action) - (while ps - (setq action (cdr (assq 'action (car ps)))) - (setq files (list (cdr (assq 'name (car ps))))) - (while (and ps (cdr ps) - (string= (or action "1") - (or (cdr (assq 'action (car (cdr ps)))) "2"))) - (setq files (cons (cdr (assq 'name (car (cdr ps)))) files)) - (setcdr ps (cdr (cdr ps)))) - (if (not files) - () - (if (not (string-match "%s" action)) - (setq files (cons " " files))) - (setq files (cons " " files)) - (and (assq 'execute (car ps)) - (setcdr (assq 'execute (car ps)) - (funcall (if (string-match "%s" action) - 'format 'concat) - action - (mapconcat (lambda (f) f) files " "))))) - (setq ps (cdr ps))))) - (if (and gnus-view-pseudos (not not-view)) - (while pslist - (and (assq 'execute (car pslist)) - (gnus-execute-command (cdr (assq 'execute (car pslist))) - (eq gnus-view-pseudos 'not-confirm))) - (setq pslist (cdr pslist))) - (save-excursion - (while pslist - (gnus-summary-goto-subject (or (cdr (assq 'article (car pslist))) - (gnus-summary-article-number))) - (gnus-data-enter - (gnus-summary-article-number) - gnus-reffed-article-number gnus-unread-mark - (progn (forward-line 1) (point)) - (car pslist) 0) - (setq b (point)) - (insert " " - (file-name-nondirectory (cdr (assq 'name (car pslist)))) - ": " (or (cdr (assq 'execute (car pslist))) "") "\n") - (add-text-properties - b (1+ b) (list 'gnus-number gnus-reffed-article-number - 'gnus-mark gnus-unread-mark - 'gnus-level 0 - 'gnus-pseudo (car pslist))) - ;; Fucking XEmacs redisplay bug with truncated lines. - (goto-char b) - (sit-for 0) - ;; Grumble.. Fucking XEmacs stickyness of text properties. - (remove-text-properties - (1+ b) (1+ (gnus-point-at-eol)) - '(gnus-number nil gnus-mark nil gnus-level nil)) - (forward-line -1) - (setq gnus-newsgroup-unreads - (cons gnus-reffed-article-number gnus-newsgroup-unreads)) - (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) - (setq pslist (cdr pslist))))))) - - -(defun gnus-copy-article-buffer-xemacs (&optional article-buffer) - (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) - (buffer-disable-undo gnus-article-copy) - (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)) - buf) - (if (and (get-buffer article-buffer) - (buffer-name (get-buffer article-buffer))) - (save-excursion - (set-buffer article-buffer) - (widen) - (setq buf (buffer-substring (point-min) (point-max))) - (set-buffer gnus-article-copy) - (erase-buffer) - (insert (format "%s" buf)))))) - -(defun gnus-article-push-button-xemacs (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `gnus-callback' property, -call it with the value of the `gnus-data' text property." - (interactive "e") - (set-buffer (window-buffer (event-window event))) - (let* ((pos (event-closest-point event)) - (data (get-text-property pos 'gnus-data)) - (fun (get-text-property pos 'gnus-callback))) - (if fun (funcall fun data)))) - -;; Re-build the thread containing ID. -(defun gnus-rebuild-thread-xemacs (id) - (let ((dep gnus-newsgroup-dependencies) - (buffer-read-only nil) - parent headers refs thread art) - (while (and id (setq headers - (car (setq art (gnus-gethash (downcase id) - dep))))) - (setq parent art) - (setq id (and (setq refs (mail-header-references headers)) - (string-match "\\(<[^>]+>\\) *$" refs) - (substring refs (match-beginning 1) (match-end 1))))) - (setq thread (gnus-make-sub-thread (car parent))) - (gnus-rebuild-remove-articles thread) - (let ((beg (point))) - (gnus-summary-prepare-threads (list thread) 0) - (save-excursion - (while (and (>= (point) beg) - (not (bobp))) - (or (eobp) - (remove-text-properties - (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) - '(gnus-number nil gnus-mark nil gnus-level nil))) - (forward-line -1))) - (gnus-summary-update-lines beg (point))))) - - -;; Fixed by Christopher Davis . -(defun gnus-article-add-button-xemacs (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (and gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) - (add-text-properties from to - (append - (and gnus-article-mouse-face - (list 'mouse-face gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data)) - (list 'highlight t)))) - -(defun gnus-window-top-edge-xemacs (&optional window) - (nth 1 (window-pixel-edges window))) - -;; Select the lowest window on the frame. -(defun gnus-appt-select-lowest-window-xemacs () - (let* ((lowest-window (selected-window)) - (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges)))))) - (last-window (previous-window)) - (window-search t)) - (while window-search - (let* ((this-window (next-window)) - (next-bottom-edge (car (cdr (cdr (cdr - (window-pixel-edges - this-window))))))) - (if (< bottom-edge next-bottom-edge) - (progn - (setq bottom-edge next-bottom-edge) - (setq lowest-window this-window))) - - (select-window this-window) - (if (eq last-window this-window) - (progn - (select-window lowest-window) - (setq window-search nil))))))) - - (defun gnus-ems-redefine () (cond ((string-match "XEmacs\\|Lucid" emacs-version) - ;; XEmacs definitions. - (fset 'gnus-mouse-face-function 'identity) - (fset 'gnus-summary-make-display-table (lambda () nil)) - (fset 'gnus-visual-turn-off-edit-menu 'identity) - (fset 'gnus-highlight-selected-summary - 'gnus-highlight-selected-summary-xemacs) - (fset 'gnus-summary-recenter 'gnus-summary-recenter-xemacs) - (fset 'gnus-group-insert-group-line-info - 'gnus-group-insert-group-line-info-xemacs) - (fset 'gnus-copy-article-buffer 'gnus-copy-article-buffer-xemacs) - (fset 'gnus-summary-refer-article 'gnus-summary-refer-article-xemacs) - (fset 'gnus-summary-insert-pseudos 'gnus-summary-insert-pseudos-xemacs) - (fset 'gnus-article-push-button 'gnus-article-push-button-xemacs) - (fset 'gnus-rebuild-thread 'gnus-rebuild-thread-xemacs) - (fset 'gnus-article-add-button 'gnus-article-add-button-xemacs) - (fset 'gnus-window-top-edge 'gnus-window-top-edge-xemacs) - (fset 'set-text-properties 'gnus-set-text-properties-xemacs) - - (or (fboundp 'appt-select-lowest-window) - (fset 'appt-select-lowest-window - 'gnus-appt-select-lowest-window-xemacs)) - - (if (not gnus-visual) - () - (setq gnus-group-mode-hook - (cons - '(lambda () - (easy-menu-add gnus-group-reading-menu) - (easy-menu-add gnus-group-group-menu) - (easy-menu-add gnus-group-misc-menu) - (gnus-install-mouse-tracker)) - gnus-group-mode-hook)) - (setq gnus-summary-mode-hook - (cons - '(lambda () - (easy-menu-add gnus-summary-article-menu) - (easy-menu-add gnus-summary-thread-menu) - (easy-menu-add gnus-summary-misc-menu) - (easy-menu-add gnus-summary-post-menu) - (easy-menu-add gnus-summary-kill-menu) - (gnus-install-mouse-tracker)) - gnus-summary-mode-hook)) - (setq gnus-article-mode-hook - (cons - '(lambda () - (easy-menu-add gnus-article-article-menu) - (easy-menu-add gnus-article-treatment-menu)) - gnus-article-mode-hook))) - - (defvar gnus-logo (make-glyph (make-specifier 'image))) - - (defun gnus-group-startup-xmessage (&optional x y) - "Insert startup message in current buffer." - ;; Insert the message. - (erase-buffer) - (if (featurep 'xpm) - (progn - (set-glyph-property gnus-logo 'image "~/tmp/gnus.xpm") - (set-glyph-image gnus-logo "~/tmp/gnus.xpm" 'global 'x) - - (insert " ") - (set-extent-begin-glyph (make-extent (point) (point)) gnus-logo) - (insert " - Gnus * A newsreader for Emacsen - A Praxis Release * larsi@ifi.uio.no") - (goto-char (point-min)) - (while (not (eobp)) - (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2) - ? )) - (forward-line 1)) - (goto-char (point-min)) - ;; +4 is fuzzy factor. - (insert-char ?\n (/ (max (- (window-height) (or y 24)) 0) 2))) - - (insert - (format " - %s - A newsreader - for GNU Emacs - - Based on GNUS - written by - Masanobu UMEDA - - A Praxis Release - larsi@ifi.uio.no -" - gnus-version)) - ;; And then hack it. - ;; 18 is the longest line. - (indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 28)) 0) 2)) - (goto-char (point-min)) - ;; +4 is fuzzy factor. - (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))) - - ;; Fontify some. - (goto-char (point-min)) - (search-forward "Praxis") - (put-text-property (match-beginning 0) (match-end 0) 'face 'bold) - (goto-char (point-min))) - - - - ) + (gnus-xmas-redefine)) ((boundp 'MULE) ;; Mule definitions - (if (not (fboundp 'truncate-string)) - (defun truncate-string (str width) - (let ((w (string-width str)) - (col 0) (idx 0) (p-idx 0) chr) - (if (<= w width) - str - (while (< col width) - (setq chr (aref str idx) - col (+ col (char-width chr)) - p-idx idx - idx (+ idx (char-bytes chr)) - )) - (substring str 0 (if (= col width) - idx - p-idx)) - ))) - ) + (or (fboundp 'truncate-string) + (fset 'truncate-string 'gnus-mule-truncate-string)) (defalias 'gnus-truncate-string 'truncate-string) - (defun gnus-cite-add-face (number prefix face) - ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (if face - (let ((inhibit-point-motion-hooks t) - from to) - (goto-line number) - (if (boundp 'MULE) - (forward-char (chars-in-string prefix)) - (forward-char (length prefix))) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (if (< from to) - (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) - - (defun gnus-max-width-function (el max-width) - (` (let* ((val (eval (, el))) - (valstr (if (numberp val) - (int-to-string val) val))) - (if (> (length valstr) (, max-width)) - (truncate-string valstr (, max-width)) - valstr)))) - (fset 'gnus-summary-make-display-table (lambda () nil)) + (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) + (fset 'gnus-max-width-function 'gnus-mule-max-width-function) (if (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting (delq 'long-lines - (delq 'control-chars gnus-check-before-posting))) - ) + (delq 'control-chars gnus-check-before-posting)))) ) )) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index fab16237a..4822ab820 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -174,7 +174,7 @@ optional. If you want Gnus not to insert some header, remove it from this list.") (defvar gnus-required-mail-headers - '(From Date To Subject In-Reply-To Message-ID Organization Lines) + '(From Date To Subject (optional . In-Reply-To) Message-ID Organization Lines) "*Headers to be generated or prompted for when mailing a message. RFC822 required that From, Date, To, Subject and Message-ID be included. Organization, Lines and X-Mailer are optional.") @@ -402,7 +402,7 @@ header line with the old Message-ID." (if (gnus-post-news 'post gnus-newsgroup-name) (progn (erase-buffer) - (insert-buffer gnus-article-buffer) + (insert-buffer-substring gnus-article-buffer) (if (search-forward "\n\n" nil t) (forward-char -1) (goto-char (point-max))) @@ -451,8 +451,9 @@ Type \\[describe-mode] in the buffer to get a list of commands." (interactive (list t)) (let* ((group (or group gnus-newsgroup-name)) (to-address - (assq 'to-address - (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))))) + (cdr (assq + 'to-address + (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))))) (if (and (gnus-member-of-valid 'post (or group gnus-newsgroup-name)) (not to-address)) (if post @@ -460,14 +461,14 @@ Type \\[describe-mode] in the buffer to get a list of commands." (gnus-news-followup yank group)) (if post (progn - (gnus-new-mail) + (gnus-new-mail to-address) ;; Arrange for mail groups that have no `to-address' to ;; get that when the user sends off the mail. (or to-address (progn (make-local-variable 'gnus-add-to-address) (setq gnus-add-to-address group)))) - (gnus-mail-reply yank (and to-address (cdr to-address)) 'followup))))) + (gnus-mail-reply yank to-address 'followup))))) (defun gnus-inews-news (&optional use-group-method) "Send a news message. @@ -546,7 +547,7 @@ will attempt to use the foreign server to post the article." ;; We copy the article over to a temp buffer since we are ;; going to modify it a little. (nnheader-set-temp-buffer " *Gnus-mailing*") - (insert-buffer buffer) + (insert-buffer-substring buffer) ;; We remove Fcc, because we don't want the mailer to see ;; that header. (gnus-inews-narrow-to-headers) @@ -1029,35 +1030,47 @@ Headers in `gnus-required-headers' will be generated." (looking-at "[ \t]*$"))) ;; So we find out what value we should insert. (progn - (setq value - (or (if (consp elem) - ;; The element is a cons. Either the cdr is - ;; a string to be inserted verbatim, or it - ;; is a function, and we insert the value - ;; returned from this function. - (or (and (stringp (cdr elem)) (cdr elem)) - (and (fboundp (cdr elem)) (funcall (cdr elem)))) - ;; The element is a symbol. We insert the - ;; value of this symbol, if any. - (and (boundp header) (symbol-value header))) - ;; We couldn't generate a value for this header, - ;; so we just ask the user. - (read-from-minibuffer - (format "Empty header for %s; enter value: " header)))) + (setq value + (cond + ((and (consp elem) (eq (car elem) 'optional)) + ;; This is an optional header. If the cdr of this + ;; is something that is nil, then we do not insert + ;; this header. + (setq header (cdr elem)) + (or (and (fboundp (cdr elem)) (funcall (cdr elem))) + (and (boundp (cdr elem)) (symbol-value (cdr elem))))) + ((consp elem) + ;; The element is a cons. Either the cdr is a + ;; string to be inserted verbatim, or it is a + ;; function, and we insert the value returned from + ;; this function. + (or (and (stringp (cdr elem)) (cdr elem)) + (and (fboundp (cdr elem)) (funcall (cdr elem))))) + ((and (boundp header) (symbol-value header)) + ;; The element is a symbol. We insert the value + ;; of this symbol, if any. + (symbol-value header)) + (t + ;; We couldn't generate a value for this header, + ;; so we just ask the user. + (read-from-minibuffer + (format "Empty header for %s; enter value: " header))))) ;; Finally insert the header. - (save-excursion - (if (bolp) - (progn - (goto-char (point-max)) - (insert (symbol-name header) ": " value "\n") - (forward-line -1)) - (replace-match value t t)) - ;; Add the deletable property to the headers that require it. - (and (memq header gnus-deletable-headers) - (progn (beginning-of-line) (looking-at "[^:]+: ")) - (add-text-properties - (point) (match-end 0) - '(gnus-deletable t face italic) (current-buffer)))))) + (if (not value) + () + (save-excursion + (if (bolp) + (progn + (goto-char (point-max)) + (insert (symbol-name header) ": " value "\n") + (forward-line -1)) + (replace-match value t t)) + ;; Add the deletable property to the headers that require it. + (and (memq header gnus-deletable-headers) + (progn (beginning-of-line) (looking-at "[^:]+: ")) + (add-text-properties + (point) (match-end 0) + '(gnus-deletable t face italic) (current-buffer))))))) (setq headers (cdr headers))) ;; Insert new Sender if the From is strange. (let ((from (mail-fetch-field "from")) @@ -1241,8 +1254,10 @@ domain is undefined, the domain name is got from it." gnus-local-domain ;; Function `system-name' may return full internet name. ;; Suggested by Mike DeCorte . - (if (string-match "\\." system-name) - (substring system-name (match-end 0))) + (if (string-match "\\.." system-name) + ;; Some machines return "name.", and that's not + ;; very nice. + (substring system-name (1- (match-end 0)))) (read-string "Domain name (no host): "))) (host (or (if (string-match "\\." system-name) (substring system-name 0 (match-beginning 0))) @@ -1585,6 +1600,7 @@ mailer." (erase-buffer) (news-reply-mode) (news-setup nil subject nil group nil) + (gnus-inews-insert-signature) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) (local-set-key "\C-c\C-c" 'gnus-inews-news))) @@ -1678,6 +1694,7 @@ mailer." (make-local-variable 'gnus-in-reply-to) (setq gnus-in-reply-to message-of) + (gnus-inews-insert-signature) (auto-save-mode auto-save-default) (gnus-inews-modify-mail-mode-map) @@ -1739,7 +1756,7 @@ mailer." (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (if (not yank) - (gnus-configure-windows 'reply 'force) + (gnus-configure-windows 'followup 'force) (let ((last (point)) end) (if (not (listp yank)) @@ -1762,7 +1779,7 @@ mailer." (goto-char end) (setq yank (cdr yank)))) (goto-char last)) - (gnus-configure-windows 'reply-yank 'force)) + (gnus-configure-windows 'followup-yank 'force)) (make-local-variable 'gnus-article-check-size) (setq gnus-article-check-size @@ -1854,7 +1871,7 @@ mailer." (defun gnus-forward-insert-buffer (buffer) (let ((beg (goto-char (point-max)))) (insert "------- Start of forwarded message -------\n") - (insert-buffer buffer) + (insert-buffer-substring buffer) (goto-char (point-max)) (insert "------- End of forwarded message -------\n") ;; Suggested by Sudish Joseph . @@ -2030,7 +2047,7 @@ this is a reply." ;; Create a mail buffer. (gnus-new-mail) (erase-buffer) - (insert-buffer gnus-article-buffer) + (insert-buffer-substring gnus-article-buffer) (goto-char (point-min)) (search-forward "\n\n") ;; We remove everything before the bounced mail. @@ -2194,7 +2211,7 @@ Headers will be generated before sending." (widen) (save-excursion (nnheader-set-temp-buffer " *enter-draft*") - (insert-buffer buf) + (insert-buffer-substring buf) (save-restriction (widen) (gnus-inews-narrow-to-headers) @@ -2257,7 +2274,7 @@ Headers will be generated before sending." (, (list (cdr gnus-article-current))) (, gnus-newsgroup-name) t))))) ;; Insert the draft. - (insert-buffer gnus-article-buffer) + (insert-buffer-substring gnus-article-buffer) ;; Insert the separator. (goto-char (point-min)) (search-forward "\n\n") diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index c10a055a7..fcbe57eae 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -27,7 +27,7 @@ (require 'gnus) -(defvar gnus-group-topic-face 'underline +(defvar gnus-group-topic-face 'bold "*Face used to highlight topic headers.") (defvar gnus-group-topics '(("misc" "." nil)) diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 273ecbfd1..b9961282a 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -3,7 +3,6 @@ ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 -;; Version: v3.0 ;; Keyword: news ;; This file is part of GNU Emacs. @@ -1797,7 +1796,7 @@ If no file has been included, the user will be asked for a file." (get-buffer-create uuencode-buffer-name))) (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) - (insert-buffer uubuf) + (insert-buffer-substring uubuf) (error "Encoding unsuccessful")) (kill-buffer uubuf)) file-name)) diff --git a/lisp/gnus-vis.el b/lisp/gnus-vis.el index 1984cb495..854af238b 100644 --- a/lisp/gnus-vis.el +++ b/lisp/gnus-vis.el @@ -235,14 +235,15 @@ variable it the real callback function.") (defvar gnus-header-button-alist '(("^\\(References\\|Message-ID\\):" "<[^>]+>" 0 t gnus-button-message-id 0) - ("^\\(From\\|Reply-To\\): " ".*" 0 t gnus-button-reply 0) - ("^\\(Cc\\|To\\):" "[^ \t]+@[^ \t]+\\|<[^>]+>" 0 t gnus-button-mailto 0)) + ("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0) + ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" + 0 t gnus-button-mailto 0)) "Alist of headers and regexps to match buttons in article heads. This alist is very similar to `gnus-button-alist', except that each alist has an additional HEADER element first in each entry: -(HEADER REGEXP BUTTON FORM CALLBACK PAR) +\(HEADER REGEXP BUTTON FORM CALLBACK PAR) HEADER is a regexp to match a header. For a fuller explanation, see `gnus-button-alist'.") @@ -655,7 +656,8 @@ HEADER is a regexp to match a header. For a fuller explanation, see ["All" gnus-article-hide t] ["Headers" gnus-article-hide-headers t] ["Signature" gnus-article-hide-signature t] - ["Citation" gnus-article-hide-citation t]) + ["Citation" gnus-article-hide-citation t] + ["PGP" gnus-article-hide-pgp t]) ("Highlight" ["All" gnus-article-highlight t] ["Headers" gnus-article-highlight-headers t] @@ -982,7 +984,7 @@ If nil, the user will be asked for a duration.") (while (and list (not (eval (car (car list))))) (setq list (cdr list))) (let ((face (and list (cdr (car list))))) - (or (eobp) + (or (null mark) (eq face (get-text-property beg 'face)) (put-text-property beg end 'face (if (boundp face) (symbol-value face) face)))) @@ -1364,15 +1366,19 @@ specified by `gnus-button-alist'." entry beg end) (gnus-narrow-to-headers) (while alist + ;; Each alist entry. + (setq entry (car alist) + alist (cdr alist)) (goto-char (point-min)) - (if (not (re-search-forward (car (setq entry (car alist))) nil t)) - () ; That header isn't here. + (while (re-search-forward (car entry) nil t) + ;; Each header matching the entry. (setq beg (match-beginning 0)) (setq end (or (and (re-search-forward "^[^ \t]" nil t) (match-beginning 0)) (point-max))) (goto-char beg) (while (re-search-forward (nth 1 entry) end t) + ;; Each match within a header. (let* ((from (match-beginning 0)) (entry (cdr entry)) (start (match-beginning (nth 1 entry))) @@ -1383,9 +1389,8 @@ specified by `gnus-button-alist'." (gnus-article-add-button start end (nth 3 entry) (buffer-substring (match-beginning (nth 4 entry)) - (match-end (nth 4 entry)))))))) - (goto-char end) - (setq alist (cdr alist)))) + (match-end (nth 4 entry))))))) + (goto-char end)))) (widen))) (defun gnus-netscape-open-url (url) @@ -1412,10 +1417,10 @@ specified by `gnus-button-alist'." 'face gnus-article-button-face)) (add-text-properties from to - (append (and gnus-article-mouse-face - (list 'mouse-face gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data))))) + (nconc (and gnus-article-mouse-face + (list 'mouse-face gnus-article-mouse-face)) + (list 'gnus-callback fun) + (and data (list 'gnus-data data))))) ;;; Internal functions: diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el new file mode 100644 index 000000000..54b357ba4 --- /dev/null +++ b/lisp/gnus-xmas.el @@ -0,0 +1,491 @@ +;;; gnus-xmal.el --- Gnus functions for XEmacs +;; Copyright (C) 1995 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; 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 'mode-motion) +(require 'text-props) + +(defvar gnus-xmas-glyph-directory nil + "*Directory where Gnus logos and icons are located. +If this variable is nil, Gnus will try to locate the directory +automatically.") + +;;; Internal variables. + +(defvar gnus-xmas-logo (make-glyph (make-specifier 'image))) + +;; Don't warn about these undefined variables. + +(defvar gnus-group-mode-hook) +(defvar gnus-summary-mode-hook) +(defvar gnus-article-mode-hook) + +;;defined in gnus.el +(defvar gnus-active-hashtb) +(defvar gnus-article-buffer) +(defvar gnus-auto-center-summary) +(defvar gnus-buffer-list) +(defvar gnus-current-headers) +(defvar gnus-level-killed) +(defvar gnus-level-zombie) +(defvar gnus-newsgroup-bookmarks) +(defvar gnus-newsgroup-dependencies) +(defvar gnus-newsgroup-selected-overlay) +(defvar gnus-newsrc-hashtb) +(defvar gnus-read-mark) +(defvar gnus-refer-article-method) +(defvar gnus-reffed-article-number) +(defvar gnus-unread-mark) +(defvar gnus-version) +(defvar gnus-view-pseudos) +(defvar gnus-view-pseudos-separately) +(defvar gnus-visual) +(defvar gnus-zombie-list) +;;defined in gnus-msg.el +(defvar gnus-article-copy) +(defvar gnus-check-before-posting) +;;defined in gnus-vis.el +(defvar gnus-article-button-face) +(defvar gnus-article-mouse-face) +(defvar gnus-summary-selected-face) +(defvar gnus-group-reading-menu) +(defvar gnus-group-group-menu) +(defvar gnus-group-misc-menu) +(defvar gnus-summary-article-menu) +(defvar gnus-summary-thread-menu) +(defvar gnus-summary-misc-menu) +(defvar gnus-summary-post-menu) +(defvar gnus-summary-kill-menu) +(defvar gnus-article-article-menu) +(defvar gnus-article-treatment-menu) +(defvar gnus-mouse-2) +(defvar standard-display-table) + +(defun gnus-xmas-install-mouse-tracker () + (add-hook 'mode-motion-hook 'mode-motion-highlight-line)) + +(defun gnus-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 (and (stringp buffer) (not (setq buffer (get-buffer 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))) + +(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)))) + +(defun gnus-xmas-summary-recenter () + (let* ((top (cond ((< (window-height) 4) 0) + ((< (window-height) 7) 1) + (t 2))) + (height (- (window-height) 2)) + (bottom (save-excursion (goto-char (point-max)) + (forward-line (- height)) + (point))) + (window (get-buffer-window (current-buffer)))) + (and + ;; The user has to want it, + gnus-auto-center-summary + ;; the article buffer must be displayed, + (get-buffer-window gnus-article-buffer) + ;; Set the window start to either `bottom', which is the biggest + ;; possible valid number, or the second line from the top, + ;; whichever is the least. + (set-window-start + window (min bottom (save-excursion (forward-line (- top)) + (point))))))) + +(defun gnus-xmas-group-insert-group-line-info (group) + (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) + (beg (point)) + active info) + (if entry + (progn + (setq info (nth 2 entry)) + (gnus-group-insert-group-line + nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info))) + (setq active (gnus-gethash group gnus-active-hashtb)) + + (gnus-group-insert-group-line + nil group (if (member group gnus-zombie-list) gnus-level-zombie + gnus-level-killed) + nil (if active (- (1+ (cdr active)) (car active)) 0) nil)) + (save-excursion + (goto-char beg) + (remove-text-properties + (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) + '(gnus-group nil))))) + +(defun gnus-xmas-copy-article-buffer (&optional article-buffer) + (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) + (buffer-disable-undo gnus-article-copy) + (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)) + buf) + (if (and (get-buffer article-buffer) + (buffer-name (get-buffer article-buffer))) + (save-excursion + (set-buffer article-buffer) + (widen) + (setq buf (buffer-substring (point-min) (point-max))) + (set-buffer gnus-article-copy) + (erase-buffer) + (insert (format "%s" buf)))))) + +(defun gnus-xmas-article-push-button (event) + "Check text under the mouse pointer for a callback function. +If the text under the mouse pointer has a `gnus-callback' property, +call it with the value of the `gnus-data' text property." + (interactive "e") + (set-buffer (window-buffer (event-window event))) + (let* ((pos (event-closest-point event)) + (data (get-text-property pos 'gnus-data)) + (fun (get-text-property pos 'gnus-callback))) + (if fun (funcall fun data)))) + +(defun gnus-xmas-move-overlay (extent start end &optional buffer) + (set-extent-endpoints extent start end)) + +;; Fixed by Christopher Davis . +(defun gnus-xmas-article-add-button (from to fun &optional data) + "Create a button between FROM and TO with callback FUN and data DATA." + (and gnus-article-button-face + (gnus-overlay-put (gnus-make-overlay from to) + 'face gnus-article-button-face)) + (add-text-properties + from to + (nconc + (and gnus-article-mouse-face + (list 'mouse-face gnus-article-mouse-face)) + (list 'gnus-callback fun) + (and data (list 'gnus-data data)) + (list 'highlight t)))) + +(defun gnus-xmas-window-top-edge (&optional window) + (nth 1 (window-pixel-edges window))) + +;; Select the lowest window on the frame. +(defun gnus-xmas-appt-select-lowest-window () + (let* ((lowest-window (selected-window)) + (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges)))))) + (last-window (previous-window)) + (window-search t)) + (while window-search + (let* ((this-window (next-window)) + (next-bottom-edge (car (cdr (cdr (cdr + (window-pixel-edges + this-window))))))) + (if (< bottom-edge next-bottom-edge) + (progn + (setq bottom-edge next-bottom-edge) + (setq lowest-window this-window))) + + (select-window this-window) + (if (eq last-window this-window) + (progn + (select-window lowest-window) + (setq window-search nil))))))) + +(defun gnus-xmas-group-menu-add () + (easy-menu-add gnus-group-reading-menu) + (easy-menu-add gnus-group-group-menu) + (easy-menu-add gnus-group-misc-menu) + (gnus-xmas-install-mouse-tracker)) + +(defun gnus-xmas-summary-menu-add () + (easy-menu-add gnus-summary-article-menu) + (easy-menu-add gnus-summary-thread-menu) + (easy-menu-add gnus-summary-misc-menu) + (easy-menu-add gnus-summary-post-menu) + (easy-menu-add gnus-summary-kill-menu) + (gnus-xmas-install-mouse-tracker)) + +(defun gnus-xmas-article-menu-add () + (easy-menu-add gnus-article-article-menu) + (easy-menu-add gnus-article-treatment-menu)) + + +(defun gnus-xmas-define () + (setq gnus-mouse-2 [button2]) + + (or (memq 'underline (list-faces)) + (and (fboundp 'make-face) + (funcall (intern "make-face") 'underline))) + ;; Must avoid calling set-face-underline-p directly, because it + ;; is a defsubst in emacs19, and will make the .elc files non + ;; portable! + (or (face-differs-from-default-p 'underline) + (funcall (intern "set-face-underline-p") 'underline t)) + + (fset 'gnus-make-overlay 'make-extent) + (fset 'gnus-overlay-put 'set-extent-property) + (fset 'gnus-move-overlay 'gnus-xmas-move-overlay) + + (fset 'set-text-properties 'gnus-xmas-set-text-properties) + + (or (boundp 'standard-display-table) (setq standard-display-table nil)) + (or (boundp 'read-event) (fset 'read-event 'next-command-event)) + + ;; Fix by "jeff (j.d.) sparkes" . + (defvar gnus-display-type (device-class) + "A symbol indicating the display Emacs is running under. +The symbol should be one of `color', `grayscale' or `mono'. If Emacs +guesses this display attribute wrongly, either set this variable in +your `~/.emacs' or set the resource `Emacs.displayType' in your +`~/.Xdefaults'. See also `gnus-background-mode'. + +This is a meta-variable that will affect what default values other +variables get. You would normally not change this variable, but +pounce directly on the real variables themselves.") + + + (or (fboundp 'x-color-values) + (fset 'x-color-values + (lambda (color) + (color-instance-rgb-components + (make-color-instance color))))) + + (defvar gnus-background-mode + (let ((bg-resource + (condition-case () + (x-get-resource ".backgroundMode" "BackgroundMode" 'string) + (error nil))) + (params (frame-parameters))) + (cond (bg-resource (intern (downcase bg-resource))) + ((and (assq 'background-color params) + (< (apply '+ (x-color-values + (cdr (assq 'background-color params)))) + (/ (apply '+ (x-color-values "white")) 3))) + 'dark) + (t 'light))) + "A symbol indicating the Emacs background brightness. +The symbol should be one of `light' or `dark'. +If Emacs guesses this frame attribute wrongly, either set this variable in +your `~/.emacs' or set the resource `Emacs.backgroundMode' in your +`~/.Xdefaults'. +See also `gnus-display-type'. + +This is a meta-variable that will affect what default values other +variables get. You would normally not change this variable, but +pounce directly on the real variables themselves.")) + + + +(defun gnus-xmas-redefine () + (fset 'gnus-mouse-face-function 'identity) + (fset 'gnus-summary-make-display-table (lambda () nil)) + (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-group-insert-group-line-info + 'gnus-xmas-group-insert-group-line-info) + (fset 'gnus-copy-article-buffer 'gnus-xmas-copy-article-buffer) + (fset 'gnus-article-push-button 'gnus-xmas-article-push-button) + (fset 'gnus-article-add-button 'gnus-xmas-article-add-button) + (fset 'gnus-window-top-edge 'gnus-xmas-window-top-edge) + (fset 'set-text-properties 'gnus-xmas-set-text-properties) + + (or (fboundp 'appt-select-lowest-window) + (fset 'appt-select-lowest-window + 'gnus-xnas-appt-select-lowest-window)) + + (add-hook 'gnus-group-menu-hook 'gnus-xmas-group-menu-add) + (add-hook 'gnus-summary-menu-hook 'gnus-xmas-summary-menu-add) + (add-hook 'gnus-article-menu-hook 'gnus-xmas-article-menu-add) + + (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar) + (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar) + + ) + + +;;; XEmacs logo and toolbar. + +(defun gnus-xmas-find-glyph-directory () + (or gnus-xmas-glyph-directory ; We have a dir already... + (let ((path load-path) + dir) + ;; We try to find the dir by looking at the load path, + ;; stripping away the last component and adding "etc/". + (while path + (setq dir (concat + (file-name-directory (directory-file-name (car path))) + "etc/")) + (if (and (file-exists-p dir) + (file-directory-p dir)) + (setq gnus-xmas-glyph-directory dir + path nil) + (setq path (cdr path)))) + gnus-xmas-glyph-directory))) + +(defun gnus-xmas-group-startup (&optional x y) + "Insert startup message in current buffer." + ;; Insert the message. + (erase-buffer) + (if (featurep 'xpm) + (progn + (set-glyph-property gnus-xmas-logo 'image "~/tmp/gnus.xpm") + (set-glyph-image gnus-xmas-logo "~/tmp/gnus.xpm" 'global 'x) + + (insert " ") + (set-extent-begin-glyph (make-extent (point) (point)) gnus-xmas-logo) + (insert " + Gnus * A newsreader for Emacsen + A Praxis Release * larsi@ifi.uio.no") + (goto-char (point-min)) + (while (not (eobp)) + (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2) + ? )) + (forward-line 1)) + (goto-char (point-min)) + ;; +4 is fuzzy factor. + (insert-char ?\n (/ (max (- (window-height) (or y 24)) 0) 2))) + + (insert + (format " + %s + A newsreader + for GNU Emacs + + Based on GNUS + written by + Masanobu UMEDA + + A Praxis Release + larsi@ifi.uio.no +" + gnus-version)) + ;; And then hack it. + ;; 18 is the longest line. + (indent-rigidly (point-min) (point-max) + (/ (max (- (window-width) (or x 28)) 0) 2)) + (goto-char (point-min)) + ;; +4 is fuzzy factor. + (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))) + + ;; Fontify some. + (goto-char (point-min)) + (search-forward "Praxis") + (put-text-property (match-beginning 0) (match-end 0) 'face 'bold) + (goto-char (point-min))) + +;;; The toolbar. + +(defvar gnus-use-toolbar 'default-toolbar + "*If nil, do not use a toolbar. +If it is non-nil, it must be a toolbar. The five legal values are +`default-toolbar', `top-toolbar', `bottom-toolbar', +`right-toolbar', and `left-toolbar'.") + +(defvar gnus-group-toolbar + '([gnus-group-exit-icon gnus-group-exit t "Exit Gnus"] + [gnus-group-kill-group-icon gnus-group-kill-group t "Kill group"] + [gnus-group-get-new-news-icon gnus-group-get-new-news t "Get new news"] + [gnus-group-get-new-news-this-group-icon + gnus-group-get-new-news-this-group t "Get new new in this group"] + [gnus-group-catchup-current-icon + gnus-group-catchup-current t "Catchup group"] + [gnus-group-describe-group-icon + gnus-group-describe-group t "Describe group"]) + "The group buffer toolbar.") + +(defvar gnus-summary-toolbar + '([gnus-summary-post-news-icon + gnus-summary-post-news t "Post an article"] + [gnus-summary-save-article-file-icon + gnus-summary-save-article-file t "Save article in file"] + [gnus-summary-save-article-icon + gnus-summary-save-article t "Save article"] + [gnus-summary-reply-icon + gnus-summary-reply t "Mail a reply"] + [gnus-summary-reply-with-original-icon + gnus-summary-reply-with-original t "Mail a reply and yank the original"] + [gnus-summary-followup-icon + gnus-summary-followup t "Post a followup"] + [gnus-summary-followup-with-original-icon + gnus-summary-followup-with-original t + "Post a followup and yank the original"] + [gnus-uu-decode-uu-icon + gnus-uu-decode-uu t "Decode uuencoded articles"] + [gnus-uu-post-news-icon + gnus-uu-post-news t "Post an uuencoded article"] + [gnus-summary-caesar-message-icon + gnus-summary-caesar-message t "Rot 13"] + [gnus-summary-cancel-article-icon + gnus-summary-cancel-article t "Cancel article"]) + "The summary buffer toolbar.") + +(defun gnus-xmas-setup-toolbar (bar &optional force) + (let ((dir (file-name-as-directory (gnus-xmas-find-glyph-directory))) + icon up down disabled name) + (if (or (not dir) + (and (not force) + (boundp (aref (car bar) 0)))) + () + (while bar + (setq icon (aref (car bar) 0) + name (symbol-name icon) + bar (cdr bar)) + (setq up (concat dir name "-up.xpm")) + (setq down (concat dir name "-down.xpm")) + (setq disabled (concat dir name "-disabled.xpm")) + (if (not (file-exists-p up)) + (set icon nil) + (set icon (toolbar-make-button-list + up (and (file-exists-p down) down) + (and (file-exists-p disabled) disabled)))))))) + +(defun gnus-xmas-setup-group-toolbar () + (if (not gnus-use-toolbar) + () + (gnus-xmas-setup-toolbar gnus-group-toolbar) + (set-specifier (symbol-value gnus-use-toolbar) + (cons (current-buffer) gnus-group-toolbar)))) + +(defun gnus-xmas-setup-summary-toolbar () + (if (not gnus-use-toolbar) + () + (gnus-xmas-setup-toolbar gnus-summary-toolbar) + (set-specifier (symbol-value gnus-use-toolbar) + (cons (current-buffer) gnus-summary-toolbar)))) + + +;;; gnus-xmas.el ends here diff --git a/lisp/gnus.el b/lisp/gnus.el index f7008596d..493b8f518 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -1450,7 +1450,7 @@ 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 "September Gnus v0.4" +(defconst gnus-version "September Gnus v0.5" "Version number for this version of Gnus.") (defvar gnus-info-nodes @@ -3508,12 +3508,21 @@ prompt the user for the name of an NNTP server to use." (unload-feature feature 'force)) (setq history (cdr history))))) +(defun gnus-indent-rigidly (start end arg) + (save-excursion + (save-restriction + (narrow-to-region start end) + (indent-rigidly start end arg) + (goto-char (point-min)) + (while (search-forward "\t" nil t) + (replace-match " " t t))))) + (defun gnus-group-startup-message (&optional x y) "Insert startup message in current buffer." ;; Insert the message. (erase-buffer) (insert - (format " + (format " %s _ ___ _ _ _ ___ __ ___ __ _ ___ __ _ ___ __ ___ @@ -3532,27 +3541,21 @@ prompt the user for the name of an NNTP server to use." _ __ - -%s * A newsreader for Emacsen - A Praxis release * larsi@ifi.uio.no " gnus-version)) ;; And then hack it. - ;; 18 is the longest line. - (indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 46)) 0) 2)) + (gnus-indent-rigidly (point-min) (point-max) + (/ (max (- (window-width) (or x 46)) 0) 2)) (goto-char (point-min)) + (forward-line 1) (let* ((pheight (count-lines (point-min) (point-max))) (wheight (window-height)) (rest (- wheight pheight))) (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - - - ;; Fontify some. (goto-char (point-min)) - (search-forward "Praxis") - (put-text-property (match-beginning 0) (match-end 0) 'face 'bold) + (and (search-forward "Praxis" nil t) + (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) (goto-char (point-min))) (defun gnus-group-startup-message-old (&optional x y) @@ -4539,7 +4542,8 @@ of the Earth\". There is no undo." (list 'nndoc name (list 'nndoc-address (concat (file-name-as-directory (car path)) "doc.txt")) - (list 'nndoc-article-type 'mbox)))) + (list 'nndoc-article-type 'mbox))) + (forward-line -1)) (gnus-group-position-point)) (defun gnus-group-make-doc-group (file type) @@ -4564,7 +4568,9 @@ of the Earth\". There is no undo." (gnus-group-real-name name) (list 'nndoc name (list 'nndoc-address file) - (list 'nndoc-article-type type))))) + (list 'nndoc-article-type type))) + (forward-line -1) + (gnus-group-position-point))) (defun gnus-group-make-archive-group (&optional all) "Create the (ding) Gnus archive group of the most recent articles. @@ -4576,9 +4582,11 @@ Given a prefix, create a full group." (error "Archive group already exists")) (gnus-group-make-group (gnus-group-real-name group) - "nndir" - (if all gnus-group-archive-directory - gnus-group-recent-archive-directory))) + (list 'nndir (if all "hpc" "edu") + (list 'nndir-directory + (if all gnus-group-archive-directory + gnus-group-recent-archive-directory))))) + (forward-line -1) (gnus-group-position-point)) (defun gnus-group-make-directory-group (dir) @@ -4591,6 +4599,7 @@ mail messages or news articles in files that have numeric names." (or (file-exists-p dir) (error "No such directory")) (or (file-directory-p dir) (error "Not a directory")) (gnus-group-make-group dir "nndir" dir) + (forward-line -1) (gnus-group-position-point)) (defun gnus-group-make-kiboze-group (group address scores) @@ -4603,7 +4612,8 @@ score file entries for articles to include in the group." (read-string "Source groups (regexp): ") (let ((headers (mapcar (lambda (group) (list group)) '("subject" "from" "number" "date" "message-id" - "references" "chars" "lines" "xref"))) + "references" "chars" "lines" "xref" + "followup" "all" "body" "head"))) scores header regexp regexps) (while (not (equal "" (setq header (completing-read "Match on header: " headers nil t)))) @@ -4620,8 +4630,8 @@ score file entries for articles to include in the group." (let (emacs-lisp-mode-hook) (pp scores (current-buffer))) (write-region (point-min) (point-max) - (concat (or gnus-kill-files-directory "~/News") - "nnkiboze:" group "." gnus-score-file-suffix))) + (gnus-score-file-name (concat "nnkiboze:" group)))) + (forward-line -1) (gnus-group-position-point)) (defun gnus-group-add-to-virtual (n vgroup) @@ -5865,6 +5875,7 @@ buffer. (define-key gnus-summary-wash-hide-map "h" 'gnus-article-hide-headers) (define-key gnus-summary-wash-hide-map "s" 'gnus-article-hide-signature) (define-key gnus-summary-wash-hide-map "c" 'gnus-article-hide-citation) + (define-key gnus-summary-wash-hide-map "p" 'gnus-article-hide-pgp) (define-key gnus-summary-wash-hide-map "\C-c" 'gnus-article-hide-citation-maybe) @@ -6813,6 +6824,8 @@ or a straight list of headers." (while (or threads stack new-adopts new-roots) (if (and (= level 0) + (or (not stack) + (= (car (car stack)) 0)) (not gnus-tmp-false-parent) (or new-adopts new-roots)) (progn @@ -6849,18 +6862,14 @@ or a straight list of headers." (cond ((eq gnus-summary-make-false-root 'adopt) ;; We let the first article adopt the rest. - (let ((th (car (cdr (car thread))))) - (while (cdr th) - (setq th (cdr th))) - ;(setcdr th (cdr (cdr (car thread)))) - (setq new-adopts (nconc new-adopts - (cdr (cdr (car thread))))) - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cdr (cdr (car thread)))) - gnus-tmp-gathered)) - (setcdr (cdr (car thread)) nil)) + (setq new-adopts (nconc new-adopts + (cdr (cdr (car thread))))) + (setq gnus-tmp-gathered + (nconc (mapcar + (lambda (h) (mail-header-number (car h))) + (cdr (cdr (car thread)))) + gnus-tmp-gathered)) + (setcdr (cdr (car thread)) nil) (setq level -1 gnus-tmp-false-parent t)) ((eq gnus-summary-make-false-root 'empty) @@ -6983,8 +6992,6 @@ or a straight list of headers." ;; We may have to root out some bad articles... (cond - ((memq (setq number (mail-header-number header)) - gnus-newsgroup-dormant)) ((and gnus-summary-expunge-below (< (or (cdr (assq number gnus-newsgroup-scored)) gnus-summary-default-score 0) @@ -8375,7 +8382,6 @@ If optional argument UNREAD is non-nil, only unread article is selected." (if (not data) (message "Can't find article %d" article) (goto-char (gnus-data-pos data)) - (gnus-summary-show-thread) ;; Skip dummy articles. (if (eq (gnus-summary-article-mark) gnus-dummy-mark) (gnus-summary-find-next)) @@ -8795,9 +8801,9 @@ Returns how many articles were removed." (marks (append marks nil)) ; Transform to list. articles) (while data - (or (if reverse (not (memq (gnus-data-mark (car data)) marks)) - (memq (gnus-data-mark (car data)) marks)) - (setq articles (cons (gnus-data-number (car data)) articles))) + (and (if reverse (not (memq (gnus-data-mark (car data)) marks)) + (memq (gnus-data-mark (car data)) marks)) + (setq articles (cons (gnus-data-number (car data)) articles))) (setq data (cdr data))) (gnus-summary-limit articles))) (gnus-summary-position-point))) @@ -8906,8 +8912,9 @@ The difference between N and the number of articles fetched is returned." (let ((ref (mail-header-references (gnus-summary-article-header)))) (if (and ref (not (equal ref "")) (string-match "<[^<>]*>[ \t]*$" ref)) - (gnus-summary-refer-article - (substring ref (match-beginning 0) (match-end 0))) + (or (gnus-summary-refer-article + (substring ref (match-beginning 0) (match-end 0))) + (gnus-message 1 "Couldn't find parent")) (gnus-message 1 "No references in article %d" (gnus-summary-article-number)) nil))) @@ -9505,9 +9512,7 @@ functions. (Ie. mail newsgroups at present.)" (if (not (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)) () - (let* ((info (nth 2 (gnus-gethash gnus-newsgroup-name - gnus-newsrc-hashtb))) - (total (gnus-group-total-expirable-p gnus-newsgroup-name)) + (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) (expirable (if total (gnus-list-of-read-articles gnus-newsgroup-name) (setq gnus-newsgroup-expirable @@ -10466,39 +10471,37 @@ Returns nil if no threads were there to be hidden." (gnus-set-global-variables) (let ((buffer-read-only nil) (start (point)) - (level (gnus-summary-thread-level)) (article (gnus-summary-article-number)) (end (point))) ;; Go forward until either the buffer ends or the subthread ;; ends. (if (eobp) () - (while (and (gnus-summary-find-next) - (> (gnus-summary-thread-level) level)) - (setq end (point))) - (prog1 - (save-excursion - (goto-char end) - (search-backward "\n" start t)) - (subst-char-in-region start end ?\n ?\^M) - (gnus-summary-goto-subject article) - (gnus-summary-position-point))))) + (if (not (zerop (gnus-summary-next-thread 1))) + () + (gnus-summary-find-prev) + (prog1 + (save-excursion + (search-backward "\n" start t)) + (subst-char-in-region start (point) ?\n ?\^M) + (gnus-summary-goto-subject article) + (gnus-summary-position-point)))))) (defun gnus-summary-go-to-next-thread (&optional previous) "Go to the same level (or less) next thread. If PREVIOUS is non-nil, go to previous thread instead. Return the article number moved to, or nil if moving was impossible." - (let ((level (gnus-summary-thread-level)) - (article (gnus-summary-article-number))) - (if previous - (while (and (gnus-summary-find-prev) - (> (gnus-summary-thread-level) level))) - (while (and (gnus-summary-find-next) - (> (gnus-summary-thread-level) level)))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (let ((oart (gnus-summary-article-number))) - (and (/= oart article) oart)))) + (let* ((level (gnus-summary-thread-level)) + (article (gnus-summary-article-number)) + (data (cdr (gnus-data-find-list article (gnus-data-list previous)))) + oart) + (while data + (if (<= (gnus-data-level (car data)) level) + (setq oart (gnus-data-number (car data)) + data nil) + (setq data (cdr data)))) + (and oart + (gnus-summary-goto-subject oart)))) (defun gnus-summary-next-thread (n) "Go to the same level next N'th thread. @@ -11108,8 +11111,6 @@ is initialized from the SAVEDIR environment variable." (put 'gnus-article-mode 'mode-class 'special) -(defvar gnus-boogaboo nil) - (if gnus-article-mode-map nil (setq gnus-article-mode-map (make-keymap)) @@ -11153,7 +11154,7 @@ is initialized from the SAVEDIR environment variable." ;; "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve" ;; "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi" ))) - (while (and gnus-boogaboo commands) ; disabled + (while commands (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command) (setq commands (cdr commands)))) @@ -11161,7 +11162,7 @@ is initialized from the SAVEDIR environment variable." (let ((commands (list "q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" ;; "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "n" "^" "\M-^"))) - (while (and gnus-boogaboo commands) ; disabled + (while commands (define-key gnus-article-mode-map (car commands) 'gnus-article-summary-command-nosave) (setq commands (cdr commands))))) @@ -11308,8 +11309,9 @@ The following commands are available: ;; It was a pseudo. (t article))) (setq gnus-original-article (cons group article)) - (erase-buffer) - (insert-buffer gnus-original-article-buffer))) + (let (buffer-read-only) + (erase-buffer) + (insert-buffer-substring gnus-original-article-buffer)))) (defun gnus-read-header (id) "Read the headers of article ID and enter them into the Gnus system." @@ -11576,7 +11578,9 @@ Provided for backwards compatability." (interactive) (save-excursion (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil)) + (let ((buffer-read-only nil) + p) + (widen) (goto-char (point-min)) (search-forward "\n\n" nil t) (end-of-line 1) @@ -11676,6 +11680,29 @@ or not." (delete-char 1)) ((gnus-message 3 "Malformed MIME quoted-printable message")))))) +(defun gnus-article-hide-pgp () + "Hide any PGP headers and signatures in the current article." + (interactive) + (save-excursion + (set-buffer gnus-article-buffer) + (let (buffer-read-only) + (goto-char (point-min)) + ;; Hide the "header". + (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) + (add-text-properties (match-beginning 0) (match-end 0) + gnus-hidden-properties)) + ;; Hide the actual signature. + (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) + (add-text-properties + (match-beginning 0) + (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) + (match-end 0) + ;; Perhaps we shouldn't hide to the end of the buffer + ;; if there is no end to the signature? + (point-max)) + gnus-hidden-properties))))) + + (defvar gnus-article-time-units (list (cons 'year (* 365.25 24 60 60)) (cons 'week (* 7 24 60 60)) @@ -13525,7 +13552,9 @@ If FORCE is non-nil, the .newsrc file is read." (let (gnus-newsrc-assoc) (condition-case nil (load ding-file t t t) - (error nil)) + (error + (gnus-message 1 "Error in %s" ding-file) + (ding))) (and gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc))) (let ((inhibit-quit t)) (gnus-uncompress-newsrc-alist)) diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el index d4b5c6b5d..c7b397679 100644 --- a/lisp/nnbabyl.el +++ b/lisp/nnbabyl.el @@ -338,7 +338,7 @@ (goto-char (point-max)) (search-backward "\n\^_") (goto-char (match-end 0)) - (insert-buffer buf) + (insert-buffer-substring buf) (and last (progn (save-buffer) (nnmail-save-active diff --git a/lisp/nndir.el b/lisp/nndir.el index a6e3fe2ae..6ae862ba6 100644 --- a/lisp/nndir.el +++ b/lisp/nndir.el @@ -61,7 +61,7 @@ (defun nndir-retrieve-headers (sequence &optional group server fetch-old) (nndir-execute-nnml-command (` (nnml-retrieve-headers - (quote (, sequence)) (, group) (, server) (, fetch-old))))) + (quote (, sequence)) group (, server) (, fetch-old))))) (defun nndir-open-server (server &optional defs) (nnheader-init-server-buffer) @@ -96,11 +96,11 @@ (defun nndir-request-article (id &optional group server buffer) (nndir-execute-nnmh-command - (` (nnmh-request-article (, id) (, group) (, server) (, buffer))))) + (` (nnmh-request-article (, id) group (, server) (, buffer))))) (defun nndir-request-group (group &optional server dont-check) (nndir-execute-nnmh-command - (` (nnmh-request-group (, group) "" (, dont-check))))) + (` (nnmh-request-group group "" (, dont-check))))) (defun nndir-request-list (&optional server dir) (nndir-execute-nnmh-command @@ -116,12 +116,12 @@ (defun nndir-request-expire-articles (articles group &optional server force) (nndir-execute-nnmh-command - (` (nnmh-request-expire-articles (, articles) (, group) + (` (nnmh-request-expire-articles (, articles) group (, server) (, force))))) (defun nndir-request-accept-article (group &optional last) (nndir-execute-nnmh-command - (` (nnmh-request-accept-article (, group) (, last))))) + (` (nnmh-request-accept-article group (, last))))) (defun nndir-close-group (group &optional server) t) @@ -146,7 +146,7 @@ (setq dir (substring dir 0 (match-beginning 0)))) (string-match "/[^/]+$" dir) (let ((group (substring dir (1+ (match-beginning 0)))) - (nnmh-directory (substring dir 0 (1+ (match-beginning 0)))) + (nnmh-directory (substring dir 0 (1+ (match-beginning 0)))) (nnmh-get-new-mail nil)) (eval command)))) @@ -156,7 +156,7 @@ (setq dir (substring dir 0 (match-beginning 0)))) (string-match "/[^/]+$" dir) (let ((group (substring dir (1+ (match-beginning 0)))) - (nnml-directory (substring dir 0 (1+ (match-beginning 0)))) + (nnml-directory (substring dir 0 (1+ (match-beginning 0)))) (nnml-nov-is-evil nndir-nov-is-evil) (nnml-get-new-mail nil)) (eval command)))) diff --git a/lisp/nneething.el b/lisp/nneething.el index d5d2aae43..2446859cc 100644 --- a/lisp/nneething.el +++ b/lisp/nneething.el @@ -206,7 +206,7 @@ nneething-group nneething-map-file)) (defun nneething-create-mapping () - ;; Read nneething-active and nneething-map + ;; Read nneething-active and nneething-map. (let ((map-file (nneething-map-file)) (files (directory-files nneething-directory)) touched) @@ -242,7 +242,8 @@ (setq touched t) (setcdr nneething-active (1+ (cdr nneething-active))) (setq nneething-map - (cons (cons (car files) (cdr nneething-active)) nneething-map)))) + (cons (cons (car files) (cdr nneething-active)) + nneething-map)))) (setq files (cdr files))) (if (or (not touched) nneething-read-only) () diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el index d19d3555d..0c66b8aa0 100644 --- a/lisp/nnkiboze.el +++ b/lisp/nnkiboze.el @@ -37,6 +37,12 @@ (expand-file-name (or gnus-article-save-directory "~/News/")) "nnkiboze will put its files in this directory.") +(defvar nnkiboze-level 9 + "*The maximum level to be searched for articles.") + +(defvar nnkiboze-remove-read-articles t + "*If non-nil, nnkiboze will remove read articles from the kiboze group.") + (defconst nnkiboze-version "nnkiboze 1.0" @@ -145,7 +151,8 @@ If the stream is opened, return T, otherwise return NIL." (defun nnkiboze-close-group (group &optional server) (nnkiboze-possibly-change-newsgroups group) ;; Remove NOV lines of articles that are marked as read. - (if (not (file-exists-p (nnkiboze-nov-file-name))) + (if (or (not (file-exists-p (nnkiboze-nov-file-name))) + (not nnkiboze-remove-read-articles)) () (save-excursion (let ((unreads gnus-newsgroup-unreads) @@ -202,9 +209,15 @@ Finds out what articles are to be part of the nnkiboze groups." (gnus-expert-user t)) (gnus)) (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) - (newsrc gnus-newsrc-alist)) + (newsrc gnus-newsrc-alist) + gnus-newsrc-hashtb) + (gnus-make-hashtable-from-newsrc-alist) + ;; We have copied all the newsrc alist info over to local copies + ;; so that we can mess all we want with these lists. (while newsrc (if (string-match "nnkiboze" (car (car newsrc))) + ;; For each kiboze group, we call this function to generate + ;; it. (nnkiboze-generate-group (car (car newsrc)))) (setq newsrc (cdr newsrc))))) @@ -225,10 +238,12 @@ Finds out what articles are to be part of the nnkiboze groups." gnus-thread-sort-functions gnus-show-threads gnus-visual method nnkiboze-newsrc nov-buffer gname newsrc active - ginfo lowest) + ginfo lowest glevel) (setq nnkiboze-current-score-group group) (or info (error "No such group: %s" group)) + ;; Load the kiboze newsrc file for this group. (and (file-exists-p newsrc-file) (load newsrc-file)) + ;; We also load the nov file for this group. (save-excursion (set-buffer (setq nov-buffer (find-file-noselect nov-file))) (buffer-disable-undo (current-buffer))) @@ -236,37 +251,59 @@ Finds out what articles are to be part of the nnkiboze groups." ;; kiboze regexp. (mapatoms (lambda (group) - (if (and (string-match regexp (setq gname (symbol-name group))) ; Match - (not (assoc gname nnkiboze-newsrc)) ; It isn't registered - (numberp (car (symbol-value group))) ; It is active - (not (string-match "^nnkiboze:" gname))) ; Exclude kibozes - (setq nnkiboze-newsrc - (cons (cons gname (1- (car (symbol-value group)))) - nnkiboze-newsrc)))) + (and (string-match regexp (setq gname (symbol-name group))) ; Match + (not (assoc gname nnkiboze-newsrc)) ; It isn't registered + (numberp (car (symbol-value group))) ; It is active + (or (> nnkiboze-level 7) + (and (setq glevel (nth 1 (nth 2 (gnus-gethash + gname gnus-newsrc-hashtb)))) + (>= nnkiboze-level glevel))) + (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes + (setq nnkiboze-newsrc + (cons (cons gname (1- (car (symbol-value group)))) + nnkiboze-newsrc)))) gnus-active-hashtb) + ;; `newsrc' is set to the list of groups that possibly are + ;; component groups to this kiboze group. This list has elements + ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest + ;; number that has been kibozed in GROUP in this kiboze group. (setq newsrc nnkiboze-newsrc) (while newsrc (if (not (setq active (gnus-gethash (car (car newsrc)) gnus-active-hashtb))) + ;; This group isn't active after all, so we remove it from + ;; the list of component groups. (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) + (setq lowest (cdr (car newsrc))) + ;; Ok, we have a valid component group, so we jump to it. (switch-to-buffer gnus-group-buffer) (gnus-group-jump-to-group (car (car newsrc))) - (if (and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name) - gnus-newsrc-hashtb))) - (nth 3 ginfo)) - (setcar (nthcdr 3 ginfo) nil)) + ;; We set all list of article marks to nil. Since we operate + ;; on copies of the real lists, we can destroy anything we + ;; want here. + (and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name) + gnus-newsrc-hashtb))) + (nth 3 ginfo) + (setcar (nthcdr 3 ginfo) nil)) + ;; We set the list of read articles to be what we expect for + ;; this kiboze group -- either nil or `(1 . LOWEST)'. + (and ginfo (setcar (nthcdr 2 ginfo) + (and (not (= lowest 1)) (cons 1 lowest)))) (if (not (and (or (not ginfo) (> (length (gnus-list-of-unread-articles (car ginfo))) 0)) (progn (gnus-group-select-group nil) (eq major-mode 'gnus-summary-mode)))) - () - (setq lowest (cdr (car newsrc))) + () ; No unread articles, or we couldn't enter this group. + ;; We are now in the group where we want to be. (setq method (gnus-find-method-for-group gnus-newsgroup-name)) (and (eq method gnus-select-method) (setq method nil)) + ;; We go through the list of scored articles. (while gnus-newsgroup-scored (if (> (car (car gnus-newsgroup-scored)) lowest) + ;; If it has a good score, then we enter this article + ;; into the kiboze group. (nnkiboze-enter-nov nov-buffer (gnus-summary-article-header @@ -275,12 +312,15 @@ Finds out what articles are to be part of the nnkiboze groups." (gnus-group-prefixed-name gnus-newsgroup-name method) gnus-newsgroup-name))) (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) - (gnus-summary-quit))) + ;; That's it. We exit this group. + (gnus-summary-exit-no-update))) (setcdr (car newsrc) (car active)) (setq newsrc (cdr newsrc))) + ;; We save the nov file. (set-buffer nov-buffer) (save-buffer) (kill-buffer (current-buffer)) + ;; We save the kiboze newsrc for this group. (set-buffer (get-buffer-create "*nnkiboze work*")) (buffer-disable-undo (current-buffer)) (erase-buffer) diff --git a/lisp/nnml.el b/lisp/nnml.el index f68f6436a..b35c04514 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -180,10 +180,10 @@ all. This may very well take some time.") (file (and number (concat - nnml-current-directory - (if (numberp id) - (int-to-string number) - (car group-num))))) + (if (numberp id) + nnml-current-directory + (nnmail-article-pathname (car group-num) nnml-directory)) + (int-to-string number)))) (nntp-server-buffer (or buffer nntp-server-buffer))) (and file (file-exists-p file) @@ -457,7 +457,7 @@ all. This may very well take some time.") ;; start with the one in the current directory. It seems most ;; likely that the article we are looking for is in that group. (if (setq number (nnml-find-id nnml-current-group id)) - (cons nnml-current-group id) + (cons nnml-current-group number) ;; It wasn't there, so we look through the other groups as well. (while (and (not number) alist) @@ -470,7 +470,9 @@ all. This may very well take some time.") (defun nnml-find-id (group id) (erase-buffer) - (insert-file-contents (nnmail-article-pathname group nnml-directory)) + (insert-file-contents + (concat (nnmail-article-pathname group nnml-directory) + nnml-nov-file-name)) (let (number found) (while (and (not found) (search-forward id nil t)) ; We find the ID. diff --git a/lisp/x-easymenu.el b/lisp/x-easymenu.el new file mode 100644 index 000000000..3b3f40626 --- /dev/null +++ b/lisp/x-easymenu.el @@ -0,0 +1,354 @@ +;;; easymenu.el - Easy menu support for Emacs 19 and XEmacs. +;; +;; $Id: easymenu.el,v 5.9 1995/02/14 19:44:00 amanda Exp $ +;; +;; LCD Archive Entry: +;; easymenu|Per Abrahamsen|abraham@iesd.auc.dk| +;; Easy menu support for XEmacs| +;; $Date: 1995/02/14 19:44:00 $|$Revision: 5.9 $|~/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 +;;; easymenu.el - Easy menu support for Emacs 19 and XEmacs. +;; +;; $Id: easymenu.el,v 5.9 1995/02/14 19:44:00 amanda Exp $ +;; +;; LCD Archive Entry: +;; easymenu|Per Abrahamsen|abraham@iesd.auc.dk| +;; Easy menu support for XEmacs| +;; $Date: 1995/02/14 19:44:00 $|$Revision: 5.9 $|~/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 diff --git a/texi/Makefile b/texi/Makefile index 95df3cf78..700051608 100644 --- a/texi/Makefile +++ b/texi/Makefile @@ -14,3 +14,9 @@ dvi: gnus.texi refcard.dvi: refcard.tex $(LATEX) refcard.tex + +clean: + rm -f gnus.*.bak gnus.ky gnus.cp gnus.aux gnus.fn gnus.dvi gnus.cps gnus.kys gnus.log gnus.pg gnus.tp gnus.vr gnus.toc + +clean: + rm -f gnus.*.bak gnus.ky gnus.cp gnus.aux gnus.fn gnus.dvi gnus.cps gnus.kys gnus.log gnus.pg gnus.tp gnus.vr gnus.toc diff --git a/texi/gnus.texi b/texi/gnus.texi index 1a926881b..d1c53861e 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -103,13 +103,6 @@ luck. @sc{gnus} was written by Masanobu UMEDA. When autumn crept up in '94, Lars Magne Ingebrigtsen grew bored and decided to rewrite Gnus. -The recommended pronunciation of the name this program is "ding -guh-noose", with "ding" being half-sung in a loud, high-pitched voice, -and "guh-noose" being grumbled and a disaffected fashion. Any -irritation and/or damage this name may cause you is not the -responsibility of the author, even though you might like to strangle him -for the stupid idea. - If you want to investigate the person responsible for this outrage, you can point your (feh!) web browser to @file{http://www.ifi.uio.no/~larsi/}. This is also the primary @@ -229,11 +222,6 @@ Overall, a casual user who hasn't written much code that depends on @sc{gnus} internals should suffer no problems. If problems occur, please let me know (@kbd{M-x gnus-bug}). -Problems specific to GNU XEmacs can be reported to popineau@@ese-metz.fr -(Fabrice Popineau). I will just forward any such questions to him, -anyway, so you might have to wait longer if you mail XEmacs questions to -me. - @node Conformity @section Conformity @@ -289,7 +277,24 @@ don't hesitate to drop a note to Gnus Towers and let us know. @cindex Mule @cindex Emacs -Gnus should work on Emacs 19.26 and up, XEmacs 19.12 and up and Mule. +Gnus should work on : + +@itemize @bullet + +@item +Emacs 19.26 and up. + +@item +XEmacs 19.12 and up. + +@item +Mule versions based on Emacs 19.26 and up. + +@end itemize + +Gnus will absolutely not work on any Emacsen older than that. Not +reliably, at least. + There are some vague differences in what Gnus does, though: @itemize @bullet @@ -807,7 +812,7 @@ if you're in a hurry as well. @section Slave Gnusii @cindex slave -You might with to run more than one Emacs with more than one Gnus at the +You might want to run more than one Emacs with more than one Gnus at the same time. If you are using different @file{.newsrc} files (eg., if you are using the two different Gnusii to read from two different servers), that is no problem whatsoever. You just do it. @@ -816,12 +821,12 @@ The problem appears when you want to run two Gnusii that uses the same @code{.newsrc} file. To work around that problem some, we here at the Think-Tank at the Gnus -Towers have come up with a new concept: @dfn{Master} and -@dfn{servants}. (We have applied for a patent on this concept, and have -taken out a copyright on those words. If you wish to use those words in -conjunction with each other, you have to send ¢1 per usage to me. Usage -of the patent (@dfn{Master/Slave Relationships In Computer -Applications}), that will be much more expensive, of course.) +Towers have come up with a new concept: @dfn{Master} and @dfn{servants}. +(We have applied for a patent on this concept, and have taken out a +copyright on those words. If you wish to use those words in conjunction +with each other, you have to send ¢1 per usage to me. Usage of the +patent (@dfn{Master/Slave Relationships In Computer Applications}) will +be much more expensive, of course.) Anyways, you start one Gnus up the normal way with @kbd{M-x gnus} (or however you do it). Each subsequent slave Gnusii should be started with @@ -941,7 +946,7 @@ cheaper. This also means that you can get rid of the list of killed groups altogether, so you may set @code{gnus-save-killed-list} to @code{nil}, which will save time both at startup, at exit, and all over. Saves disk space, too. Why isn't this the default, then? -Unfortunately, not all servers support this function. +Unfortunately, not all servers support this function. This variable can also be a list of select methods. If so, Gnus will issue an @code{ask-server} command to each of the select methods, and @@ -2857,7 +2862,7 @@ Sort the groups according to the function given by the @code{gnus-group-sort-function} variable (@code{gnus-group-sort-groups}). Available sorting functions include: -@table +@table @code @item gnus-group-sort-by-level @findex gnus-group-sort-by-level @@ -3891,6 +3896,9 @@ you want to insert a funny quote, you could enter something like @code{(X-Yow . yow)} into the list. The function @code{yow} will then be called without any arguments. +The list contains a cons where the car of the cons is @code{optional}, +the cdr of this cons will only be inserted if it is non-@code{nil}. + Other variables for customizing outgoing articles: @table @code @@ -4215,12 +4223,12 @@ day, and send it when you feel its finished. @kindex C-c C-d (Mail) @kindex C-c C-d (Post) @findex gnus-enter-into-draft-group -@vindex gnus-group-draft-directory +@vindex gnus-draft-group-directory What you then do is simply push @kbd{C-c C-d} (@code{gnus-enter-into-draft-group}). This will put the current (unfinished) message in a special draft group (which is implemented as an @code{nndir} group, if you absolutely have to know) called -@samp{nndir:drafts}. The variable @code{gnus-group-draft-directory} +@samp{nndir:drafts}. The variable @code{gnus-draft-group-directory} controls both the name of the group and the location -- the leaf element in the path will be used as the name of the group. @@ -4378,14 +4386,14 @@ all yet. All the following marks mark articles as read. @table @samp -@item D +@item r Articles that are marked as read. They have a @samp{r} (@code{gnus-del-mark}) in the first column. These are articles that the user has marked as read more or less manually. -@item d +@item R Articles that are actually read are marked with @samp{R} (@code{gnus-read-mark}). -@item A +@item O Articles that were marked as read in previous sessions are now @dfn{old} and marked with @samp{O} (@code{gnus-ancient-mark}). @item K @@ -4492,11 +4500,13 @@ Mark all articles that have the same subject as the current one as read @item M C @kindex M C (Summary) @findex gnus-summary-catchup -Catchup the current group (@code{gnus-summary-catchup}). +Mark all unread articles in the group as read +(@code{gnus-summary-catchup}). @item M C-c @kindex M C-c (Summary) @findex gnus-summary-catchup-all -Catchup all articles in the current group (@code{gnus-summary-catchup-all}). +Mark all articles in the group as read - even the ticked and dormant +articles (@code{gnus-summary-catchup-all}). @item M H @kindex M H (Summary) @findex gnus-summary-catchup-to-here @@ -5699,7 +5709,7 @@ these articles easier. @cindex highlight Not only do you want your article buffer to look like fruit salad, but -you want it to look like techicolor fruit salad. +you want it to look like technicolor fruit salad. @table @kbd @@ -5754,8 +5764,8 @@ Regexp matching mangled SuperCite attribution lines. Minimum number of identical prefixes we have to see before we believe that it's a citation. -@item gnus-cire-attribution-prefix -@vindex gnus-cire-attribution-prefix +@item gnus-cite-attribution-prefix +@vindex gnus-cite-attribution-prefix Regexp matching the beginning of an attribution line. @item gnus-cite-addtribution-suffix @@ -5806,6 +5816,11 @@ Headers}. @findex gnus-article-hide-signature Hide signature (@code{gnus-article-hide-signature}). +@item W W p +@kindex W W p (Summary) +@findex gnus-article-hide-pgp +Hide @sc{pgp} signatures (@code{gnus-article-hide-pgp}). + @item W W c @kindex W W c (Summary) @findex gnus-article-hide-citation @@ -6201,9 +6216,10 @@ editing and make the changes permanent, type @kbd{C-c C-c} @item B q @kindex B q (Summary) -@findex gnus-summary-fancy-query -If you are using fancy splitting, this command will tell you where an -article would go (@code{gnus-summary-fancy-query}). +@findex gnus-summary-respool-query +If you want to respool an article, you might be curious as to what group +the article will end up in before you do the respooling. This command +will tell you (@code{gnus-summary-fancy-query}). @end table @node Various Summary Stuff @@ -6419,6 +6435,7 @@ rather stupid.) Any similarity to real events and people is purely coincidental. Ahem. + @node Customizing Articles @section Customizing Articles @cindex article customization @@ -6426,40 +6443,14 @@ Any similarity to real events and people is purely coincidental. Ahem. @vindex gnus-article-display-hook The @code{gnus-article-display-hook} is called after the article has been inserted into the article buffer. It is meant to handle all -treatment of the article before it is displayed. By default it contains -@code{gnus-article-hide-headers}, which hides unwanted headers. +treatment of the article before it is displayed. -@findex gnus-article-subcite -@findex gnus-article-hide-signature -@findex gnus-article-hide-citation -Other useful functions you might add to this hook is: - -@table @code - -@item gnus-article-hide-citation -Hide all cited text. - -@item gnus-article-hide-signature -Umn, hides the signature. - -@item gnus-article-treat-overstrike -Treat @samp{^H_} in a reasonable manner. - -@item gnus-article-maybe-highlight -Do some fancy article highlighting. - -@item gnus-article-highlight -Do lots of article highlighting. - -@item gnus-article-remove-cr -Removes trailing carriage returns. - -@item gnus-article-de-quoted-unreadable -Do naive decoding of articles encoded with Quoted-Printable. - -@item gnus-article-display-x-face -Displays any @code{X-Face} headers. -@end table +By default it contains @code{gnus-article-hide-headers}, +@code{gnus-article-treat-overstrike}, and +@code{gnus-article-maybe-highlight}, but there are thousands, nay +millions, of functions you can put in this hook. For an overview of +functions @xref{Article Highlighting}, @xref{Article Hiding}, +@xref{Article Washing}, @xref{Article Buttons} and @xref{Article Date}. You can, of course, write your own functions. The functions are called from the article buffer, and you can do anything you like, pretty much. @@ -6467,6 +6458,7 @@ There is no information that you have to keep in the buffer - you can change everything. However, you shouldn't delete any headers. Instead make them invisible if you want to make them go away. + @node Article Keymap @section Article Keymap @@ -6565,6 +6557,9 @@ you had to specify that for each group that used this server, that would be too much work, so Gnus offers a way of putting names to methods, which is what you do in the server buffer. +To enter the server buffer, user the @kbd{^} +(@code{gnus-group-enter-server-mode}) command in the group buffer. + @menu * Server Buffer Format:: You can customize the look of this buffer. * Server Commands:: Commands to manipulate servers. @@ -6738,42 +6733,56 @@ General score commands that don't actually change the score file: @kindex V s (Summary) @findex gnus-summary-set-score Set the score of the current article (@code{gnus-summary-set-score}). + @item V S @kindex V S (Summary) @findex gnus-summary-current-score Display the score of the current article (@code{gnus-summary-current-score}). + @item V t @kindex V t (Summary) @findex gnus-score-find-trace Display all score rules that have been used on the current article (@code{gnus-score-find-trace}). + @item V a @kindex V a (Summary) @findex gnus-summary-score-entry Add a new score entry, and allow specifying all elements (@code{gnus-summary-score-entry}). + @item V c @kindex V c (Summary) @findex gnus-score-change-score-file Make a different score file the current (@code{gnus-score-change-score-file}). + @item V e @kindex V e (Summary) @findex gnus-score-edit-alist Edit the current score file (@code{gnus-score-edit-alist}). You will be popped into a @code{gnus-score-mode} buffer (@pxref{Score File Editing}). + @item V f @kindex V f (Summary) @findex gnus-score-edit-file Edit a score file and make this score file the current one (@code{gnus-score-edit-file}). + +@item V C +@kindex V C (Summary) +@findex gnus-score-customize +Customize a score file in a visually pleasing manner +(@code{gnus-score-customize}). + @item I C-i @kindex I C-i (Summary) @findex gnus-summary-raise-score Increase the score of the current article (@code{gnus-summary-raise-score}). + @item L C-l @kindex L C-l (Summary) @findex gnus-summary-lower-score @@ -7074,7 +7083,10 @@ article and do the match on larger parts of the article: @samp{Body} will perform the match on the body of the article, @samp{Head} will perform the match on the head of the article, and @samp{All} will perform the match on the entire article. Note that using any of these -last three keys will slow down group entry @emph{considerably}. +last three keys will slow down group entry @emph{considerably}. The +final "header" you can score on is @samp{Followup}. These score entries +will result in new score entries being added for all follow-ups to +articles that matches these score entries. Following this key is a random number of score entries, where each score entry has one to four elements. @@ -7404,8 +7416,8 @@ holding our breath yet? @cindex kill files Gnus still supports those pesky old kill files. In fact, the kill file -entries can now be expiring, which is something I wrote before Per -thought of doing score files, so I've left the code in there. +entries can now be expiring, which is something I wrote before Daniel +Quinlan thought of doing score files, so I've left the code in there. In short, kill processing is a lot slower (and I do mean @emph{a lot}) than score processing, so it might be a good idea to rewrite your kill @@ -8491,7 +8503,7 @@ required-atom = mark / expunge / mark-and-expunge / files / exclude-files / read-only / touched optional-atom = adapt / local / eval mark = "mark" space nil-or-number -nil-or-t = "nil" / +nil-or-number = "nil" / expunge = "expunge" space nil-or-number mark-and-expunge = "mark-and-expunge" space nil-or-number files = "files" *[ space ] -- 2.25.1