home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / gnus / gnusmisc.el < prev    next >
Encoding:
Text File  |  1992-12-28  |  9.1 KB  |  262 lines
  1. ;;; Miscellaneous commands for GNUS newsreader
  2. ;; Copyright (C) 1989 Fujitsu Laboratories LTD.
  3. ;; Copyright (C) 1989, 1990 Masanobu UMEDA
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  9. ;; accepts responsibility to anyone for the consequences of using it
  10. ;; or for whether it serves any particular purpose or works at all,
  11. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12. ;; License for full details.
  13.  
  14. ;; Everyone is granted permission to copy, modify and redistribute
  15. ;; GNU Emacs, but only under the conditions described in the
  16. ;; GNU Emacs General Public License.   A copy of this license is
  17. ;; supposed to have been given to you along with GNU Emacs so you
  18. ;; can know your rights and responsibilities.  It should be in a
  19. ;; file named COPYING.  Among other things, the copyright notice
  20. ;; and this notice must be preserved on all copies.
  21.  
  22. (provide 'gnusmisc)
  23. (require 'gnus)
  24.  
  25. (defvar gnus-Browse-killed-mode-hook nil
  26.   "*A hook for GNUS Browse-Killed Mode.")
  27.  
  28. (defvar gnus-Browse-killed-buffer "*Killed Newsgroup*")
  29. (defvar gnus-Browse-killed-mode-map nil)
  30. (defvar gnus-winconf-browse-killed nil)
  31.  
  32. (autoload 'timezone-make-date-arpa-standard "timezone")
  33.  
  34. (put 'gnus-Browse-killed-mode 'mode-class 'special)
  35.  
  36. ;;;
  37. ;;; GNUS Browse-Killed Mode
  38. ;;;
  39.  
  40. ;; Some ideas are due to roland@wheaties.ai.mit.edu (Roland McGrath).
  41. ;; I'd like to thank him very much.
  42.  
  43. ;; Make the buffer to be managed by GNUS.
  44.  
  45. (or (memq gnus-Browse-killed-buffer gnus-buffer-list)
  46.     (setq gnus-buffer-list
  47.       (cons gnus-Browse-killed-buffer gnus-buffer-list)))
  48.  
  49. (if gnus-Browse-killed-mode-map
  50.     nil
  51.   (setq gnus-Browse-killed-mode-map (make-keymap))
  52.   (suppress-keymap gnus-Browse-killed-mode-map t)
  53.   (define-key gnus-Browse-killed-mode-map " " 'gnus-Group-next-group)
  54.   (define-key gnus-Browse-killed-mode-map "\177" 'gnus-Group-prev-group)
  55.   (define-key gnus-Browse-killed-mode-map "\C-n" 'gnus-Group-next-group)
  56.   (define-key gnus-Browse-killed-mode-map "\C-p" 'gnus-Group-prev-group)
  57.   (define-key gnus-Browse-killed-mode-map "n" 'gnus-Group-next-group)
  58.   (define-key gnus-Browse-killed-mode-map "p" 'gnus-Group-prev-group)
  59.   (define-key gnus-Browse-killed-mode-map "y" 'gnus-Browse-killed-yank)
  60.   (define-key gnus-Browse-killed-mode-map "\C-y" 'gnus-Browse-killed-yank)
  61.   (define-key gnus-Browse-killed-mode-map "l" 'gnus-Browse-killed-groups)
  62.   (define-key gnus-Browse-killed-mode-map "q" 'gnus-Browse-killed-exit)
  63.   (define-key gnus-Browse-killed-mode-map "\C-c\C-c" 'gnus-Browse-killed-exit)
  64.   (define-key gnus-Browse-killed-mode-map "\C-c\C-i" 'gnus-Info-find-node))
  65.  
  66. (defun gnus-Browse-killed-mode ()
  67.   "Major mode for browsing the killed newsgroups.
  68. All normal editing commands are turned off.
  69. Instead, these commands are available:
  70. \\{gnus-Browse-killed-mode-map}
  71.  
  72. The killed newsgroups are saved in the quick startup file (.newsrc.el)
  73. unless it against the options line in the startup file (.newsrc).
  74.  
  75. Entry to this mode calls gnus-Browse-killed-mode-hook with no arguments,
  76. if that value is non-nil."
  77.   (interactive)
  78.   (kill-all-local-variables)
  79.   ;; Gee.  Why don't you upgrade?
  80.   (cond ((boundp 'mode-line-modified)
  81.      (setq mode-line-modified "--- "))
  82.     ((listp (default-value 'mode-line-format))
  83.      (setq mode-line-format
  84.            (cons "--- " (cdr (default-value 'mode-line-format)))))
  85.     (t
  86.      (setq mode-line-format
  87.            "--- GNUS: Killed Newsgroups  %[(%m)%]----%3p-%-")))
  88.   (setq major-mode 'gnus-Browse-killed-mode)
  89.   (setq mode-name "Browse-Killed")
  90.   (setq mode-line-buffer-identification    "GNUS: Killed Newsgroups")
  91.   (use-local-map gnus-Browse-killed-mode-map)
  92.   (buffer-disable-undo (current-buffer))
  93.   (setq buffer-read-only t)        ;Disable modification
  94.   (run-hooks 'gnus-Browse-killed-mode-hook))
  95.  
  96. (defun gnus-Browse-killed-groups ()
  97.   "Browse the killed newsgroups.
  98. The keys y and C-y yank the newsgroup on the current line into the
  99. Newsgroups buffer."
  100.   (interactive)
  101.   (or gnus-killed-assoc
  102.       (error "No killed newsgroups"))
  103.   ;; Save current window configuration if this is first invocation..
  104.   (or (get-buffer-window gnus-Browse-killed-buffer)
  105.       (setq gnus-winconf-browse-killed
  106.         (current-window-configuration)))
  107.   ;; Prepare browsing buffer.
  108.   (gnus-pop-to-buffer (get-buffer-create gnus-Browse-killed-buffer))
  109.   (gnus-Browse-killed-mode)
  110.   (let ((buffer-read-only nil)
  111.     (killed-assoc gnus-killed-assoc))
  112.     (erase-buffer)
  113.     (while killed-assoc
  114.       (insert (gnus-Group-prepare-line (car killed-assoc)))
  115.       (setq killed-assoc (cdr killed-assoc)))
  116.     (goto-char (point-min))
  117.     ))
  118.  
  119. (defun gnus-Browse-killed-yank ()
  120.   "Yank current newsgroup to Newsgroup buffer."
  121.   (interactive)
  122.   (let ((group (gnus-Group-group-name)))
  123.     (if group
  124.     (let* ((buffer-read-only nil)
  125.            (killed (assoc group gnus-killed-assoc)))
  126.       (gnus-pop-to-buffer gnus-Group-buffer) ;Needed to adjust point.
  127.       (if killed
  128.           (gnus-Group-insert-group killed))
  129.       (gnus-pop-to-buffer gnus-Browse-killed-buffer)
  130.       (beginning-of-line)
  131.       (delete-region (point)
  132.              (progn (forward-line 1) (point)))
  133.       )))
  134.   (gnus-Browse-killed-check-buffer))
  135.  
  136. (defun gnus-Browse-killed-check-buffer ()
  137.   "Exit if the buffer is empty by deleting the window and killing the buffer."
  138.   (and (null gnus-killed-assoc)
  139.        (get-buffer gnus-Browse-killed-buffer)
  140.        (gnus-Browse-killed-exit)))
  141.  
  142. (defun gnus-Browse-killed-exit ()
  143.   "Exit this mode by deleting the window and killing the buffer."
  144.   (interactive)
  145.   (and (get-buffer-window gnus-Browse-killed-buffer)
  146.        (delete-window (get-buffer-window gnus-Browse-killed-buffer)))
  147.   (kill-buffer gnus-Browse-killed-buffer)
  148.   ;; Restore previous window configuration if available.
  149.   (and gnus-winconf-browse-killed
  150.        (set-window-configuration gnus-winconf-browse-killed))
  151.   (setq gnus-winconf-browse-killed nil))
  152.  
  153.  
  154. ;;;
  155. ;;; kill/yank newsgroup commands of GNUS Group Mode
  156. ;;;
  157.  
  158. (defun gnus-Group-kill-region (begin end)
  159.   "Kill newsgroups in current region (excluding current point).
  160. The killed newsgroups can be yanked by using \\[gnus-Group-yank-group]."
  161.   (interactive "r")
  162.   (let ((lines
  163.      ;; Exclude a line where current point is on.
  164.      (1-
  165.       ;; Count lines.
  166.       (save-excursion
  167.         (count-lines
  168.          (progn
  169.            (goto-char begin)
  170.            (beginning-of-line)
  171.            (point))
  172.          (progn
  173.            (goto-char end)
  174.            (end-of-line)
  175.            (point)))))))
  176.     (goto-char begin)
  177.     (beginning-of-line)            ;Important when LINES < 1
  178.     (gnus-Group-kill-group lines)))
  179.  
  180. (defun gnus-Group-kill-group (n)
  181.   "Kill newsgroup on current line, repeated prefix argument N times.
  182. The killed newsgroups can be yanked by using \\[gnus-Group-yank-group]."
  183.   (interactive "p")
  184.   (let ((buffer-read-only nil)
  185.     (group nil))
  186.     (while (> n 0)
  187.       (setq group (gnus-Group-group-name))
  188.       (or group
  189.       (signal 'end-of-buffer nil))
  190.       (beginning-of-line)
  191.       (delete-region (point)
  192.              (progn (forward-line 1) (point)))
  193.       (gnus-kill-newsgroup group)
  194.       (setq n (1- n))
  195.       ;; Add to killed newsgroups in the buffer if exists.
  196.       (if (get-buffer gnus-Browse-killed-buffer)
  197.       (save-excursion
  198.         (set-buffer gnus-Browse-killed-buffer)
  199.         (let ((buffer-read-only nil))
  200.           (goto-char (point-min))
  201.           (insert (gnus-Group-prepare-line (car gnus-killed-assoc)))
  202.           )))
  203.       )
  204.     (search-forward ":" nil t)
  205.     ))
  206.  
  207. (defun gnus-Group-yank-group ()
  208.   "Yank the last newsgroup killed with \\[gnus-Group-kill-group],
  209. inserting it before the newsgroup on the line containging point."
  210.   (interactive)
  211.   (gnus-Group-insert-group (car gnus-killed-assoc))
  212.   ;; Remove killed newsgroups from the buffer if exists.
  213.   (if (get-buffer gnus-Browse-killed-buffer)
  214.       (save-excursion
  215.     (set-buffer gnus-Browse-killed-buffer)
  216.     (let ((buffer-read-only nil))
  217.       (goto-char (point-min))
  218.       (delete-region (point-min)
  219.              (progn (forward-line 1) (point)))
  220.       )))
  221.   (gnus-Browse-killed-check-buffer))
  222.  
  223. (defun gnus-Group-insert-group (info)
  224.   "Insert newsgroup at current line using gnus-newsrc-assoc INFO."
  225.   (if (null gnus-killed-assoc)
  226.       (error "No killed newsgroups"))
  227.   (if (not gnus-have-all-newsgroups)
  228.       (error
  229.        (substitute-command-keys
  230.     "Not all newsgroups are displayed.  Type \\[gnus-Group-list-all-groups] to display all newsgroups.")))
  231.   (let ((buffer-read-only nil)
  232.     (group (gnus-Group-group-name)))
  233.     (gnus-insert-newsgroup info group)
  234.     (beginning-of-line)
  235.     (insert (gnus-Group-prepare-line info))
  236.     (forward-line -1)
  237.     (search-forward ":" nil t)
  238.     ))
  239.  
  240.  
  241. ;;; Rewrite Date: field in GMT to local
  242.  
  243. (defun gnus-gmt-to-local ()
  244.   "Rewrite Date: field described in GMT to local in current buffer.
  245. The variable gnus-local-timezone is used for local time zone.
  246. Intended to be used with gnus-Article-prepare-hook."
  247.   (save-excursion
  248.     (save-restriction
  249.       (widen)
  250.       (goto-char (point-min))
  251.       (narrow-to-region (point-min)
  252.             (progn (search-forward "\n\n" nil 'move) (point)))
  253.       (goto-char (point-min))
  254.       (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
  255.       (let ((buffer-read-only nil)
  256.         (date (buffer-substring (match-beginning 1) (match-end 1))))
  257.         (delete-region (match-beginning 1) (match-end 1))
  258.         (insert
  259.          (timezone-make-date-arpa-standard date nil gnus-local-timezone))
  260.         ))
  261.       )))
  262.