| 1 | ;;; gnusmisc.el --- miscellaneous commands for GNUS newsreader |
| 2 | |
| 3 | ;; Copyright (C) 1989, 1990, 1993 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp> |
| 6 | ;; Keywords: news |
| 7 | |
| 8 | ;; This file is part of GNU Emacs. |
| 9 | |
| 10 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 11 | ;; it under the terms of the GNU General Public License as published by |
| 12 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 13 | ;; any later version. |
| 14 | |
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;; GNU General Public License for more details. |
| 19 | |
| 20 | ;; You should have received a copy of the GNU General Public License |
| 21 | ;; along with GNU Emacs; see the file COPYING. If not, write to |
| 22 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
| 23 | |
| 24 | ;;; Code: |
| 25 | |
| 26 | (require 'gnus) |
| 27 | |
| 28 | ;;; |
| 29 | ;;; GNUS Browse-Killed Mode |
| 30 | ;;; |
| 31 | |
| 32 | ;; Some ideas are due to roland@wheaties.ai.mit.edu (Roland McGrath). |
| 33 | ;; I'd like to thank him very much. |
| 34 | |
| 35 | (defvar gnus-browse-killed-mode-hook nil |
| 36 | "*A hook for GNUS Browse-Killed Mode.") |
| 37 | |
| 38 | (defvar gnus-browse-killed-buffer "*Killed Newsgroup*") |
| 39 | (defvar gnus-browse-killed-mode-map nil) |
| 40 | (defvar gnus-winconf-browse-killed nil) |
| 41 | |
| 42 | (autoload 'timezone-make-date-arpa-standard "timezone") |
| 43 | |
| 44 | (put 'gnus-browse-killed-mode 'mode-class 'special) |
| 45 | |
| 46 | \f |
| 47 | ;;; |
| 48 | ;;; GNUS Browse-Killed Mode |
| 49 | ;;; |
| 50 | |
| 51 | ;; Some ideas are due to roland@wheaties.ai.mit.edu (Roland McGrath). |
| 52 | ;; I'd like to thank him very much. |
| 53 | |
| 54 | ;; Make the buffer to be managed by GNUS. |
| 55 | |
| 56 | (or (memq gnus-browse-killed-buffer gnus-buffer-list) |
| 57 | (setq gnus-buffer-list |
| 58 | (cons gnus-browse-killed-buffer gnus-buffer-list))) |
| 59 | |
| 60 | (if gnus-browse-killed-mode-map |
| 61 | nil |
| 62 | (setq gnus-browse-killed-mode-map (make-keymap)) |
| 63 | (suppress-keymap gnus-browse-killed-mode-map t) |
| 64 | (define-key gnus-browse-killed-mode-map " " 'gnus-group-next-group) |
| 65 | (define-key gnus-browse-killed-mode-map "\177" 'gnus-group-prev-group) |
| 66 | (define-key gnus-browse-killed-mode-map "\C-n" 'gnus-group-next-group) |
| 67 | (define-key gnus-browse-killed-mode-map "\C-p" 'gnus-group-prev-group) |
| 68 | (define-key gnus-browse-killed-mode-map "n" 'gnus-group-next-group) |
| 69 | (define-key gnus-browse-killed-mode-map "p" 'gnus-group-prev-group) |
| 70 | (define-key gnus-browse-killed-mode-map "y" 'gnus-browse-killed-yank) |
| 71 | (define-key gnus-browse-killed-mode-map "\C-y" 'gnus-browse-killed-yank) |
| 72 | (define-key gnus-browse-killed-mode-map "l" 'gnus-list-killed-groups) |
| 73 | (define-key gnus-browse-killed-mode-map "q" 'gnus-browse-killed-exit) |
| 74 | (define-key gnus-browse-killed-mode-map "\C-c\C-c" 'gnus-browse-killed-exit) |
| 75 | (define-key gnus-browse-killed-mode-map "\C-c\C-i" 'gnus-info-find-node)) |
| 76 | |
| 77 | (defun gnus-browse-killed-mode () |
| 78 | "Major mode for browsing the killed newsgroups. |
| 79 | All normal editing commands are turned off. |
| 80 | Instead, these commands are available: |
| 81 | \\{gnus-browse-killed-mode-map} |
| 82 | |
| 83 | The killed newsgroups are saved in the quick startup file (.newsrc.el) |
| 84 | unless it against the options line in the startup file (.newsrc). |
| 85 | |
| 86 | Entry to this mode calls gnus-browse-killed-mode-hook with no arguments, |
| 87 | if that value is non-nil." |
| 88 | (interactive) |
| 89 | (kill-all-local-variables) |
| 90 | ;; Gee. Why don't you upgrade? |
| 91 | (cond ((boundp 'mode-line-modified) |
| 92 | (setq mode-line-modified "--- ")) |
| 93 | ((listp (default-value 'mode-line-format)) |
| 94 | (setq mode-line-format |
| 95 | (cons "--- " (cdr (default-value 'mode-line-format))))) |
| 96 | (t |
| 97 | (setq mode-line-format |
| 98 | "--- GNUS: Killed Newsgroups %[(%m)%]----%3p-%-"))) |
| 99 | (setq major-mode 'gnus-browse-killed-mode) |
| 100 | (setq mode-name "Browse-Killed") |
| 101 | (setq mode-line-buffer-identification "GNUS: Killed Newsgroups") |
| 102 | (use-local-map gnus-browse-killed-mode-map) |
| 103 | (buffer-flush-undo (current-buffer)) |
| 104 | (setq buffer-read-only t) ;Disable modification |
| 105 | (run-hooks 'gnus-browse-killed-mode-hook)) |
| 106 | |
| 107 | (defun gnus-list-killed-groups () |
| 108 | "List the killed newsgroups. |
| 109 | The keys y and C-y yank the newsgroup on the current line into the |
| 110 | Newsgroups buffer." |
| 111 | (interactive) |
| 112 | (or gnus-killed-assoc |
| 113 | (error "No killed newsgroups")) |
| 114 | ;; Save current window configuration if this is first invocation.. |
| 115 | (or (get-buffer-window gnus-browse-killed-buffer) |
| 116 | (setq gnus-winconf-browse-killed |
| 117 | (current-window-configuration))) |
| 118 | ;; Prepare browsing buffer. |
| 119 | (pop-to-buffer (get-buffer-create gnus-browse-killed-buffer)) |
| 120 | (gnus-browse-killed-mode) |
| 121 | (let ((buffer-read-only nil) |
| 122 | (killed-assoc gnus-killed-assoc)) |
| 123 | (erase-buffer) |
| 124 | (while killed-assoc |
| 125 | (insert (gnus-group-prepare-line (car killed-assoc))) |
| 126 | (setq killed-assoc (cdr killed-assoc))) |
| 127 | (goto-char (point-min)) |
| 128 | )) |
| 129 | |
| 130 | (defun gnus-browse-killed-yank () |
| 131 | "Yank current newsgroup to Newsgroup buffer." |
| 132 | (interactive) |
| 133 | (let ((group (gnus-group-group-name))) |
| 134 | (if group |
| 135 | (let* ((buffer-read-only nil) |
| 136 | (killed (gnus-gethash group gnus-killed-hashtb))) |
| 137 | (pop-to-buffer gnus-group-buffer) ;Needed to adjust point. |
| 138 | (if killed |
| 139 | (gnus-group-insert-group killed)) |
| 140 | (pop-to-buffer gnus-browse-killed-buffer) |
| 141 | (beginning-of-line) |
| 142 | (delete-region (point) |
| 143 | (progn (forward-line 1) (point))) |
| 144 | ))) |
| 145 | (gnus-browse-killed-check-buffer)) |
| 146 | |
| 147 | (defun gnus-browse-killed-check-buffer () |
| 148 | "Exit if the buffer is empty by deleting the window and killing the buffer." |
| 149 | (and (null gnus-killed-assoc) |
| 150 | (get-buffer gnus-browse-killed-buffer) |
| 151 | (gnus-browse-killed-exit))) |
| 152 | |
| 153 | (defun gnus-browse-killed-exit () |
| 154 | "Exit this mode by deleting the window and killing the buffer." |
| 155 | (interactive) |
| 156 | (and (get-buffer-window gnus-browse-killed-buffer) |
| 157 | (delete-window (get-buffer-window gnus-browse-killed-buffer))) |
| 158 | (kill-buffer gnus-browse-killed-buffer) |
| 159 | ;; Restore previous window configuration if available. |
| 160 | (and gnus-winconf-browse-killed |
| 161 | (set-window-configuration gnus-winconf-browse-killed)) |
| 162 | (setq gnus-winconf-browse-killed nil)) |
| 163 | |
| 164 | \f |
| 165 | ;;; |
| 166 | ;;; kill/yank newsgroup commands of GNUS Group Mode |
| 167 | ;;; |
| 168 | |
| 169 | (defun gnus-group-transpose-groups (arg) |
| 170 | "Exchange current newsgroup and previous newsgroup. |
| 171 | With argument ARG, takes previous newsgroup and moves it past ARG newsgroup." |
| 172 | (interactive "p") |
| 173 | ;; BUG: last newsgroup and the last but one cannot be transposed |
| 174 | ;; since gnus-group-search-forward does not move forward beyond the |
| 175 | ;; last. If we instead use forward-line, no problem, but I don't |
| 176 | ;; want to use it for later extension. |
| 177 | (while (> arg 0) |
| 178 | (gnus-group-search-forward t t) |
| 179 | (gnus-group-kill-group 1) |
| 180 | (gnus-group-search-forward nil t) |
| 181 | (gnus-group-yank-group) |
| 182 | (gnus-group-search-forward nil t) |
| 183 | (setq arg (1- arg)) |
| 184 | )) |
| 185 | |
| 186 | (defun gnus-group-kill-region (begin end) |
| 187 | "Kill newsgroups in current region (excluding current point). |
| 188 | The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." |
| 189 | (interactive "r") |
| 190 | (let ((lines |
| 191 | ;; Exclude a line where current point is on. |
| 192 | (1- |
| 193 | ;; Count lines. |
| 194 | (save-excursion |
| 195 | (count-lines |
| 196 | (progn |
| 197 | (goto-char begin) |
| 198 | (beginning-of-line) |
| 199 | (point)) |
| 200 | (progn |
| 201 | (goto-char end) |
| 202 | (end-of-line) |
| 203 | (point))))))) |
| 204 | (goto-char begin) |
| 205 | (beginning-of-line) ;Important when LINES < 1 |
| 206 | (gnus-group-kill-group lines))) |
| 207 | |
| 208 | (defun gnus-group-kill-group (n) |
| 209 | "Kill newsgroup on current line, repeated prefix argument N times. |
| 210 | The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." |
| 211 | (interactive "p") |
| 212 | (let ((buffer-read-only nil) |
| 213 | (group nil)) |
| 214 | (while (> n 0) |
| 215 | (setq group (gnus-group-group-name)) |
| 216 | (or group |
| 217 | (signal 'end-of-buffer nil)) |
| 218 | (beginning-of-line) |
| 219 | (delete-region (point) |
| 220 | (progn (forward-line 1) (point))) |
| 221 | (gnus-kill-newsgroup group) |
| 222 | (setq n (1- n)) |
| 223 | ;; Add to killed newsgroups in the buffer if exists. |
| 224 | (if (get-buffer gnus-browse-killed-buffer) |
| 225 | (save-excursion |
| 226 | (set-buffer gnus-browse-killed-buffer) |
| 227 | (let ((buffer-read-only nil)) |
| 228 | (goto-char (point-min)) |
| 229 | (insert (gnus-group-prepare-line (car gnus-killed-assoc))) |
| 230 | ))) |
| 231 | ) |
| 232 | (search-forward ":" nil t) |
| 233 | )) |
| 234 | |
| 235 | (defun gnus-group-yank-group () |
| 236 | "Yank the last newsgroup killed with \\[gnus-group-kill-group], |
| 237 | inserting it before the newsgroup on the line containing point." |
| 238 | (interactive) |
| 239 | (gnus-group-insert-group (car gnus-killed-assoc)) |
| 240 | ;; Remove killed newsgroups from the buffer if exists. |
| 241 | (if (get-buffer gnus-browse-killed-buffer) |
| 242 | (save-excursion |
| 243 | (set-buffer gnus-browse-killed-buffer) |
| 244 | (let ((buffer-read-only nil)) |
| 245 | (goto-char (point-min)) |
| 246 | (delete-region (point-min) |
| 247 | (progn (forward-line 1) (point))) |
| 248 | ))) |
| 249 | (gnus-browse-killed-check-buffer)) |
| 250 | |
| 251 | (defun gnus-group-insert-group (info) |
| 252 | "Insert newsgroup at current line using gnus-newsrc-assoc INFO." |
| 253 | (if (null gnus-killed-assoc) |
| 254 | (error "No killed newsgroups")) |
| 255 | ;; Huuum. It this right? |
| 256 | ;;(if (not gnus-have-all-newsgroups) |
| 257 | ;; (error |
| 258 | ;; (substitute-command-keys |
| 259 | ;; "Not all newsgroups are displayed. Type \\[gnus-group-list-all-groups] to display all newsgroups."))) |
| 260 | (let ((buffer-read-only nil) |
| 261 | (group (gnus-group-group-name))) |
| 262 | (gnus-insert-newsgroup info group) |
| 263 | (beginning-of-line) |
| 264 | (insert (gnus-group-prepare-line info)) |
| 265 | (forward-line -1) |
| 266 | (search-forward ":" nil t) |
| 267 | )) |
| 268 | |
| 269 | \f |
| 270 | ;;; Rewrite Date: field in GMT to local |
| 271 | |
| 272 | (defun gnus-gmt-to-local () |
| 273 | "Rewrite Date: field described in GMT to local in current buffer. |
| 274 | The variable gnus-local-timezone is used for local time zone. |
| 275 | Intended to be used with gnus-article-prepare-hook." |
| 276 | (save-excursion |
| 277 | (save-restriction |
| 278 | (widen) |
| 279 | (goto-char (point-min)) |
| 280 | (narrow-to-region (point-min) |
| 281 | (progn (search-forward "\n\n" nil 'move) (point))) |
| 282 | (goto-char (point-min)) |
| 283 | (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t) |
| 284 | (let ((buffer-read-only nil) |
| 285 | (date (buffer-substring (match-beginning 1) (match-end 1)))) |
| 286 | (delete-region (match-beginning 1) (match-end 1)) |
| 287 | (insert |
| 288 | (timezone-make-date-arpa-standard date nil gnus-local-timezone)) |
| 289 | )) |
| 290 | ))) |
| 291 | |
| 292 | (provide 'gnusmisc) |
| 293 | |
| 294 | ;;; gnusmisc.el ends here |