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 / gnus-user-tale.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  11.0 KB  |  257 lines
  1. ;;; User Contributed Software for GNUS newsreader
  2. ;; Copyright (C) 1989 Masanobu UMEDA
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21. ;; The program in this file is contributed by tale@pawl.rpi.edu (David
  22. ;; C Lawrence), and is not part of the standard distribution of GNUS.
  23. ;; This may be included in the future releases of GNUS.  Please do not
  24. ;; send me any flame on it.
  25.  
  26. ;;Date: 28 Feb 89 02:41:31 GMT
  27. ;;From: tale@pawl.rpi.edu (David C Lawrence)
  28. ;;Organization: The Octagon Room
  29. ;;Subject: A different article mode-line
  30. ;;To: info-gnus-english@cis.ohio-state.edu
  31. ;;
  32. ;;Well, I've seen at least three other people ask for something like
  33. ;;this and I've also wanted it, so I went in and made some changes.
  34. ;;Basically, this is what the following code does:
  35. ;;
  36. ;; o One new function is added; others merely have their current
  37. ;;definitions modified to accept the new function.
  38. ;;
  39. ;; o The exception to the first point is gnus-Article-set-mode-line.
  40. ;;The way I have defined it is to show a modeline similar to this:
  41. ;;
  42. ;;--- GNUS: comp.theory.cell-automata  2 more  5:32pm 2.27[0]  (GNUS Article)--46%
  43. ;;
  44. ;;Note that comp.theory.cell-automata is one of the longest group names
  45. ;;and everything fits into the modeline happily; only one or two group
  46. ;;would break that.  
  47. ;;
  48. ;; o The display-time-string is there so because I like it for both
  49. ;;telling time and getting my mail notification.
  50. ;; 
  51. ;; o The percentage displayed on the mode line is how many lines of the
  52. ;;total buffer size are not beyond the bottom of the window, like more(1).
  53. ;;
  54. ;; o The "2 more" refers to how many unmarked articles remain in the
  55. ;;group. Spaces are printed if there are no more unmarked articles.
  56. ;;
  57. ;;I did the "2 more" thing rather than paging because knowing that the
  58. ;;range is {1191-2010} and that I am at 2009 is mostly useless to me;
  59. ;;since I follow subjects, which particular article I am on in the group
  60. ;;is meaningless as far as helping me predict when I'll be on my way to
  61. ;;the next group.
  62. ;;
  63. ;;This was only given non-rigourous, but seemingly adequate, testing.
  64. ;;If you find a problem with it, please let me know so I can improve it.
  65. ;;
  66. ;;Dave
  67.  
  68. (provide 'gnus-user-tale)
  69.  
  70. (setq gnus-Article-mode-hook
  71.       '(lambda ()
  72.          (make-local-variable 'gnus-Article-head-to-window-bottom)
  73.          (kill-local-variable 'global-mode-string)
  74.          (setq mode-line-format
  75.                (list (purecopy "")
  76.                      'mode-line-modified 'mode-line-buffer-identification
  77.                      (purecopy "  ")
  78.                      'global-mode-string
  79.                      (purecopy "  %[(")
  80.                      'mode-name 'minor-mode-alist "%n"
  81.                      (purecopy ")%]--")
  82.                      'gnus-Article-head-to-window-bottom
  83.                      (purecopy "-%-")))))
  84.  
  85. (defun gnus-Article-set-percent (&optional new-article)
  86.   "Set gnus-Article-head-to-window-bottom as a string which represents the
  87. percentage of total Article lines that are before the bottom of the window.
  88. Also forces mode-line update.  Optional NEW-ARTICLE is necessary when a new
  89. article is selected."
  90.   (save-excursion
  91.     (save-restriction
  92.       (setq gnus-Article-head-to-window-bottom
  93.             (if new-article
  94.                 (progn
  95. ;;                  (vertical-motion (- (screen-height)
  96. ;;                                      gnus-subject-lines-height 3))
  97.                   (vertical-motion (- (screen-height)
  98.                       (save-excursion
  99.                     (set-buffer gnus-Subject-buffer)
  100.                     (window-height))
  101.                       3))
  102.                   ;; The next bit is in case the last real line is
  103.                   ;; (will be) visible on the screen.
  104.                   (move-to-column (- (screen-width) 3))
  105.                   (if (not (eobp)) (forward-char 1))
  106.                   ;; Might only be at end-of-page
  107.                   (widen)
  108.                   (if (eobp) "All"
  109.                     (concat (/ (* 100 (count-lines (point-min) (point)))
  110.                                (count-lines (point-min) (point-max))) "%")))
  111.               (move-to-window-line (- (window-height) 2))
  112.               ;; Same deal as above
  113.               (move-to-column (- (window-width) 3))
  114.               (if (not (eobp)) (forward-char 1))
  115.               ;; Might only be at end-of-page
  116.               (widen)
  117.               (if (eobp) "Bot"
  118.                 (concat (/ (* 100 (count-lines (point-min) (point)))
  119.                            (count-lines (point-min) (point-max))) "%"))))))
  120.   (set-buffer-modified-p t))
  121.  
  122. (defun gnus-Article-set-mode-line ()
  123.   "Set Article mode line string."
  124.   (setq mode-line-buffer-identification
  125.     (list 17
  126.           (format "GNUS: %s  %s"
  127.               gnus-newsgroup-name
  128.                       (let ((unmarked (length (gnus-set-difference
  129.                                                gnus-newsgroup-unreads
  130.                                                gnus-newsgroup-marked))))
  131.                         (if (= 0 unmarked) "      "
  132.                           (concat unmarked " more"))))))
  133.   ;; Even if we did this when narrowing to page, do it again as a
  134.   ;; new article.
  135.   (gnus-Article-set-percent 1)
  136.   (set-buffer-modified-p t))
  137.  
  138. (defun gnus-Article-next-page (lines)
  139.   "Show next page of current article.
  140. If end of article, return non-nil. Otherwise return nil.
  141. Argument LINES specifies lines to be scrolled up."
  142.   (interactive "P")
  143.   (move-to-window-line -1)
  144.   (if (eobp)
  145.       (if (or (not gnus-break-pages)
  146.               (string-match "All\\|Bot" gnus-Article-head-to-window-bottom)
  147.           (save-restriction (widen) (eobp))) ;Real end-of-buffer?
  148.       t
  149.     (gnus-narrow-to-page 1)        ;Go to next page.
  150.     nil
  151.     )
  152.     (scroll-up lines)
  153.     (gnus-Article-set-percent)
  154.     nil
  155.     ))
  156.  
  157. (defun gnus-Article-prev-page (lines)
  158.   "Show previous page of current article.
  159. Argument LINES specifies lines to be scrolled down."
  160.   (interactive "P")
  161.   (move-to-window-line 0)
  162.   (if (and gnus-break-pages
  163.        (bobp)
  164.        (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
  165.       (progn
  166.     (gnus-narrow-to-page -1) ;Go to previous page.
  167.     (goto-char (point-max))
  168.     (recenter -1))
  169.     (scroll-down lines)
  170.     (gnus-Article-set-percent)))
  171.  
  172. ;; I don't want to copy the whole function to my gnus-etc.el, so just
  173. ;; rebind it here.  The only change the original function needs,
  174. ;; however is to include (gnus-Article-set-percent) as the last 
  175. ;; function called by gnus-narrow-to-page.
  176. (or (fboundp 'original-gnus-narrow-to-page)
  177.     (fset 'original-gnus-narrow-to-page
  178.           (symbol-function 'gnus-narrow-to-page)))
  179.  
  180. (defun gnus-narrow-to-page (&optional arg)
  181.   "Make text outside current page invisible except for page delimiter.
  182. A numeric arg specifies to move forward or backward by that many pages,
  183. thus showing a page other than the one point was originally in.
  184. NOTE: This function has been modified to also update the Article buffer
  185. mode-line after narrowing."
  186.   (interactive "P")
  187.   (setq arg (if arg (prefix-numeric-value arg) 0))
  188.   (original-gnus-narrow-to-page arg)
  189.   (gnus-Article-set-percent))
  190.  
  191. ;; This is a function which I have as my gnus-Save-newsrc-hook.  I like
  192. ;; it because it keeps my .newsrc and .newsrc.el trimmed down by not
  193. ;; letting unsubscribed groups build up long strings of marked article
  194. ;; ranges because of cross-posted articles.  (This saves over 14k on my
  195. ;; average newsrc.el size.)  It also keeps a fairly organized newsrc by
  196. ;; sorting unsubscribed groups alphabetically and putting them all at the
  197. ;; end of my newsrc.  It doesn't do anything to the order of subscribed
  198. ;; groups.   If you only desire one feature or the other you can call it
  199. ;; with the appropriate optional arguments.
  200.  
  201. ;;; Based on an idea by David.Detlefs@DLD.AVALON.CS.CMU.EDU
  202. ;;; Suitable for calling as a gnus-Save-newsrc-hook.
  203. (defun gnus-reorder-newsrc-file (&optional nosort nocompress)
  204.   (let (gnus-unsub-assoc reordered)
  205.     (save-excursion
  206.       (set-buffer (get-file-buffer gnus-current-startup-file))
  207.       (goto-char (point-max))
  208.       ;; protect against a totally unsubscribed .newsrc
  209.       (if (not (re-search-backward "^.*:" nil t)) nil
  210.         (re-search-forward "^.*! " nil t)
  211.         (setq gnus-unsub-assoc
  212.               (memq (assoc
  213.                      (buffer-substring (- (point) 2)
  214.                                        (progn (beginning-of-line) (point)))
  215.                      gnus-newsrc-assoc) gnus-newsrc-assoc))
  216.         (while (re-search-backward "^.*! " nil t)
  217.           (let ((position (point)) unsub-line)
  218.             (setq gnus-unsub-assoc
  219.                   (cons (assoc
  220.                          (buffer-substring
  221.                           (point) (progn (skip-chars-forward "^!") (point)))
  222.                          gnus-newsrc-assoc) gnus-unsub-assoc)
  223.                   unsub-line (buffer-substring position
  224.                                                (progn (beginning-of-line)
  225.                                                  (next-line 1) (point)))
  226.                   reordered t)
  227.             (delete-region position (point))
  228.             (goto-char (point-max)) (insert unsub-line) (goto-char position)))
  229.         (if (or nosort (not reordered)) nil
  230.           (sort-lines nil (progn (re-search-forward "! " nil t)
  231.                                  (beginning-of-line) (point)) (point-max))
  232.           (setq gnus-unsub-assoc (sort gnus-unsub-assoc 'gnus-assoc-lessp)))
  233.         (if nocompress nil
  234.           (goto-char (point-min))
  235.           (re-search-forward "! " nil t)
  236.           (while (re-search-forward "," nil t)
  237.             (let ((compress-group
  238.                    (assoc (buffer-substring
  239.                            (progn (beginning-of-line) (point))
  240.                            (progn (skip-chars-forward "^!") (point)))
  241.                           gnus-newsrc-assoc)) first-unread)
  242.               (delete-region (progn (skip-chars-forward "^-,") (point))
  243.                              (progn (end-of-line) (skip-chars-backward "^-,")
  244.                                     (point)))
  245.               (insert "-")
  246.               (setcdr (nth 2 compress-group)
  247.                       (cdr (nth (1- (length compress-group)) compress-group)))
  248.               (setcdr (memq (nth 2 compress-group) compress-group) nil))))
  249.         (setq gnus-newsrc-assoc
  250.               (append (gnus-set-difference gnus-newsrc-assoc gnus-unsub-assoc)
  251.                       gnus-unsub-assoc))))))
  252.  
  253. (defun gnus-assoc-lessp (list1 list2)
  254.   "Returns t if the car of LIST1 (a string) is less than the car of
  255. LIST2 by doing comparison with string-lessp."
  256.   (string-lessp (car list1) (car list2)))
  257.