Mercurial > emacs
view lisp/gnus/gnus-bcklg.el @ 109313:e856a274549b
Constify functions taking char *
* alloc.c (pending_malloc_warning, malloc_warning): Add const.
* callproc.c (relocate_fd, getenv_internal_1, getenv_internal)
(egetenv): Likewise.
* doprnt.c (doprnt): Likewise.
* editfns.c (set_time_zone_rule, format2): Likewise.
* emacs.c (decode_env_path): Likewise.
* eval.c (signal_error, error): Likewise.
* insdel.c (replace_range_2): Likewise.
* keyboard.c (cmd_error_internal): Likewise.
* lread.c (isfloat_string, make_symbol, dir_warning): Likewise.
* print.c (write_string, write_string_1, print_error_message):
Likewise.
* vm-limit.c (warn_function, memory_warnings): Likewise.
* xdisp.c (message1, message1_nolog, message_with_string)
(vmessage, message, message_nolog): Likewise.
* emacs.c: Remove duplicate declaration.
* keyboard.h: Likewise.
* lisp.h: Update prototypes.
author | Andreas Schwab <schwab@linux-m68k.org> |
---|---|
date | Sun, 11 Jul 2010 11:27:13 +0200 |
parents | 1d1d5d9bd884 |
children | 8d09094063d0 376148b31b5e |
line wrap: on
line source
;;; gnus-bcklg.el --- backlog functions for Gnus ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;;; Code: (eval-when-compile (require 'cl)) (require 'gnus) ;;; ;;; Buffering of read articles. ;;; (defvar gnus-backlog-buffer " *Gnus Backlog*") (defvar gnus-backlog-articles nil) (defvar gnus-backlog-hashtb nil) (defun gnus-backlog-buffer () "Return the backlog buffer." (or (get-buffer gnus-backlog-buffer) (save-excursion (set-buffer (gnus-get-buffer-create gnus-backlog-buffer)) (buffer-disable-undo) (setq buffer-read-only t) (get-buffer gnus-backlog-buffer)))) (defun gnus-backlog-setup () "Initialize backlog variables." (unless gnus-backlog-hashtb (setq gnus-backlog-hashtb (gnus-make-hashtable 1024)))) (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) (defun gnus-backlog-shutdown () "Clear all backlog variables and buffers." (interactive) (when (get-buffer gnus-backlog-buffer) (gnus-kill-buffer gnus-backlog-buffer)) (setq gnus-backlog-hashtb nil gnus-backlog-articles nil)) (defun gnus-backlog-enter-article (group number buffer) (when (and (numberp number) (not (string-match "^nnvirtual" group))) (gnus-backlog-setup) (let ((ident (intern (concat group ":" (int-to-string number)) gnus-backlog-hashtb)) b) (if (memq ident gnus-backlog-articles) () ; It's already kept. ;; Remove the oldest article, if necessary. (and (numberp gnus-keep-backlog) (>= (length gnus-backlog-articles) gnus-keep-backlog) (gnus-backlog-remove-oldest-article)) (push ident gnus-backlog-articles) ;; Insert the new article. (save-excursion (set-buffer (gnus-backlog-buffer)) (let (buffer-read-only) (goto-char (point-max)) (unless (bolp) (insert "\n")) (setq b (point)) (insert-buffer-substring buffer) ;; Tag the beginning of the article with the ident. (if (> (point-max) b) (gnus-put-text-property b (1+ b) 'gnus-backlog ident) (gnus-error 3 "Article %d is blank" number)))))))) (defun gnus-backlog-remove-oldest-article () (save-excursion (set-buffer (gnus-backlog-buffer)) (goto-char (point-min)) (if (zerop (buffer-size)) () ; The buffer is empty. (let ((ident (get-text-property (point) 'gnus-backlog)) buffer-read-only) ;; Remove the ident from the list of articles. (when ident (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) ;; Delete the article itself. (delete-region (point) (next-single-property-change (1+ (point)) 'gnus-backlog nil (point-max))))))) (defun gnus-backlog-remove-article (group number) "Remove article NUMBER in GROUP from the backlog." (when (numberp number) (gnus-backlog-setup) (let ((ident (intern (concat group ":" (int-to-string number)) gnus-backlog-hashtb)) beg end) (when (memq ident gnus-backlog-articles) ;; It was in the backlog. (save-excursion (set-buffer (gnus-backlog-buffer)) (let (buffer-read-only) (when (setq beg (text-property-any (point-min) (point-max) 'gnus-backlog ident)) ;; Find the end (i. e., the beginning of the next article). (setq end (next-single-property-change (1+ beg) 'gnus-backlog (current-buffer) (point-max))) (delete-region beg end) ;; Return success. t)) (setq gnus-backlog-articles (delq ident gnus-backlog-articles))))))) (defun gnus-backlog-request-article (group number &optional buffer) (when (and (numberp number) (not (string-match "^nnvirtual" group))) (gnus-backlog-setup) (let ((ident (intern (concat group ":" (int-to-string number)) gnus-backlog-hashtb)) beg end) (when (memq ident gnus-backlog-articles) ;; It was in the backlog. (save-excursion (set-buffer (gnus-backlog-buffer)) (if (not (setq beg (text-property-any (point-min) (point-max) 'gnus-backlog ident))) ;; It wasn't in the backlog after all. (ignore (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) ;; Find the end (i. e., the beginning of the next article). (setq end (next-single-property-change (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) (save-excursion (and buffer (set-buffer buffer)) (let ((buffer-read-only nil)) (erase-buffer) (insert-buffer-substring gnus-backlog-buffer beg end))) t)))) (provide 'gnus-bcklg) ;; arch-tag: 66259e56-505a-4bba-8a0d-3552c5b94e39 ;;; gnus-bcklg.el ends here