view lisp/=gnusmisc.el @ 26088:b7aa6ac26872

Add support for large files, 64-bit Solaris, system locale codings. * Makefile.in (emacs): Set the LC_ALL environment variable to "C" when dumping, so that the dumped Emacs doesn't have stray locale info. (dired.o): Depend on systime.h. (editfns.o): Depend on coding.h. * alloc.c, buffer.c, callproc.c, ccl.c, charset.c, coding.c, data.c, dispnew.c, editfns.c, emacs.c, filelock.c, floatfns.c, hftctl.c, keyboard.c, process.c, sysdep.c, unexelf.c, unexhp9k800.c, unexsunos4.c, vmsfns.c, vmsgmalloc.c, w32faces.c, w32menu.c, w32term.c, w32xfns.c, xfaces.c, xfns.c, xmenu.c, xterm.c: Include <config.h> before any system include files. * alloc.c, buffer.c, ccl.c, data.c, editfns.c, emacs.c, eval.c, fileio.c, filelock.c, frame.c, insdel.c, keymap.c, lread.c, m/alpha.h, print.c, search.c, sysdep.c, xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c: Do not include <stdlib.h>, as <config.h> does this now. * callproc.c (Fcall_process): Synchronize messages locale before invoking strerror. Decode resulting string with locale-coding-system. * coding.c (Vlocale_coding_system): New var. (syms_of_coding): Adjust to above change. (emacs_strerror): New function. * coding.h (emacs_strerror, Vlocale_coding_system): New decls. * config.in (HAVE_STDIO_EXT_H, HAVE_TM_GMTOFF, HAVE___FPENDING, HAVE_FTELLO, HAVE_GETLOADAVG, HAVE_MBLEN, HAVE_MBRLEN, HAVE_STRSIGNAL): New macros. (BITS_PER_LONG): Default to 64 if _LP64 is defined. <stdlib.h>: Include if HAVE_STDLIB_H is defined and NOT_C_CODE isn't. * dired.c: Include "systime.h". (Ffile_attributes): Do not cast s.st_size to int; this loses information if int is 32 bits but st_size and EMACS_INT are larger. Treat large device numbers like large inode numbers. * dispnew.c (PENDING_OUTPUT_COUNT): Use __fpending if available. * editfns.c: Include coding.h. (emacs_strftime): Remove decl. (emacs_strftimeu): New decl. (emacs_memftimeu): Renamed from emacs_memftime; new arg UT. Use emacs_strftimeu instead of emacs_strftime. (Fformat_time_string): Convert format string using Vlocale_coding_system, and convert result back. Synchronize time locale before invoking lower level function. Invoke emacs_memftimeu, passing ut, instead of emacs_memftime. * emacs.c: Include <locale.h> if HAVE_SETLOCALE is defined. (Vmessages_locale, Vprevious_messages_locale, Vtime_locale, Vprevious_time_locale): New variables. (main): Invoke setlocale early, so that initial error messages are localized properly. But skip locale-setting if LC_ALL is "C". Fix up locale when it's safe to do so. (fixup_locale): Moved here from xterm.c. (synchronize_locale, synchronize_time_locale, synchronize_messages_locale): New functions. (syms_of_emacs): Accommodate above changes. * fileio.c (report_file_error): Convert strerror output according to Vlocale_coding_system. (Finsert_file_contents): Check for arithmetic overflow in computations that depend on file size. Report IO errors with emacs_strerror, not strerror. * fns.c (Fgethash): Declare dflt parameter. * gmalloc.c: Do not define const to nothing if HAVE_CONFIG_H is defined; that's config.h's job. * lisp.h (EMACS_INT, BITS_PER_EMACS_INT, EMACS_UINT): If _LP64, default these values to long, BITS_PER_LONG, and unsigned long. (VALBITS, MARKBIT, XINT): Do not assume 32-bit EMACS_INT. (PNTR_COMPARISON_TYPE): Default to EMACS_UINT, not to unsigned int. (code_convert_string_norecord, fixup_locale, synchronize_messages_locale, synchronize_time_locale, emacs_open, emacs_close, emacs_read, emacs_write): New decls. All Emacs callers of open, close, read, write changed to use emacs_open, emacs_close, emacs_read, emacs_write. * lread.c (file_offset, file_tell): New macros. All uses of ftell changed to file_tell. (saved_doc_string_position, prev_saved_doc_string_position): Now of type file_offset. (init_lread): Do not fix locale here; fixup_locale now does this. * m/amdahl.h, s/usg5-4.h: (NSIG): Remove. (NSIG_MINIMUM): New macro. * m/cydra5.h, m/dpx2.h, m/mips.h, m/pfa50.h, m/sps7.h, m/stride.h, m/ustation.h, s/gnu-linux.h, s/hpux.h, s/iris3-5.h, s/iris3-6.h, s/umips.h, s/usg5-4.h: (SIGIO): Do not undef. (BROKEN_SIGIO): New macro. * m/ustation.h: (SIGTSTP): Do not undef. (BROKEN_SIGTSTP): New macro. * s/gnu-linux.h: (SIGPOLL, SIGURG): Do not undef. (BROKEN_SIGPOLL, BROKEN_SIGURG): New macros. * s/ptx4.h: (SIGINFO): Do not undef. (BROKEN_SIGINFO): New macros. * m/delta.h, s/ptx.h, s/template.h: Doc fix. * mktime.c, strftime.c: Update to glibc 2.1.2 version, with some Emacs-related changes merged. * print.c (float_to_string): Prepend "-" to representation of a NaN if the NaN is negative. * process.c (sys_siglist): Omit if HAVE_STRSIGNAL. (wait_reading_process_input): Use emacs_strerror, not strerror. * process.c (status_message, sigchld_handler): Synchronize locale, then use strsignal istead of sys_siglist. * w32proc.c (sys_wait): Likewise. * s/aix3-1.h, s/bsd4-1.h, s/dgux.h, s/gnu-linux.h, s/hiuxmpp.h, s/hpux.h, s/iris3-5.h, s/iris3-6.h, s/irix3-3.h, s/osf1.h, s/rtu.h, s/sunos4-1.h, s/unipl5-0.h, s/unipl5-2.h, s/usg5-0.h, s/usg5-2-2.h, s/usg5-2.h, s/usg5-3.h, s/xenix.h: (open, close, read, write, INTERRUPTIBLE_OPEN, INTERRUPTIBLE_CLOSE, INTERRUPTIBLE_IO): Remove. * s/sol2-5.h (_LARGEFILE_SOURCE, _FILE_OFFSET_BITS): New macros. * sysdep.c (sys_read, sys_write, read, write, sys_close, close, sys_open, open): Remove. (emacs_open, emacs_close, emacs_read, emacs_write): Always define; the old INTERRUPTIBLE_OPEN, INTERRUPTIBLE_CLOSE, and INTERRUPTIBLE_IO macros are no longer used. (emacs_open): Renamed from sys_open. Merge BSD4_1 version. (emacs_close): Renamed from sys_close. (emacs_read): Renamed from sys_read. (emacs_write): Renamed from sys_write. (sys_siglist): Do not declare if HAVE_STRSIGNAL. (dup2): Do not print error on failure; the real dup2 doesn't. (strsignal): New function, defined if !HAVE_STRSIGNAL. * syssignal.h (SIGINFO): Undef if defined and if BROKEN_SIGINFO is defined. (SIGIO, SIGPOLL, SIGTSTP, SIGURG): Likewise. (NSIG): If less than NSIG_MINIMUM, define to NSIG_MINIMUM. (strsignal): Declare if !HAVE_STRSIGNAL. * unexelf.c (ElfBitsW, ELFSIZE, ElfExpandBitsW): New macros. (ElfW): Define in terms of ElfExpandBitsW. * w32proc.c (sys_siglist): Remove decl. * xdisp.c (decode_mode_spec): 3rd arg is int, not char, to comply with ANSI C. (display_string): Declare face_string_pos arg. * xfns.c (Fx_show_tip): Declare timeout param. * xterm.c: No need to include locale.h. (x_alloc_lighter_color, x_setup_relief_color): Pass arg as double, not float, for compatibility with ANSI C. (fixup_locale): Move to emacs.c. (x_term_init): Do not setlocale or fixup locale; the main program does this now.

;;; gnusmisc.el --- miscellaneous commands for GNUS newsreader

;; Copyright (C) 1989, 1990, 1993 Free Software Foundation, Inc.

;; Author: Masanobu UMEDA <[e-mail]>
;; 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.

;;; Code:

(require 'gnus)

;;;
;;; GNUS Browse-Killed Mode
;;;

;; Some ideas are due to [e-mail] (Roland McGrath).
;; I'd like to thank him very much.

(defvar gnus-browse-killed-mode-hook nil
  "*A hook for GNUS Browse-Killed Mode.")

(defvar gnus-browse-killed-buffer "*Killed Newsgroup*")
(defvar gnus-browse-killed-mode-map nil)
(defvar gnus-winconf-browse-killed nil)

(autoload 'timezone-make-date-arpa-standard "timezone")

(put 'gnus-browse-killed-mode 'mode-class 'special)


;;;
;;; GNUS Browse-Killed Mode
;;;

;; Some ideas are due to [e-mail] (Roland McGrath).
;; I'd like to thank him very much.

;; Make the buffer to be managed by GNUS.

(or (memq gnus-browse-killed-buffer gnus-buffer-list)
    (setq gnus-buffer-list
	  (cons gnus-browse-killed-buffer gnus-buffer-list)))

(if gnus-browse-killed-mode-map
    nil
  (setq gnus-browse-killed-mode-map (make-keymap))
  (suppress-keymap gnus-browse-killed-mode-map t)
  (define-key gnus-browse-killed-mode-map " " 'gnus-group-next-group)
  (define-key gnus-browse-killed-mode-map "\177" 'gnus-group-prev-group)
  (define-key gnus-browse-killed-mode-map "\C-n" 'gnus-group-next-group)
  (define-key gnus-browse-killed-mode-map "\C-p" 'gnus-group-prev-group)
  (define-key gnus-browse-killed-mode-map "n" 'gnus-group-next-group)
  (define-key gnus-browse-killed-mode-map "p" 'gnus-group-prev-group)
  (define-key gnus-browse-killed-mode-map "y" 'gnus-browse-killed-yank)
  (define-key gnus-browse-killed-mode-map "\C-y" 'gnus-browse-killed-yank)
  (define-key gnus-browse-killed-mode-map "l" 'gnus-list-killed-groups)
  (define-key gnus-browse-killed-mode-map "q" 'gnus-browse-killed-exit)
  (define-key gnus-browse-killed-mode-map "\C-c\C-c" 'gnus-browse-killed-exit)
  (define-key gnus-browse-killed-mode-map "\C-c\C-i" 'gnus-info-find-node))

(defun gnus-browse-killed-mode ()
  "Major mode for browsing the killed newsgroups.
All normal editing commands are turned off.
Instead, these commands are available:
\\{gnus-browse-killed-mode-map}

The killed newsgroups are saved in the quick startup file (.newsrc.el)
unless it against the options line in the startup file (.newsrc).

Entry to this mode calls gnus-browse-killed-mode-hook with no arguments,
if that value is non-nil."
  (interactive)
  (kill-all-local-variables)
  ;; Gee.  Why don't you upgrade?
  (cond ((boundp 'mode-line-modified)
	 (setq mode-line-modified "--- "))
	((listp (default-value 'mode-line-format))
	 (setq mode-line-format
	       (cons "--- " (cdr (default-value 'mode-line-format)))))
	(t
	 (setq mode-line-format
	       "--- GNUS: Killed Newsgroups  %[(%m)%]----%3p-%-")))
  (setq major-mode 'gnus-browse-killed-mode)
  (setq mode-name "Browse-Killed")
  (setq mode-line-buffer-identification	"GNUS: Killed Newsgroups")
  (use-local-map gnus-browse-killed-mode-map)
  (buffer-flush-undo (current-buffer))
  (setq buffer-read-only t)		;Disable modification
  (run-hooks 'gnus-browse-killed-mode-hook))

(defun gnus-list-killed-groups ()
  "List the killed newsgroups.
The keys y and C-y yank the newsgroup on the current line into the
Newsgroups buffer."
  (interactive)
  (or gnus-killed-assoc
      (error "No killed newsgroups"))
  ;; Save current window configuration if this is first invocation..
  (or (get-buffer-window gnus-browse-killed-buffer)
      (setq gnus-winconf-browse-killed
	    (current-window-configuration)))
  ;; Prepare browsing buffer.
  (pop-to-buffer (get-buffer-create gnus-browse-killed-buffer))
  (gnus-browse-killed-mode)
  (let ((buffer-read-only nil)
	(killed-assoc gnus-killed-assoc))
    (erase-buffer)
    (while killed-assoc
      (insert (gnus-group-prepare-line (car killed-assoc)))
      (setq killed-assoc (cdr killed-assoc)))
    (goto-char (point-min))
    ))

(defun gnus-browse-killed-yank ()
  "Yank current newsgroup to Newsgroup buffer."
  (interactive)
  (let ((group (gnus-group-group-name)))
    (if group
	(let* ((buffer-read-only nil)
	       (killed (gnus-gethash group gnus-killed-hashtb)))
	  (pop-to-buffer gnus-group-buffer) ;Needed to adjust point.
	  (if killed
	      (gnus-group-insert-group killed))
	  (pop-to-buffer gnus-browse-killed-buffer)
	  (beginning-of-line)
	  (delete-region (point)
			 (progn (forward-line 1) (point)))
	  )))
  (gnus-browse-killed-check-buffer))

(defun gnus-browse-killed-check-buffer ()
  "Exit if the buffer is empty by deleting the window and killing the buffer."
  (and (null gnus-killed-assoc)
       (get-buffer gnus-browse-killed-buffer)
       (gnus-browse-killed-exit)))

(defun gnus-browse-killed-exit ()
  "Exit this mode by deleting the window and killing the buffer."
  (interactive)
  (and (get-buffer-window gnus-browse-killed-buffer)
       (delete-window (get-buffer-window gnus-browse-killed-buffer)))
  (kill-buffer gnus-browse-killed-buffer)
  ;; Restore previous window configuration if available.
  (and gnus-winconf-browse-killed
       (set-window-configuration gnus-winconf-browse-killed))
  (setq gnus-winconf-browse-killed nil))


;;;
;;; kill/yank newsgroup commands of GNUS Group Mode
;;;

(defun gnus-group-transpose-groups (arg)
  "Exchange current newsgroup and previous newsgroup.
With argument ARG, takes previous newsgroup and moves it past ARG newsgroup."
  (interactive "p")
  ;; BUG: last newsgroup and the last but one cannot be transposed
  ;; since gnus-group-search-forward does not move forward beyond the
  ;; last.  If we instead use forward-line, no problem, but I don't
  ;; want to use it for later extension.
  (while (> arg 0)
    (gnus-group-search-forward t t)
    (gnus-group-kill-group 1)
    (gnus-group-search-forward nil t)
    (gnus-group-yank-group)
    (gnus-group-search-forward nil t)
    (setq arg (1- arg))
    ))

(defun gnus-group-kill-region (begin end)
  "Kill newsgroups in current region (excluding current point).
The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
  (interactive "r")
  (let ((lines
	 ;; Exclude a line where current point is on.
	 (1-
	  ;; Count lines.
	  (save-excursion
	    (count-lines
	     (progn
	       (goto-char begin)
	       (beginning-of-line)
	       (point))
	     (progn
	       (goto-char end)
	       (end-of-line)
	       (point)))))))
    (goto-char begin)
    (beginning-of-line)			;Important when LINES < 1
    (gnus-group-kill-group lines)))

(defun gnus-group-kill-group (n)
  "Kill newsgroup on current line, repeated prefix argument N times.
The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
  (interactive "p")
  (let ((buffer-read-only nil)
	(group nil))
    (while (> n 0)
      (setq group (gnus-group-group-name))
      (or group
	  (signal 'end-of-buffer nil))
      (beginning-of-line)
      (delete-region (point)
		     (progn (forward-line 1) (point)))
      (gnus-kill-newsgroup group)
      (setq n (1- n))
      ;; Add to killed newsgroups in the buffer if exists.
      (if (get-buffer gnus-browse-killed-buffer)
	  (save-excursion
	    (set-buffer gnus-browse-killed-buffer)
	    (let ((buffer-read-only nil))
	      (goto-char (point-min))
	      (insert (gnus-group-prepare-line (car gnus-killed-assoc)))
	      )))
      )
    (search-forward ":" nil t)
    ))

(defun gnus-group-yank-group ()
  "Yank the last newsgroup killed with \\[gnus-group-kill-group],
inserting it before the newsgroup on the line containing point."
  (interactive)
  (gnus-group-insert-group (car gnus-killed-assoc))
  ;; Remove killed newsgroups from the buffer if exists.
  (if (get-buffer gnus-browse-killed-buffer)
      (save-excursion
	(set-buffer gnus-browse-killed-buffer)
	(let ((buffer-read-only nil))
	  (goto-char (point-min))
	  (delete-region (point-min)
			 (progn (forward-line 1) (point)))
	  )))
  (gnus-browse-killed-check-buffer))

(defun gnus-group-insert-group (info)
  "Insert newsgroup at current line using gnus-newsrc-assoc INFO."
  (if (null gnus-killed-assoc)
      (error "No killed newsgroups"))
  ;; Huuum.  It this right?
  ;;(if (not gnus-have-all-newsgroups)
  ;;    (error
  ;;     (substitute-command-keys
  ;;	"Not all newsgroups are displayed.  Type \\[gnus-group-list-all-groups] to display all newsgroups.")))
  (let ((buffer-read-only nil)
	(group (gnus-group-group-name)))
    (gnus-insert-newsgroup info group)
    (beginning-of-line)
    (insert (gnus-group-prepare-line info))
    (forward-line -1)
    (search-forward ":" nil t)
    ))


;;; Rewrite Date: field in GMT to local

(defun gnus-gmt-to-local ()
  "Rewrite Date: field described in GMT to local in current buffer.
The variable gnus-local-timezone is used for local time zone.
Intended to be used with gnus-article-prepare-hook."
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (narrow-to-region (point-min)
			(progn (search-forward "\n\n" nil 'move) (point)))
      (goto-char (point-min))
      (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
	  (let ((buffer-read-only nil)
		(date (buffer-substring (match-beginning 1) (match-end 1))))
	    (delete-region (match-beginning 1) (match-end 1))
	    (insert
	     (timezone-make-date-arpa-standard date nil gnus-local-timezone))
	    ))
      )))

(provide 'gnusmisc)

;;; gnusmisc.el ends here